         SYSTEM   BPM
         SYSTEM   SIG7
         REF      F:101,F:102
         REF      M:LO
         REF      F:103
         REF      J:JIT,M:UC
         DEF      BEGIN
*
*
*
*******************************************************************
*
*  POST BOO-CPV RELEASE OF 'GAC' PROCESSOR LOADS WITH :J0 .
*  PLEASE SEE SAMPLE LOCCT SETUP PROVIDED.
*
*******************************************************************
*
*        !LOCCT (LMN,GAC),(BIAS,A000),(MAP),;
*        !       (SL,F),(NOTCB),(PERM),(ABS),;
*        !       (NOSYSLIB),(EF,(GACROM),(:J0))
*        :LOCCT  GAC
*
*******************************************************************
*
         TITLE    'GRANULE ACCOUNTING CLEANUP PROCESSOR'
*
*
R0       EQU      0
R1       EQU      1
R2       EQU      2
R3       EQU      3
R4       EQU      4
R5       EQU      5
R6       EQU      6
R7       EQU      7
SR1      EQU      8
SR2      EQU      9
SR3      EQU      10
SR4      EQU      11
D1       EQU      12
D2       EQU      13
D3       EQU      14
D4       EQU      15
*
*
*  ENTRIES ':UNML' THRU 'OPDIS' ARE DISPLACEMENTS
* INTO THE :USERS RECORD AND WILL NEED TO BE ALTERED
* WHEN :USERS FORMAT IS ALTERED. INITIAL VERSION OF
* GAC IS WRITTEN TO RUN UNDER CPV-AOO.
:UNML    EQU      30                MAX LIMS
:UBML    EQU      46                BATCH MAX LIMS
:UOML    EQU      62                ONLINE MAX LIMS
         PAGE
*
*
BEGIN    EQU      %
         M:OPEN   F:101,(IN),;
                  (SEQUEN),;
                  (FILE,'DISKPOOL','99999999')
         M:OPEN   F:102,(INOUT),;
                  (SEQUEN),;
                  (FILE,':USERS',':SYS')
         M:OPEN   F:103,(FILE,'XTEMP'),(OUTIN),;
                  (REL),(CONSEC)
         M:WRITE  M:LO,(BUF,INIT),(SIZE,42),(WAIT)
         M:DEVICE M:LO,(HEADER,1,TOPHD)
         M:DEVICE M:LO,(PAGE)
         M:DEVICE M:LO,(TAB,5,17,33,45,57,69,81,93)
         M:TYPE   (MESS,TELQ)
         LW,R1    J:JIT             SEE IF ONLINE OR BATCH
         BGEZ     TYPE0
CRLF     M:WRITE  M:UC,(BUF,CRBUF),(SIZE,2)
TYPE0    M:TYPE   (MESS,TELLOP0)
         LW,R1    J:JIT
         BGEZ     KEYIN
         EXU      CRLF
KEYIN    M:KEYIN  (MESS,ASKOP),(REPLY,ASKBUF),;
                  (SIZE,2),(ECB,ECB)
         LW,R2    ECB               RESPONSE YET?
         BL       %-1               NO WAIT FOR IT
*
*
         LW,R3    ASKBUF
         SLS,R3   -16
         AND,R3   L(X'FF')
         CI,R3    'C'               CHK FOR CANCEL
         BE       EXIT
         CI,R3    'F'               FULL?
         BNE      %+6
         M:TYPE   (MESS,TELLOP1)
         LW,R1    J:JIT
         BGEZ     %+2
         EXU      CRLF
         B        READ1
         CI,R3    'P'               PARTIAL?
         BNE      KEYIN             BAD ANS, ASK AGAIN
         M:TYPE   (MESS,TELLOP2)
         LW,R1    J:JIT
         BGEZ     %+2
         EXU      CRLF
         MTW,1    TYPEWORD          =1 FOR PARTIAL CLEANUP
READ1    M:READ   F:101,(BUF,DISKBUF),(SIZE,28),;
                  (ABN,ABRD1)
         MTW,1    RD101             RD1 COUNTER
READ2    M:READ   F:102,(BUF,USEBUF),(SIZE,504),;
                  (ABN,ABRD2)
         MTW,1    RD102             RD2 COUNTER
         BAL,SR4  GETL              GET USER LIMITS
*
GAC2     BAL,SR4  COMPR             COMPARE ACCT STRINGS
         BE       GAC1              PROCESS RECORDS
         BCS,1    NOTAUTH           REC IS NOT IN :USERS
         MTW,0    TYPEWORD
         BNEZ     READ2             DONT ZERO, NOT *FULL*
