RECORDFORMAT  CRECF(STRING  (6) USER, INTEGER  NEXT, USEP, FILEP)
OWNRECORDARRAYFORMAT  CRECAF(0 : 5000)(CRECF)
RECORDFORMAT  STATSF(STRING  (6) USER,  C 
   INTEGER  NEXT, FSYS, IKINST, BKINST, IPTURN, BPTURN,  C 
   KBTSLDEV, KBFSLDEV, IMSOCP, BMSOCP, CONNECT, AFILE, AKB,  C 
   DFILE, DKB, CFILE, CKB)
OWNRECORDARRAYFORMAT  STATSAF(0 : 5000)(STATSF)
EXTERNALSTRINGFNSPEC  DATE
EXTERNALSTRINGFNSPEC  TIME
EXTERNALINTEGERFNSPEC  EXIST(STRING  (24) FILE)
EXTERNALINTEGERFNSPEC  SMADDR(INTEGER  CHAN, INTEGERNAME  SIZE)
EXTERNALROUTINESPEC  DEFINE(STRING  (255) S)
EXTERNALROUTINESPEC  NEWSMFILE(STRING  (255) S)
EXTERNALROUTINESPEC  CLOSESM(INTEGER  CHAN)
EXTERNALROUTINESPEC  CHANGESM(INTEGER  CHAN, SIZE)
EXTERNALROUTINESPEC  SEND(STRING  (255) S)
CONSTSTRING (1) SNL="
"
!*
!*

EXTERNALROUTINE  GETUSE(STRING  (6) USER,  C 
   INTEGER  FSYS, RESET, ADR)
!* This routine returns accounting information in a record array starting
!* at ADR, for all accredited EMAS users (if FSYS is -1), or for all
!* users on the disc pack specified by FSYS, or for a single user (if
!* USER is non-null).  In the latter case FSYS can be used to specify
!* where the user's file index resides, if known.
!* The record array starting at ADR is assumed to be (0:n) (STATSF).
!* The records are held in a list structure to give alphabetic order
!* (_NEXT giving the next item in the list). This list is terminated
!* by a dummy record held in array element 0, with _USER="ZZZZZZ".
!* The genuine last user record thus has _NEXT=0.
!* The 0th record, on return from GETUSE, holds two items of
!* information:
!*   (0)_NEXT  gives the FIRST record in the list structure
!*   (0)_FSYS  gives the TOTAL number of (genuine) user records in the
!*             structure
!* If on entry (0)_NEXT is non-zero, this indicates that a
!* record array structure already exists.  In this case
!* the accounting information is added in to the corresponding record
!* (unless no such record currently exists, when one is created).  When
!* (0)_NEXT is non-zero on entry, it is assumed to point to the start
!* of the structure, and (0)_FSYS is assumed to give the total number of
!* user records in the structure.
!* If all the file systems are searched and more than one file index is
!* found for a particular user, then the accounting information for each
!* is stored in a separate record of the record array.
!* If RESET is 0 on entry, the accounting information is merely
!* read from the users' file indexes.  If it is 1, the file indexes are
!* also reset.
!* It is expected that GETUSE will be called on a regular basis with RESET=1,
!* and that either all the discpacks will be searched in a single call,
!* or that GETUSE will be called for each discpack in turn, the calling program
!* having used GET AV FSYS beforehand.
!* The user of GETUSE must be running at an ACR level of 5 or less.
EXTERNALROUTINESPEC  GET AV FSYS(INTEGERNAME  NFSYS,  C 
      INTEGERARRAYNAME  DISCPACK)
EXTERNALINTEGERFNSPEC  GETUSNAMES(INTEGERNAME  NUSERS,  C 
      INTEGER  ADR, FSYS)
EXTERNALINTEGERFNSPEC  DSFI(STRING  (6) USER,  C 
      INTEGER  FSYS, TYPE, SET, ADR)
RECORDNAME  CURRENT, EXIST(STATSF)
RECORDARRAYNAME  STATS(STATSF)
RECORDFORMAT  USERF(STRING  (6) USER)
RECORDARRAY  DUSER(1 : 512)(USERF)
OWNINTEGERARRAY  TYPE(1 : 8) =     C 
 20,23,25,26,27,29,31,30
