Table of Contents

BCUSE

Table Of Contents

Source Code

BCUSE.txt 
  1. BCUSE 
  2. * /---   FILE TYPE = E
  3. * /---   BLOCK      BCUSE      00 000   80/06/27  12.07 
  4.       PROGRAM BCUSE(BBC,TAPE1=BBC,TAPE2,TAPE3,TAPE10) 
  5. C     PUBLISHED LESSON USAGE OUTPUT TO BE PF TO DATASET 
  6. C     FOR COURSEWARE SERVICES 
  7. C 
  8. C --- PROGRAM TO PREPARE DATA ABOUT THE USAGE TIME FOR
  9. C --- LESSONS IN PARTICULAR ACCOUNTS.  THE RESULTS ARE
  10. C --- *PF*ED BACK INTO A DATASET. 
  11. C 
  12. C --- TAPE1 (BC) IS THE DATA (FROM RAFPBC AND ASM1) ABOUT 
  13. C ---        LESSON USAGE.
  14. C 
  15. C --- TAPE2 IS THE LIST OF SELECTED LESSON ACCOUNTS ABOUT 
  16. C ---        WHICH DATA IS TO BE GATHERED.  IT IS A BLOCK 
  17. C ---        IN THIS FILE CALLED *PARAMETERS* AND IS *PF*ED 
  18. C ---        OUT TO THE LOCAL FILE (TAPE2).  IT IS ALSO USED
  19. C ---        AS THE UNSORTED DATA ABOUT THE SPECIFIED ACCTS.
  20. C 
  21. C --- TAPE3 IS THE TEMPORARY FILE, WHERE THE LESSONS FROM 
  22. C ---        THE SELECTED ACCOUNTS ARE STORED IN ALPHABETIC 
  23. C ---        ORDER, TO BE SORTED LATER BY DESCENDING ORDER
  24. C ---        OF USAGE TIME. 
  25. C 
  26. C --- TAPE10 IS THE SORTED VERSION OF TAPE3.
  27. C 
  28.       DIMENSION LINE(8) 
  29. C 
  30.       INTEGER ACCTS(500)
  31. C 
  32.       EXTERNAL ADD
  33. C 
  34.       DATA NACCTS/1/,KOUNT/0/,ACCTS/500*0/
  35. C 
  36. C --- READ IN THE LIST OF ACCOUNTS (MAXIMUM OF 500) 
  37. C 
  38.       REWIND 2
  39. C 
  40.  1    CONTINUE
  41.       READ (2,2) ACCTS(NACCTS)
  42.  2    FORMAT (A7) 
  43.       IF (EOF(2)) 4, 3
  44.  3    CONTINUE
  45.       NACCTS = NACCTS + 1 
  46.       IF (NACCTS .EQ. 501) GO TO 4
  47.       GO TO 1 
  48. C 
  49. C --- MAKE *NACCTS* RIGHT SIZE
  50. C 
  51.  4    CONTINUE
  52. C 
  53.       NACCTS = NACCTS - 1 
  54. C 
  55. C --- PULL THE SELECTED ACCOUNTS FROM TAPE1 AND WRITE ON
  56. C --- TAPE2 (SINCE THE SPECIFIED ACCOUNTS HAVE BEEN READ).
  57. C 
  58.       REWIND 1
  59.       REWIND 2
  60. C 
  61.  10   CONTINUE
  62.       READ (1,11) LINE
  63.  11   FORMAT (3A10,A4,A10,A7,2F10.3)
  64.       IF (EOF(1)) 15, 12
  65.  12   CONTINUE
  66.       DO 14 INDEX = 1, NACCTS 
  67.       IF (ACCTS(INDEX) .NE. LINE(6)) GO TO 14 
  68.       WRITE (2,13) LINE(5), LINE(7) 
  69.  13   FORMAT (A10,F8.3) 
  70.       GO TO 10
  71.  14   CONTINUE
  72.       GO TO 10
  73. C 
  74. C --- NOW REWIND AND SORT TAPE2 BY LESSON NAME, 
  75. C --- ADDING ALL RECORDS WITH DUPLICATE KEYS, 
  76. C --- AND WRITE THE RESULTS ON TAPE3. 
  77. C 
  78.  15   CONTINUE
  79.       REWIND 2
  80.       REWIND 3
  81. C 
  82.       CALL SM5SORT(0) 
  83.       CALL SM5FROM("TAPE2") 
  84.       CALL SM5TO("TAPE3") 
  85.       CALL SM5KEY(1,10,"DISPLAY","A") 
  86.       CALL SM5OWN5(ADD) 
  87.       CALL SM5END 
  88. C 
  89. C --- NOW SORT TAPE3 BY THE SECOND FIELD, USAGE TIME, 
  90. C --- IN ASCENDING ORDER AND PUT THE RESULTS ON TAPE10. 
  91. C 
  92.       REWIND 3
  93.       REWIND 10 
  94. C 
  95.       CALL SM5SORT(0) 
  96.       CALL SM5FROM("TAPE3") 
  97.       CALL SM5TO("TAPE10")
  98.       CALL SM5KEY(11,8,"COBOL6","D")
  99.       CALL SM5END 
  100. C 
  101.       STOP
  102.       END 
  103. * /---   BLOCK      ADD        00 000   78/11/16  10.07 
  104.       SUBROUTINE ADD(IRC,L1,LR1,L2,LR2) 
  105. C 
  106. C --- SUBROUTINE TO ADD THE TIMES OF TWO RECORDS WITH THE 
  107. C --- SAME SORTING KEYS.  CALLING ROUTINE MUST HAVE AN
  108. C --- *EXTERNAL ADD* STATEMENT FOR THIS TO WORK.
  109. C 
  110.       DIMENSION L1(2), L2(2)
  111. C 
  112.       DECODE (18,10,L1) NAME, TIME1 
  113.  10   FORMAT (A10,F8.3) 
  114.       DECODE (18,11,L2) TIME2 
  115.  11   FORMAT (10X,F8.3) 
  116. C 
  117.       TIME1 = TIME1 + TIME2 
  118. C 
  119.       ENCODE (18,10,L1) NAME, TIME1 
  120. C 
  121. C     SET FLAG TO REPLACE RECORD. 
  122. C 
  123.       IRC = 1 
  124. C 
  125.       RETURN
  126.       END