*
         LI,R4    0                 ZERO ENTRIES
         STW,R4   USEBUF+18         RESET RADS
         STW,R4   USEBUF+22         RESET DISKS
         EXU      UPDATE            REWRT REC
         LI,R1    ' '               BLANK TO R1
         STB,R1   PRNT2             BLANK POSSIBLE *
         BAL,SR4  BLDPRT            SETUP FOR PRINT
         EXU      OUTPUT
         B        READ2
*
         PAGE
*
GAC1     EQU      %
         LI,R4    0
         STW,R4   ASTFLG
         LW,R4    DISKBUF+5         GET ACCUM RADS
         STW,R4   USEBUF+18         UPDATE ACCUM TOTAL
         CW,R4    BPSTO             AGNST BCH RADS
         BLE      GAC4
         CW,R4    OPSTO             AGNST O/L RADS
         BLE      GAC4
         MTW,2    ASTFLG            MARK BOTH FAILURES
GAC4     LW,R4    DISKBUF+6         GET ACCUM DISKS
         STW,R4   USEBUF+22         UPDATE TOTAL
         CW,R4    BPDIS             AGNST BCH DISK
         BLE      %+2
         MTW,1    ASTFLG            MARK FAILURE
         CW,R4    OPDIS             AGNST O/L DISK
         BG       %+2
         MTW,-1   ASTFLG
UPDATE   M:WRITE  F:102,(BUF,USEBUF),(SIZE,504),(WAIT)
         MTW,0    ASTFLG            ERR FLG SET??
         BLEZ     %+3
         LI,R2    '*'
         STB,R2   PRNT2
         BAL,SR4  BLDPRT
OUTPUT   M:WRITE  M:LO,(BUF,PRNT2),(WAIT),;
                  (SIZE,77)
         LI,R2    0
         STB,R2   PRNT2             RESET ASTERISK.
         EXU      READ2             READ ANOTHER USERS REC
         MTW,1    RD102
         BAL,SR4  GETL              GET USER LIMITS
         BAL,SR4  COMPR             SEE IF SAME ACCT DIF NAME
         BE       GAC1              YES
         M:PRECORD F:102,(N,1),(REV) BACKUP TO START AGAIN
         MTW,-1   RD102             DECR AND GET IT LATER
         B        READ1
         PAGE