! FOR CALLING DSFI.
OWNINTEGERARRAY  POSN(1 : 8) =     1,3,5,6,7,9,10,12
INTEGERARRAY  DISCPACK(0 : 63)
INTEGERARRAYNAME  DATA
INTEGERARRAYFORMAT  DATAF(1 : 15)
OWNINTEGERARRAY  ZERO(1 : 4) =      0(4)
INTEGER  I, J, ND, ERROR, NDUSERS, AZ
INTEGERNAME  NUSERS, START

   ROUTINE  ADDTOLIST(INTEGERNAME  NEW, START)
!* Finds correct position for CURRENT (i.e. STATS(NEW)) and links it in.
   INTEGER  OLDP, P
      IF  CURRENT_USER < STATS(START)_USER START 
!* At start of list.
         CURRENT_NEXT = START;  START = NEW
         RETURN 
      FINISH 
      P = START
      OLDP = P AND  P = STATS(P)_NEXT C 
         WHILE  CURRENT_USER > STATS(P)_USER C 
         OR  (CURRENT_USER = STATS(P)_USER C 
         AND  CURRENT_FSYS > STATS(P)_FSYS)
      IF  CURRENT_USER < STATS(P)_USER C 
         OR  (CURRENT_USER = STATS(P)_USER C 
         AND  CURRENT_FSYS < STATS(P)_FSYS) START 
!* CURRENT goes in between OLDP and P.
         STATS(OLDP)_NEXT = NEW;  CURRENT_NEXT = P
      FINISH  ELSE  START 
!* Same user, same fsys as STATS(P) - add in info from CURRENT.
         EXIST == STATS(P)
         EXIST_IKINST = EXIST_IKINST+CURRENT_IKINST
         EXIST_BKINST = EXIST_BKINST+CURRENT_BKINST
         EXIST_IPTURN = EXIST_IPTURN+CURRENT_IPTURN
         EXIST_BPTURN = EXIST_BPTURN+CURRENT_BPTURN
         EXIST_KBTSLDEV = EXIST_KBTSLDEV+CURRENT_KBTSLDEV
         EXIST_KBFSLDEV = EXIST_KBFSLDEV+CURRENT_KBFSLDEV
         EXIST_IMSOCP = EXIST_IMSOCP+CURRENT_IMSOCP
         EXIST_BMSOCP = EXIST_BMSOCP+CURRENT_BMSOCP
         EXIST_CONNECT = EXIST_CONNECT+CURRENT_CONNECT
!* REMAINING INFO IS ASSIGNED, NOT ADDED IN.
         EXIST_AFILE = CURRENT_AFILE
         EXIST_AKB = CURRENT_AKB
         EXIST_DFILE = CURRENT_DFILE
         EXIST_DKB = CURRENT_DKB
         EXIST_CFILE = CURRENT_CFILE
         EXIST_CKB = CURRENT_CKB
         NEW = NEW-1;                   ! Decrement total no of records.
      FINISH 
   END ;                                ! Of %EXTERNALROUTINE ADDTOLIST.
   STATS == ARRAY(ADR,STATSAF)
   NUSERS == STATS(0)_FSYS
   START == STATS(0)_NEXT
   IF  START = 0 START 
      STATS(0)_USER = "ZZZZZZ";  NUSERS = 0
   FINISH 
   IF  FSYS = -1 THEN  GETAVFSYS(ND,DISCPACK) C 
      ELSE  ND = 1 AND  DISCPACK(0) = FSYS
   AZ = ADDR(ZERO(1))
   WHILE  ND > 0 CYCLE ;                ! "FSYS" cycle.
      ND = ND-1;  FSYS = DISCPACK(ND)
      ERROR = GETUSNAMES(NDUSERS,ADDR(DUSER(1)),FSYS)
