         PCC      0
*
*        "A"..PROGRAM TO CHECK SYSID STATUS
*                 AND BUILD FILE CONTAINING ID+COMMENT
*
*        REQUIRES MODULE "BOERREXIT.JEFF" (PRINTS ERRMSG+EXITS)
*        REQUIRES MODULE "BOSCAN.JEFF" (SCANS J:CCBUF FOR FILE.ACCN.PASS)
*
*        BREAK KEY GOES TO STATUS WITHOUT DELETING RECORDS.
*
*        IF LINKED TO, OUTPUT IN R15 IS:
*                 0 IF MORE RECORDS IN FILE
*                -1 IF FILE EMPTY
*
         REF      M:UC,M:SL
         REF      M:EI
         REF      SCAN:C            J:CCBUF SCANNER FOR F.A.P
         REF      ERREXIT           ERRMSG PRINTER
         DEF      J
J        CSECT    1
         STW,8    LINKFPT+1         SAVE M:LINK CALLER
         STW,8    NODELETE          SET NO DELETE
*
*        USER MAY SPECIFY FILE OR ACCOUNT OR BOTH OR NOTHING.
*
         LW,3     FPT+1             CLEAR THE
         AND,3    L(-1-X'200')       PASSWORD
         STW,3    FPT+1               INDICATOR
         LI,3     1                 CLEAR OUT FILENAME
         STH,3    FPT+6              VLP WORD
         MTW,0    LINKFPT+1         ENTERED VIA M:LINK?
         BNEZ     OPEN              => YES. NO SCAN NEEDED.
         LI,8     FPT+6             VLP AREA
         BAL,14   SCAN:C            SCAN J:CCBUF FOR F.A.P
         BCS,8    SORRY             BAD SCAN
         M:PT     0                 GOTTA WRITE HERE!
         DEF      OPEN,FPT          FOR DEBUGGING
OPEN     EQU      %
,FPT     M:OPEN   F:A,FILE,PASS,INOUT,SAVE,;
         (ERR,OPENERR),(ABN,OPENERR)
         M:PT     1                 NO MORE WRITING HERE!
         MTW,0    LINKFPT+1         ENTERED VIA M:LINK ?
         BNEZ     STATUS            => YUP. ONLY STATUS
         B        CONTINUE
*
OPENERR  LB,3     10                CHECK CODE
         CI,3     3                 NO %%JOB FILE?
         BNE      ERREXIT           SOMETHING ELSE WRONG.
         MTW,0    LINKFPT+1         ENTERED VIA M:LINK?
         BNEZ     EXIT              => YES. NO FILE TO PRINT.
         M:OPEN   F:A,OUTIN,SAVE,KEYED,(KEYM,3),;
                  (ERR,OPENERR2),(ABN,OPENERR2)
         B        CONTINUE          => CREATED OK.
OPENERR2 LH,3     10                GET ERROR CODE
         CI,3     X'1400'           TRIED OTHER ACCOUNT?
         BNE      ERREXIT           => NO. SOMETHING ELSE
         LW,10    L(X'03000000')    YES. SET "NO FILE"
         B        ERREXIT            AND REPORT THAT ONE.
CONTINUE EQU      %
         M:PC     '>'
         M:SETDCB F:A,(ABN,ERREXIT),(ERR,ERREXIT)
         M:INT    BREAKKEY          IF BREAK, GO THERE
READ     EQU      %
         BAL,14   INPUT             GET NEW RECORD FOR FILE
         BAL,14   EBC2BIN           GET JOBID
         CI,8     0                 JOBID = ZERO??
         BNE      WRITE             => NOPE. IS OK.
         M:WRITE  M:SL,(BUF,EH),(SIZE,4)
         B        READ              TRY AGAIN
*
WRITE    EQU      %
         OR,8     L(X'03000000')    INSERT KEYLEN
         STW,8    KEY               SAVE KEY
         M:WRITE  F:A,(BUF,BUF),(KEY,KEY),(ABN,ERREXIT),;
                  (ERR,ERREXIT),;
                  ONEWKEY,(SIZE,*11)
         B        READ
         PAGE
BREAKKEY EQU      %                 BREAK HANDLER.
         MTW,1    NODELETE          SET NOT TO DELETE
         M:WRITE  M:SL,(SIZE,1),(BUF,%FIN)    1 BLANK MAKES NL
         B        STATUS             AND DO STATUS
         PAGE
STATUS   EQU      %
         M:PFIL   F:A,BOF
STATUS2  EQU      %
         M:READ   F:A,(SIZE,140),(ERR,CLOSE),(ABN,CLOSE)
         MTW,+1   #RECS             BUMP # OF RECORDS
         LW,11    F:A+4
         SLS,11   -17               GET ARS FOR LATER
         LW,8     *F:A+10           GET KEY (JOBID)
         AND,8    L(X'FFFFFF')      DROP SIZE OF KEY