NOTAUTH  EQU      %
         MTW,1    TEMPCELL          COUNT UNATH ENTRIES
         M:WRITE  F:103,(BUF,DISKBUF),(SIZE,28),(WAIT)
         EXU      READ1             G{T ANOTHER DISKPOOL ENTRY
         MTW,1    RD101             COUNT READ
         B        GAC2
*
*
COMPR    EQU      %
         LI,R2    BA(DISKBUF)
         LI,R3    BA(USEBUF)
         LI,R5    X'08'             BYTE COUNT
         STB,R5   R3                 STORE IT.
         CBS,R2   0                 COMPARE STRINGS
         B        *SR4
         PAGE
*
*  LINK=SR4   BUILDS OUTPUT IN BUFFER PRNT2.
*
BLDPRT   EQU      %
         LI,R1    1                 BUF POS COUNTER
         LI,R6    0
         LI,R5    X'05'             TAB CHAR.
         STB,R5   PRNT2,R1
         AI,R1    1
         LB,R2    USEBUF,R6
         STB,R2   PRNT2,R1          MOVE ACCT NO
         AI,R1    1
         AI,R6    1
         CI,R6    7                 #CHARS IN NAME
         BLE      %-5
         STB,R5   PRNT2,R1
         LI,R6    0
         LB,SR1   USEBUF+2,R6
         AI,R1    1
         STB,SR1  PRNT2,R1          MOVE NAME
         AI,R6    1
         CI,R6    12
         BL       %-5
         AI,R1    1
         STB,R5   PRNT2,R1          TAB CHAR
         LW,D1    USEBUF+18         ACCUM RADS
         BAL,R0   MVTAB
         LW,D1    USEBUF+22         ACCUM DISKS
         BAL,R0   MVTAB
         LW,D1    BPSTO             BCH RADS
         BAL,R0   MVTAB
         LW,D1    BPDIS             BCH DISKS
         BAL,R0   MVTAB
         LW,D1    OPSTO             O/L RADS
         BAL,R0   MVTAB
         LW,D1    OPDIS             O/L DISKS
         BAL,R0   MVTAB
         B        *SR4
         PAGE
MVTAB    EQU      %
*  D1=WD TO CONVERT....BIN TO HEX
*  R0=LINK
*  SR4=PREV LINK
*  R1=BUF POS
*
         LI,R6    0
         BAL,SR1  BINDCB
         LB,R2    D1,R6
         AI,R1    1
         STB,R2   PRNT2,R1          BUFFER DATA
         AI,R6    1
         CI,R6    8
         BL       %-5
         AI,R1    1
         STB,R5   PRNT2,R1
         B        *R0
         PAGE
*
* GETL: GETS BCH & O/L RAD AND DISK VALUES FROM :USERS
* RECORD AND SETS UP DATA CELLS FOR COMPARISION AND OUTPUT.
*   LINK:  SR4
*
GETL     EQU      %
         LI,R1    :UNML
         LW,D1    PDISK
         LI,R4    0
GETL2    CW,D1    USEBUF,R1
         BE       GETL1
         AI,R4    1
         AI,R1    1
         CI,R4    16
         BL       GETL2
         LI,R4    0
         CW,D1    PSTORE
         BE       GETL3
         STW,R4   BPDIS
         STW,R4   OPDIS
         LW,D1    PSTORE
         LI,R1    :UNML
         B        GETL2
*
GETL3    STW,R4   BPSTO
         STW,R4   OPSTO
         B        GETLX
*
*
GETL1    CW,D1    PDISK
         BNE      GETL4
         LI,R1    :UBML
         AW,R1    R4
         LW,R3    USEBUF,R1
         STW,R3   BPDIS
         LI,R1    :UOML
         AW,R1    R4
         LW,R3    USEBUF,R1
         STW,R3   OPDIS
         LI,R4    0
         LW,D1    PSTORE
         LI,R1    :UNML
         B        GETL2
*
*
GETL4    LI,R1    :UBML
         AW,R1    R4
         LW,R3    USEBUF,R1
         STW,R3   BPSTO
         LI,R1    :UOML
         AW,R1    R4
         LW,R3    USEBUF,R1
         STW,R3   OPSTO
GETLX    B        *SR4
*
         PAGE
ENDIT    EQU      %
         M:DEVICE M:LO,(HEADER,20,ENDHD)
         M:DEVICE M:LO,(PAGE)
         M:CLOSE  F:101,(REL)
         M:CLOSE  F:102,(SAVE)
         M:PFIL   F:103,(BOF)
READ3    M:READ   F:103,(BUF,DISKBUF),(SIZE,28),(WAIT),(ABN,ABRD3)
         LW,R2    DISKBUF           GET ACCT
         STW,R2   NOUSER+2
         LW,R2    DISKBUF+1
         STW,R2   NOUSER+3
         LW,D1    DISKBUF+5
         BAL,SR1  BINDCB
         STW,D1   NOUSER+6
         STW,D2   NOUSER+7
         LW,D1    DISKBUF+6         RAW DISKS
         BAL,SR1  BINDCB
         STW,D1   NOUSER+11
         STW,D2   NOUSER+12
         M:WRITE  M:LO,(BUF,NOUSER),(SIZE,52),(WAIT)
         B        READ3
         PAGE
ABRD3    M:CLOSE F:103,(REL)
         M:DEVICE M:LO,(HEADER,20,SUMM)
         M:DEVICE M:LO,(PAGE)
         LW,D1    RD101             READS ON DISKPOOL
         BAL,SR1  BINDCB
         STW,D1   1RDS+7
         STW,D2   1RDS+8
         LW,D1    RD102
         BAL,SR1  BINDCB
         STW,D1   2RDS+7
         STW,D2   2RDS+8
         LW,D1    TEMPCELL
         BAL,SR1  BINDCB
         STW,D1   3RDS+7
         STW,D2   3RDS+8
         LI,R3    1RDS
FINWRT   M:WRITE  M:LO,(BUF,*R3),(SIZE,36),(WAIT)
         LI,R3    2RDS
         EXU      FINWRT
         LI,R3    3RDS
         EXU      FINWRT
         MTW,0    TYPEWORD          WHAT KIND OF RUN?
         BNEZ     %+3
         M:WRITE  M:LO,(BUF,ENDF),(SIZE,45),(WAIT)
         B        EXIT
         M:WRITE  M:LO,(BUF,ENDP),(SIZE,46),(WAIT)
EXIT     M:TYPE   (MESS,EOJ)
         M:EXIT
         PAGE
*
* ROUTINE CONVERTS HEX TO EBCD DEC NOS.
*
* D1=DIGIT TO CONVT
* D1,D2=ANSWER
* LINK SR1
*
*
BINDCB   EQU      %
         LI,R2    7
         LW,D4    D1
BINA     LI,D3    0
         DW,D3    XA
         AI,D3    X'F0'
         STB,D3   D1,R2
         AI,R2    -1
         BGEZ     BINA
         B        *SR1
         PAGE
*
ABRD1    EQU      %                 ABN FOR RD F:101
         MTW,0    TYPEWORD          FIND IF ALL OR NOT
         BEZ      ABRD12            ALL
         B        ENDIT
ABRD12   LW,R3    F:102+2           GET LAST TYC
         SLS,R3   -17
         AND,R3   =X'0000007F'
         CI,R3    7                 LAST OP AN EOF??
         BE       ENDIT
         LI,R3    XEND              BLOCK ABEND ON F:102
         LW,R2    0,R3              FETCH INSTR
         STW,R2   ABRD2             BLOCK ENTRY
ABRD13   LI,R4    0                 SET TO ZERO THE REST
         STW,R4   USEBUF+18         0 RADS
         STW,R4   USEBUF+22         0 DISKS
         EXU      UPDATE
         BAL,SR4  BLDPRT            SET UP OUTPUT
         EXU      OUTPUT            DO IT
         EXU      READ2
         MTW,1    RD102             COUNT THE READ
         BAL,SR4  GETL              GET USER LIMITS
         B        ABRD13            LOOP TILL FINSH F:102
*
*
ABRD2    EQU      %
         BAL,SR4  COMPR             SEE IF BUF'D REC AUTH??
         BE       %+3
         MTW,1    TEMPCELL          COUNT IT AS BAD
         M:WRITE  F:103,(BUF,DISKBUF),(SIZE,28),(WAIT)
         EXU      READ1             READ
         MTW,1    RD101             COUNT THE READ
         B        %-4               LOOP TILL FINSH F:101
         PAGE
TELLOP0  TEXTC    'DO YOU WISH A FULL OR';
                  ,' PARTIAL UPDATE OF :USERS';
                  ,'...OR CANCEL??'
ASKOP    TEXTC    'REPLY:  F,P OR C'
TELLOP1  TEXTC    'FULL UPDATE OF :USERS IN PROGRESS'
TELLOP2  TEXTC    'PARTIAL UPDATE OF :USERS IN PROGRESS'
XA       DATA     X'A'
XEND     B        ENDIT
TEMPCELL DATA     0
RD101    DATA     0
RD102    DATA     0
TYPEWORD DATA     0
ASTFLG   DATA     0
ECB      DATA     0
*
*
BPSTO    DATA     0                 MAX BATCH RADS
BPDIS    DATA     0                 MAX BATCH DISK
OPSTO    DATA     0                 MAX O/L   RADS
OPDIS    DATA     0                 MAX O/L   DISK
*
PDISK    TEXT     'PDIS'
PSTORE   TEXT     'PSTO'
*
PATCH    RES      50
*
         TITLE    'MESSAGES AND BUFFERS'
TELQ     TEXTC    'RECOMMEND SYST QUIESCENT ';
                  ,'BEFORE RUNNING GAC PROCESSOR'
EOJ      TEXTC    '** END OF GAC **'
NOUSER   TEXT     '                    RAD=        ';
                  ,'       DISK=        '
ENDHD    TEXTC    '  THE FOLLOWING ACCOUNTS NOT AUTHORIZED'
         BOUND    4
DISKBUF  RES      7
USEBUF   RES,1    504
ASKBUF   RES,1    4
TOPHD    TEXTC    'FLG ACCOUNT     NAME            ';
                  ,'ACCUM RADS  ACCUM DISK  BCH RADS    ';
                  ,'BCH DISK    O/L RADS    O/L DISK'
SUMM     TEXTC    'SUMMARY SHEET'
1RDS     TEXT     'NO. RECORDS IN *DISKPOOL* =         '
2RDS     TEXT     'NO. RECORDS IN * :USERS * =         '
3RDS     TEXT     'NO. RECORDS NOT AUTHORIZED=         '
INIT     TEXT     '** GRANULE ACCOUNTING CLEANUP PROCESSOR **'
ENDF     TEXT     '***** END OF FULL UPDATE OF :USERS FILE *****'
ENDP     TEXT     '#### END OF PARTIAL UPDATE OF :USERS FILE ####'
CRBUF    DATA     X'150D0000'       CR/LF
PRNT2    RES,1    120
         END      BEGIN

