         TITLE    'COMMON JOURNAL END ACTION ROUTINE'
MONPROC  SET      1
         SYSTEM   UTS
         DEF      CJEA
         REF      T:GJOBSTRT
         REF      MASKS
         PAGE
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
EOR      EQU      5
WRTERR   EQU      9
CJCFUA   EQU      11
         PAGE
CJEA     EQU      %
         LI,R5    0                 ASSUME NO ERROR
         LW,R4    R8                DCB INTO INDEX REG
         LW,R2    CJCFUA,R4         FETCH CFU ADDRESS
         LI,R4    TYC*4+1           POINT TO TYC
         LB,R4    *R8,R4            AND FETCH IT
         SLS,R4   -1                RIGHT JUSTIFY TYC
         CI,R4    EOR               IS TYC END-OF-REEL
         BNE      CJEA050           NO
         LI,R5    X'1C'             YES, TRANSLATE TYC FOR USER
         B        CJEA100           CONTINUE END-ACTION WORK
CJEA050  EQU      %
         CI,R4    WRTERR            IS TYC PERM WRITE ERROR
         BNE      CJEA200           NO, NO ERRORS
         LI,R5    X'45'             YES, TRANSLATE TYC FOR USER
CJEA100  EQU      %
         LI,R6    TDA*4             POINT TO BYTE ZERO OF TDA
         LI,R4    0                 SET BYTE ZERO OF TDA TO ZERO
         STB,R4   *R2,R6            TO INFORM TPG OF PROBLEM
         AI,R6    1                 INDICATE SPECIFIC PROBLEM
         STB,R5   *R2,R6            TO TPG
         PUSH     11,R2             SAVE UNPROTECTED REGISTERS
         LD,R0    CJEATPG           FETCH TPG NAME
         BAL,R10  T:GJOBSTRT        GIVE TPG A JOLT
         PULL     11,R2
         CI,R5    X'1C'             WAS IT EOT
         BNE      CJEA150           NO
         LI,R4    1
         LW,R5    MASKS+7
         SLD,R4   17                RESET TYC TO 1 BECAUSE
         LW,R6    R8                RECORD WAS ACTUALLY
         STS,R4   TYC,R6            WRITTEN
         AI,R3    0                 CHECK FOR ECB
         BEZ      CJEA200           NONE, ALL DONE
         SLS,R4   7                 POSITION TYC
         STW,R4   2,R3              AND PLACE IN COMPLETION CODE
         B        CJEA200           FIN
CJEA150  EQU      %
         AI,R3    0                 CHECK FOR ECB
         BEZ      CJEA210           NONE, ALLDONE
         LW,R4    WRTCODE           FETCH USER ERROR CODE
         STW,R4   2,R3              AND PLACE INTO ECB COMPLETION CODE
         B        CJEA210           SKIP COUNTING BLOCKS
CJEA200  EQU      %
         MTW,1    SREC,R2           INCREMENT BLOCK COUNT
CJEA210  EQU      %
         B        *R11              RETURN
         BOUND    8
CJEATPG  TEXTC    'TPG'
         TEXT     '    '
WRTCODE  DATA     X'FF004502'
         END