!* Returns into DUSER the names of the NDUSERS on this FSYS.
      UNLESS  ERROR = 0 START 
         PRINTSTRING("Director fault");  WRITE(ERROR,1)
         PRINTSTRING(" from GETUSNAMES with FSYS =")
         WRITE(FSYS,1)
         NEWLINE
         NDUSERS = 0
      FINISH 
      IF  USER # "" START ;             ! Single user specified in input parameters.
         NDUSERS = NDUSERS-1 WHILE  NDUSERS > 0 C 
            AND  DUSER(NDUSERS)_USER # USER
         I = NDUSERS;  I = I-1 UNLESS  I = 0
      FINISH  ELSE  I = 0
      WHILE  I < NDUSERS CYCLE ;        ! "Users within FSYS" cycle.
         I = I+1
!* Now want to get (and possibly reset) the info for user I on disc FSYS.
         IF  DUSER(I)_USER # "" START ; ! IGNORE "NO-NAME" USERS.
            NUSERS = NUSERS+1
            CURRENT == STATS(NUSERS);   ! Map CURRENT onto end of record array.
            CURRENT_USER = DUSER(I)_USER;    ! Current user's name.
            DATA == ARRAY(ADDR(CURRENT_IKINST),DATAF)
            CYCLE  J = 1,1,8
               ERROR = DSFI(CURRENT_USER,FSYS,TYPE(J),0,ADDR( C 
                  DATA(POSN(J))))
               EXIT  IF  ERROR # 0
            REPEAT 
            IF  RESET = 1 AND  ERROR = 0 START 
!* NOTE: DO NOT RESET AFILE, AKB, ETC.
               CYCLE  J = 1,1,6
                  ERROR = DSFI(CURRENT_USER,FSYS,TYPE(J),1,AZ)
                  EXIT  IF  ERROR # 0
               REPEAT 
            FINISH 
            IF  ERROR # 0 START 
               PRINTSTRING("Director fault no.")
               WRITE(ERROR,1)
               PRINTSTRING( C 
                  " when accessing file index for user ". C 
                  CURRENT_USER)
               PRINTSTRING(" on FSYS");  WRITE(FSYS,1)
               NEWLINE
            FINISH 
!* Now all info read into CURRENT, and reset in user's index
!* (if RESET=1).
!* Next, position CURRENT in record list.
            ADDTOLIST(NUSERS,START) IF  ERROR = 0
         FINISH 
      REPEAT ;                          ! "Users within FSYS" cycle.
   REPEAT ;                             ! FSYS CYCLE
END ;                                   ! Of %EXTERNALROUTINE GETUSE.
!*

EXTERNALROUTINE  LIST CUSE(STRING  (255) USERMASK)
STRING  (30) OUTFILE, CUSE
INTEGER  I, J, NEXT
RECORDARRAYNAME  CREC(CRECF)
RECORDNAME  CURRENT(CRECF)
RECORDFORMAT  REC1F(STRING  (6) USER, INTEGER  START, NUMBER)
RECORDNAME  REC1(REC1F)
!*
INTEGER  SUBN
INTEGERARRAY  SUBSTA(1 : 3);  INTEGERARRAY  SUBFINA(1 : 3)
!* Pointers to start and finish of substrings of mask.
STRING  (6) ARRAY  SUBA(1 : 3);         ! Substrings of mask.

   ROUTINE  MATCHINIT(STRING  (6) USER MASK)
!* A routine to set up substring variables used by MATCH.
   INTEGER  P, L
      L = LENGTH(USER MASK)
      P = 1;  SUBN = 0
      WHILE  P <= L CYCLE 
         P = P+1 WHILE  P <= L AND  CHARNO(USER MASK,P) = '?'
         EXIT  IF  P > L
         SUBN = SUBN+1
         SUBSTA(SUBN) = P
         P = P+1 WHILE  P <= L AND  CHARNO(USER MASK,P) # '?'
         SUBFINA(SUBN) = P-1
         SUBA(SUBN) = FROMSTRING(USER MASK,SUBSTA(SUBN), C 
            SUBFINA(SUBN))
      REPEAT 
   END ;                                ! OF %ROUTINE MATCHINIT.
!*

   INTEGERFN  MATCH(STRING  (6) USER)
   INTEGER  P
      P = 0
      WHILE  P < SUBN CYCLE 
         P = P+1
         RESULT  = 0 UNLESS  SUBA(P) = FROMSTRING(USER,SUBSTA( C 
            P),SUBFINA(P))
      REPEAT 
      RESULT  = 1
   END ;                                ! OF %INTEGERFN MATCH.
