Retro1.org codex

BCUSE 
* /---   FILE TYPE = E
* /---   BLOCK      BCUSE      00 000   80/06/27  12.07 
      PROGRAM BCUSE(BBC,TAPE1=BBC,TAPE2,TAPE3,TAPE10) 
C     PUBLISHED LESSON USAGE OUTPUT TO BE PF TO DATASET 
C     FOR COURSEWARE SERVICES 
C 
C --- PROGRAM TO PREPARE DATA ABOUT THE USAGE TIME FOR
C --- LESSONS IN PARTICULAR ACCOUNTS.  THE RESULTS ARE
C --- *PF*ED BACK INTO A DATASET. 
C 
C --- TAPE1 (BC) IS THE DATA (FROM RAFPBC AND ASM1) ABOUT 
C ---        LESSON USAGE.
C 
C --- TAPE2 IS THE LIST OF SELECTED LESSON ACCOUNTS ABOUT 
C ---        WHICH DATA IS TO BE GATHERED.  IT IS A BLOCK 
C ---        IN THIS FILE CALLED *PARAMETERS* AND IS *PF*ED 
C ---        OUT TO THE LOCAL FILE (TAPE2).  IT IS ALSO USED
C ---        AS THE UNSORTED DATA ABOUT THE SPECIFIED ACCTS.
C 
C --- TAPE3 IS THE TEMPORARY FILE, WHERE THE LESSONS FROM 
C ---        THE SELECTED ACCOUNTS ARE STORED IN ALPHABETIC 
C ---        ORDER, TO BE SORTED LATER BY DESCENDING ORDER
C ---        OF USAGE TIME. 
C 
C --- TAPE10 IS THE SORTED VERSION OF TAPE3.
C 
      DIMENSION LINE(8) 
C 
      INTEGER ACCTS(500)
C 
      EXTERNAL ADD
C 
      DATA NACCTS/1/,KOUNT/0/,ACCTS/500*0/
C 
C --- READ IN THE LIST OF ACCOUNTS (MAXIMUM OF 500) 
C 
      REWIND 2
C 
 1    CONTINUE
      READ (2,2) ACCTS(NACCTS)
 2    FORMAT (A7) 
      IF (EOF(2)) 4, 3
 3    CONTINUE
      NACCTS = NACCTS + 1 
      IF (NACCTS .EQ. 501) GO TO 4
      GO TO 1 
C 
C --- MAKE *NACCTS* RIGHT SIZE
C 
 4    CONTINUE
C 
      NACCTS = NACCTS - 1 
C 
C --- PULL THE SELECTED ACCOUNTS FROM TAPE1 AND WRITE ON
C --- TAPE2 (SINCE THE SPECIFIED ACCOUNTS HAVE BEEN READ).
C 
      REWIND 1
      REWIND 2
C 
 10   CONTINUE
      READ (1,11) LINE
 11   FORMAT (3A10,A4,A10,A7,2F10.3)
      IF (EOF(1)) 15, 12
 12   CONTINUE
      DO 14 INDEX = 1, NACCTS 
      IF (ACCTS(INDEX) .NE. LINE(6)) GO TO 14 
      WRITE (2,13) LINE(5), LINE(7) 
 13   FORMAT (A10,F8.3) 
      GO TO 10
 14   CONTINUE
      GO TO 10
C 
C --- NOW REWIND AND SORT TAPE2 BY LESSON NAME, 
C --- ADDING ALL RECORDS WITH DUPLICATE KEYS, 
C --- AND WRITE THE RESULTS ON TAPE3. 
C 
 15   CONTINUE
      REWIND 2
      REWIND 3
C 
      CALL SM5SORT(0) 
      CALL SM5FROM("TAPE2") 
      CALL SM5TO("TAPE3") 
      CALL SM5KEY(1,10,"DISPLAY","A") 
      CALL SM5OWN5(ADD) 
      CALL SM5END 
C 
C --- NOW SORT TAPE3 BY THE SECOND FIELD, USAGE TIME, 
C --- IN ASCENDING ORDER AND PUT THE RESULTS ON TAPE10. 
C 
      REWIND 3
      REWIND 10 
C 
      CALL SM5SORT(0) 
      CALL SM5FROM("TAPE3") 
      CALL SM5TO("TAPE10")
      CALL SM5KEY(11,8,"COBOL6","D")
      CALL SM5END 
C 
      STOP
      END 
* /---   BLOCK      ADD        00 000   78/11/16  10.07 
      SUBROUTINE ADD(IRC,L1,LR1,L2,LR2) 
C 
C --- SUBROUTINE TO ADD THE TIMES OF TWO RECORDS WITH THE 
C --- SAME SORTING KEYS.  CALLING ROUTINE MUST HAVE AN
C --- *EXTERNAL ADD* STATEMENT FOR THIS TO WORK.
C 
      DIMENSION L1(2), L2(2)
C 
      DECODE (18,10,L1) NAME, TIME1 
 10   FORMAT (A10,F8.3) 
      DECODE (18,11,L2) TIME2 
 11   FORMAT (10X,F8.3) 
C 
      TIME1 = TIME1 + TIME2 
C 
      ENCODE (18,10,L1) NAME, TIME1 
C 
C     SET FLAG TO REPLACE RECORD. 
C 
      IRC = 1 
C 
      RETURN
      END