*********************************************
*********************************************
***                                       ***
***       JSTAT - JOB STATUS PROGRAM      ***
***                                       ***
*** TELLS C0-PRIV USER ABOUT HIS JOB      ***
*** AND HOW IT FINISHED (OK, ABORT, ETC.) ***
***                                       ***
***     CALL FROM TEL:                    ***
***                                       ***
***      !J <SYSID>                       ***
***                                       ***
***   WHERE <SYSID> IS THE SYSID OF THE   ***
***   JOB WHOSE STATUS IS BEING REQUESTED ***
***                                       ***
*********************************************
*********************************************
         REF      M:EI,M:SI,M:EO,M:UC,JB:PRIV
         REF      SLURPO,SLURPN,SLURP,SLURPDCB
R0       EQU      0
R1       EQU      1
R2       EQU      2
R3       EQU      3
R4       EQU      4
R5       EQU      5
R6       EQU      6
R7       EQU      7
R8       EQU      8
R9       EQU      9
R10      EQU      10
R11      EQU      11
R12      EQU      12
R13      EQU      13
R14      EQU      14
R15      EQU      15
ICVH     LI,R1    1                 FORCE HEX
         LI,R14   0                 CLEAR R14 FOR DBL SHIFT
         LI,R15   0                 ZAP THE ACCUMULATOR
         LI,R0    1                 R0 COUNTS DIGITS CONVERTED
ICVNXT   LI,R2    -16               16 DIGITS IN BASE
         CB,R5    EBCDIC+4,R2       TRY FOR A MATCH
         BE       ICV2              GOT IT
         BIR,R2   %-2               NO, TRY ANOTHER DIGIT
         BDR,R0   *R8               NON-DIGIT ENCOUNTERED;
*                                   RETURN IF >0 DIGITS SEEN
ICVBC    M:PRINT  (MESS,=X'03C5886F')  'Eh?'
         CAL1,9   1
ICV2     SLD,R14  4                 SHIFT THE ACCUMULATOR
         BOV      ICVBC             ERROR IF OVERFLOW
         AI,R2    1                 ADJUST NUMBER
         SW,R15   R2                ADD DIGIT TO ACCUM
         AI,R0    1                 BUMP DIGIT COUNTER
         AI,R6    1
         LB,R5    0,R6              NEXT BYTE
         B        ICVNXT            PROCESS
EBCDIC   TEXT     'FEDCBA9876543210'
*
*
WRT      EQU      %                 WRITE/OMIT TRAILING BLANKS
         LB,R0    *R1,R2            GET BYTE
         CI,R0    ' '               BLANK?
         BNE      %+2               NO->SKIP OUT
         BDR,R2   WRT               YES->SHORTEN COUNT
         AI,R2    1                 BUMP COUNT
         M:WRITE  M:UC,(BUF,*R1),(SIZE,*R2),WAIT
         B        0,R7              RETURN
*
A2       M:PRINT  (MESS,CANTFIND)
         CAL1,9   1
CANTFIND TEXTC    'CANNOT FIND JOB'
NOPRIV   TEXTC    'SORRY, YOU ARE NOT ALLOWED TO ACCESS J'
M:JOB    GEN,8,24,32 X'2F',M:EO,0
         TITLE    'J O B - S T A T U S   P R O C E S S O R'
START    EQU      %
         LC       *X'4F'
         BCR,8    EXIT              DON'T RUN IF NOT ONLINE
         LB,R15   JB:PRIV           C0?
         CI,R15   X'C0'             HUH
         BGE      C0PRIV            GOT IT, OK TO RUN
         M:PRINT  (MESS,NOPRIV)     NOT JUST ANY OLD AARON A. AARDVARK
         CAL1,9   1                  IS PERMITTED TO USE ME!!
C0PRIV   M:INT    EXIT              QUIT IF INTERRUPTED
         LI,R6    BA(M:SI+23)+1
         LB,R5    0,R6
         BAL,R8   ICVH
         LI,R7    -1                OLD JOB STATUS
STATUS   LW,R8    R15
         CAL1,1   M:JOB             CHK STATUS
         CW,R8    R7
         BNE      NEW
         M:WAIT   4
         B        STATUS
NEW      LW,R7    R8
         SLS,R8   2
         AI,R8    %TATU%            STATUS MESSAGE
         M:WRITE  M:LL,(BUF,*R8),(SIZE,16),WAIT
         B        STVEC,R7          CHANGE STATE
STVEC    B        OPEN              COMPLETED
         B        STATUS            RUNNING
         B        STATUS            WAIT TO RUN
         CAL1,9   1                 DOESN'T EXIST
         B        OPEN              WAIT TO OUTPUT
OPEN     M:OPEN   M:EI,(FILE,':ACCTLG',':SYS'),IN,(ABN,A1)
         M:PFIL   M:EI,EOF
READ     M:READ   M:EI,REV,(BUF,B1),(SIZE,168),(ABN,A2)
         LB,R11   B1+12
         CI,R11   X'FF'             BATCH?
         BNE      READ              NO
         CH,R15   B1+19             CHK SYSID
         BNE      READ              NOT YET
         LI,R1    B1                WRITE
         LI,R2    7                  USER'S
         BAL,R7   WRT                 ACCT
         M:TYPE   (MESS,=X'016B4040')  A COMMA
         LI,R1    B1+2                  AND
         LI,R2    11                     HIS
         BAL,R7   WRT                     ID
         M:TYPE   (MESS,=X'010D4040')      AND RETURN
         LI,R1    M:UC
         STW,R1   SLURPDCB
         LW,R1    B1+30
         AW,R1    B1+31
         AW,R1    B1+33
         AW,R1    B1+34
         LI,R0    0
         DW,R0    =30000            R1=MINS R0=TICS
         LI,R5    BA(CPUFMT)
         BAL,R15  SLURP
         LI,R9    0
         BAL,R15  SLURPN
         LI,R9    3
         LW,R1    R0
         LI,R0    0
         MI,R1    1000
         DW,R0    =30000            R1=MILLI-MINUTES
         AI,R1    1000
         BAL,R15  SLURPN
         BAL,R15  SLURPO
NONAME   LI,R10   X'8000'
         LI,R1    8
LOOP     CW,R10   B1+12             CORRECT RNST?
         BANZ     GOTSTAT           YES
         SLS,R10  -1
         BDR,R1   LOOP
GOTSTAT  SLS,R1   2
         AI,R1    REASONS
         M:WRITE  M:LL,(BUF,*R1),(SIZE,16),WAIT
EXIT     CAL1,9   1
A1       M:WAIT   1                 WAIT, TRY AGAIN
         B        OPEN
B1       RES,1    168
CPUFMT   TEXT     ' CPU= %.%%'      BELs (X'07') BRACKET 'CPU='
REASONS  TEXT     'NORMAL EXIT     '
         TEXT     'TRAP ABORT      '
         TEXT     'I/O ERROR ABORT '
         TEXT     'LIMIT EXCEEDED  '
         TEXT     '????????????????'
         TEXT     'OPERATOR ABORT  '
         TEXT     'OPRTR "E" KEYIN '
         TEXT     'M:XXX ABORT     '
         TEXT     'M:ERR LAST STEP '
%TATU%   TEXT     'COMPLETED       '
         TEXT     'RUNNING         '
         TEXT     'WAITING TO RUN  '
         TEXT     'DOES NOT EXIST  '
         TEXT     'WAITING TO PRINT'
         END      START