!*
   IF  USERMASK -> USERMASK.(",").OUTFILE START 
      CUSE = "CUSE" UNLESS  OUTFILE -> OUTFILE.(",").CUSE
      OUTFILE = ".OUT" IF  OUTFILE = ""
   FINISH  ELSE  START 
      OUTFILE = ".OUT"
      CUSE = "CUSE"
   FINISH 
   IF  EXIST(CUSE) = 0 START ;          ! FILE DOES NOT EXIST - CREATE IT.
      NEWSMFILE(CUSE.",100040");        ! ENOUGH FOR 5000 USERS.
      DEFINE("74,".CUSE)
      I = SMADDR(74,J);                 ! IGNORE J.
      STRING(I) = DATE;  STRING(I+10) = "00/00/00"
      REC1 == RECORD(I+20);             ! SET UP EMPTY RECORD STRUCTURE.
      REC1_USER = "ZZZZZZ"
      REC1_START = 0
      REC1_NUMBER = 0
      PRINTSTRING("File ".CUSE." created and initialised.")
      NEWLINE
   FINISH  ELSE  START ;                ! CUSE EXISTS - LIST IT.
      DEFINE("74,".CUSE)
      I = SMADDR(74,J);                 ! IGNORE J.
      CREC == ARRAY(I+20,CRECAF)