*
         M:JOB    M:EI
         LW,3     8                 INDEX REG
         LW,3     MSGTAB,3          GET MSG CODE
         CI,8     0                 COMPLETE?
         BE       DELETE            => YES. DELETE
         CI,8     3                 NO SUCH JOB?
         BE       DELETE            => YES. DELETE.
         CI,8     2                 WAITING TO RUN?
         BNE      PRINT             => NOPE!
         LI,8     0
         LW,9     10
         AND,9    L(X'FF')          SAVE ONLY UP TO 255
         LI,4     %WAITNUM          INDEX
         LI,0     10                DIVISOR
         LI,8     0                 LEFT HALF
         DW,8     0
         AI,9     '0'               SET EBCDIC
         STB,9    0,4               STORE IT
         AI,4     1                 NEXT
         AI,8     '0'               MAKE EBCDIC
         STB,8    0,4               INSERT
         B        PRINT             GO PRINT IT.
DELETE   EQU      %
         MTW,+1   #DELS             BUMP # OF DELETE CANDIDATES
         MTW,0    NODELETE          SHOULD WE DELETE?
         BNEZ     PRINT             => NO. JUST PRINT MESSAGE
         M:DELREC F:A               DELETE RECORD.
         PAGE
*
PRINT    EQU      %
         LCI      3                 GET THE WORD
         LM,4     *3                 AND MOVE TO
         STM,4    BUF1                THE BUFFER
         AI,11    12                BUMP TO INCLUDE THE STUFF
         M:WRITE  M:SL,(BUF,BUF1),(SIZE,*11)
         B        STATUS2           DO NEXT
CLOSE    EQU      %
         M:PFIL   F:A,BOF
         M:READ   F:A,(SIZE,140),(ERR,CLOSE2),(ABN,CLOSE2)
         LW,0     #RECS             ARE ALL RECORDS
         CW,0     #DELS              DELETE CANDIDATES?
         BNE      CLOSE1            => NOPE. SAVE FILE
         MTW,0    LINKFPT+1         LINKED TO?
         BNEZ     CLOSE3            => YES. DELETE WHOLE FILE!
CLOSE1   M:CLOSE  F:A,SAVE          FILE NOT NULL
         LI,15    0                 MORE TO DO
         B        EXIT
CLOSE2   LB,10    10                GET ERROR CODE
         CI,10    6                 END OF DATA?
         BNE      ERREXIT           NOPE--BOMB
CLOSE3   M:CLOSE  F:A,REL           NULL FILE--DELETE IT.
         LI,15    -1                ALL FINISHED!
EXIT     MTW,0    LINKFPT+1         ENTERED VIA M:LINK?
         BGZ      %+2               => YUP. GO BACK
         M:EXIT
         M:LDTRC,E LINKFPT          GAGA.
SORRY    M:WRITE  M:SL,(BUF,EH),(SIZE,4)
         M:EXIT
         PAGE
EBC2BIN  EQU      %
         LI,1     4                 COUNTER
         LI,8     0                 ACCUMULATOR
         LI,4     0                 INDEX
BYTE     LB,5     BUF,4             GET BYTE
         CLM,5    XF0F9             NUMERIC?
         BCR,9    GOTIT             => YES. CONTINUE
         CLM,5    XC1C6             A-F?
         BCR,9    GOTIT             => YES. CONTINUE.
         CI,5     ' '               SPACE ?
         BLE      DONE              => YES. DONE.
GOTIT    EQU      %
         SLS,8    4
         AND,5    L(X'1F')          DROP HI ZONE
         LB,5     TABLE,5           TRANSLATE
         OR,8     5                 INSERT INTO ACCUMULATOR
         AI,4     1                 NEXT
         BDR,1    BYTE
DONE     EQU      %
         B        *14               RETURN
         PAGE
INPUT    EQU      %
         M:READ   M:UC,(BUF,BUF),(SIZE,140)
         LW,11    M:UC+4            GET ARS
         SLS,11   -17
         AI,11    -1                DROP ACTIVATION CHARACTER
         BEZ      STATUS            NULL--NOW DO STAUS
         B        *14
         PAGE
MSGTAB   EQU      %
         DATA     %FIN
         DATA     %RUN
         DATA     %WAIT:N
         DATA     %NOSUCH
         DATA     %WAIT:OP
TABLE    DATA     X'000A0B0C',X'0D0E0F00',0,0
         DATA     X'00010203',X'04050607',X'08090000'
         BOUND    8
XF0F9    DATA     '0','9'
XC1C6    DATA     'A','F'
EH       TEXT     'Eh?'
         PAGE
         CSECT    0
NODELETE DATA     0                 =0 MEANS DELETE RECORDS
#RECS    DATA     0
#DELS    DATA     0
LINKFPT  DATA     X'03000000',0,0
KEY      DATA     0
%FIN     TEXT     ' COMPLETE * '
%RUN     TEXT     ' RUNNING  * '
%WAIT:N  TEXT     ' WAIT: XX * '
%NOSUCH  TEXT     ' NO SUCH  * '
%WAIT:OP TEXT     ' WAIT:O/P * '
%WAITNUM EQU      BA(%WAIT:N)+7
BUF1     RES,1    12                SLOT FOR INFO
BUF      RES,1    140
         PAGE
F:A      DSECT    2
F:A      M:DCB    FILE,PASS,KEYED,DIRECT,(BUF,BUF),(KEYM,3),;
                  (WRITE,'ALL')
ENDF     EQU      %
         ORG      F:A+22            INSERT DEFAULT FILE NAME
         DATA     X'01000208'       VLP WORD
         TEXTC    '%%JOB'           DEFAULT FILE NAME
         ORG      ENDF
         END      J