!* NOW SET UP USER MASK.
      IF  0 # LENGTH(USERMASK) # 6 START 
         PRINTSTRING("Faulty parameters.")
         NEWLINE
      FINISH  ELSE  START 
         MATCHINIT(USERMASK)
         DEFINE("75,".OUTFILE)
         SELECTOUTPUT(75)
         NEWLINES(2)
         PRINTSTRING("EMAS 2900 Charging Summary, from ")
         PRINTSTRING(STRING(I)." to ".STRING(I+10))
         PRINTSTRING("
-----------------------------------------------------")
         NEWLINES(2)
         PRINTSTRING("Total number of user numbers in file =")
         WRITE(CREC(0)_USEP,1);  NEWLINES(2)
         NEXT = CREC(0)_NEXT
         PRINTSTRING(" User       Usage  File Space")
         NEWLINE
         PRINTSTRING("           (pence)   (pence)")
         NEWLINES(2)
         WHILE  NEXT > 0 CYCLE 
            CURRENT == CREC(NEXT)
            IF  MATCH(CURRENT_USER) = 1 START 
               PRINTSTRING(CURRENT_USER);  WRITE(CURRENT_USEP,9)
               WRITE(CURRENT_FILEP,9)
               NEWLINE
            FINISH 
            NEXT = CURRENT_NEXT
         REPEAT 
!*
         SELECTOUTPUT(0)
      FINISH 
   FINISH ;                             ! END OF FILE LISTING SECTION.
   CLOSESM(74)
END ;                                   ! OF %EXTERNALROUTINE LISTCUSE.
!*

EXTERNALROUTINE  CHARGES(STRING  (255) MODE)
EXTERNALROUTINESPEC  TRANSFER(STRING  (255) S)
EXTERNALINTEGERFNSPEC  PACKDATEANDTIME(STRING  (8) DATE, TIME)
EXTERNALSTRINGFNSPEC  UINFS(INTEGER  TYPE)
EXTERNALINTEGERFNSPEC  UINFI(INTEGER  TYPE)
EXTERNALINTEGERFNSPEC  DTRANSFER(STRING  (6) ME, HIM,  C 
      STRING  (11) FILE, NEWNAME,  C 
      INTEGER  MY FSYS, HIS FSYS, TYPE)
EXTERNALINTEGERFNSPEC  DFSYS(STRING  (6) USER,  C 
      INTEGERNAME  FSYS)
EXTERNALINTEGERFNSPEC  PSTOI(STRING  (4) N)
RECORDARRAYNAME  STATS(STATSF)
RECORDNAME  CURRENT(STATSF)
RECORDARRAYNAME  CREC(CRECF)
!*
OWNSTRING  (8) JUSE = "JUSE", CUSE = "CUSE"
CONSTSTRING  (8) JUSESIZE = "255000"
CONSTSTRING  (4) BACKPASS = "ARCH"
CONSTINTEGER  DEFAULTDAYS = 1
CONSTINTEGERNAME  KINSPERSEC= X'80C000C0'
REAL  SECPERKINS
STRING  (10) DD, MM, USECHARGE, FILECHARGE, CTIME, ODD, OMM
STRING (6) SINGLE USER
INTEGERNAME  CNUSERS
INTEGER  I, J, NEXT, OLDCP, CP, DAYS, MMI, DDI, OMMI, ODDI
INTEGER  CMOUT, CUMLIM, ACCNTS FSYS, RESET INDEXES
CONSTINTEGERARRAY  CUMDAYS(1 : 12) =     C 
0, 31, 59, 90, 120, 151, 181,
          212, 243, 273, 304, 334
CONSTINTEGER  USEMIN = 5, FILEMIN = 5
! Any individual charge less than the corresponding minimum is ignored.
!*
!*

   INTEGERFN  FILECH
!* THIS RETURNS THE FILE CHARGE IN PENCE DERIVED FROM THE VALUES
!* IN RECORD "CURRENT".
   REAL  TOTAL
   CONSTREAL  AKBCOST = 0.00125;        ! THESE VALUES ARE A QUARTER OF THE
   CONSTREAL  DKBCOST = 0.025;          ! 'PER PAGE' COSTS, SINCE THEY RELATE
   CONSTREAL  CKBCOST = 0.05;           ! TO KBYTES.
!* THESE FIGURES ARE 'PER DAY' COSTS.
      TOTAL = CURRENT_AKB*AKBCOST+CURRENT_DKB*DKBCOST+CURRENT_ C 
         CKB*(CKBCOST-DKBCOST)
!* NOTE THAT CKB IS A SUBSET OF DKB.
      RESULT  = INT(3.85*TOTAL)*DAYS
!* DAYS IS THE NO. OF DAYS SINCE CHARGE LAST MADE.
   END ;                                ! OF %INTEGERFN FILECH.
!*

   INTEGERFN  USECH
!* THIS RETURNS THE USE CHARGE IN PENCE DERIVED FROM THE VALUES IN
!* RECORD "CURRENT".
   REAL  TOTAL
      TOTAL = (CURRENT_IKINST+CURRENT_BKINST*0.5)*SECPERKINS+ C 
         (CURRENT_IPTURN+CURRENT_BPTURN*0.5)*0.004+(CURRENT_ C 
         KBTSLDEV+CURRENT_KBFSLDEV)*26.0*0.003333333+CURRENT_ C 
         CONNECT*0.01666666
      RESULT  = INT(3.85*TOTAL)
!* THE FORMULA ABOVE IS TAKEN FROM ERCC CHARGES FOR 1979/80, PUBLISHED
!* IN THE JULY 1979 NEWSLETTER.  THE MEANINGS OF THE CONSTANTS,
!* IN ORDER OF APPEARANCE, ARE AS FOLLOWS:
!* SECPERKINS  APPROXIMATE TIME FOR 1000 MACHINE INSTRUCTIONS
!*             (RECIPROCAL OF FIGURE GIVEN IN PCOMF RECORD).
!* 0.5         BATCH TIME AND PAGE TURNS HALF COST OF INTERACTIVE.
!* 0.004    = 1/250, THE COST IN P PER PAGE TURN.
!* 0.0166.. = 1/60, THE COST IN P PER CONNECT TIME SECOND.
!* 26.0     = ESTIMATED RECORDS/KB OF SLOW DEVICE MATERIAL.
!* 0.00333..= 1/300, THE COST IN P PER SLOW DEVICE (I.E. UNIT) RECORD.
!* 3.85     = OVERALL CONSTANT.
   END ;                                ! OF %INTEGERFN USECH.
!*
!*
!*   Start of main code of %ROUTINE CHARGES.
!*
!*    Set up constants
!*
   SECPERKINS = 1.0/KINSPERSEC
   DD = DATE;  LENGTH(DD) = 5
   DD -> DD.("/").MM
   IF  MODE = "" START ;         ! REAL ACCOUNTING RUN
      RESET INDEXES = 1
      SINGLE USER = ""
   FINISHELSESTART 
      ! Test run, for all users (TEST specified) or for a single specified user.
      PRINTSTRING(MODE."?".SNL) AND  RETURN  IF  C 
        MODE # "TEST" AND  LENGTH(MODE) # 6
      RESET INDEXES = 0
      IF  MODE = "TEST" THEN  SINGLE USER = "" ELSE  SINGLE USER = MODE
      MODE = "TEST"
   FINISH 
!*
!*
!*            Prepare the files
!*
!*   CUMULATIVE USE FILE.
   CMOUT = 0;                           ! "Cumulative use file full" marker.
   CUSE = CUSE.MODE
   LIST CUSE(",,".CUSE) IF  EXIST(CUSE) = 0;   ! CREATES CUSE IF NECESSARY.
   DEFINE("74,".CUSE)
   I = SMADDR(74,J)
   CUMLIM = I+J-1;                      ! Address of end of file.
!*
! CALCULATE NO. OF DAYS SINCE CHARGE LAST MADE (RELEVANT FOR FILE
!* SPACE CHARGES).
   ODD = STRING(I+10);                  ! DATE FROM CUSE FILE.
   LENGTH(ODD) = 5;  ODD -> ODD.("/").OMM
   IF  OMM = "00" THEN  DAYS = DEFAULTDAYS ELSE  START 
!* "00" - CUSE IS EMPTY.
      DDI = PSTOI(DD);  ODDI = PSTOI(ODD);   ! STRING -> INTEGER.
      IF  OMM = MM THEN  DAYS = DDI-ODDI ELSE  START 
         MMI = PSTOI(MM);  OMMI = PSTOI(OMM)
         DAYS = CUMDAYS(MMI)+DDI-(CUMDAYS(OMMI)+ODDI)
         DAYS = DAYS+365 IF  DAYS < 0
      FINISH 
   FINISH 
   STRING(I+10) = DATE;  I = I+20
!* CHANGES THE "END" DATE AT THE START OF THE FILE TO TODAY'S
!* DAY'S DATE, AND MOVES I TO THE START OF THE RECORD STRUCTURE.
   CREC == ARRAY(I,CRECAF);             ! RECORD ARRAY NOW MAPPED ON TO CUSE.
!*
!* NOW GET JOURNAL FILE.
!*
   JUSE = JUSE.MODE
   SEND(JUSE.",.JOURNAL") IF  EXIST(JUSE) # 0 AND  MODE # "TEST"
! NOTE THAT IN "TEST" MODE ANY PREVIOUS JUSETEST FILE WILL BE OVERWRITTEN.
   NEWSMFILE(JUSE.",".JUSESIZE) IF  EXIST(JUSE) = 0
   DEFINE("79,".JUSE)
   I = SMADDR(79,J);                    ! IGNORE J.
! Insert header information for JOURNL file.
   J = I&X'FFFF0000'+20
   INTEGER(J) = PACKDATEANDTIME(DATE,TIME)
   INTEGER(J+4) = X'FFFFFF03'
   STATS == ARRAY(I,STATSAF);           ! STATS RECORD ARRAY MAPPED ON TO JUSE.
!*
!*
!* NOW GET THE INFORMATION.
!*
   STATS(0)_NEXT = 0;                   ! MEANS THAT THE RECORD STRUCTURE IS NEW.
   GETUSE(SINGLE USER,-1,RESET INDEXES,ADDR(STATS(0)))
!* ALL USERS (OR A SINGLE USER), ALL FSYSS, RESET FILE INDEXES (OR NOT).
!* GETUSE GENERATES MESSAGES AS NECESSARY.
!*
!* NOW GO THROUGH THE RECORD STRUCTURE, WORKING OUT THE CHARGES
!* AND WRITING THEM TO THE CHARGE FILES AND THE CUMULATIVE FILE.
!* FIRST SET UP CHARGE FILES (CHARACTER STREAMS).
!*
   USECHARGE = "A".DD.MM."U".MODE
   FILECHARGE = "A".DD.MM."F".MODE
   DEFINE("76,".USECHARGE."-MOD")
   DEFINE("77,".FILECHARGE."-MOD")
   CTIME = TIME
   NEXT = STATS(0)_NEXT;                ! START OF LIST.
!*
! CUMULATIVE FILE POINTERS
   OLDCP = 0;  CP = CREC(0)_NEXT
   CNUSERS == CREC(0)_USEP
!*
   WHILE  NEXT > 0 CYCLE 
      CURRENT == STATS(NEXT)
      I = USECH;  J = FILECH;           ! FUNCTIONS USING VALUES IN RECORD "CURRENT".
!*
      IF  I >= USEMIN START 
         SELECTOUTPUT(76);              ! USECHARGE.
         PRINTSTRING(CTIME." ".CURRENT_USER."   ");  WRITE(I,1)
         NEWLINE
      FINISH 
!*
      IF  J >= FILEMIN START 
         SELECTOUTPUT(77);              ! FILECHARGE
         PRINTSTRING(CTIME." ".CURRENT_USER."    ");  WRITE(J,1)
         NEWLINE
      FINISH 
!*
! UPDATE CUMULATIVE FILE
      OLDCP = CP AND  CP = CREC(CP)_NEXT C 
         WHILE  CURRENT_USER > CREC(CP)_USER
      IF  CURRENT_USER < CREC(CP)_USER START 
!* NEW USER: CREATE NEW RECORD, AND INSERT BETWEEN OLDCP AND CP.
         IF  ADDR(CREC(CNUSERS))+20 > CUMLIM START 
            SELECTOUTPUT(0)
            IF  CMOUT = 0 START 
               PRINTSTRING( C 
                  "Cumulative use file full.  Following users not added:")
               NEWLINE;  CMOUT = 1
            FINISH 
            PRINTSTRING(CURRENT_USER);  NEWLINE
         FINISH  ELSE  START 
            CNUSERS = CNUSERS+1
            CREC(CNUSERS)_NEXT = CP
            CREC(CNUSERS)_USER = CURRENT_USER
            CREC(CNUSERS)_USEP = I;  CREC(CNUSERS)_FILEP = J
            CP = CNUSERS;               ! (CONSECUTIVE INPUT RECORDS CAN BE FOR THE SAME USER.)
            CREC(OLDCP)_NEXT = CP
         FINISH 
      FINISH  ELSE  START ;             ! RECORD EXISTS FOR THIS USER - ADD IN INFO.
         CREC(CP)_USEP = CREC(CP)_USEP+I
         CREC(CP)_FILEP = CREC(CP)_FILEP+J
      FINISH 
!*
      NEXT = CURRENT_NEXT
   REPEAT 
!*
   SELECTOUTPUT(0)
!*
   I = (CNUSERS+2)*20;                  ! APPROX NO. OF BYTES IN USE.
   CLOSESM(74)
   CHANGESM(74,I+10000);                ! EXTRA 10000 ALLOWS 500 NEW USERS NEXT TIME.
   PRINTSTRING("Cumulative file ".CUSE." updated.".SNL)
!*
   CLOSESTREAM(76)
   PRINTSTRING("File ".USECHARGE." complete.".SNL)
!*
!* NOW SEND USECHARGE TO SYSTEM 4 UNLESS IN TEST MODE.
   TRANSFER(USECHARGE.",ARKTST.".USECHARGE.",".BACKPASS. C 
      ",OVERWRITE") UNLESS  MODE = "TEST"
!*
   CLOSESTREAM(77)
   PRINTSTRING("File ".FILECHARGE." complete.".SNL)
!*
!* NOW SEND FILECHARGE TO SYSTEM 4 UNLESS IN TEST MODE.
   TRANSFER(FILECHARGE.",ARKTST.".FILECHARGE.",".BACKPASS. C 
      ",OVERWRITE") UNLESS  MODE = "TEST"
!*
!* NOW TRANSFER FILECHARGE AND USECHARGE FILES TO ACCNTS PROCESS (UNLESS IN TEST MODE)
   UNLESS  MODE = "TEST" START 
      ACCNTS FSYS = -1
      I = DFSYS("ACCNTS",ACCNTS FSYS)
      IF  I = 0 START 
         I = DTRANSFER(UINFS(1),"ACCNTS",USECHARGE,USECHARGE, C 
            UINFI(1),ACCNTS FSYS,1)
         PRINTSTRING("Failed to transfer file ".USECHARGE. C 
            " to ACCNTS process".SNL) IF  I # 0
         I = DTRANSFER(UINFS(1),"ACCNTS",FILECHARGE,FILECHARGE, C 
            UINFI(1),ACCNTS FSYS,1)
         PRINTSTRING("Failed to transfer file ".FILECHARGE. C 
            " to ACCNTS process".SNL) IF  I # 0
      FINISH  ELSE  PRINTSTRING( C 
         "ACCNTS process not available - files ".USECHARGE. C 
         " and ".FILECHARGE." not transferred".SNL)
   FINISH 
!*
!* NOW TIDY UP JUSE FILE.
   I = (STATS(0)_FSYS+5)*76;            ! APPROX SIZE.
   CLOSESM(79)
   CHANGESM(79,I)
   PRINTSTRING("File ".JUSE." complete.".SNL)
   SEND(JUSE.",.JOURNAL") UNLESS  MODE = "TEST"
!*
END ;                                   ! OF %EXTERNALROUTINE CHARGES.
!*

EXTERNALROUTINE  LISTJUSE(STRING  (255) JUSE)
! LISTS THE CONTENTS OF FILE JUSE, THE FILE CREATED FOR THE JOURNAL SYSTEM
! ON EACH RUN OF THE CHARGING ROUTINE CHARGES.
RECORDFORMAT  F2(STRING  (6) USER, INTEGERARRAY  D(1 : 17))
RECORDNAME  R(F2)
RECORDARRAYNAME  STATS(STATSF)
INTEGER  I, J, NEXT
STRING  (20) OUT
!*
   OUT = ".OUT" UNLESS  JUSE -> JUSE.(",").OUT
   IF  EXIST(JUSE) = 0 START 
      PRINTSTRING("File ".JUSE. C 
         " does not exist, or no access.")
      NEWLINE
      RETURN 
   FINISH 
   DEFINE("75,".OUT)
   SELECTOUTPUT(75)
   DEFINE("79,".JUSE)
   I = SMADDR(79,J);                    ! IGNORE J.
   I = I+1 WHILE  STRING(I) # "ZZZZZZ"; ! SKIP OVER 'JOURNAL HEADER' (VARIOUS FORMATS).
   STATS == ARRAY(I,STATSAF)
! STATS (RECORD ARRAY) NOW MAPPED ONTO TO RECORD STRUCTURE IN JUSE.
   NEXT = STATS(0)_NEXT;                ! ARRAY SUBSCRIPT OF START OF LIST.
   PRINTSTRING( C 
      " USER FSYS  IKINST  BKINST  IPTURN  BPTURN  KBTSLD  KBFSLD")
   PRINTSTRING( C 
      "  IMSOCP  BMSOCP CONNECT   AFILE     AKB   DFILE")
   PRINTSTRING("     DKB   CFILE     CKB");  NEWLINES(2)
   CYCLE  I = 1,1,STATS(0)_FSYS
      IF  NEXT = 0 START 
         SELECTOUTPUT(0)
         PRINTSTRING("Only")
         WRITE(I,1)
         PRINTSTRING(" records in file:")
         WRITE(STATS(0)_FSYS,1)
         PRINTSTRING(" expected.".SNL)
         RETURN 
      FINISH 
      R == STATS(NEXT)
      PRINTSTRING(R_USER);  WRITE(R_D(2),3)
      CYCLE  J = 3,1,17
         WRITE(R_D(J),7)
      REPEAT 
      NEWLINE
      NEXT = R_D(1)
   REPEAT 
   NEWLINES(2)
   SELECTOUTPUT(0)
END ;                                   ! OF %EXTERNALROUTINE LISTJUSE.
ENDOFFILE