//MBJES01R JOB 001,MBJES01,CLASS=A,MSGCLASS=X
//*
//SMPREC  EXEC SMPREC
//SMPCNTL   DD *
  REJECT SELECT(MBJES01).
  RESETRC.
  RECEIVE SELECT(MBJES01).
//SMPPTFIN  DD *
++USERMOD(MBJES01).
++VER(Z038) FMID(EJE1103) PRE(UZ31176 UZ33158 UZ35334
      UZ37263 UZ54837 UZ57911 UZ63374 UZ65742 UZ71437
      UZ79531).
++MACUPD($HCT) DISTLIB(HASPSRC).
./    CHANGE NAME=$HCT                                         MBJ20053 DT000000
$QGET    DC    V(HASPQGET)         ENTRY FOR QGET ROUTINE      MBJ20053 DT062000
++MACUPD($JQE) DISTLIB(HASPSRC).
./  CHANGE NAME=$JQE MBJ20053                                  MBJ20053 EM000000
JQEDNAME DS    CL32                NAMES FROM AFT/BEF/CNTL CARDS J20053 EM060100
JQERESRT DS    BL3                 RESOURCE ROUTING.           MBJ20026 EM060200
JQEFLAG3 DS    BL1                 MORE JOBQ FLAGS             MBJ20026 EM060300
QUEDNAME EQU   JQEDNAME-JQEDSECT   JOB DEP/CNTL NAME           MBJ20026 EM110100
QUERESRT EQU   JQERESRT-JQEDSECT   RESOURCE ROUTING.           MBJ20026 EM110200
QUEFLAG3 EQU   JQEFLAG3-JQEDSECT   MORE JOBQ FLAGS             MBJ20026 EM110300
         SPACE 2                                               MBJ20026 EM170100
QUEAFT   EQU   X'01'               /*AFTER SPECIFIED           MBJ20053 EM170600
QUEBEF   EQU   X'02'               /*BEFORE SPECIFIED          MBJ20053 EM170650
QUECNTL  EQU   X'04'               /*CNTL SPECIFIED            MBJ20053 EM170700
QUEEXC   EQU   X'80'               CURRENT NAME IS EXCLUSIVE   MBJ20053 EM170750
*  QUERJE MAY BE ON BEFORE CONVERSION,                         MBJ20053 EM170760
*  QUEPCS MAY BE ON AFTER FIRST PRINT FOR Z JOBS               MBJ20053 EM170765
*                                                              MBJ20053 EM170775
QUENCTL  EQU   X'04'               MAX # OF NAMES INCLUDING    MBJ20053 EM170800
*                                /*AFTER /*BEFORE AND /*CNTL   MBJ20053 EM170900
++MACUPD($QGET) DISTLIB(HASPSRC)
    ASSEM(HASPMISC,HASPPRPU,HASPXEQ).
./        CHANGE NAME=$QGET                                    MBJ20053 GD000000
         L     R15,$QGET           ENTRY TO $QGET ROUTINE      MBJ20053 GD009000
         BALR  LINK,R15            LINK TO CNTL SERVICE PGM    MBJ20053 GD010000
++MACUPD($QSE) DISTLIB(HASPSRC)
    ASSEM(HASPINIT,HASPMISC,HASPCOMM,HASPRDR).
./       CHANGE NAME=$QSE                                      MBJ20026 GL000000
QSEMELON DS    H                   RESERVED.                   MBJ20026 GL022050
QSERESTB DS    BL3                 RESOURCE ROUTING TABLE      MBJ20026 GL022100
++MACUPD($RDRWORK) DISTLIB(HASPSRC).
./      CHANGE NAME=$RDRWORK                                   MBJ20053 GT000000
RQUEDNAM DS    CL32                DEPENDENT/CNTL NAMES        MBJ20053 GT098010
RQUERESR DS    BL3                 RESOURCE ROUTING BITS       MBJ20026 GT098020
RQUEFLG3 DS    BL1                 MORE JQE FLAGS              MBJ20026 GT098030
++SRCUPD(HASPCOMM) DISTLIB(HASPSRC).
./       CHANGE NAME=HASPCOMM                                  MBJ20053 K0000000
         BAL   R0,COFJRES          ADD RESOURCE ROUTINGS       MBJ20026 K0792510
         BAL   R0,COFJRES          ADD RESOURCE ROUTINGS       MBJ20026 K0827510
************************************************************** MBJ20026 K1002502
*        ADD RESOURCE ROUTINGS TO JOB MESSAGE.               * MBJ20026 K1002504
************************************************************** MBJ20026 K1002506
COFJRES  STM   WA,WC,COMWREGS      SAVE REGISTERS WA,WB,WC     MBJ20026 K1002508
         LA    R15,COFJOB+L'COMMAND-9  MAXIMUM MESSAGE LENGTH  MBJ20026 K1002510
         SLR   R14,R14             CLEAR R14                   MBJ20026 K1002512
         IC    R14,COFLNGTH        GET MESSAGE LENGTH          MBJ20026 K1002514
         LA    R14,COFJOB+1(R14)   AND POINT TO MESSAGE END    MBJ20026 K1002516
         LA    WA,$RESTAB          GET RESOURCE TABLE          MBJ20026 K1002518
         SLR   WB,WB               CLEAR WB                    MBJ20026 K1002520
         ICM   WB,14,JQERESRT      GET JOBS RESOURCE ROUTINGS  MBJ20026 K1002522
         BZ    COFJRES6            IF NONE, MAKE QUICK EXIT    MBJ20026 K1002524
COFJRES1 DS    0H        CC INDICATES RESOURCE STATUS          MBJ20026 K1002526
         BP    COFJRES4            HIGH BIT 0-NOT ROUTED TO IT MBJ20026 K1002528
         BZ    COFJRES5            ALL BITS 0-NO MORE ROUTINGS MBJ20026 K1002530
         MVC   0(8,R14),0(WA)      MOVE RESOURCE NAME INTO MSG MBJ20026 K1002532
         LA    R14,7(,R14)         POINT TO LAST CHAR OF NAME  MBJ20026 K1002534
COFJRES2 CLI   0(R14),C' '         Q. BLANK                    MBJ20026 K1002536
         BNE   COFJRES3            A. NO-POLISH IT UP          MBJ20026 K1002538
         BCT   R14,COFJRES2        ELSE BACK UP AND TRY AGAIN  MBJ20026 K1002540
COFJRES3 DS    0H                  SEPARATE RESOURCES BY COMMA MBJ20026 K1002542
         LA    R14,2(,R14)         AND BUMP TO NEXT AREA       MBJ20026 K1002544
         CR    R14,R15             Q. NEAR END OF MESSAGE AREA MBJ20026 K1002546
         BNH   COFJRES4            A. NO-CONTINUE BUILDING     MBJ20026 K1002548
         LA    R15,COFJOB          GET MSG START               MBJ20026 K1002550
         SR    R14,R15             CALCULATE MSG LENGTH        MBJ20026 K1002552
         STC   R14,COFLNGTH        AND STORE FOR WTOER         MBJ20026 K1002554
         LR    R15,R0              SAVE RETURN ADDRESS IN R15  MBJ20026 K1002556
         BAL   R14,COFJWTO         AND ISSUE MESSAGE           MBJ20026 K1002558
*  NOTE- ONE BAL TO COFJWTO MAY RESULT IN TWO WTO'S            MBJ20026 K1002560
*        WHERE SUBSEQUENT LINES BEGIN AT COFQUE.               MBJ20026 K1002562
         LR    R0,R15              RESTORE RETURN ADDRESS      MBJ20026 K1002564
         LA    R15,COFJOB+L'COMMAND-9  MAXIMUM MESSAGE LENGTH  MBJ20026 K1002566
         LA    R14,COFQUE          START OF SUBSEQUENT MSGS    MBJ20026 K1002568
COFJRES4 LA    WA,$RESLEN(,WA)     BUMP TO NEXT RESOURCE NAME  MBJ20026 K1002570
         SLL   WB,1                AND JOB'S NEXT ROUTING BIT  MBJ20026 K1002572
         LTR   WB,WB               SET CONDITION CODE.         MBJ20026 K1002573
         B     COFJRES1            GO CHECK THIS RESOURCE      MBJ20026 K1002574
COFJRES5 LA    R15,COFQUE          GET REAL START OF 2ND MSGS  MBJ20026 K1002576
         CR    R14,R15             Q. 2ND LINE WITH NO NAMES   MBJ20026 K1002578
         BE    COFJRES6            A. YES-NO WTO               MBJ20026 K1002580
         BCTR  R14,0               BACK UP ONE                 MBJ20026 K1002582
         MVI   0(R14),C' '         AND PUT BLANK-SHOULD BE ',' MBJ20026 K1002584
         LA    R15,COFJOB-1        GET MESSAGE START-1         MBJ20026 K1002586
         SR    R14,R15             AND CALCULATE LENGTH        MBJ20026 K1002588
         STC   R14,COFLNGTH        STORE FOR WTO               MBJ20026 K1002590
COFJRES6 LR    R15,R0              GET RETURN ADDRESS          MBJ20026 K1002592
         LM    WA,WC,COMWREGS      RESTORE WORK REGS WA,WB,WC  MBJ20026 K1002594
         BR    R15                 AND RETURN TO CALLER        MBJ20026 K1002596
         SPACE 2                                               MBJ20026 K1002598
         TITLE 'HASP COMMAND PROCESSOR - SYSTEM RESOURCE TABLE' BJ20026 K1426100
         $RESTABL                 GENERATE JES2 RESOURCE TABLE MBJ20026 K1426150
         SPACE 5                                               MBJ20026 K1426155
************************************************************** MBJ20026 K1426160
*        TABLE FOR TRANSLATION OF JQETYPE TO OFFSET TO       * MBJ20026 K1426161
*        JOB QUEUE HEADER (HERE USED TO TRANSLATE TO AN      * MBJ20026 K1426162
*        OFFSET TO A COUNTER AREA)                           * MBJ20026 K1426163
************************************************************** MBJ20026 K1426164
         SPACE 1                                               MBJ20026 K1426165
$QINDEX  DC    AL1(2)              $PURGE                      MBJ20026 K1426166
         DC    AL1(4)              $HARDCPY                    MBJ20026 K1426167
         DC    AL1(6,0)            $OUTPUT                     MBJ20026 K1426168
         DC    AL1(8,0,0,0)        $RECEIVE                    MBJ20026 K1426169
         DC    AL1(10),7AL1(0)     $SETUP                      MBJ20026 K1426170
         DC    AL1(12),15AL1(0)    $XMIT                       MBJ20026 K1426171
         DC    AL1(14),31AL1(0)    $INPUT                      MBJ20026 K1426172
         DC    AL1(16)             $XEQ (CONVERSION)           MBJ20026 K1426173
         DC    AL1(24,26,28,30,32,34,36,38,40),6AL1(0)    XEQ A-I 20026 K1426174
         DC    AL1(20-20)                                 STC     20026 K1426175
         DC    AL1(42,44,46,48,50,52,54,56,58),6AL1(0)    XEQ I-R 20026 K1426176
         DC    AL1(22-22,0)                               TSU     20026 K1426177
         DC    AL1(60,62,64,66,68,70,72,74),6AL1(0)       XEQ S-Z 20026 K1426178
         DC    AL1(76,78,80,82,84,86,88,90,92,94),6AL1(0) XEQ 0-9 20026 K1426179
         DC    AL1(18),127AL1(0)                          $DUMMY  20026 K1426180
***************   $NUMRJE PARAMETERS................********** MBJ20026 K1426182
MBNUMRJE EQU   175                 = TO $NUMRJE                MBJ20026 K1426183
MBRJE1   DC    H'350'              = TO $NUMRJE X 2.           MBJ20026 K1426184
MBRJE2   DC    H'176'              = TO $NUMRJE + 1.           MBJ20026 K1426185
         SPACE 5                                               MBJ20026 K1426186
         $COMTAB DB,HASPCJB5,REJECT=COMR   DISPLAY SYS BACKLOG MBJ20026 K1686550
         $COMTAB DC,HASPCRES,REJECT=COMR    DISPLAY CONFLICTS  MBJ20026 K1686600
         $COMTAB DN,HASPCJMB,REDIR=$DN  MELLON DN QUEUE DISPLY MBJ20026 K1689000
         $COMTAB DQ,HASPCJMB,REDIR=$DQ  MELLON DQ QUEUE DISPLY MBJ20026 K1690000
         $COMTAB DR,HASPCRES,REJECT=COMR    DISPLAY RESOURCES  MBJ20026 K1690100
COMTBLQ  $COMTAB QA,HASPCRES,REJECT=COMR+COMS    ADD RESOURCE  MBJ20026 K1710100
         $COMTAB QD,HASPCRES,REJECT=COMR+COMS    DROP RESOURCE MBJ20026 K1710200
         $COMTAB QJ,HASPCJB2,REJECT=COMR    INFO JOB JCL FILE. MBJ20026 K1710300
         DC    C'Q',AL3(COMTBLQ)   ENTRY FOR 'Q' VERBS         MBJ20026 K1731550
         COPY MBDNDQ      COPY   MELLON JOB QUEUE COMMANDS     MBJ20026 K1765550
         LA    WC,CDNCTR       BLNK OUT LABEL CDN FOR MB MOD   MBJ20026 K1897000
         LA    WC,CDQCTR       BLNK OUT LABEL CDQ FOR MB MOD   MBJ20026 K1901000
         COPY  MBDB                 MELLON BANK QUEUE DISPLAY  MBJ20026 K2209202
HASPCJB2 $COMGRUP AJ,AS,AT,CJ,CS,CT,DJ,DS,                     MBJ20026CK2578500
               DT,EJ,HJ,HS,HT,IJ,LJ,LS,LT,                     MBJ20026CK2578550
               PJ,PS,PT,QJ,DELAY=YES  DECLARE SUBPROCESSOR     MBJ20026 K2579000
         EJECT                                                 MBJ20026 K2771003
         COPY  MBQJ                                            MBJ20026 K2771006
         COPY  MBMULT      MELLON BANK CMDS (DP QS QA QD DC)   MBJ20053 K4697510
         LTORG                                                 MBJ20026 K6041510
CRESAREA DS    CL4096              WORKAREA FOR $LC            MBJ20026 K6041520
++SRCUPD(HASPNUC) DISTLIB(HASPSRC).
./       CHANGE NAME=HASPNUC                                   MBJ20053 P0000000
HASPQGET CSECT                                                 MBJ20053 P0813500
*        R15   = ENTRY POINT, UNPREDICTABLE ON EXIT            MBJ20053 P0827000
         ENTRY $QGETAFF            ENTRY FOR INITIALIZATION    MBJ20053 P0831000
         USING HASPQGET,R15        ADDRESSABILITY              MBJ20053 P0831500
         LR    R0,WA               SAVE WA                     MBJ20053 P0832000
         L     WA,QGETUSE          $QSUSE ROUTINE              MBJ20053 P0832100
         BALR  R15,0               SET RETURN ADDR FROM QSUSE  MBJ20053 P0832200
         USING *,R15               ADDRESSABILITY              MBJ20053 P0832300
         TM    $STATUS,$QSONDA          MAY QS BE USED         MBJ20053 P0832400
         BNZR  WA                  BR TO QSUSE RTN IF NO       MBJ20053 P0832500
         LR    WA,R0               RESTORE WA                  MBJ20053 P0832600
         N     R1,QGETA255         MASK OFF HIGH ORDER BYTES   MBJ20053 P0833000
         N     R1,QGETAFFF          OF NEXT JQE                MBJ20053 P0843000
         COPY  MBQGET                                          MBJ20026 P0859400
         ST    WA,PCEWA            SAVE WA                     MBJ20053 P0871500
         L     WA,QGETCKPT         QCKPT ROUTINE               MBJ20053 P0872000
         BALR  R15,WA              FORCE CKPT OF JQE (SET CC)  MBJ20053 P0872100
         L     WA,PCEWA            RESTORE WA                  MBJ20053 P0872200
         SPACE 1                                               MBJ20053 P0874450
QGETUSE  DC    V($QSUSES)          $QSUSE ROUNTINE             MBJ20053 P0874500
QGETCKPT DC    V(QCKPT)            QCKPT ROUTINE               MBJ20053 P0874525
QGETA255 DC    A(255)              MASK                        MBJ20053 P0874550
QGETAFFF DC    A(X'0000FFFF')      MASK                        MBJ20053 P0874600
QRESORCE DC    BL3'0'              RESOURCE  COMPARE FIELD     MBJ20053 P0874650
         DROP  R15                                             MBJ20053 P0874700
HASPNUC  CSECT                     REVERT TO HASPNUC           MBJ20053 P0875500
         ENTRY QCKPT                                           MBJ20053 P1071500
         ENTRY $QSUSES                                         MBJ20053 P1139500
INITGOOD L     R1,=V($QGETAFF)     SET MASK FOR 'TM'           MBJ20053 P5486800
++SRCUPD(HASPRDR) DISTLIB(HASPSRC).
./       CHANGE NAME=HASPRDR                                   MBJ20026 R0000000
         DC   AL1(4),AL3(RCNTCARD),CL8'CNTL'     HASP CNTL    MBJ20026  R1336010
         DC    AL1(6),AL3(RBEFCARD),CL8'BEFORE'   HASP BEFORE  MBJ20026 R1336020
         DC    AL1(5),AL3(RAFTCARD),CL8'AFTER'    HASP AFTER   MBJ20026 R1336030
*                                                              MBJ20026 R1341001
*                                                              MBJ20026 R1341005
*                                                              MBJ20026 R1341010
*                             HASP  BEFORE, AFTER, CNTL CARD   MBJ20026 R1341015
*                                           PROCESSING ROUTINE MBJ20026 R1341020
*                                                              MBJ20026 R1341025
         SPACE 3                                               MBJ20026 R1341030
RBEFCARD DS    0H                                              MBJ20026 R1341035
         LTR   JCT,JCT             TEST FOR JOB                MBJ20026 R1341040
         BZ    RILLCCRD            IGNORE BEFORE CARD IF NOT   MBJ20026 R1341045
         OI    RCARDLRC,LRC1INUL+RDLMSKIP SHOW SUPERFLOUS      MBJ20026 R1341050
         BAL   RL1,RPUT            ADD CARD TO OUTPUT FILE     MBJ20026 R1341055
         TM    RDRSW,RJCLSW        TEST STATUS                 MBJ20026 R1341060
         BO    *+12                BRANCH IF JCL FILE          MBJ20026 R1341065
         BAL   RL1,RPUT            TERMINATE DATASET           MBJ20026 R1341070
         OI    RDRSW,RJCLSW        SET JCL SWITCH              MBJ20026 R1341075
         MVC   JCTWORK(79),0(RPI)  SAVE CARD IMAGE             MBJ20026 R1341080
         TM    RQUEFLG3,QUECNTL    /*CNTL SPECIFIED            MBJ20053 R1341082
         BO    RILLBADC           YES - CARDS ARE OUT OF ORDER MBJ20053 R1341084
         OI    RQUEFLG3,QUEBEF     SET TO BEFORE CARD          MBJ20026 R1341085
         LA    R15,8(,RPI)         START OF SCAN               MBJ20026 R1341095
         LA    RL1,RQUEDNAM       DEPENDENT JOB NAME AREA      MBJ20053 R1341100
         TM    RQUEFLG3,QUEAFT    /*AFTER SPECIFIED            MBJ20053 R1341105
         BNO   RMVENAM            NO - USE FIRST DEPENDENT AREAMBJ20053 R1341110
         LA    RL1,8(0,RL1)       USE SECOND DEPENDENT AREA    MBJ20053 R1341115
RMVENAM  LA    R14,50              MAX POSITIONS TO SEARCH     MBJ20026 R1341200
RFINDCAR CLI   0(R15),C'A'         FIND START OF JOBNAME       MBJ20026 R1341205
         BL    RFINDCON            NOT IN GOOD RANGE           MBJ20026 R1341210
         CLI   0(R15),C'Z'         TRY OTHER SIDE              MBJ20026 R1341215
         BNH   RPUTNAM             THIS IS GOOD                MBJ20026 R1341220
RFINDCON LA    R15,1(,R15)         POINT TO NEXT POSITION      MBJ20026 R1341225
         BCT   R14,RFINDCAR        LOOP TILL END               MBJ20026 R1341230
         NI    RQUEFLG3,255-QUEBEF-QUEAFT SET OFF FLAGS        MBJ20026 R1341235
         B     RILLBADC            ILLEGAL BEFORE/AFTER CARD   MBJ20026 R1341245
RPUTNAM  MVC   0(8,RL1),0(R15)    PUT NAME IN                  MBJ20053 R1341250
         B     ROPSHIFT            GO TERMINATE NORMALLY       MBJ20026 R1341255
         SPACE 3                                               MBJ20026 R1341260
RAFTCARD DS    0H                                              MBJ20026 R1341265
         LTR   JCT,JCT             TEST FOR JOB                MBJ20026 R1341270
         BZ    RILLCCRD            IGNORE AFTER CARD IF NOT    MBJ20026 R1341275
         OI    RCARDLRC,LRC1INUL+RDLMSKIP SHOW SUPERFLOUS      MBJ20026 R1341280
         BAL   RL1,RPUT            ADD CARD TO OUTPUT FILE     MBJ20026 R1341285
         TM    RDRSW,RJCLSW        TEST STATUS                 MBJ20026 R1341290
         BO    *+12                BRANCH IF JCL FILE          MBJ20026 R1341295
         BAL   RL1,RPUT            TERMINATE DATASET           MBJ20026 R1341300
         OI    RDRSW,RJCLSW        SET JCL SWITCH              MBJ20026 R1341305
         MVC   JCTWORK(79),0(RPI)  SAVE CARD IMAGE             MBJ20026 R1341310
         TM    RQUEFLG3,QUEBEF+QUECNTL /*BEFORE OR /*CNTL SPECIFIED 053 R1341312
         BNZ   RILLBADC           YES - CARDS ARE OUT OF ORDER MBJ20053 R1341314
         OI    RQUEFLG3,QUEAFT     SET TO AFTER CARD           MBJ20026 R1341315
         LA    R15,7(,RPI)         SET START OF SCAN           MBJ20026 R1341325
         LA    RL1,RQUEDNAM       DEPENDENT JOB NAME AREA      MBJ20053 R1341327
         B     RMVENAM             TREAT LIKE BEFORE           MBJ20026 R1341330
         SPACE 3                                               MBJ20026 R1341335
RCNTCARD DS    0H                                              MBJ20026 R1341340
         LTR   JCT,JCT             TEST FOR JOB                MBJ20026 R1341345
         BZ    RILLCCRD            IGNORE CNTL CARD IF NOT     MBJ20026 R1341350
         OI    RCARDLRC,LRC1INUL+RDLMSKIP SHOW SUPERFLOUS      MBJ20026 R1341355
         BAL   RL1,RPUT            ADD CARD TO OUTPUT FILE     MBJ20026 R1341360
         TM    RDRSW,RJCLSW        TEST STATUS                 MBJ20026 R1341365
         BO    *+12                BRANCH IF JCL FILE          MBJ20026 R1341370
         BAL   RL1,RPUT            TERMINATE DATASET           MBJ20026 R1341375
         OI    RDRSW,RJCLSW        SET JCL SWITCH              MBJ20026 R1341380
         MVC   JCTWORK(79),0(RPI)  SAVE CARD IMAGE             MBJ20026 R1341385
         OI    RQUEFLG3,QUECNTL    SET TO CNTL CARD            MBJ20026 R1341390
         LA    R15,6(,RPI)         SET START OF SCAN           MBJ20026 R1341500
         LA    R0,30               MAX FOR SEARCH              MBJ20026 R1341505
RCTLFIND CLI   0(R15),C' '         NON BLANK                   MBJ20026 R1341510
         BNE   RCTLGOT             YEP, GOT IT.                MBJ20026 R1341520
         LA    R15,1(,R15)         BUMP TO NEXT POSITION       MBJ20026 R1341530
         BCT   R0,RCTLFIND         CONTINUE                    MBJ20026 R1341540
         B     RILLBADC            ERROR IF HERE               MBJ20026 R1341550
RCTLGOT  LA    R0,8                MAX FOR SEARCH              MBJ20026 R1341560
         LR    R14,R15             SAVE STARTING POINT         MBJ20026 R1341570
REXCFIND CLI   1(R14),C','         FIND , EXC  ,SHR            MBJ20026 R1341580
         BE    REXCGOT             GOT IT                      MBJ20026 R1341590
         CLI   1(R14),C' '        BLANK TERMINATES NAME ALSO   MBJ20053 R1341593
         BE    REXCGOT            GOT IT                       MBJ20053 R1341596
         LA    R14,1(,R14)         POINT TO NEXT POSITION      MBJ20026 R1341600
         BCT   R0,REXCFIND         CONTINUE                    MBJ20026 R1341605
         B     RILLBADC           ERROR IF HERE                MBJ20053 R1341610
REXCGOT  CLC   2(3,R14),=C'EXC'    EXCLUSIVE CONT DESIRED      MBJ20026 R1341615
         BNE   RTRYSHR             NO TRY SHR                  MBJ20026 R1341620
         NI    0(R15),X'7F'       SET TO EXCLUSIVE             MBJ20053 R1341625
REXCPUT  SR    R14,R15             GET LENGTH-1                MBJ20026 R1341630
         SLR   RL1,RL1            ZERO FOR IC                  MBJ20053 R1341631
         IC    RL1,RQUEFLG3       FLAGS AND CNTL COUNT         MBJ20053 R1341632
         SRL   RL1,4              SHIFT OUT FLAGS              MBJ20053 R1341633
         TM    RQUEFLG3,QUEAFT+QUEBEF /*AFTER AND/OR /*BEFORE  MBJ20053 R1341634
         BZ    RCTLCTL            NO - FIRST CNTL NAME         MBJ20053 R1341635
         BM    RCTLBEF            ONE - SECOND CNTL NAME       MBJ20053 R1341636
         LA    RL1,1(0,RL1)       THIRD CNTL NAME              MBJ20053 R1341637
RCTLBEF  LA    RL1,1(0,RL1)       SECOND CNTL NAME             MBJ20053 R1341638
RCTLCTL  LA    RL2,QUENCTL        MAX # OF NAMES               MBJ20053 R1341639
         CR    RL1,RL2            LESS THAN MAX #              MBJ20053 R1341640
         BNL   RILLBADC           NO - TOO MANY SPECIFICATIONS MBJ20053 R1341641
         SLL   RL1,3              TIMES 8                      MBJ20053 R1341642
         LA    RL2,RQUEDNAM(RL1)  PROPER NAME DISPLACEMENT     MBJ20053 R1341643
         MVI   0(RL2),C' '        BLANK                        MBJ20053 R1341644
         MVC   1(7,RL2),0(RL2)       OUT NAME                  MBJ20053 R1341645
         STC   R14,*+L'*+1        SET LENGTH IN MVC            MBJ20053 R1341646
         MVC   0(0,RL2),0(R15)    MOVE IN CNTL NAME            MBJ20053 R1341647
         IC    RL1,RQUEFLG3       FLAGS AND CNTL COUNT         MBJ20053 R1341648
         LA    RL1,16(0,RL1)       BUMP CNTL COUNT             MBJ20053 R1341650
         STC   RL1,RQUEFLG3       FLAGS AND CNTL COUNT         MBJ20053 R1341652
         OI    0(R15),X'80'        MAKE VALID AGAIN            MBJ20053 R1341653
         B     ROPSHIFT            GO END NORMALLY             MBJ20026 R1341655
RTRYSHR  CLC   2(3,R14),=C'SHR'    IS IT SHR                   MBJ20026 R1341660
         BE    REXCPUT             YES, MOVE NAME AND EXIT     MBJ20026 R1341665
         CLI   1(R14),C' '        BLANK                        MBJ20053 R1341667
         BE    REXCPUT            YES - MOVE NAME AND EXIT     MBJ20053 R1341669
         SPACE 3                                               MBJ20026 R1341670
RILLBADC DS    0H                                              MBJ20026 R1341675
         MVI   0(RPI),C'0'         FORCE DOUBLE SPACE          MBJ20026 R1341680
         MVI   1(RPI),C'*'         FILL OUT CARD IMAGE         MBJ20026 R1341690
         MVC   2(78,RPI),1(RPI)    WITH ASTERISKS              MBJ20026 R1341700
         MVC   (81-46)/2(46,RPI),RSHRVLID+4 MV IN ERROR MSG    MBJ20026 R1341710
         MVI   RCARDLRC,LRC1CCTL+LRC1TASA ASA CONT CHAR        MBJ20026 R1341720
         BAL   RL1,RPUT            ADD TO OUTPUT FILE          MBJ20026 R1341730
         $WTO  RSHRVLID,L'RSHRVLID,JOB=YES,  ISSUE ERR         MBJ20026CR1341740
               ROUTE=$LOG+$UR,CLASS=$TRIVIA,PRI=$ST    MSG     MBJ20026 R1341750
         BAL   RL1,RJOBKILL        KILL JOB                    MBJ20026 R1341760
         LA    RL2,RFLTEST         ADDRESS OF EXIT             MBJ20026 R1341770
         $RETURN                   AND RETURN                  MBJ20026 R1341780
         EJECT                                                 MBJ20026 R1341790
         CLC   0(3,R1),=C'XEQ'    IS IT SHRSPL XEQ ?           MBJ20026 R1514050
         BE    RXEQCARD           YES, GO PROCESS              MBJ20026 R1514100
ROUTEXIT B     ROPSHIFT            BR IF VALID DEST.           MBJ20026 R1526100
RXEQCARD DS    0H                                              MBJ20026 R1534010
         LA    WA,3(,R1)           SET FOR THIRD OPERAND       MBJ20026 R1534020
         LA    R1,64               MAXIMUM FOR SEARCH          MBJ20026 R1534030
RRCOMP3  CLI   0(WA),C' '          CHARACTER YET               MBJ20026 R1534040
         BNE   RXEQOP3             YES DO THIRD OPERAND        MBJ20026 R1534050
         LA    WA,1(WA)            STEP TO NEXT                MBJ20026 R1534060
         BCT   R1,RRCOMP3          LOOP TILL END               MBJ20026 R1534070
         B     RILLROUT            ERROR IF END OF CARD        MBJ20026 R1534080
RXEQOP3  CLC   0(3,WA),=C'CPU'     CPU ROUTING?                MBJ20026 R1534090
         BNE   ROUTHERE            NO TRY HERE                 MBJ20026 R1534100
         IC    WE,3(WA)            GET DIGIT                   MBJ20026 R1534110
         SLL   WE,28               GET RID OF ZONES            MBJ20026 R1534120
         SRL   WE,28               PUT BACK                    MBJ20026 R1534130
         STC   WE,RCPUCOMP+1       STORE FOR COMPARE           MBJ20026 R1534140
         L     R15,$QSE1           POINT TO FIRST QSE          MBJ20026 R1534150
         USING QSEDSECT,R15        ADDRESS IT                  MBJ20026 R1534160
RCPUCOMP CLI   QSESIBSY,*-*        IS IT THIS QSE?             MBJ20026 R1534170
         BE    ROUTCPU             YES CONTINUE                MBJ20026 R1534180
         TM    QSEFLAGS,QSELAST    IS IT LAST QSE?             MBJ20026 R1534190
         BO    RILLROUT            YES, ERROR                  MBJ20026 R1534200
         AH    R15,=AL2(QSELEN)    NO, GO TO NEXT QSE          MBJ20026 R1534210
         B     RCPUCOMP            GO TRY COMPARE AGAIN        MBJ20026 R1534220
ROUTCPU  DS    0H                                              MBJ20026 R1534222
         MVI   RDRSIAFF,0          CLEAR ANY CPU ROUTING.      MBJ20026 R1534224
         OC    RDRSIAFF,QSESIAFF   SET CPU AFFINITY            MBJ20026 R1534230
         B     ROUTEXIT            GO EXIT.                    MBJ20026 R1534240
ROUTHERE CLC   0(4,WA),=C'HERE'    IS IT ROUTHERE              MBJ20026 R1534250
         BNE   ROUTRES             NO, GO TRY RESOURCES.       MBJ20026 R1534260
         LA    R15,$SIDAFF-(QSESIAFF-QSEDSECT) POINT TO QSE    MBJ20026 R1534270
         MVI   RDRSIAFF,0          CLEAR ANY CPU ROUTING.      MBJ20026 R1534275
         OC    RDRSIAFF,QSESIAFF   SET CPU AFFINITY            MBJ20026 R1534280
         B     ROUTEXIT            GO EXIT                     MBJ20026 R1534290
ROUTRES  LA    WE,1                SET ONE BIT ON IN MASK      MBJ20026 R1534400
         SLL   WE,24-1             SHIFT OVER MAXRES-1         MBJ20026 R1534410
         LA    R15,$RESTAB         POINT TO RESOURCE TABLE     MBJ20026 R1534420
         LA    R1,24               MAXIMUM RESOURCES           MBJ20026 R1534430
RRCOMP4  CLC   0($RESLEN,WA),0(R15) CMPARE FOR RESOURCE EQUAL  MBJ20026 R1534440
         BE    RFINDRES            BR IF HIT.                  MBJ20026 R1534450
         LA    R15,$RESLEN(,R15)   GO TO NEXT TABLE ENTRY      MBJ20026 R1534460
         SRL   WE,1                SHIFT MASK 1 BIT            MBJ20026 R1534470
         BCT   R1,RRCOMP4          GO TRY AGAIN.               MBJ20026 R1534480
         B     RILLROUT            NO HIT, ERROR               MBJ20026 R1534490
RFINDRES LA    R15,24/8            NO. OF BYTES IN MASK        MBJ20026 R1534500
         LA    R1,RQUERESR+(24/8)-1 ADDR OF LAST BYTE OF -     MBJ20026 R1534510
*                                   RESOURCE MASK IN JQE       MBJ20026 R1534520
RRESTOP  STC   WE,RSAVE1           SAVE A BYTE FOR OR'ING      MBJ20026 R1534530
         OC    0(1,R1),RSAVE1      OR IN A BYTE OF RESOURCE    MBJ20026 R1534540
         SRL   WE,8                SHIFT TO NEXT BYTE OF MASK  MBJ20026 R1534550
         BCTR  R1,0                BACKUP RQUERER POINTER      MBJ20026 R1534560
         BCT   R15,RRESTOP         GO PUT IN NEXT BYTE         MBJ20026 R1534570
         MVC   RMESSAGE(L'ROUTRESM),ROUTRESM MOVE IN MSG.      MBJ20026 R1534580
         MVC   RMESSAGE+25($RESLEN),0(WA) MOVE IN RESOURCE     MBJ20026 R1534590
         $WTO  RMESSAGE,L'ROUTRESM,JOB=YES,   PUT OUT          MBJ20026CR1534600
               ROUTE=$LOG+$MAIN,CLASS=$ACTION,PRI=$ST THE MSG  MBJ20026 R1534610
         B     ROUTEXIT            GO EXIT.                    MBJ20026 R1534620
ROUTRESM $MSG  118,'-- RESOURCE ROUTING -- ******** '          MBJ20026 R2312050
RSHRVLID $MSG  114,'-- INVALID /*BEFORE AFTER OR CNTL SPECIFICATION' 26 R2312350
         $RESTABL                  GENERATE RESOURCE TABLE.    MBJ20026 R2312560
         SPACE 3                                               MBJ20026 R2312570
         MVI   RQUEDNAM,C' '      BLANK                        MBJ20053 R2489501
         MVC   RQUEDNAM+1(31),RQUEDNAM OUT NAMES               MBJ20053 R2489502
         XC    RQUERESR(4),RQUERESR CLEAR REMAINING            MBJ20053 R2489503
         MVC   JQEDNAME(36),RQUEDNAM PUT IN ANY RESOURCE STUFF MBJ20053 R3869050
++MAC($RESTABL) DISTLIB(HASPSRC).
         MACRO -- $RESTABL -- EXECUTION RESOURCE TABLE.        MBJ20026 RT001000
         $RESTABL &DUMMY                                       MBJ20026 RT001500
*                                                              MBJ20026 RT002000
*        DO NOT CHANGE THE ORDER OF THESE RESOURCES AFTER THEY MBJ20026 RT003000
*        HAVE BEEN ATTACHED.........                           MBJ20026 RT004000
*                                                              MBJ20026 RT005000
*        THE FOLLOWING APPLIES ONLY TO MELLON BANK -           MBJ20026 RT005010
*        WHEN RESOURCES ARE ADDED OR DELETED FROM THIS TABLE   MBJ20026 RT005020
*        BESURE TO UPDATE TSO HELP RESOURCE MEMBER.            MBJ20026 RT005030
$RESLEN  EQU   8                                               MBJ20026 RT006000
$RESTAB  DS    0H                                              MBJ20026 RT007000
         DC    CL8'DUALD'          DUALD DENSITY DRIVE         MBJ20026 RT008000
         DC    CL8'TAPE7'          7 TRACK TAPE DRIVES.        MBJ20026 RT009000
         DC    CL8'SPWORK'         SP RESOURCE.                MBJ20026 RT010000
         DC    CL8'3525'           3525 PUNCH/INTERPRET        MBJ20026 RT011000
         DC    CL8'NOINQ'          ANYWHERE BUT INQUIRY.       MBJ20026 RT012000
         DC    CL8'ARCHIVE'                                    MBJ20026 RT013000
         DC    CL8'GIS'            GIS PACKS.                  MBJ20026 RT014000
         DC    CL8'TSO'            TIME SHARING SYSTEM.        MBJ20026 RT015000
         DC    CL8'INQUIRY'        ONLINE INQUIRY SYSTEM.      MBJ20026 RT016000
         DC    CL8'TRIMS'          TRUST IMS DATABASE.         MBJ20026 RT017000
         DC    CL8'FDR'                                        MBJ20026 RT018000
         DC    CL8'OVERNITE'                                   MBJ20026 RT019000
         DC    CL8'CHECKWTR'       UTILITY CHECK WRITER.       MBJ20026 RT020000
         DC    CL8'MSS'           MASS STORAGE                 MBJ20026 RT020050
         DC    CL8'AUTODIAL'      OLS-370                      MBJ20026 RT020100
         DC    CL8'ZIMS'                                       MBJ20026 RT021000
         DC    CL8'NOTSO '                                     MBJ20026 RT021010
         DC    CL8'7FLOOR'                                     MBJ20026 RT021015
         DC    CL8'NITEXMIT'                                   MBJ20026 RT021020
         DC    CL8'EMPTY9'                                     MBJ20026 RT021025
         DC    CL8'EMPTYA'                                     MBJ20026 RT021030
         DC    CL8'EMPTYB'                                     MBJ20026 RT021035
         DC    CL8'EMPTYC'                                     MBJ20026 RT021040
         DC    CL8'EMPTYD'                                     MBJ20026 RT021045
$NOLEFT  EQU   (*-$RESTAB)/$RESLEN NUMBER OF ENTRIES.          MBJ20026 RT022000
         MEND                                                  MBJ20026 RT023000
++SRC(MBDNDQ) DISTLIB(HASPSRC).
*        COPY MBDNDQ      COPY   MELLON JOB QUEUE COMMANDS     MBJ20026 K1766000
HASPCJMB $COMGRUP DN,DQ          MELLON JOB QUEUE COMMANDS     MBJ20026 K1766000
***************************************************************MBJ20026 K1895000
*                                                             *MBJ20026 K1895002
*        $DN -- DISPLAY INFORMATION ON EACH QUEUED JOB.       *MBJ20026 K1895004
*                                                             *MBJ20026 K1895006
*        SEE $DQ FOR FORMAT OF OPERANDS.                      *MBJ20026 K1895008
*                                                             *MBJ20026 K1895010
*        NOTE: $DN,ALL IS NOT ALLOWED... IT WILL RECIEVE      *MBJ20026 K1895012
*              ONLY A SPOOL UTILIZATION MESSAGE AS RESPONSE.  *MBJ20026 K1895014
*                                                             *MBJ20026 K1895016
***************************************************************MBJ20026 K1895018
         SPACE 1                                               MBJ20026 K1895020
         USING JQEDSECT,R1         JQE ADDRESSABILITY          MBJ20026 K1895021
CDN      DS    0H                                              MBJ20026 K1895022
         MVI   MDNFLAG1,MDNBIT     REMEMBER $DN                MBJ20026 K1895024
         B     MDQBREAK            AND JOIN WITH $DQ           MBJ20026 K1895026
         SPACE 5                                               MBJ20026 K1895028
***************************************************************MBJ20026 K1895030
*                                                             *MBJ20026 K1895032
*        $DQ -- DISPLAY COUNT OF QUEUED JOBS.                 *MBJ20026 K1895034
*                                                             *MBJ20026 K1895036
*        FORMAT OF OPERANDS (SAME FOR $DN) -                  *MBJ20026 K1895038
*                                                             *MBJ20026 K1895040
*        $DX,SID,N1-N2,QTYPE                                  *MBJ20026 K1895042
*          SID - JOBS WITH AFFINITY FOR THIS SYSTEM           *MBJ20026 K1895044
*                'ANY' - AFFINITY FOR ANY SYSTEM.             *MBJ20026 K1895046
*                '68#X'- AFFINITY FOR THE SPECIFIC SYSTEM.    *MBJ20026 K1895048
*          N1  - RJE #                                        *MBJ20026 K1895050
*          N2  - RJE # (2ND OPTIONAL) - TOGETHER WITH N1 FORM *MBJ20026 K1895052
*                A RANGE OF RJE #S. ALL JOBS WITH OUTPUT      *MBJ20026 K1895054
*                ROUTED TO THESE RJE'S WITH BE PROCESSED.     *MBJ20026 K1895056
*          QTYPE - SPECIFIC JOB STATUS QUEUE ENTRIES.         *MBJ20026 K1895058
*              ALL  - ALL JOBS IN ALL QUEUES - $DQ ONLY       *MBJ20026 K1895060
*              CON  - ALL JOBS IN CONVERSION QUEUE.           *MBJ20026 K1895062
*             *XEQ  - ALL JOBS AWAITING EXECUTION.            *MBJ20026 K1895064
*             *RES  - ALL JOBS AWAITING EXECUTION, WITH       *MBJ20026 K1895066
*                     SOME SPECIFIC RESOURCE ROUTING.         *MBJ20026 K1895068
*              HELD - JOBS AWAITING EXECUTION OR CONVERSION   *MBJ20026 K1895070
*                     WHICH ARE HELD FOR ANY REASON.          *MBJ20026 K1895072
*              OUT  - ALL JOBS AWAITING THE OUTPUT PROCESSOR. *MBJ20026 K1895074
*              PPU  - ALL JOBS AWAITING PRINT/PUNCH.          *MBJ20026 K1895076
*                                                             *MBJ20026 K1895078
*           * - A SPECIFIC JOB CLASS MAY BE REQUESTED,        *MBJ20026 K1895080
*               OR STC OR TSU.                                *MBJ20026 K1895082
*                                                             *MBJ20026 K1895084
*        NOTE- $DQ WITH NO OPERANDS IS SAME AS $DQ,ALL        *MBJ20026 K1895086
*                                                             *MBJ20026 K1895088
***************************************************************MBJ20026 K1895090
         SPACE 1                                               MBJ20026 K1895092
CDQ      DS    0H                                              MBJ20026 K1895094
         MVI   MDQFLAG,MDQBIT      REMEMBER $DQ                MBJ20026 K1895096
         USING MDQDSECT,WB         $DQ ADDRESSABILITY OF CRESAREA 20026 K1895098
         EJECT                                                 MBJ20026 K1895100
MDQBREAK DS    0H                  SCAN OPERANDS               MBJ20026 K1895102
         LR    R0,WD               SAVE OPERAND REGISTER       MBJ20026 K1895104
         L     WA,=A(CRESAREA)     POINT TO WORKAREA           MBJ20026 K1895106
         LA    WB,MDQLEN           SET LENGTH TO CLEAR         MBJ20026 K1895108
         SLR   WD,WD               SET LENGTH2 AND PAD TO X'00' BJ20026 K1895110
         MVCL  WA,WC               CLEAR WORKAREA TO X'00'     MBJ20026 K1895112
         LR    WD,R0               RESTORE FIRST OPERAND REGISTER 20026 K1895114
         MVI   MDQCPU,QUESYSAF     SET DEFAULT SYSTEM ID 'ANY' MBJ20026 K1895116
         MVI   MDQRMLO,0           SET DEFAULT LOW REMOTE      MBJ20026 K1895118
         LH    WA,$NUMRJE         GET NUMBER OF RMTS           MBJ20026 K1895119
         STCM  WA,1,MDQRMHI       GET DEFAULT HIGH REMOTE      MBJ20026 K1895120
         TM    COMFLAG,CMBFLAGR   Q. REMOTE ISSUER             MBJ20026 K1895121
         BZ    MDQLOCAL            A. NO  - DEFAULTS OK        MBJ20026 K1895122
         IC    WA,COMUCM           A. YES - GET HIS ROUTCODE   MBJ20026 K1895123
         STC   WA,MDQRMLO          REMOTE ISSUER - SET LIMIT   MBJ20026 K1895126
         STC   WA,MDQRMHI          FOR ONLY HIS JOBS           MBJ20026 K1895128
MDQLOCAL DS    0H                                              MBJ20026 K1895129
         LA    WA,HCTDSECT         POINT TO HCT                MBJ20026 K1895130
         L     WA,($RATABLE-HCTDSECT)(,WA) POINT TO RAT ORIGIN MBJ20026 K1895132
         USING RATDSECT,WA         ADDRESS THE RAT             MBJ20026 K1895134
         LA    R10,1               START WITH REMOTE 1         MBJ20026 K1895136
         LA   WC,4                 START WITH OFFSET = 4       MBJ20026 K1895138
         L     WB,=A(CRESAREA)     POINT TO WORKAREA           MBJ20026 K1895140
MDQBLDRM LH    R0,RATROUTE         GET REMOTE ROUTCODE         MBJ20026 K1895142
         STH   R0,MDQRMTAB+2(WC)   SAVE IN TABLE               MBJ20026 K1895143
         STH   R10,MDQRMTAB(WC)    PUT REMOTE # IN TOO         MBJ20026 K1895144
         LA    WC,4(,WC)           BUMP TO NEXT TABLE ENTRY    MBJ20026 K1895146
         LH    R0,$NUMRJE         GET NUMBER OF REMOTES        MBJ20026 K1895147
         CR    R10,R0             Q. ANY MORE REMOTES          MBJ20026 K1895148
         BNL   MDQBUILT            A. NO - TABLE IS BUILT      MBJ20026 K1895150
         LA    R10,1(,R10)         NEXT RJE NUMBER             MBJ20026 K1895152
         LA    WA,RATEND           POINT TO NEXT RAT           MBJ20026 K1895154
         B     MDQBLDRM            AND LOOP                    MBJ20026 K1895156
MDQBUILT MVC   MDQRMEND,=F'-1'     SET END OF TABLE            MBJ20026 K1895158
         XC    MDQHEADS,MDQHEADS   SET HI/LO JQE HEADERS TO 0  MBJ20026 K1895160
         BXH   WD,WE,MDQNOPER      NEXT OPERAND (IF ANY)       MBJ20026 K1895162
         L     R1,0(,WD)           GET NEXT OPERAND ADDRESS    MBJ20026 K1895164
         CLC   0(3,R1),=C'ANY'     Q. REQUEST FOR ANY          MBJ20026 K1895166
         BE    MDQOPER2            A. YES - SET AND GET NEXT   MBJ20026 K1895168
         L     WA,$QSE1            POINT TO FIRST QSE          MBJ20026 K1895170
         USING QSEDSECT,WA         ADDRESS THE QSE             MBJ20026 K1895172
MDQCKSID CLC   QSESID,0(R1)        Q. THIS SYS REQUESTED       MBJ20026 K1895174
         BE    MDQSYSID            A. YES - GO SET AFFINITY    MBJ20026 K1895176
         TM    QSEFLAGS,QSELAST    Q. WAS THIS THE LAST QSE    MBJ20026 K1895178
         BO    MDQCKRMT            A. NO - MAY BE A REMOTE REQ MBJ20026 K1895180
         AH    WA,=AL2(QSELEN)     POINT TO NEXT QSE           MBJ20026 K1895182
         B     MDQCKSID            AND LOOP                    MBJ20026 K1895184
MDQSYSID MVC   MDQCPU,QSESIAFF     SET REQUESTED AFFINITIES    MBJ20026 K1895186
         DROP  WA                  DROP QSE ADDRESSABILITY     MBJ20026 K1895188
MDQOPER2 OI    MDQFLAG,MDQSPEC     REMEMBER SPECIAL REQUEST    MBJ20026 K1895190
         BXH   WD,WE,MDQNOPER      GET PNTR NEXT OPERAND IF ANYMBJ20026 K1895192
MDQCKRMT L     R1,0(WD)            GET NEXT OPERAND            MBJ20026 K1895193
         CLI   0(R1),C'0'          INSURE NUMERIC.             MBJ20026 K1895194
         BL    MDQOPER3            IF NOT CHECK FURTHER.       MBJ20026 K1895195
        $CFCVB POINTER=(WD),NOK=MDQOPER3,NUM=2                 MBJ20026 K1895196
         TM    COMFLAG,CMBFLAGR    Q. LOCAL REQUESOR           MBJ20026 K1895198
         BNZ   MDQRMOUT            A. NO - DONT SET THEM THEN  MBJ20026 K1895200
         STC   R1,MDQRMLO          A. YES - SET LOW REQUESTED  MBJ20026 K1895202
         STC   R0,MDQRMHI                   SET HIGH REQUESTED MBJ20026 K1895204
MDQRMOUT BXLE  WD,WE,MDQOPER3      GET NEXT OPERAND AND SCAN IT BJ20026 K1895206
MDQNOPER TM    MDQFLAG,MDQBIT      Q. WAS IT $DQ,ALL           MBJ20026 K1895208
         BZ    MDQEND              A. NO - JUST SPOOL UTILIZATIMBJ20026 K1895210
         OI    MDQFLAG,MDQALL      REMEMBER $DQ,ALL            MBJ20026 K1895212
         MVI   MDQHEADL,MDQALLL    SET LOW HEADER OFFSET       MBJ20026 K1895214
         MVI   MDQHEADH,MDQALLH    SET HIGH HEADER OFFSET      MBJ20026 K1895216
         LA    WF,MDQXEQ           SET INITIAL SUBPROC.        MBJ20026 K1895218
         B     MDQSTART            AND START SCAN              MBJ20026 K1895220
         SPACE 1                                               MBJ20026 K1895222
MDQOPER3 L     R1,0(,WD)           GET LAST OPERAND            MBJ20026 K1895224
         CLC   0(3,R1),=C'ALL'     A. REQUEST FOR ALL          MBJ20026 K1895226
         BE    MDQNOPER            A. YES - SAME AS NO REQUEST MBJ20026 K1895228
         SPACE 1                                               MBJ20026 K1895230
MDQCONT  CLC   0(3,R1),=C'CON'     Q. REQUEST FOR 'CON'        MBJ20026 K1895232
         BNE   MDQXEQT             A. NO - MAYBE 'XEQ'         MBJ20026 K1895234
         MVI   MDQHEADL,MDQCONL    SET LOW HEADER OFFSET       MBJ20026 K1895236
         MVI   MDQHEADH,MDQCONH    SET HIGH HEADER OFFSET      MBJ20026 K1895238
         LA    WF,MDQCON           SET INITIAL SUBPROC.        MBJ20026 K1895240
         B     MDQSTART            AND START SCAN              MBJ20026 K1895242
         SPACE 1                                               MBJ20026 K1895244
MDQXEQT  CLC   0(3,R1),=C'XEQ'     Q. REQUEST FOR 'XEQ'        MBJ20026 K1895246
         BNE   MDQREST             A. NO - MAYBE 'RES'         MBJ20026 K1895248
         LA    WF,MDQXEQ           SET INITIAL SUBPROC.        MBJ20026 K1895250
         CLI   3(R1),C' '          Q. SPECIFIC JOB CLASS REQUESMBJ20026 K1895252
         BNE   MDQCLREQ            A. YES - SET LIMITS BY JOB CMBJ20026 K1895254
         MVI   MDQHEADL,MDQXEQL    SET LOW HEADER OFFSET       MBJ20026 K1895256
         MVI   MDQHEADH,MDQXEQH    SET HIGH HEADER OFFSET      MBJ20026 K1895258
         B     MDQSTART            AND START SCAN              MBJ20026 K1895260
         SPACE 1                                               MBJ20026 K1895262
MDQREST  CLC   0(3,R1),=C'RES'     Q. REQUEST FOR 'RES'        MBJ20026 K1895264
         BNE   MDQHLDT             A. NO - MAYBE HOLD          MBJ20026 K1895266
         LA    WF,MDQRES           SET INITIAL SUBPROC.        MBJ20026 K1895268
         CLI   3(R1),C' '          Q. SPECIFIC CLASS REQUESTED MBJ20026 K1895270
         BNE   MDQCLREQ            A. YES - SET LIMITS BY JOB CMBJ20026 K1895272
         MVI   MDQHEADL,MDQRESL    SET LOW HEADER OFFSET       MBJ20026 K1895274
         MVI   MDQHEADH,MDQRESH    SET HIGH HEADER OFFSET      MBJ20026 K1895276
         B     MDQSTART            AND START SCAN              MBJ20026 K1895278
         SPACE 1                                               MBJ20026 K1895280
MDQHLDT  CLC   0(4,R1),=C'HOLD'    Q. REQUEST FOR 'HOLD'       MBJ20026 K1895282
         BNE   MDQOUTT             A. NO - MAYBE 'OUT'         MBJ20026 K1895284
         MVI   MDQHEADL,MDQHLDL    SET LOW HEADER LIMIT        MBJ20026 K1895286
         MVI   MDQHEADH,MDQHLDH    SET HIGH HEADER LIMIT       MBJ20026 K1895288
         LA    WF,MDQHLD           SET INITIAL SUBPROC.        MBJ20026 K1895290
         B     MDQSTART            AND START SCAN              MBJ20026 K1895292
         SPACE 1                                               MBJ20026 K1895294
MDQOUTT  CLC   0(3,R1),=C'OUT'     Q. REQUEST FOR 'OUT'        MBJ20026 K1895296
         BNE   MDQPPUT             A. NO - MAYBE 'PPU'         MBJ20026 K1895298
         MVI   MDQHEADL,MDQOUTL    SET LOW HEADER LIMIT        MBJ20026 K1895300
         MVI   MDQHEADH,MDQOUTH    SET HIGH HEADER LIMIT       MBJ20026 K1895302
         LA    WF,MDQOUT           SET INITIAL SUBPROC.        MBJ20026 K1895304
         B     MDQSTART            AND START SCAN              MBJ20026 K1895306
         SPACE 1                                               MBJ20026 K1895308
MDQPPUT  CLC   0(3,R1),=C'PPU'     Q. REQUEST FOR 'PPU'        MBJ20026 K1895310
         BNE   MDQABEND            A. NO - ASSUME NO OPERANDS  MBJ20026 K1895312
         MVI   MDQHEADL,MDQPPUL    SET LOW HEADER LIMIT        MBJ20026 K1895314
         MVI   MDQHEADH,MDQPPUH    SET HIGH HEADER LIMIT       MBJ20026 K1895316
         LA    WF,MDQPPU           SET INITIAL SUBPROC.        MBJ20026 K1895318
         B     MDQSTART            AND START SCAN              MBJ20026 K1895320
MDQABEND CLC   0(4,R1),=C'$0C1'   DO WE DIE                    MBJ20026 K1895321
         BNE   MDQNOPER           NO LET IT GO                 MBJ20026 K1895322
OC1      DC    XL4'00000000'      0C1 HERE                     MBJ20026 K1895323
MDQCLREQ DS    0H                  SPECIFIC JOB CLASS REQUESTEDMBJ20026 K1895324
         CLC   3(3,R1),=C'STC'     Q. STC REQUEST              MBJ20026 K1895326
         BE    MDQCLSTC            A. YES - SET LINITS         MBJ20026 K1895328
         CLI   3(R1),C'$'          Q. SHORTHAND FOR STC        MBJ20026 K1895330
         BNE   MDQTSREQ            A. NO - MAYBE TSU           MBJ20026 K1895332
MDQCLSTC MVI   MDQHEADL,MDQSTCL    SET LOW HEADER LIMIT        MBJ20026 K1895334
         MVI   MDQHEADH,MDQSTCH    SET HIGH HEADER LIMIT       MBJ20026 K1895336
         B     MDQSTART            AND START SCAN OF JOBQ      MBJ20026 K1895338
MDQTSREQ CLC   3(3,R1),=C'TSU'     Q. TSU REQUESTED            MBJ20026 K1895340
         BE    MDQCLTSU            A. YES - GO SET LIMITS      MBJ20026 K1895342
         CLI   3(R1),C'@'          Q. SHORTHAND FOR TSU        MBJ20026 K1895344
         BNE   MDQCLCHR            A. NO - MUST BE VALID CHARACT J20026 K1895346
MDQCLTSU MVI   MDQHEADL,MDQTSUL    SET LOW HEADER LIMIT        MBJ20026 K1895348
         MVI   MDQHEADH,MDQTSUH    SET HIGH HEADER LIMIT       MBJ20026 K1895350
         B     MDQSTART            AND START JOBQ SCAN         MBJ20026 K1895352
MDQCLCHR DS    0H                                              MBJ20026 K1895354
         NI    3(R1),X'7F'         CLEAR ACTIVE BIT            MBJ20026 K1895358
         SLR   WB,WB               CLEAR WB FOR INSERT         MBJ20026 K1895360
         IC    WB,3(R1)            GET CLASS INTO WB           MBJ20026 K1895362
         IC    WB,$QINDEX(WB)      GET JQE HEADER OFFSET       MBJ20026 K1895364
         LTR   WB,WB               Q. VALIE JOB CLASS          MBJ20026 K1895366
         BZ    MDQNOPER            A. NO - DEFAULT TO ALL      MBJ20026 K1895368
         STC   WB,MDQHEADH         SET AS HIGH HEADER          MBJ20026 K1895370
         BCTR  WB,0                - 2 FOR                     MBJ20026 K1895372
         BCTR  WB,0                    LOW HEADER              MBJ20026 K1895374
         STC   WB,MDQHEADL         SET AS LOW HEADER           MBJ20026 K1895376
         CLI   4(R1),C'-'          Q. RANGE OF CLASSES         MBJ20026 K1895378
         BNE   MDQSTART            A. NO - LETS GO             MBJ20026 K1895380
         NI    5(R1),X'7F'         CLEAR HI BIT                MBJ20026 K1895382
         IC    WB,5(R1)            GET CLASS IN WB             MBJ20026 K1895384
         IC    WB,$QINDEX(WB)      GET HEADER OFFSET           MBJ20026 K1895386
         LTR   WB,WB               Q. VALID CLASS              MBJ20026 K1895388
         BZ    MDQSTART            A. NO - START WITHOUT IT    MBJ20026 K1895390
         CLM   WB,1,MDQHEADL       Q. HIGHER THAN FIRST        MBJ20026 K1895392
         BNH   MDQSTART            A. NO - START WITHOUT IT    MBJ20026 K1895394
         STC   WB,MDQHEADH         A. YES - USE AS HIGH HEADER MBJ20026 K1895396
         B     MDQSTART            START SCAN                  MBJ20026 K1895398
         EJECT                                                 MBJ20026 K1895400
*************************************************************  MBJ20026 K1895402
***                                                       ***  MBJ20026 K1895404
***    TABLE FOR SETTING OF LOW AND HIGH HEADER VALUES    ***  MBJ20026 K1895406
***                                                       ***  MBJ20026 K1895408
***                   LOW      HIGH     INITIAL           ***  MBJ20026 K1895410
***          QTYPE   HEADER   HEADER   SUBPROCESSOR       ***  MBJ20026 K1895412
***          -----   ------   ------   ------------       ***  MBJ20026 K1895414
***           ALL       4       94      CDQXEQ            ***  MBJ20026 K1895416
***           PPU       2        4      CDQPPU            ***  MBJ20026 K1895418
***           OUT       4        6      CDQOUT            ***  MBJ20026 K1895420
***           CON      14       16      CDQCON            ***  MBJ20026 K1895422
***           XEQ     *24      *94      CDQXEQ            ***  MBJ20026 K1895424
***           XEQSTC   20       22      CDQXEQ            ***  MBJ20026 K1895426
***           XEQTSU   22       24      CDQXEQ            ***  MBJ20026 K1895428
***           RES     *24      *94      CDQRES            ***  MBJ20026 K1895430
***           HOLD     14       94      CDQHLD            ***  MBJ20026 K1895432
***                                                       ***  MBJ20026 K1895434
***    * - DEPENDENT UPON POSSIBLE REQUEST FOR A          ***  MBJ20026 K1895436
***        PARTICULAR JOB CLASS.                          ***  MBJ20026 K1895438
***                                                       ***  MBJ20026 K1895440
*************************************************************  MBJ20026 K1895442
         SPACE 2                                               MBJ20026 K1895444
MDQSTART DS    0H                  START JOBQ SCAN             MBJ20026 K1895446
         LA    WC,MDNCTR           ASSUME $DN                  MBJ20026 K1895448
         TM    MDQFLAG,MDQBIT      Q. WAS IT $DQ               MBJ20026 K1895450
         BZ    *+8                 A. NO - ASSUMPTION WAS RIGHTMBJ20026 K1895452
         LA    WC,MDQCTR           A. YES- CHANGE TO $DQ       MBJ20026 K1895454
         SPACE 1                                               MBJ20026 K1895456
MDQNHEAD DS    0H                  START A NEW JQE HEADER      MBJ20026 K1895458
         LH    R15,MDQHIGH         GET CURRENT HEADER          MBJ20026 K1895460
         BCTR  R15,0               DECREMENT TO                MBJ20026 K1895462
         BCTR  R15,0                 NEXT LOWER HEADER         MBJ20026 K1895464
         STH   R15,MDQHIGH         AND RESET AS CURRENT        MBJ20026 K1895466
         LA    R1,$JQHEADS-(JQECHAIN-JQEDSECT)(R15)            MBJ20026XK1895468
                                   SET R1 TO LOOK LIKE A JQE   MBJ20026 K1895470
         SPACE 1                                               MBJ20026 K1895472
MDQNEXT  DS    0H                  GET THE NEXT JQE ON CHAIN   MBJ20026 K1895474
         LH    R1,JQECHAIN         GET OFFSET TO NEXT          MBJ20026 K1895476
         N     R1,=A(X'0000FFFF')  CLEAR UPPER BYTES           MBJ20026 K1895478
         BZ    MDQENDCH            IF 0, END OF CHAIN          MBJ20026 K1895480
         SLL   R1,2                * 4 FOR TRUE OFFSET         MBJ20026 K1895482
         AL    R1,$JOBQPTR         CALCULATE JQE ADDRESS (ABSOLMBJ20026 K1895484
         B     4(,WF)              BRANCH TO SUB-PROCESSOR     MBJ20026 K1895486
         SPACE 1                                               MBJ20026 K1895488
MDQENDCH DS    0H                  END OF A CHAIN SEGMENT      MBJ20026 K1895490
         CLC   MDQHIGH,MDQLOW      Q. WAS THAT THE LAST SEGMENTMBJ20026 K1895492
         BNH   0(,WF)              A. YES-BRANCH TO EDITOR     MBJ20026 K1895494
         B     MDQNHEAD            A. NO - GET NEXT HEADER     MBJ20026 K1895496
         SPACE 3                                               MBJ20026 K1895498
MDQXEQ   B     MDQXEQE       *** GENERAL ENTRY TO EDITOR ***   MBJ20026 K1895500
         CLI   JQETYPE,$XEQ        Q. AT END OF XEQ JQE'S      MBJ20026 K1895502
         BE    MDQXEQE             A. YES - 2ND ENTRY TO EDITORMBJ20026 K1895504
         TM    JQETYPE,$XEQ        Q. IN ANNY EXECUTION QUEUE  MBJ20026 K1895506
         BZ    MDQXEQE             A. NO - EDIT THE COUNT      MBJ20026 K1895508
         BR    WC                  A. NO - ENTER JQE PROCESSOR MBJ20026 K1895510
         SPACE 1                                               MBJ20026 K1895512
MDQXEQE  TM    MDQFLAG,MDQBIT      Q. $DQ                      MBJ20026 K1895514
         BZ    MDQEND              A. NO - FINISH WITH SPOOL   MBJ20026 K1895516
         L     WB,=A(CRESAREA)     POINT TO WORKAREA           MBJ20026 K1895518
         MVC   COMMAND(17),=C'EXECUTION BACKLOG'   TITLE       MBJ20026 K1895520
         LR    WD,R1               SAVE JQE REG OVER CALLS     MBJ20026 K1895522
        $CWTO  L=17                                            MBJ20026 K1895523
         LR    R1,WD               RESTORE JQE POINTER         MBJ20026 K1895524
         TM    MDQFLAG,MDQSPEC     Q. SPECIAL SYSTEM REQUESTED MBJ20026 K1895525
         BNO   *+12                A. NO - GO AHEAD WITH DISPLAY J20026 K1895526
         CLI   MDQCPU,QUESYSAF     Q. WAS THE REQUEST FOR ANY  MBJ20026 K1895527
         BNE   MDQXEQE1            A. NO - GO CHECK EACH SYSTEM BJ20026 K1895528
         MVC   COMMAND(4),=CL4'ANY '          SUB-TITLE        MBJ20026 K1895529
         MVC   COMMAND+4(L'COMMAND-4),COMMAND+3   CLEAR        MBJ20026 K1895530
         LA    WD,MDQANYCT         POINT TO BUCKET FOR 'ANY'   MBJ20026 K1895532
         BAL   WA,MDQCLASS         PROCESS IT                  MBJ20026 K1895534
MDQXEQE1 LA    WD,MDQCPUCT         POINT TO BUCKET FOR CPU1    MBJ20026 K1895536
         L     WC,$QSE1            POINT TO QSE FOR CPU1       MBJ20026 K1895538
         USING QSEDSECT,WC         QSE ADDRESSABILITY          MBJ20026 K1895539
MDQXEQE2 TM    MDQFLAG,MDQSPEC     Q. SPECIAL SYSTEM REQUESTED MBJ20026 K1895540
         BNO   *+14                A. NO - CONTINE WITH DISPLAY BJ20026 K1895541
         CLC   MDQCPU,QSESIAFF     Q. WAS THIS SYSTEM REQUESTED BJ20026 K1895542
         BNE   MDQXEQE4            A. NO - GO CHECK NEXT SYSTEM BJ20026 K1895543
         MVC   COMMAND(4),QSESID   SUB-TITLE                   MBJ20026 K1895544
         MVI   COMMAND+4,C' '                  CLEAR LINE      MBJ20026 K1895545
         MVC   COMMAND+5(L'COMMAND-5),COMMAND+4  TO BLANKS     MBJ20026 K1895546
         BAL   WA,MDQCLASS         PROCESS CPU'S QUEUE         MBJ20026 K1895548
MDQXEQE4 DS    0H                  PROCESS NEXT SYSTEM         MBJ20026 K1895549
         LA    WD,(38*2)(,WD)      TO NEXT CPU'S BUCKET        MBJ20026 K1895550
         TM    QSEFLAGS,QSELAST    Q. WAS THAT THE LAST CPU    MBJ20026 K1895552
         BO    MDQXEQE3            A. YES - END LOOP           MBJ20026 K1895554
         AH    WC,=AL2(QSELEN)     A. NO - POINT TO NEXT QSE   MBJ20026 K1895556
         B     MDQXEQE2               AND LOOP                 MBJ20026 K1895558
         DROP  WC                  DROP QSE ADDRESSABITLTY     MBJ20026 K1895560
MDQXEQE3 TM    MDQFLAG,MDQALL      Q. $DQ,ALL                  MBJ20026 K1895562
         LA    WC,MDQCTR           RE-ESTABLISH PROCESSOR $DQ  MBJ20026 K1895564
         BO    MDQRESE2            A. YES - BR ENTER $DQ,RES EDMBJ20026 K1895566
         B     MDQEND              A. NO - FINISH WITH SPOOL UTMBJ20026 K1895568
         SPACE 1                                               MBJ20026 K1895570
MDQRES   B     MDQRESE        *** GENERAL ENTRY TO EDITOR ***  MBJ20026 K1895572
         ICM   WA,8+4+2,JQERESRT   Q. ANY RESOURCES REQUESTED  MBJ20026 K1895574
         BZ    MDQNEXT             A. NO - NEXT JQE            MBJ20026 K1895576
         BR    WC                  A. YES - PROCESS HIM        MBJ20026 K1895578
         SPACE 1                                               MBJ20026 K1895580
MDQRESE  TM    MDQFLAG,MDQBIT      Q. $DQ                      MBJ20026 K1895582
         BZ    MDQEND              A. NO - FINISH WITH SPOOL UTMBJ20026 K1895584
         L     WB,=A(CRESAREA)     GET WORKAREA ADDRESS        MBJ20026 K1895586
MDQRESE2 DS    0H *** BRANCH ENTRY FROM XEQ EDITOR IF $DQ,ALL *MBJ20026 K1895588
         LA    WD,MDQRESCT         RESOURCE BUCKET             MBJ20026 K1895590
         LA    WC,$NOLEFT          NUMBER OF RESOURCES         MBJ20026 K1895592
         LA    WB,$RESTAB          RESOURCE TABLE (DROP WORKAREMBJ20026 K1895594
MDQRESE3 MVC   COMMAND(8),0(WB)    PUT RESOURCE NAME IN MSG    MBJ20026 K1895596
         MVI   COMMAND+8,C' '      CLEAR                       MBJ20026 K1895598
         MVC   COMMAND+9(L'COMMAND-9),COMMAND+8                MBJ20026 K1895600
         BAL   WA,MDQCLASS         PRINT MSG BY CLASS          MBJ20026 K1895602
         LA    WD,(38*2)(,WD)      TO NEXT RESOURCE BUCKET     MBJ20026 K1895604
         LA    WB,$RESLEN(,WB)     TO NEXT $RESTAB ENTRY       MBJ20026 K1895606
         BCT   WC,MDQRESE3         LOOP                        MBJ20026 K1895608
         TM    MDQFLAG,MDQALL      Q. $DQ,ALL                  MBJ20026 K1895610
         BZ    MDQEND              A. NO - FINISH WITH SPOOL UTMBJ20026 K1895612
         LA    WC,MDQCTR           RE-ESTABLISH PROCESSOR $DQ  MBJ20026 K1895614
         LA    WF,MDQCON           SET UP NEXT SUB-PROC.       MBJ20026 K1895616
         B     4(,WF)              AND BRANCH TO HIM           MBJ20026 K1895618
         SPACE 2                                               MBJ20026 K1895620
MDQCON   B     MDQCONE       *** GENERAL ENTRY TO EDITOR ***   MBJ20026 K1895622
         CLI   JQETYPE,$XEQ        Q. AWAITING CONV.           MBJ20026 K1895624
         BER   WC                  A. YES - PROCESS HIM        MBJ20026 K1895626
MDQCONE  TM    MDQFLAG,MDQBIT      Q. $DQ                      MBJ20026 K1895628
         BZ    MDQEND              A. NO - FINISH WITH SPOOL UTMBJ20026 K1895630
         L     WB,=A(CRESAREA)     GET WORKAREA ADDRESS        MBJ20026 K1895632
         LH    R0,MDQCONCT         GET COUNT                   MBJ20026 K1895634
         LTR   R0,R0               Q. ZERO                     MBJ20026 K1895636
         BZ    MDQNOCON            A. YES - NO MSG             MBJ20026 K1895638
         LR    WD,R1               SAVE JQE REG OVER CALLS     MBJ20026 K1895640
        $CFCVE ,                   CONVERT TO EBCDIC           MBJ20026 K1895642
         MVC   COMMAND(21),=C'CONVERSION BACKLOG - '           MBJ20026 K1895644
         MVC   COMMAND+21(4),COMDWORK+1 COUNT IN MSG           MBJ20026 K1895646
        $CWTO  L=25                                            MBJ20026 K1895648
         LR    R1,WD               RESTORE JQE REGISTER        MBJ20026 K1895650
MDQNOCON TM    MDQFLAG,MDQALL      Q. $DQ,ALL                  MBJ20026 K1895652
         BZ    MDQEND              A. NO - FINISH WITH SPOOL UTMBJ20026 K1895654
         LA    WC,MDQCTR           RE-ESTABLISH PROCESSOR $DQ  MBJ20026 K1895656
         LA    WF,MDQOUT           A. YES - SETUP NEXT SUB-PROCMBJ20026 K1895658
         B     4(,WF)              AND BRANCH TO HIM           MBJ20026 K1895660
         SPACE 2                                               MBJ20026 K1895662
MDQOUT   B     MDQOUTE        *** GENERAL ENTRY TO EDITOR ***  MBJ20026 K1895664
         CLI   JQETYPE,$OUTPUT     Q. AWAITING $OUTPUT         MBJ20026 K1895666
         BER   WC                  A. YES - PROCESS HIM        MBJ20026 K1895668
MDQOUTE  TM    MDQFLAG,MDQBIT      Q. $DQ                      MBJ20026 K1895670
         BZ    MDQEND              A. NO - FINISH WITH SPOOL UTMBJ20026 K1895672
         L     WB,=A(CRESAREA)     GET WORKAREA ADDRESS        MBJ20026 K1895674
         LH    R0,MDQOUTCT         GET COUNT                   MBJ20026 K1895676
         LTR   R0,R0               Q. ZERO                     MBJ20026 K1895678
         BZ    MDQNOOUT            A. YES - NO MSG             MBJ20026 K1895680
         LR    WD,R1               SAVE JQE REG OVER CALLS     MBJ20026 K1895682
        $CFCVE ,                   CONVERT TO EBCDIC           MBJ20026 K1895684
         MVC   COMMAND(17),=C'OUTPUT BACKLOG - '               MBJ20026 K1895686
         MVC   COMMAND+17(4),COMDWORK+1                        MBJ20026 K1895688
        $CWTO  L=21                                            MBJ20026 K1895690
         LR    R1,WD               RESTORE JQE REGISTER        MBJ20026 K1895692
MDQNOOUT TM    MDQFLAG,MDQALL      Q. $DQ,ALL                  MBJ20026 K1895694
         BZ    MDQEND              A. NO - FINISH WITH SPOOL UTMBJ20026 K1895696
         LA    WC,MDQCTR           RE-ESTABLISH PROCESSOR $DQ  MBJ20026 K1895698
         LA    WF,MDQPPU           A. YES - SETUP NEXT SUB-PROCMBJ20026 K1895700
         B     4(,WF)              AND BRANCH TO HIM           MBJ20026 K1895702
         SPACE 2                                               MBJ20026 K1895704
MDQPPU   B     MDQPPUE       *** GENERAL ENTRY TO EDITOR ***   MBJ20026 K1895706
         TM    JQETYPE,$HARDCPY    Q. AWAITING $HARDCPY        MBJ20026 K1895708
         BOR   WC                  A. YES - PROCESS HIM        MBJ20026 K1895710
MDQPPUE  TM    MDQFLAG,MDQBIT      Q. $DQ                      MBJ20026 K1895712
         BZ    MDQEND              A. NO - FINISH WITH SPOOL UTMBJ20026 K1895714
         L     WB,=A(CRESAREA)     GET WORKAREA ADDRESS        MBJ20026 K1895716
         SPACE 1                                               MBJ20026 K1895718
         LH    R9,$NUMRJE         GET NUMBER OF RMT LINES      MBJ20026 K1895719
         SLL   R9,1               MULTIPLY BY 2                MBJ20026 K1895720
         LA    LINK,MDQPPUCT       POINT TO BEGIN COUNTERS     MBJ20026 K1895721
MDQLOOPZ OC    0(2,LINK),0(LINK)   ANY COUNT?                  MBJ20026 K1895722
         BNZ   MDQLOOPX            YES, GO PRINT.              MBJ20026 K1895723
         LA    LINK,2(LINK)        BUMP TO NEXT BUCKET         MBJ20026 K1895724
         BCT   R9,MDQLOOPZ         LOOP TO DONE.               MBJ20026 K1895725
         B     MDQEND              NO COUNTS, GET OUT.         MBJ20026 K1895726
MDQLOOPX MVC   COMMAND(19),=C'PRINT/PUNCH BACKLOG'   TITLE     MBJ20026 K1895728
        $CWTO  L=19                                            MBJ20026 K1895730
         MVI   COMMAND,C' '        CLEAR                       MBJ20026 K1895732
         MVC   COMMAND+1(L'COMMAND-1),COMMAND                  MBJ20026 K1895734
         LA    R9,COMMAND+1        START OF MSG GENERATING     MBJ20026 K1895736
         SLR   R0,R0               CLEAR FOR INSERTS           MBJ20026 K1895738
         SLR   WE,WE               INITIALIZE REMOTE COUNTER   MBJ20026 K1895740
         ICM   R0,2+1,MDQPPUCT     GET COUNT AWAITING CENTRAL  MBJ20026 K1895742
         BZ    MDQNOCEN            ...IF NONE, SKIP IT         MBJ20026 K1895744
        $CFCVE ,                   CONVERT TO EBCDIC           MBJ20026 K1895746
         MVC   0(4,R9),COMDWORK+1  PUT INTO MSG                MBJ20026 K1895748
         MVC   4(6,R9),=C'-LOCAL'  SUB-TITLE                   MBJ20026 K1895750
         LA    R9,11(,R9)          BUMP PAST MSG               MBJ20026 K1895752
MDQNOCEN LA    R15,COMMAND+$MAXMSG END OF MSG GENERATING       MBJ20026 K1895754
         LA    WD,MDQPPUCT         POINT TO PPU BUCKET         MBJ20026 K1895756
MDQNEWRM DS    0H  START HERE FOR EACH NEW REMOTE              MBJ20026 K1895758
         LA    WE,1(,WE)           BUMP REMOTE COUNTER         MBJ20026 K1895760
         LH    R0,$NUMRJE         GET NUMBER OF RMTS           MBJ20026 K1895761
         CR    WE,R0              Q. PAST END OF REMOTES       MBJ20026 K1895762
         BH    MDQENDRM            A. YES - BRANCH OUT OF LOOP MBJ20026 K1895764
         SLL   WE,1                * 2 = OFFSET TO REMOTE COUNTMBJ20026 K1895766
         LH    R0,0(WE,WD)         GET REMOTE COUNT R          MBJ20026 K1895768
         SRL   WE,1                BACK TO REMOTE #            MBJ20026 K1895770
         LTR   R0,R0               Q. ANY FOR THIS REMOTE      MBJ20026 K1895772
         BZ    MDQNEWRM            A. NO - TRY NEXT REMOTE     MBJ20026 K1895774
        $CFCVE ,                   A. YES - CONVERT TO EBCDIC  MBJ20026 K1895776
         MVC   0(3,R9),COMDWORK+2  PUT INTO MSG                MBJ20026 K1895778
         MVC   3(3,R9),=C'-RM'     SUB-TITLE SKELETON          MBJ20026 K1895780
         LR    R0,WE               GET REMOTE #                MBJ20026 K1895782
        $CFCVE ,                   AND CONVERT TO EBCDIC       MBJ20026 K1895784
         MVC   6(1,R9),COMDWORK+4  MOVE IN ONE DIGIT           MBJ20026 K1895786
         CLI   COMDWORK+3,C' '     Q. WERE THERE 2             MBJ20026 K1895788
         BE    *+10                A. NO - MSG IS OK           MBJ20026 K1895790
         MVC   6(2,R9),COMDWORK+3  A. YES - PUT THEM BOTH IN   MBJ20026 K1895792
         CLI   COMDWORK+2,C' '     Q. WERE THERE 3             MBJ20026 K1895793
         BE    *+10                A. NO - MSG IS OK           MBJ20026 K1895794
         MVC   6(3,R9),COMDWORK+2  A. YES - PUT THEM ALL IN.   MBJ20026 K1895795
         LA    R9,10(,R9)          BUMP PAST THAT              MBJ20026 K1895796
         CR    R9,R15              Q. ROOM FOR MORE MSG        MBJ20026 K1895797
         BNH   MDQNEWRM            A. YES - NEXT REMOTE        MBJ20026 K1895798
         LA    R15,COMMAND         A. NO - CALCULATE           MBJ20026 K1895800
         SR    R9,R15                       MESSAGE LENGTH     MBJ20026 K1895802
         LR    R0,R9                        IN R0.             MBJ20026 K1895804
        $CWTO  L=(R0)                                          MBJ20026 K1895806
         MVC   COMMAND+1(L'COMMAND-1),COMMAND   CLEAR          MBJ20026 K1895808
         LA    R9,COMMAND+1        RESET MSG                   MBJ20026 K1895810
         LA    R15,COMMAND+$MAXMSG  BOUNDARIES                 MBJ20026 K1895812
         B     MDQNEWRM            AND CONTINUE REMOTE SCAN    MBJ20026 K1895814
MDQENDRM LA    R15,COMMAND+1       MINIMUM MSG                 MBJ20026 K1895816
         SR    R9,R15              CALCULATE LENGTH - 1        MBJ20026 K1895818
         BZ    MDQNOPPU            IF ZERO, NO MSG.            MBJ20026 K1895820
         LA    R0,1(,R9)           ELSE, GET IN R0             MBJ20026 K1895822
        $CWTO  L=(R0)                                          MBJ20026 K1895824
MDQNOPPU DS    0H     *** EXIT FROM EDITOR ***                 MBJ20026 K1895826
         B     MDQEND              CAN'T BE ANYTHING MORE      MBJ20026 K1895828
         SPACE 1                                               MBJ20026 K1895830
MDQHLD   B     MDQHLDE    *** GENERAL ENTRY TO EDITOR ***      MBJ20026 K1895832
         TM    JQEFLAGS,QUEHOLDA+QUEHOLD1+QUEHOLD2             MBJ20026XK1895834
                                   Q. JOB HELD FOR ANY REASON  MBJ20026 K1895836
         BZ    MDQNEXT             A. NO - NEXT JQE            MBJ20026 K1895838
         BR    WC                  A. NO - PROCESS HIM         MBJ20026 K1895840
MDQHLDE  TM    MDQFLAG,MDQBIT      Q. $DQ ISSUED               MBJ20026 K1895842
         BZ    MDQEND              A. NO - FINISH MESSAGE      MBJ20026 K1895844
         L     WB,=A(CRESAREA)     POINT TO WORKAREA           MBJ20026 K1895846
         MVC   COMMAND(23),=C'HELD AWAITING EXECUTION'         MBJ20026 K1895848
        $CWTO  L=23                ISSUE HEADER MESSAGE        MBJ20026 K1895850
         TM    MDQFLAG,MDQSPEC     Q. SPECIFIC SID REQUEST     MBJ20026 K1895851
         BZ    *+12                A. NO - SKIP NEXT CHECK     MBJ20026 K1895852
         CLI   MDQCPU,QUESYSAF     Q. WAS REQUEST FOR 'ANY'    MBJ20026 K1895853
         BNE   MDQHLDE1            A. NO - GO CHECK EACH SYSTEM BJ20026 K1895854
         MVC   COMMAND(4),=CL4'ANY '   TITLE                   MBJ20026 K1895855
         MVC   COMMAND+4(L'COMMAND-4),COMMAND+3  CLEAR         MBJ20026 K1895856
         LA    WD,MDQANYCT         POINT TO BUCKET FOR 'ANY'   MBJ20026 K1895857
         BAL   WA,MDQCLASS         AND PROCESS                 MBJ20026 K1895858
         B     MDQHLDE3                                        MBJ20026 K1895859
MDQHLDE1 LA    WD,MDQCPUCT         POINT TO FIRST CPU BUCKET   MBJ20026 K1895860
         L     WC,$QSE1            POINT TO FIRST QSE          MBJ20026 K1895861
         USING QSEDSECT,WC         ADDRESSABILITY FOR QSE'S    MBJ20026 K1895862
MDQHLDE2 TM    MDQFLAG,MDQSPEC     Q. SPECIFIC SID REQUEST     MBJ20026 K1895863
         BZ    *+14                A. NO - SKIP NEXT CHECK     MBJ20026 K1895864
         CLC   MDQCPU,QSESIAFF     Q. WAS THIS THE SID REQUESTED J20026 K1895865
         BNE   MDQHLDE4            A. NO - GO TRY NEXT SYSTEM  MBJ20026 K1895866
         MVC   COMMAND(4),QSESID   A. YES- PUT SID IN MESSAGE  MBJ20026 K1895867
         MVI   COMMAND+4,C' '      CLEAR REST                  MBJ20026 K1895868
         MVC   COMMAND+5(L'COMMAND-5),COMMAND+4  TO BLANKS     MBJ20026 K1895870
         BAL   WA,MDQCLASS         PROCESS THIS CPU            MBJ20026 K1895872
MDQHLDE4 LA    WD,(38*2)(,WD)      POINT TO NEXT CPU BUCKET    MBJ20026 K1895874
         TM    QSEFLAGS,QSELAST    Q. WAS THAT THE LAST CPU    MBJ20026 K1895876
         BO    MDQHLDE3            A. YES - END LOOP           MBJ20026 K1895878
         AH    WC,=AL2(QSELEN)     A. NO - POINT TO NEXT QSE   MBJ20026 K1895880
         B     MDQHLDE2               AND LOOP                 MBJ20026 K1895882
         DROP  WC                  DROP QSE ADDRESSABILITY     MBJ20026 K1895884
MDQHLDE3 LH    R0,MDQCONCT         GET HELD AWAIT CONV.        MBJ20026 K1895886
         LTR   R0,R0               Q. ZERO                     MBJ20026 K1895888
         BZ    MDQEND              A. YES - FINISH WITH SPOOL UMBJ20026 K1895890
        $CFCVE ,                   A. NO - CONVERT TO EBCDIC   MBJ20026 K1895892
         MVC   COMMAND(27),=C'HELD AWAITING CONVERSION - ' TITLMBJ20026 K1895894
         MVC   COMMAND+27(4),COMDWORK+1 PUT IN COUNT           MBJ20026 K1895896
        $CWTO  L=31                                            MBJ20026 K1895898
         B     MDQEND              EXIT WITH SPOOL UTILIZATION MBJ20026 K1895900
         SPACE 1                                               MBJ20026 K1895902
*                                                              MBJ20026 K1895904
*    CDQEND - COMMON EXIT FROM $DQ/$DN... DISPLAY SPOOL UTILIZAMBJ20026 K1895906
*                                                              MBJ20026 K1895908
MDQEND   DS    0H                                              MBJ20026 K1895910
         B     *+4         *** GENERAL ENTRY TO EDITOR ***     MBJ20026 K1895912
         L     R15,$SSVT               GET SSVT POINTER        MBJ20026 K1895914
         L     R1,$SVTGALC-SSVT(,R15)  GET TRACK GROUPS ALLOC. MBJ20026 K1895916
         M     R0,=F'100'              ALLOW FOR PERCENTAGE    MBJ20026 K1895918
         D     R0,$SVTGTOT-SSVT(,R15)  DIVIDE BY TOTAL         MBJ20026 K1895920
        $CFCVE VALUE=(R1)              CONVERT TO EBCDIC       MBJ20026 K1895922
         MVC   COMMAND(3),COMDWORK+2   PLACE IN MSG            MBJ20026 K1895924
         MVC   COMMAND+3(26),=C' PERCENT SPOOL UTILIZATION'    MBJ20026 K1895926
        $CRET  L=29                    RETURN WITH LAST MSG    MBJ20026 K1895928
         SPACE 5                                               MBJ20026 K1895930
MDQCHECK TM    JQEFLAGS,QUEBUSY    Q. JOB ACTIVE               MBJ20026 K1895932
         BNZ   MDQCTREX            A. YES- GET NEXT JQE        MBJ20026 K1895934
         TM    MDQFLAG,MDQSPEC     Q. WAS THERE A SPECIAL REQUEST 20026 K1895936
         BZ    MDQOKCPU            A. NO - DON'T CHECK CPU ROUTE J20026 K1895938
         IC    WB,MDQCPU           GET SYS AFFINITIES          MBJ20026 K1895940
         EX    WB,MDQTM            Q. ROUTED TO REQUESTED CPU  MBJ20026 K1895942
         BNO   MDQCTREX            A. NO - GET NEXT JQE        MBJ20026 K1895944
MDQOKCPU SLR   WB,WB               CLEAR WB FOR INSERT         MBJ20026 K1895946
         CLC   JQEPRTRT,=X'0100'  IS IT LOCAL                  MBJ20026 K1895948
         BNH   *+8                YES, USE LOCAL               MBJ20026 K1895950
         ICM   WB,3,JQEPRTRT      INSERT ROUTE CODE            MBJ20026 K1895952
         L     WC,=A(CRESAREA)     POINT TO LOCAL WORKAREA     MBJ20026 K1895953
         LA    WC,MDQRMTAB-MDQDSECT(,WC)    POINT TO ROUT TABLE BJ20026 K1895954
MDQRMCOM CH    WB,2(,WC)           Q. ROUTE CODES MATCH        MBJ20026 K1895956
         BE    MDQRMNXT            A. YES - GO CHECK REQUEST   MBJ20026 K1895958
         LA    WC,4(,WC)           POINT TO NEXT TABLE ENTRY   MBJ20026 K1895960
         CLI   0(WC),X'FF'         Q. END OF TABLE             MBJ20026 K1895962
         BNE   MDQRMCOM            A. NO - LOOP                MBJ20026 K1895964
         B     MDQCTREX            A. YES - NO MATCH-NEXT JQE  MBJ20026 K1895966
MDQRMNXT LH    WB,0(,WC)           GET REMOTE NUMBER           MBJ20026 K1895968
         CLM   WB,1,MDQRMLO        Q. IN REQUESTED RANGE       MBJ20026 K1895970
         BL    MDQCTREX            A. NO - NEXT JQE            MBJ20026 K1895972
         CLM   WB,1,MDQRMHI        Q. IN RANGE REQUESTED       MBJ20026 K1895974
         BH    MDQCTREX            A. NO - NEXT JQE            MBJ20026 K1895976
         LM    WB,WC,MDQREGWB      A. YES - RESTORE WORK REGS  MBJ20026 K1895977
         BR    WA                     AND RETURN TO SUB-PROC   MBJ20026 K1895978
MDQTM    TM    JQEFLAG2,0          --- EXECUTE ONLY ---        MBJ20026 K1895980
         EJECT                                                 MBJ20026 K1895982
************************************************************** MBJ20026 K1895984
*                                                            * MBJ20026 K1895986
*   'CDQCLASS' ROUTINE                                       * MBJ20026 K1895988
*        R0-   COUNT REGISTER                                * MBJ20026 K1895990
*        WA-   LINKAGE                                       * MBJ20026 K1895992
*        WD-   POINTER TO COUNTER BUCKET(INPUT)              * MBJ20026 K1895994
*        WE-   INDEX FOR CLASSES                             * MBJ20026 K1895996
*        R9-   POINTER FOR MSG GENERATION                    * MBJ20026 K1895998
*        R15-  MAXIMUM MSG DELIMITER                         * MBJ20026 K1896000
*                                                            * MBJ20026 K1896002
************************************************************** MBJ20026 K1896004
         SPACE 1                                               MBJ20026 K1896006
MDQCLASS DS    0H                                              MBJ20026 K1896008
         STM   R15,WF,MDQREGSV     SAVE WORK REGISTERS         MBJ20026 K1896010
         LA    R9,COMMAND+9        MESSAGE START               MBJ20026 K1896012
         LA    R15,COMMAND+$MAXMSG MESSAGE END                 MBJ20026 K1896014
         LA    WE,70               OFFSET TO LAST CLASS COUNT  MBJ20026 K1896016
MDQNEWCL LH    R0,0(WE,WD)         GET COUNT FOR THIS CLASS    MBJ20026 K1896018
         LTR   R0,R0               Q. ANYTHING THERE           MBJ20026 K1896020
         BZ    MDQNONE             A. NO - BRANCH              MBJ20026 K1896022
        $CFCVE ,                   A. YES- CONVERT TO EBCDIC   MBJ20026 K1896024
         MVC   0(4,R9),COMDWORK+1  PUT INTO MSG                MBJ20026 K1896026
         MVI   4(R9),C'-'          PUT IN SEPARATOR            MBJ20026 K1896028
         SRL   WE,1                WE=RELATIVE CLASS #         MBJ20026 K1896030
         IC    R0,MDQCLS(WE)       GET EBCDIC CLASS            MBJ20026 K1896032
         ALR   WE,WE               WE=CLASS OFFSET, AGAIN      MBJ20026 K1896034
         STC   R0,5(,R9)           PUT CLASS INTO MSG          MBJ20026 K1896036
         LA    R9,7(,R9)           BUMP PAST THAT              MBJ20026 K1896038
         CR    R9,R15              Q. ROOM FOR MORE            MBJ20026 K1896040
         BNH   MDQNONE             A. YES - CONTINUE           MBJ20026 K1896042
         LA    R15,COMMAND         CALCULATE                   MBJ20026 K1896044
         SR    R9,R15               TRUE LENGTH                MBJ20026 K1896046
         LR    R0,R9                 IN R0.                    MBJ20026 K1896048
        $CWTO  L=(R0)                                          MBJ20026 K1896050
         MVI   COMMAND,C' '        CLEAR                       MBJ20026 K1896052
         MVC   COMMAND+1(L'COMMAND-1),COMMAND   MESSAGE        MBJ20026 K1896054
         LA    R9,COMMAND+9        MESSAGE START               MBJ20026 K1896056
         LA    R15,COMMAND+$MAXMSG MESSAGE END                 MBJ20026 K1896058
MDQNONE  SH    WE,=H'2'            BACK UP TO NEXT CLASS       MBJ20026 K1896060
         BNM   MDQNEWCL            LOOP IF NOT DONE            MBJ20026 K1896062
         LH    R0,72(,WD)          GET STC COUNT               MBJ20026 K1896064
         LTR   R0,R0               Q. ANY STC WAITING          MBJ20026 K1896066
         BZ    MDQTSUCL            A. NO - MAYBE SOME TSU      MBJ20026 K1896068
        $CFCVE ,                   CONVERT TO EBCDIC           MBJ20026 K1896070
         MVC   0(4,R9),COMDWORK+1  PUT INTO MSG                MBJ20026 K1896072
         MVC   4(4,R9),=C'-STC'    PUT IDENTIFIER IN           MBJ20026 K1896074
         LA    R9,9(,R9)           BUMP MSG POINTER            MBJ20026 K1896076
MDQTSUCL LH    R0,74(,WD)          GET TSU COUNT               MBJ20026 K1896078
         LTR   R0,R0               Q. ANY TSU WAITING          MBJ20026 K1896080
         BZ    MDQMSGCL            A. NO - FINISH MESSAGE      MBJ20026 K1896082
        $CFCVE ,                   CONVERT TO EBCDIC           MBJ20026 K1896084
         MVC   0(4,R9),COMDWORK+1  PUT INTO MSG                MBJ20026 K1896086
         MVC   4(4,R9),=C'-TSU'    PUT IDENTIFIER IN           MBJ20026 K1896088
         LA    R9,9(,R9)           BUMP MSG POINTER            MBJ20026 K1896090
MDQMSGCL LA    R15,COMMAND+9       POINT TO MESSAGE START      MBJ20026 K1896092
         SR    R9,R15              Q. ACTUAL LENGTH = 0        MBJ20026 K1896094
         BZ    MDQNOWTO            A. YES - NO $CWTO           MBJ20026 K1896096
         LA    R0,9(,R9)           TRUE LENGTH IN R0           MBJ20026 K1896098
        $CWTO  L=(R0)                                          MBJ20026 K1896100
MDQNOWTO LM    R15,WF,MDQREGSV     RESTORE WORK REGISTERS      MBJ20026 K1896102
         BR    WA                  AND RETURN                  MBJ20026 K1896104
         EJECT                                                 MBJ20026 K1896106
************************************************************** MBJ20026 K1896108
*                                                            * MBJ20026 K1896110
*        $DN - JQE PROCESSOR                                 * MBJ20026 K1896112
*              DISPLAY A MSG WITH JOB INFORMATION            * MBJ20026 K1896114
*                                                            * MBJ20026 K1896116
************************************************************** MBJ20026 K1896118
         SPACE 1                                               MBJ20026 K1896120
MDNCTR   DS    0H                                              MBJ20026 K1896122
         STM   R15,WF,MDQREGSV     SAVE WORK REGISTERS         MBJ20026 K1896123
         BAL   WA,MDQCHECK         GO CHECK SYSTEM & REMOTE    MBJ20026 K1896124
         LR    WD,R1               SAVE JQE ADDRESS OVER MSG DIMBJ20026 K1896126
        $CFJMSG OPT=COFQ           DISPLAY IF QUEUED           MBJ20026 K1896128
         NOP   *-*                 SPACER TO PREVENT FUTURE ERRMBJ20026 K1896130
         SPACE 1                                               MBJ20026 K1896132
*                                                              MBJ20026 K1896134
*        SINCE $CWTO MAY ISSUE A $WAIT, IT IS NECESSARY        MBJ20026 K1896136
*        TO VERIFY THAT THE JOB QUEUE HAS NOT CHANGED          MBJ20026 K1896138
*        THEREFORE WE SHALL LOOK FOR THE JQE ON THE SAME       MBJ20026 K1896140
*        CHAIN SEGMENT AS IT WAS BEFORE... IF WE DON'T         MBJ20026 K1896142
*        FIND IT, A MESSAGE 'LIST INCOMPLETE' WILL BE          MBJ20026 K1896144
*        ISSUED INDICATING SUCH.                               MBJ20026 K1896146
*                                                              MBJ20026 K1896148
         SPACE 1                                               MBJ20026 K1896150
         LH    R15,MDQHIGH         GET CURRENT HEADER          MBJ20026 K1896152
         LA    R1,$JQHEADS-(JQECHAIN-JQEDSECT)(R15)            MBJ20026XK1896154
                                   MAKE R1 LOOK LIKE A JQE.    MBJ20026 K1896156
MDQNEXT2 LH    R1,JQECHAIN         GET NEXT JQE OFFSET         MBJ20026 K1896158
         N     R1,=A(X'0000FFFF')  CLEAR UPPER BYTES TO 0      MBJ20026 K1896160
         BZ    MDQBROKE            IF 0, END OF CHAIN          MBJ20026 K1896162
         SLL   R1,2                * 4 = TRUE OFFSET           MBJ20026 K1896164
         AL    R1,$JOBQPTR         CALCULATE ABS JQE ADDR      MBJ20026 K1896166
         CR    WD,R1               Q. SAME AS JUST DISPLAYED   MBJ20026 K1896168
         BE    MDQCTREX            A. YES - COMMON EXIT TO MAIN BJ20026 K1896170
         B     MDQNEXT2            A. NO - CONTINUE THIS SCAN  MBJ20026 K1896172
         SPACE 1                                               MBJ20026 K1896174
MDQBROKE DS    0H   *** CHAIN WAS BROKEN OVER $CWTO ***        MBJ20026 K1896176
         MVC   COMMAND(15),=C'LIST INCOMPLETE' MSG             MBJ20026 K1896178
        $CRET  L=15                RETURN WITH INCOMPLETE MSG  MBJ20026 K1896180
         EJECT                                                 MBJ20026 K1896182
************************************************************** MBJ20026 K1896184
*                                                            * MBJ20026 K1896186
*        $DQ - JQE PROCESSOR - COUNT JQE BY QUEUE.           * MBJ20026 K1896188
*                                                            * MBJ20026 K1896190
************************************************************** MBJ20026 K1896192
         SPACE 1                                               MBJ20026 K1896194
MDQCTR   DS    0H                  COUNTER FOR EACH JQE        MBJ20026 K1896196
         STM   R15,WF,MDQREGSV     SAVE WORK REGISTERS         MBJ20026 K1896198
         BAL   WA,MDQCHECK         GO CHECK SYSTEM & REMOTE    MBJ20026 K1896200
         L     WB,=A(CRESAREA)     GET WORKAREA ADDRESS        MBJ20026 K1896202
         SPACE 2                                               MBJ20026 K1896204
         CLI   JQETYPE,$XEQ        Q. AWAITING CONVERSION      MBJ20026 K1896206
         BNE   MDQCTRX             A. NO - TRY XEQ             MBJ20026 K1896208
         LH    WE,MDQCONCT            ELSE GET CURRENT COUNT   MBJ20026 K1896210
         LA    WE,1(,WE)              + 1                      MBJ20026 K1896212
         STH   WE,MDQCONCT            AND REPLACE              MBJ20026 K1896214
         B     MDQCTREX            COMMON EXIT                 MBJ20026 K1896216
         SPACE 2                                               MBJ20026 K1896218
MDQCTRX  TM    JQETYPE,$XEQ        Q. AWAITING XEQ             MBJ20026 K1896220
         BNO   MDQCTRO             A. NO - TRY OUT             MBJ20026 K1896222
         CLC   JQEJOBNO,=H'10000'  Q. BATCH JOB                MBJ20026 K1896224
         BL    MDQCTRX0            A. YES - BRANCH             MBJ20026 K1896226
         LA    WE,72                  ASSUME ITS A STC         MBJ20026 K1896228
         CLC   JQEJOBNO,=H'20000'  Q. IS IT AN STC             MBJ20026 K1896230
         BL    *+8                 A. YES - SKIP NEXT          MBJ20026 K1896232
         LA    WE,74               A. NO  - POINT TO TSU COUNTER J20026 K1896234
         B     MDQCTRX1            GO COUNT THE JOB            MBJ20026 K1896236
MDQCTRX0 SLR   WE,WE               CLEAR WE FOR INSERT         MBJ20026 K1896238
         IC    WE,JQETYPE          GET JOB CLASS               MBJ20026 K1896240
         IC    WE,$QINDEX(WE)      GET OFFSET INTO JQE HEADS   MBJ20026 K1896242
         LTR   WE,WE               Q. VALID CLASS              MBJ20026 K1896244
         BZ    MDQCTREX            A. NO - EXIT                MBJ20026 K1896246
         SH    WE,=H'24'           RELATIVE TO XEQ COUNTER     MBJ20026 K1896248
MDQCTRX1 TM    JQEFLAG2,QUESYSAF   Q. ANY SPECIAL SYS AFFINITY MBJ20026 K1896250
         BNO   MDQCTRX2            A. YES - CHECK THEM         MBJ20026 K1896252
         LH    WA,MDQANYCT(WE)        GET COUNT FOR 'ANY' CPU  MBJ20026 K1896254
         LA    WA,1(,WA)              + 1                      MBJ20026 K1896256
         STH   WA,MDQANYCT(WE)        REPLACE                  MBJ20026 K1896258
         B     MDQCTRR             GO SEE IF IT HAS RESOURCES  MBJ20026 K1896260
         SPACE 2                                               MBJ20026 K1896262
MDQCTRX2 SLR   WA,WA               CLEAR FOR INSERT            MBJ20026 K1896264
         LA    WD,6*38*2(,WE)      COUNTER IN LAST BUCKTE      MBJ20026 K1896266
         ICM   WA,8,JQEFLAG2       GET SYSTEM AFFINITIES       MBJ20026 K1896268
MDQCTRX3 SLL   WA,1                SHIFT FOR TEST              MBJ20026 K1896270
         LTR   WA,WA               Q. AFFINITY FOR THIS SYSTEM MBJ20026 K1896272
         BP    MDQCTRX4            A. NO - TRY NEXT SYSTEM     MBJ20026 K1896274
         BZ    MDQCTRR             A. NO MORE - EXIT           MBJ20026 K1896276
         LH    R10,MDQCPUCT(WD)    GET THIS CPU'S COUNT        MBJ20026 K1896278
         LA    R10,1(,R10)         + 1                         MBJ20026 K1896280
         STH   R10,MDQCPUCT(WD)    REPLACE                     MBJ20026 K1896282
MDQCTRX4 SH    WD,=H'76'           DOWN TO NEXT CPU'S BUCKET   MBJ20026 K1896284
         B     MDQCTRX3            AND LOOP TO TEST BIT        MBJ20026 K1896286
         SPACE 2                                               MBJ20026 K1896288
MDQCTRR  DS    0H                  COUNTER FOR JQE W/ RESOURCESMBJ20026 K1896290
         SLR   WA,WA               CLEAR FOR INSERT            MBJ20026 K1896292
         ICM   WA,8+4+2,JQERESRT   GET RESOURCE ROUTINGS       MBJ20026 K1896294
MDQCTRR2 LTR   WA,WA               Q. ROUTED TO THIS RESOURCE  MBJ20026 K1896296
         BP    MDQCTRR3            A. NO - TRY NEXT            MBJ20026 K1896298
         BZ    MDQCTREX            A. NO MORE ROUTINGS - EXIT  MBJ20026 K1896300
         LH    WD,MDQRESCT(WE)     GET COUNT FOR THIS RES      MBJ20026 K1896302
         LA    WD,1(,WD)           + 1                         MBJ20026 K1896304
         STH   WD,MDQRESCT(WE)     REPLACE                     MBJ20026 K1896306
MDQCTRR3 LA    WE,(38*2)(,WE)      TO NEXT RESOURCE BUCKET     MBJ20026 K1896308
         SLL   WA,1                SHIFT LEFT 1 FOR NEXT TEST  MBJ20026 K1896310
         B     MDQCTRR2            AND LOOP THROUGH TEST       MBJ20026 K1896312
         SPACE 2                                               MBJ20026 K1896314
MDQCTRO  DS    0H                  COUNTER FOR OUTPUT JQE'S    MBJ20026 K1896316
         TM    JQETYPE,$OUTPUT     Q. AWAITING OUTPUT PROCESSORMBJ20026 K1896318
         BZ    MDQCTRP             A. NO - TRY PRINT/PUNCH     MBJ20026 K1896320
         LH    WE,MDQOUTCT            GET COUNT                MBJ20026 K1896322
         LA    WE,1(,WE)              + 1                      MBJ20026 K1896324
         STH   WE,MDQOUTCT            REPLACE                  MBJ20026 K1896326
         B     MDQCTREX            COMMON EXIT                 MBJ20026 K1896328
         SPACE 2                                               MBJ20026 K1896330
MDQCTRP  DS    0H                  COUNTER FOR PRINT/PUNCH JQE'S J20026 K1896332
         TM    JQETYPE,$HARDCPY    Q. AWAITING PRINT/PUNCH     MBJ20026 K1896334
         BZ    MDQCTREX            A. NO - EXIT (WHAT IS IT?)  MBJ20026 K1896336
         SLR   WE,WE               ASSUME CENTRAL OUTPUT       MBJ20026 K1896338
         SLR   WA,WA               CLEAR FOR INSERT            MBJ20026 K1896340
         CLC   JQEPRTRT,=X'0100'  IS IT LOCAL                  MBJ20026 K1896342
         BNH   MDQCTRP4           YES                          MBJ20026 K1896344
         ICM   WA,3,JQEPRTRT      SAVE THE RMT NO              MBJ20026 K1896346
MDQCTRP0 LA    WD,MDQRMTAB         POINT TO REMOTE ROUTE TABLE MBJ20026 K1896350
MDQCTRP1 CH    WA,2(,WD)           Q. ROUTE CODES MATCH        MBJ20026 K1896352
         BE    MDQCTRP2            A. YES - EXIT FROM LOOP     MBJ20026 K1896354
         CLI   0(WD),X'FF'         Q. END OF TABLE             MBJ20026 K1896356
         LA    WD,4(,WD)              ASSUME NOT... GET NEXT   MBJ20026 K1896358
         BNE   MDQCTRP1            A. NO - LOOP FOR NEXT       MBJ20026 K1896360
         B     MDQCTREX            A. YES-INVALID ROUTE...EXIT MBJ20026 K1896362
MDQCTRP2 LH    WE,0(,WD)           GET REMOTE NUMBER           MBJ20026 K1896364
MDQCTRP4 DS    0H                  COUNTER - WE=RJE #          MBJ20026 K1896366
         AR    WE,WE               * 2 = OFFSET INTO BUCKET    MBJ20026 K1896368
         LH    WD,MDQPPUCT(WE)     GET COUNT                   MBJ20026 K1896370
         LA    WD,1(,WD)           + 1                         MBJ20026 K1896372
         STH   WD,MDQPPUCT(WE)     REPLACE                     MBJ20026 K1896374
MDQCTREX DS    0H    *** CDQCTR COMMON EXIT ***                MBJ20026 K1896380
         LM    R15,WF,MDQREGSV     RESTORE REGISTERS           MBJ20026 K1896382
         B     MDQNEXT             AND LOOP THROUGH JQE CHAIN  MBJ20026 K1896384
         DROP  WB                  DROP CRESAREA ADDRESSABILITY BJ20026 K1896386
         EJECT                                                 MBJ20026 K1896388
MDQDATA  EQU   *                                               MBJ20026 K1896390
         SPACE 1                                               MBJ20026 K1896392
************************************************************** MBJ20026 K1896394
*                                                            * MBJ20026 K1896396
*        TABLE FOR LOW/HIGH HEADER SETTINGS                  * MBJ20026 K1896398
*                                                            * MBJ20026 K1896400
************************************************************** MBJ20026 K1896402
         SPACE 1                                               MBJ20026 K1896404
MDQALLL  EQU   2                   $DQ,ALL     LOW/            MBJ20026 K1896406
MDQALLH  EQU   94                  $DQ,ALL       /HIGH         MBJ20026 K1896408
         SPACE 1                                               MBJ20026 K1896410
MDQPPUL  EQU   2                   $DQ,PPU     LOW/            MBJ20026 K1896412
MDQPPUH  EQU   4                   $DQ,PPU       /HIGH         MBJ20026 K1896414
         SPACE 1                                               MBJ20026 K1896416
MDQOUTL  EQU   4                   $DQ,OUT     LOW/            MBJ20026 K1896418
MDQOUTH  EQU   6                   $DQ,OUT       /HIGH         MBJ20026 K1896420
         SPACE 1                                               MBJ20026 K1896422
MDQCONL  EQU   14                  $DQ,CON     LOW/            MBJ20026 K1896424
MDQCONH  EQU   16                  $DQ,CON       /HIGH         MBJ20026 K1896426
         SPACE 1                                               MBJ20026 K1896428
MDQXEQL  EQU   22                  $DQ,XEQ     LOW/            MBJ20026 K1896430
MDQXEQH  EQU   94                  $DQ,XEQ       /HIGH         MBJ20026 K1896432
         SPACE 1                                               MBJ20026 K1896434
MDQRESL  EQU   22                  $DQ,RES     LOW/            MBJ20026 K1896436
MDQRESH  EQU   94                  $DQ,RES       /HIGH         MBJ20026 K1896438
         SPACE 1                                               MBJ20026 K1896440
MDQSTCL  EQU   18                  $DQ,XEQSTC  LOW/            MBJ20026 K1896442
MDQSTCH  EQU   20                  $DQ,XEQSTC    /HIGH         MBJ20026 K1896444
         SPACE 1                                               MBJ20026 K1896446
MDQTSUL  EQU   20                  $DQ,XEQTSU  LOW/            MBJ20026 K1896448
MDQTSUH  EQU   22                  $DQ,XEQTSU    /HIGH         MBJ20026 K1896450
         SPACE 1                                               MBJ20026 K1896452
MDQHLDL  EQU   14                  $DQ,HOLD    LOW/            MBJ20026 K1896454
MDQHLDH  EQU   94                  $DQ,HOLD      /HIGH         MBJ20026 K1896456
         SPACE 1                                               MBJ20026 K1896458
MDQHEADS EQU   COMPNTER+64,4       --- JQE HEADER OFFSETS ---  MBJ20026 K1896460
MDQLOW   EQU   COMPNTER+64,2       LOW HEAD FOR JQE SCAN       MBJ20026 K1896461
MDQHEADL EQU   COMPNTER+65,1       --- FOR MVI ---             MBJ20026 K1896462
MDQHIGH  EQU   COMPNTER+66,2       HIGH HEAD FOR JQE SCAN      MBJ20026 K1896463
MDQHEADH EQU   COMPNTER+67,1       --- FOR MVI ---             MBJ20026 K1896464
         SPACE 1                                               MBJ20026 K1896465
MDQCPU   EQU   COMPNTER+68,1       SYSTEM AFFINITY REQUESTED   MBJ20026 K1896466
MDQFLAG  EQU   COMPNTER+69,1       FLAG BYTE                   MBJ20026 K1896467
MDNFLAG1 EQU   MDQFLAG             SAME FLAG FOR $DN/$DQ       MBJ20026 K1896468
MDQRMLO  EQU   COMPNTER+70,1       LOW REMOTE ROUTCODE         MBJ20026 K1896469
MDQRMHI  EQU   COMPNTER+71,1       HIGH REMOTE ROUTCODE        MBJ20026 K1896470
         SPACE 1                                               MBJ20026 K1896471
MDQREGSV EQU   COMPNTER+24,36   ---SAVE AREA FOR 9 REGISTERS   MBJ20026 K1896472
MDQREG15 EQU   MDQREGSV+00,4       SAVE FOR R15                MBJ20026 K1896473
MDQREG0  EQU   MDQREGSV+04,4       SAVE FOR R0                 MBJ20026 K1896474
MDQREG1  EQU   MDQREGSV+08,4       SAVE FOR R1                 MBJ20026 K1896475
MDQREGWA EQU   MDQREGSV+12,4       SAVE FOR WA                 MBJ20026 K1896476
MDQREGWB EQU   MDQREGSV+16,4       SAVE FOR WB                 MBJ20026 K1896477
MDQREGWC EQU   MDQREGSV+20,4       SAVE FOR WC                 MBJ20026 K1896478
MDQREGWD EQU   MDQREGSV+24,4       SAVE FOR WD                 MBJ20026 K1896479
MDQREGWE EQU   MDQREGSV+28,4       SAVE FOR WE                 MBJ20026 K1896480
MDQREGWF EQU   MDQREGSV+32,4       SAVE FOR WF                 MBJ20026 K1896481
         SPACE 1                                               MBJ20026 K1896482
MDQBIT   EQU   X'80'     --- A $DQ WAS ISSUED                  MBJ20026 K1896483
MDNBIT   EQU   X'40'     --- A $DN WAS ISSUED                  MBJ20026 K1896484
MDQALL   EQU   X'20'     --- A $DQ,ALL WAS ISSUED              MBJ20026 K1896486
MDQSPEC  EQU   X'10'     --- A $DQ,SID WAS ISSUED              MBJ20026 K1896488
         SPACE 1                                               MBJ20026 K1896490
MDQCLS   DC    C'ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789'         MBJ20026 K1896492
         EJECT                                                 MBJ20026 K1896494
         LTORG ,                                               MBJ20026 K1896495
         EJECT                                                 MBJ20026 K1896496
************************************************************** MBJ20026 K1896497
*                                                            * MBJ20026 K1896498
*        CDQDSECT - A MAPPING OF HOW THE RESIDENT            * MBJ20026 K1896500
*                   WORKAREA 'CRESAREA' IS USED IN           * MBJ20026 K1896502
*                   $DQ/$DN.                                 * MBJ20026 K1896504
*                                                            * MBJ20026 K1896506
************************************************************** MBJ20026 K1896508
         SPACE 1                                               MBJ20026 K1896510
MDQDSECT DSECT                                                 MBJ20026 K1896512
MDQCONCT DS    H              --- $DQ,CON --- CONVERSION ANY   MBJ20026 K1896514
MDQANYCT EQU   *              --- $DQ,XEQ --- ANY CPU          MBJ20026 K1896516
         DS    38H                 1 PER CLASS + STC + TSU     MBJ20026 K1896518
MDQCPUCT EQU   *              --- $DQ,XEQ --- SPECIFIC CPU     MBJ20026 K1896520
         DS    (7*38)H                    38 FOR EACH CPU      MBJ20026 K1896522
MDQRESCT EQU   *              --- $DQ,RES --- XEQ RESOURCE     MBJ20026 K1896524
         DS    ($NOLEFT*38)H              38 FOR EACH RESOURCE MBJ20026 K1896526
MDQOUTCT DS    H              --- $DQ,CON --- OUTPUT           MBJ20026 K1896528
MDQPPUCT DS    (MBNUMRJE+1)H $NUMRJE+1 -- DQ,PPU --- PRPU      MBJ20026 K1896530
MDQRMTAB DS    (MBNUMRJE)F   $NUMRJE TABLE FOR REMOTE RTCDES   MBJ20026 K1896532
MDQRMEND DS    F                   LAST ENTRY IN TABLE         MBJ20026 K1896534
MDQLEN   EQU   *-MDQDSECT          DSECT LENGTH FOR CLEAR      MBJ20026 K1896536
         SPACE 5                                               MBJ20026 K1896538
HASPCOMA CSECT               REVERT TO CSECT                   MBJ20026 K1896540
         EJECT                                                 MBJ20026 K1896541
++SRC(MBDB) DISTLIB(HASPSRC).
*        COPY  MBDB                 MELLON BANK QUEUE DISPLAY  MBJ20026 K2209202
         TITLE 'HASP COMND PROCESSOR HASPCJB5 - JOB Q DISPLAY' MBJ20026 K2209202
HASPCJB5 $COMGRUP DB               JOB QUEUE DISPLAYS          MBJ20026 K2209204
************************************************************** MBJ20026 K2209206
*                                                            * MBJ20026 K2209208
*        $DB   DISPLAY BACKLOG ON ALL CPU'S                  * MBJ20026 K2209210
*                                                            * MBJ20026 K2209212
************************************************************** MBJ20026 K2209214
         SPACE 1                                               MBJ20026 K2209216
CDB      DS    0H                                              MBJ20026 K2209218
         L     WF,=A(CRESAREA)     ADDRESS                     MBJ20026 K2209220
         USING CDBWORK,WF           RESIDENT WORK AREA         MBJ20026 K2209222
         USING CDBENTRY,WB         ADDRESS EACH ENTRY FROM 'WB' BJ20026 K2209224
         LA    WA,CDBWORK          START OF AREA TO BE CLEARED MBJ20026 K2209226
         LA    WB,CDBQWORK-CDBWORK LENGTH OF AREA TO BE CLEARED BJ20026 K2209228
         SLR   WD,WD               SET FROM LENGTH=0, PAD=X'00' BJ20026 K2209230
         MVCL  WA,WC               CLEAR AREA TO X'00'         MBJ20026 K2209232
         LA    WA,CDBQWORK-CDBWORK SET FREE POINTER            MBJ20026 K2209234
         STH   WA,CDBFREE          TO INITIAL VALUE.           MBJ20026 K2209236
         SPACE 4                                               MBJ20026 K2209238
        $CFJSCAN PROCESS=CDBPROC,NEXT=CDBNEXT                  MBJ20026 K2209240
         B     CDBPRINT            AT END, GO PRINT RESULTS    MBJ20026 K2209242
CDBPROC  LA    WC,CDBBATCH         POINT TO BATCH COUNTER      MBJ20026 K2209244
         CLC   JQEJOBNO,=H'10000'  Q. BATCH JOB                MBJ20026 K2209248
         BL    CDBTOTAL            A. YES - GO TOTAL THEM      MBJ20026 K2209250
         LA    WC,CDBSTC           POINT TO STC COUNTER        MBJ20026 K2209252
         CLC   JQEJOBNO,=H'20000'  Q. STC JQE                  MBJ20026 K2209254
         BL    CDBTOTAL            A. YES - GO TOTAL THEM      MBJ20026 K2209256
         LA    WC,CDBTSU           A. NO - MUST BE TSU         MBJ20026 K2209258
CDBTOTAL LH    WB,0(,WC)           GET CURRENT COUNT           MBJ20026 K2209260
         LA    WB,1(,WB)             + 1                       MBJ20026 K2209262
         STH   WB,0(,WC)           RESTORE AS NEW              MBJ20026 K2209264
         TM    JQETYPE,$XEQ        Q. IN XEQ QUEUE             MBJ20026 K2209266
         BO    CDBXEQ              A. YES - GO CHECK IT        MBJ20026 K2209268
         TM    JQETYPE,$OUTPUT+$HARDCPY Q. IN OUTPUT STAGE     MBJ20026 K2209270
         BZ    CDBNEXT             A. NO - THEN NEXT JQE       MBJ20026 K2209272
         TM    JQETYPE,$OUTPUT     Q. AWAITING OUTPUT PROCESSOR BJ20026 K2209274
         BO    CDBWAITO            A. YES - SAME AS AWAITING PRT J20026 K2209276
         LA    WB,CDBACTCT          POINT TO HEAD OF OUTPUT Q  MBJ20026 K2209278
         LR    WC,R1               SAVE JQE OVER $CFJDCT CALL  MBJ20026 K2209280
        $CFJDCT ,                                              MBJ20026 K2209282
         B     *+8                 NOT FOUND, AWAITING P/P     MBJ20026 K2209284
         B     CDBADD              FOUND, GO ADD TO QUEUE      MBJ20026 K2209286
         LR    R1,WC               RESTORE JQE POINTER         MBJ20026 K2209288
CDBWAITO CLC   JQEJOBNO,=H'10000'  Q. TSU OR STC               MBJ20026 K2209290
         BH    CDBWAITS            A. YES - BRANCH             MBJ20026 K2209292
         SLR   WE,WE              ASSUME LOCAL ROUTING         MBJ20026 K2209294
         SLR   WB,WB              CLEAR FOR INSERT             MBJ20026 K2209296
         CLC   JQEPRTRT,=X'0100'  IS IT LOCAL                  MBJ20026 K2209298
         BNH   CDBWAIT3           YES GO COUNT                 MBJ20026 K2209300
         LH    WB,JQEPRTRT        GET RMT PRINT ROUTE          MBJ20026 K2209302
         LA    WC,HCTDSECT         GET HCT  POINTER            MBJ20026 K2209304
         L     WC,($RATABLE-HCTDSECT)(,WC) GET RAT ORIGIN      MBJ20026 K2209306
         USING RATDSECT,WC         ADDRESS THE RAT             MBJ20026 K2209308
         LH    WE,$NUMRJE          GET # RJE FOR LOOP          MBJ20026 K2209310
CDBWAIT1 CH    WB,RATROUTE         Q. ROUTED TO THIS RJE       MBJ20026 K2209312
         BE    CDBWAIT2            A. YES - EXIT LOOP          MBJ20026 K2209314
         LA    WC,RATEND           A. NO - TRY NEXT RAT        MBJ20026 K2209316
         BCT   WE,CDBWAIT1         LOOP FOR EACH RJE           MBJ20026 K2209318
         SLR   WE,WE               DOESNT MATCH ANY...MAKE LOCAL J20026 K2209320
         B     CDBWAIT3            AND COUNT                   MBJ20026 K2209322
CDBWAIT2 SH    WE,MBRJE2  -$NUMRJE+1- CALCULATE RJE # INVERSE  MBJ20026 K2209324
         LCR   WE,WE               GET ABSOLUTE RJE #          MBJ20026 K2209326
         AR    WE,WE               RJE # * 2 IS OFFSET         MBJ20026 K2209328
CDBWAIT3 LH    WC,CDBOUTCT(WE)     GET CURRENT COUNT           MBJ20026 K2209330
         LA    WC,1(,WC)           ADD 1                       MBJ20026 K2209332
         STH   WC,CDBOUTCT(WE)     AND RESTORE                 MBJ20026 K2209334
         B     CDBNEXT                                         MBJ20026 K2209336
CDBWAITS LA    WB,CDBSTCCT         POINT TO STC COUNTER        MBJ20026 K2209338
         CLC   JQEJOBNO,=H'20000'  Q. TSU                      MBJ20026 K2209340
         BL    *+8                 A. NO - SKIP                MBJ20026 K2209342
         LA    WB,CDBTSUCT         A. YES - POINT TO TSU COUNTER J20026 K2209344
         LH    WC,0(,WB)           GET CURRENT COUTN           MBJ20026 K2209346
         LA    WC,1(,WC)            Q 1                        MBJ20026 K2209348
         STH   WC,0(,WB)           AND RESTORE                 MBJ20026 K2209350
         B     CDBNEXT             NEXT JQE                    MBJ20026 K2209352
         SPACE 3                                               MBJ20026 K2209354
CDBXEQ   CLC   JQEJOBNO,=H'10000'  Q. TSU OR STC               MBJ20026 K2209356
         BH    CDBNEXT             A YES - DONT COUNT          MBJ20026 K2209358
         SLR   WB,WB               CLEAR FOR INSERT            MBJ20026 K2209360
         IC    WB,JQETYPE          GET JOB CLASS               MBJ20026 K2209362
         N     WB,=A(127)          CLEAR ACTIVE BIT            MBJ20026 K2209364
         CLM   WB,1,=AL1($XEQ)     Q. CONVERSION               MBJ20026 K2209366
         BNE   *+12                A. NO - BRANCH              MBJ20026 K2209368
         LA    WB,CDBXEQCT         A. YES - CANT USE $QINDEX   MBJ20026 K2209370
         B     CDBBUSY                GO CHECK BUSY BIT        MBJ20026 K2209372
         IC    WB,$QINDEX(WB)      GET CLASS OFFSET(FOR HALFWORD) 20026 K2209374
         AR    WB,WB               CONVERT TO FULLWORK OFFSET  MBJ20026 K2209376
         BZ    CDBNEXT             SKIP IF INVALID CLASS       MBJ20026 K2209378
         LA    WB,CDBXEQCT-44(WB)  POINT TO COUNTER FOR CLASS  MBJ20026 K2209380
CDBBUSY  LR    WC,R1               SAVE JQE FOR CDBADD ROUTINE MBJ20026 K2209382
         TM    JQEFLAGS,QUEBUSY    Q. ACTIVE SOMEWHERE         MBJ20026 K2209384
         BNZ   CDBADD              A. YES - ADD TO ACTIVE QUEUE BJ20026 K2209386
         LH    WC,CDBCOUNT         A. NO  - ADD TO COUNT       MBJ20026 K2209388
         LA    WC,1(,WC)            + 1                        MBJ20026 K2209390
         STH   WC,CDBCOUNT         AND RESTORE                 MBJ20026 K2209392
         B     CDBNEXT             DO NEXT JQE                 MBJ20026 K2209394
         SPACE 4                                               MBJ20026 K2209396
************************************************************** MBJ20026 K2209398
*                                                            * MBJ20026 K2209400
*        CDBADD - ADD A JOB # TO THE QUEUE.                  * MBJ20026 K2209402
*                                                            * MBJ20026 K2209404
*        WB -  INPUT=POINTER TO QUEUE HEAD                   * MBJ20026 K2209406
*              USAGE=BASE FOR QUEUE ENTRIES                  * MBJ20026 K2209408
*        WC -  INPUT=JQE POINTER                             * MBJ20026 K2209410
*              USAGE=QUEUE SCANNING                          * MBJ20026 K2209412
*        WD -  JOB #                                         * MBJ20026 K2209414
*        WF -  BASE FOR CDBWORK                              * MBJ20026 K2209416
*                                                            * MBJ20026 K2209418
************************************************************** MBJ20026 K2209420
         SPACE 1                                               MBJ20026 K2209422
CDBADD   DS    0H                                              MBJ20026 K2209424
         LR    R1,WC               RESTORE JQE POINTER         MBJ20026 K2209426
         LH    WD,JQEJOBNO         GET JOB #                   MBJ20026 K2209428
CDBADD0  DS    0H                                              MBJ20026 K2209430
         LH    WC,CDBFLINK         POINT TO NEXT ENTRY         MBJ20026 K2209432
         SR    WB,WF               WB=OFFSET TO HEAD           MBJ20026 K2209434
CDBADDNX LTR   WC,WC               Q. END OF QUEUE             MBJ20026 K2209436
         BZ    CDBADD1             A. YES - ADD AT END         MBJ20026 K2209438
         LR    WB,WC               A. NO  - USE WB TO ADDRESS  MBJ20026 K2209440
         LH    WC,CDBFLINK(WF)     GET NEXT ENTRY OFFSET       MBJ20026 K2209442
         CH    WD,(CDBJOBNO-CDBENTRY)(WC,WF) Q. THIS JOB # FIT MBJ20026 K2209444
         BNL   CDBADDNX            A. NO  - TRY NEXT ENTRY     MBJ20026 K2209446
CDBADD1  DS    0H    WB=OFFSET OF ENTRY AFTER WHICH TO ADD     MBJ20026 K2209448
*                    WC=LINK(WB),THE NEXT ENTRY IN THE QUEUE   MBJ20026 K2209450
         LH    WD,CDBFREE          GET A FREE ENTRY            MBJ20026 K2209452
         STH   WC,(CDBFLINK-CDBENTRY)(WD,WF) LINK(NEW)=LINK(OLD) J20026 K2209454
         STH   WD,(CDBFLINK-CDBENTRY)(WB,WF) LINK(OLD)=NEW     MBJ20026 K2209456
         LA    WB,0(WD,WF)         POINT TO NEW ENTRY          MBJ20026 K2209458
         MVC   CDBJOBNO,JQEJOBNO   MOVE JOB # INTO ENTRY       MBJ20026 K2209460
         LA    WD,4(,WD)           NEW FREE POINTER            MBJ20026 K2209462
         STH   WD,CDBFREE          SET IT                      MBJ20026 K2209464
         B     CDBNEXT             GET NEXT JQE                MBJ20026 K2209466
         EJECT                                                 MBJ20026 K2209468
CDBPRINT OC    CDBXEQCT(CDBXEQLN),CDBXEQCT Q. ANY FOR XEQ      MBJ20026 K2209470
         BZ    CDBOUTPR                    A. NO - TRY OUT     MBJ20026 K2209472
         MVC   COMMAND(32),=CL32'AWAITING,  CLASS. JOBS EXECUTING' 0026 K2209474
        $CWTO  L=32                                            MBJ20026 K2209476
         SLR   WC,WC               CLEAR WC                    MBJ20026 K2209478
         LA    WD,CDBXEQCT         POINT TO FIRST XEQ HEADER   MBJ20026 K2209480
CDBXEQPR OC    0(4,WD),0(WD)       Q. ANYTHING IN THAT CLASS Q MBJ20026 K2209482
         BZ    CDBNONEX            Q. NO - TRY NEXT CLASS      MBJ20026 K2209484
         MVI   COMMAND,C' '                    CLEAR           MBJ20026 K2209486
         MVC   COMMAND+1(L'COMMAND-1),COMMAND  MESSAGE         MBJ20026 K2209488
         LA    R9,COMMAND+18            SET LIMITS             MBJ20026 K2209490
         LA    R15,COMMAND+$MAXMSG-4    FOR MESSAGE            MBJ20026 K2209492
         LH    R0,(CDBCOUNT-CDBENTRY)(,WD) GET AWAITING COUNT  MBJ20026 K2209494
        $CFCVE ,                                               MBJ20026 K2209496
         MVC   COMMAND+2(4),COMDWORK+1 PUT INTO MESSAGE        MBJ20026 K2209498
         IC    WE,CDBCLASS(WC)     GET EBCDIC CLASS            MBJ20026 K2209500
         STC   WE,COMMAND+13       AND PUT INTO MESSAGE        MBJ20026 K2209502
         LR    WB,WD               POINT TO ENTRY FOR ADDRESSING J20026 K2209504
         SR    WB,WF               CALCULATE OFFSET            MBJ20026 K2209506
CDBNJOB  LH    WB,CDBFLINK(WF)     GET NEXT QUEUE ENTRY        MBJ20026 K2209508
         LTR   WB,WB               Q. END OF QUEUE             MBJ20026 K2209510
         BZ    CDBWTO              A. YES - FINISH MESSAGE     MBJ20026 K2209512
         LH    R0,CDBJOBNO(WF)     GET JOB #                   MBJ20026 K2209514
         CH    R0,=H'10000'        Q. STC OR TSU               MBJ20026 K2209516
         BL    CDBCVE              A. NO - CONVERT             MBJ20026 K2209518
         SH    R0,=H'10000'        RELATIVIZE                  MBJ20026 K2209520
         CH    R0,=H'10000'        Q. TSU                      MBJ20026 K2209522
         BL    CDBCVE              A. NO - CONVERT             MBJ20026 K2209524
         SH    R0,=H'10000'        A. YES - RELATIVIZE         MBJ20026 K2209526
CDBCVE  $CFCVE ,                                               MBJ20026 K2209528
         MVC   0(4,R9),COMDWORK+1  PUT JOB # IN MESSAGE        MBJ20026 K2209530
         LA    R9,5(,R9)           BUMP FOR NEXT JOB #         MBJ20026 K2209532
         CR    R9,R15              Q. ROOM FOR MORE            MBJ20026 K2209534
         BNH   CDBNJOB             A. YES - CONTINUE SCANNING Q BJ20026 K2209536
         LA    R15,COMMAND         CALCULATE                   MBJ20026 K2209538
         SR    R9,R15               LENGTH                     MBJ20026 K2209540
         LR    R0,R9                 IN R0                     MBJ20026 K2209542
        $CWTO  L=(R0)                                          MBJ20026 K2209544
         MVC   COMMAND+1(L'COMMAND-1),COMMAND CLEAR            MBJ20026 K2209546
         LA    R9,COMMAND+18       RESET BOUNDARIES            MBJ20026 K2209548
         LA    R15,COMMAND+$MAXMSG-4   FOR MESSAGE             MBJ20026 K2209550
         B     CDBNJOB             AND CONTINUE SCANNING QUEUE MBJ20026 K2209552
         SPACE 1                                               MBJ20026 K2209554
CDBWTO   LA    R15,COMMAND         CALCULATE                   MBJ20026 K2209556
         SR    R9,R15               LENGTH                     MBJ20026 K2209558
         LR    R0,R9                 IN R0                     MBJ20026 K2209560
        $CWTO  L=(R0)                                          MBJ20026 K2209562
CDBNONEX LA    WD,CDBELEN(,WD)     POINT TO NEXT HEADER        MBJ20026 K2209564
         LA    WC,1(,WC)           POINT TO NEXT CLASS         MBJ20026 K2209566
         CH    WC,=H'37'           Q. END OF CLASSES           MBJ20026 K2209568
         BL    CDBXEQPR            A. NO - CONTINUE            MBJ20026 K2209570
         SPACE 1                                               MBJ20026 K2209572
CDBOUTPR MVC   COMMAND(10),=CL10'OUTPUTING' TITLE              MBJ20026 K2209574
         MVC   COMMAND+10(L'COMMAND-10),COMMAND+9  CLEAR MSG   MBJ20026 K2209576
         LA    WB,CDBACTCT-CDBWORK GET OFFSET TO HEAD IN WB    MBJ20026 K2209578
         OC    CDBACTCT,CDBACTCT   Q. ANYTHING IN OUTPUTING QUEUE 20026 K2209580
         BZ    CDBAWOUT            A. NO - TRY AWAITING OUT QUEUE 20026 K2209582
CDBLINE2 LA    R9,COMMAND+12            SET MESSAGE            MBJ20026 K2209584
         LA    R15,COMMAND+$MAXMSG-4    LIMITS                 MBJ20026 K2209586
CDBNJOB2 LH    WB,CDBFLINK(WF)     GET NEXT ENTRY              MBJ20026 K2209588
         LTR   WB,WB               Q. END OF QUEUE             MBJ20026 K2209590
         BZ    CDBWTO2             A. YES - FINISH MESSAGE     MBJ20026 K2209592
         LH    R0,CDBJOBNO(WF)     GET JOB #                   MBJ20026 K2209594
         CH    R0,=H'10000'        Q. BATCH JOB                MBJ20026 K2209596
         BL    CDBCVE2             A. YES - GO CONVERT         MBJ20026 K2209598
         MVI   4(R9),C'T'          IDENTIFY AS TSU             MBJ20026 K2209600
         SH    R0,=H'20000'        ELIMINATE BIG NUMBERS       MBJ20026 K2209602
         BP    CDBCVE2             IF +, THEN TSU              MBJ20026 K2209604
         MVI   4(R9),C'S'          ELSE, IDENTIFY AS STC       MBJ20026 K2209606
         AH    R0,=H'10000'        AND MAKE JOB # POSITIVE AGAIN J20026 K2209608
CDBCVE2 $CFCVE ,                                               MBJ20026 K2209610
         MVC   0(4,R9),COMDWORK+1  PUT JOB # INTO MESSAGE      MBJ20026 K2209612
         LA    R9,6(,R9)           BUMP TO NEXT FIELD          MBJ20026 K2209614
         CR    R9,R15              Q. ROOM FOR MORE            MBJ20026 K2209616
         BNH   CDBNJOB2            A. YES - CONTINUE SCANNING Q BJ20026 K2209618
         LA    R15,COMMAND         CALCULATE                   MBJ20026 K2209620
         SR    R9,R15               LENGTH                     MBJ20026 K2209622
         LR    R0,R9                 IN R0                     MBJ20026 K2209624
        $CWTO  L=(R0)                                          MBJ20026 K2209626
         MVI   COMMAND,C' '                    CLEAR           MBJ20026 K2209628
         MVC   COMMAND+1(L'COMMAND-1),COMMAND  MESSAGE         MBJ20026 K2209630
         B     CDBLINE2            RESET LIMITS AND CONT SCAN  MBJ20026 K2209632
         SPACE 3                                               MBJ20026 K2209634
CDBWTO2  LA    R15,COMMAND+12      CALCULATE                   MBJ20026 K2209636
         SR    R9,R15               LENGTH                     MBJ20026 K2209638
         BZ    CDBAWOUT            IF 0, NO MSG                MBJ20026 K2209640
         LA    R0,12(,R9)          GET TRUE LENGTH IN R0       MBJ20026 K2209642
        $CWTO  L=(R0)                                          MBJ20026 K2209644
CDBAWOUT SLR   WC,WC               INDEX=0                     MBJ20026 K2209645
         LH    R9,$NUMRJE          TIMES THRU LOOP             MBJ20026 K2209646
         LA    R15,CDBOUTCT        POINT TO BUCKETS            MBJ20026 K2209647
CDBLOOPZ OC    0(2,R15),0(R15)     ANY COUNTS?                 MBJ20026 K2209648
         BNZ   CDBLOOPX            YES, GO PRINT               MBJ20026 K2209649
         LA    R15,2(R15)          BUMP TO NEXT COUNTER        MBJ20026 K2209650
         BCT   R9,CDBLOOPZ         LOOP TILL DONE              MBJ20026 K2209651
         B     CDBPRTOT            NO DATA GET OUT             MBJ20026 K2209652
CDBLOOPX MVC   COMMAND(16),=CL16'AWAITING OUTPUT' TITLE        MBJ20026 K2209654
         MVC   COMMAND+16(L'COMMAND-16),COMMAND+15 CLEAR MSG   MBJ20026 K2209656
         LA    R9,COMMAND+17            SET MESSAGE            MBJ20026 K2209658
         LA    R15,COMMAND+$MAXMSG-9    BOUNDARIES             MBJ20026 K2209660
         LH    R0,CDBOUTCT(WC)     GET CENTRAL COUNT           MBJ20026 K2209661
         LTR   R0,R0               Q. ANY THING FOR CENTRAL    MBJ20026 K2209662
         BZ    CDBNRMT             A. NO - TRY REMOTES         MBJ20026 K2209663
        $CFCVE ,                                               MBJ20026 K2209664
         MVC   0(4,R9),COMDWORK+1  PUT # INTO MSG              MBJ20026 K2209665
         MVC   4(6,R9),=CL6'-LOCAL'   TITLE                    MBJ20026 K2209666
         LA    R9,11(,R9)          BUMP FOR NEXT AREA          MBJ20026 K2209667
CDBNRMT  LA    WC,2(WC)            INDEX TO NEXT HEADER        MBJ20026 K2209668
         CH    WC,MBRJE1  -$NUMRJE X 2 -  Q. END OF REMOTES    MBJ20026 K2209669
         BH    CDBPRSTC            A. YES - FINISH MESSAGE     MBJ20026 K2209670
         LH    R0,CDBOUTCT(WC)     GET COUNT FOR REMOTE        MBJ20026 K2209672
         LTR   R0,R0               Q. ANY THING FOR IT         MBJ20026 K2209674
         BZ    CDBNRMT             A. NO - NEXT REMOTE         MBJ20026 K2209676
        $CFCVE ,                                               MBJ20026 K2209678
         MVC   0(3,R9),COMDWORK+2  PUT # INTO MSG              MBJ20026 K2209680
         MVC   3(3,R9),=C'-RM'     TITLE                       MBJ20026 K2209681
         LR    R0,WC               GET INDEX                   MBJ20026 K2209682
         SRL   R0,1                CONVERT TO REMOTE #         MBJ20026 K2209683
        $CFCVE ,                                               MBJ20026 K2209684
         MVC   6(1,R9),COMDWORK+4  ASSUME 1 DIGIT REMOTE       MBJ20026 K2209685
         CLI   COMDWORK+3,C' '     Q. REALLY 2 DIGITS          MBJ20026 K2209686
         BE    *+10                A. 1 DIGIT - SKIP NEXT INST MBJ20026 K2209687
         MVC   6(2,R9),COMDWORK+3  A. 2 DIGITS- MOVE BOTH INTO MSG 0026 K2209688
         CLI   COMDWORK+2,C' '     Q. REALLY 3 DIGITS          MBJ20026 K2209689
         BE    *+10                A. 1 DIGIT - SKIP NEXT INST MBJ20026 K2209690
         MVC   6(3,R9),COMDWORK+2  A. 3 DIGITS- MOVE ALL.      MBJ20026 K2209692
         LA    R9,10(,R9)          BUMP TO NEXT AREA           MBJ20026 K2209694
         CR    R9,R15              Q. ROOM FOR MORE            MBJ20026 K2209696
         BNH   CDBNRMT             A. YES - NEXT REMOTE        MBJ20026 K2209698
         LA    R15,COMMAND         CALCULATE                   MBJ20026 K2209700
         SR    R9,R15               LENGTH                     MBJ20026 K2209702
         LR    R0,R9                 IN R0                     MBJ20026 K2209704
        $CWTO  L=(R0)                                          MBJ20026 K2209706
         MVI   COMMAND,C' '                    CLEAR           MBJ20026 K2209708
         MVC   COMMAND+1(L'COMMAND-1),COMMAND  MESSAGE         MBJ20026 K2209710
         LA    R9,COMMAND+17                RESET MESSAGE      MBJ20026 K2209712
         LA    R15,COMMAND+$MAXMSG-9         BOUNDARIES        MBJ20026 K2209714
         B     CDBNRMT             AND CONTINUE SCANNING QUEUE MBJ20026 K2209716
CDBPRSTC LH    R0,CDBSTCCT         GET TOTAL STC'S             MBJ20026 K2209718
         LTR   R0,R0               Q. ZERO                     MBJ20026 K2209720
         BZ    CDBPRTSU            A. YES - PRINT TSU          MBJ20026 K2209722
         MVC   4(4,R9),=C'-STC'    SUB-TITLE                   MBJ20026 K2209724
        $CFCVE ,                   CONVERT TO EBCDIC           MBJ20026 K2209726
         MVC   0(4,R9),COMDWORK+1   INTO MESSAGE               MBJ20026 K2209728
         LA    R9,9(,R9)           BUMP TO NEXT FIELD          MBJ20026 K2209730
CDBPRTSU LH    R0,CDBTSUCT         GET TOTAL TSU'S             MBJ20026 K2209732
         LTR   R0,R0               Q. ZERO                     MBJ20026 K2209734
         BZ    CDBWTO3             A. YES - WRITE THE MESSAGE  MBJ20026 K2209736
         MVC   4(4,R9),=C'-TSU'    SUB-TITLE                   MBJ20026 K2209738
        $CFCVE ,                   CONVERT TO EBCDIC           MBJ20026 K2209740
         MVC   0(4,R9),COMDWORK+1   INTO MESSAGE               MBJ20026 K2209742
         LA    R9,8(,R9)           TO END OF MESSAGE           MBJ20026 K2209744
CDBWTO3  LA    R15,COMMAND+17      CALCULATE                   MBJ20026 K2209746
         SR    R9,R15               LENGTH                     MBJ20026 K2209748
         BZ    CDBPRTOT            IF 0, NO MSG                MBJ20026 K2209750
         LA    R0,17(,R9)          GET TRUE LENGTH IN R0       MBJ20026 K2209752
        $CWTO  L=(R0)                                          MBJ20026 K2209754
         SPACE 1                                               MBJ20026 K2209756
CDBPRTOT MVC   COMMAND(49),CDBTOTMG MOVE MESSAGE TO PRINT      MBJ20026 K2209758
         LH    R0,CDBBATCH         GET BATCH COUNT             MBJ20026 K2209760
        $CFCVE ,                   CONVERT TO EBCDIC           MBJ20026 K2209762
         MVC   COMMAND+11(4),COMDWORK+1  INTO MESSAGE          MBJ20026 K2209764
         LH    R0,CDBSTC           GET STC TOTAL               MBJ20026 K2209766
        $CFCVE ,                   CONVERT TO EBCDIC           MBJ20026 K2209768
         MVC   COMMAND+22(4),COMDWORK+1  INTO MESSAGE          MBJ20026 K2209770
         LH    R0,CDBTSU           GET TSU TOTAL               MBJ20026 K2209772
        $CFCVE ,                   CONVERT TO EBCDIC           MBJ20026 K2209774
         MVC   COMMAND+31(4),COMDWORK+1  INTO MESSAGE          MBJ20026 K2209776
         LH    R0,$MAXJOBS         GET MAX JOB COUNT           MBJ20026 K2209778
        $CFCVE ,                   CONVERT TO EBCDIC           MBJ20026 K2209780
         MVC   COMMAND+40(4),COMDWORK+1  INTO MESSAGE          MBJ20026 K2209782
        $CRET  L=49                RETURN WITH TOTAL LINE      MBJ20026 K2209784
         EJECT                                                 MBJ20026 K2209786
************************************************************** MBJ20026 K2209787
*        DATA AREAS FOR $DB                                  * MBJ20026 K2209788
************************************************************** MBJ20026 K2209789
         SPACE 1                                               MBJ20026 K2209790
CDBTOTMG DC    C'TOTAL JOBS     -BATCH     -STC     -TSU     -JQES' 026 K2209791
CDBCLASS DC    C'*ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789'        MBJ20026 K2209792
$MAXMSG  EQU   44                  MAXIMUM MESSAGE LENGTH      MBJ20026 K2209793
         LTORG ,                                               MBJ20026
CDBENTRY DSECT                                                 MBJ20026 K2209794
CDBJOBNO DS    0H                  JOB #                       MBJ20026 K2209795
CDBCOUNT DS    H                   COUNT, IF AWAITING          MBJ20026 K2209796
CDBFLINK DS    H                   OFFSET TO NEXT ENTRY IN Q   MBJ20026 K2209797
CDBELEN  EQU   *-CDBENTRY          ENTRY LENGTH                MBJ20026 K2209798
         SPACE 3                                               MBJ20026 K2209799
CDBWORK  DSECT                                                 MBJ20026 K2209800
CDBFREE  DS    H                   OFFSET TO FIRST FREE ELEMENT BJ20026 K2209801
CDBSTCCT DS    H                   STC'S AWAITING OUT          MBJ20026 K2209802
CDBTSUCT DS    H                   TSU'S AWAITING OUT          MBJ20026 K2209803
CDBACTCT DS    F       HEADER ENTRY FOR ACTIVE OUTPUTING       MBJ20026 K2209804
CDBOUTCT DS    (MBNUMRJE+1)H $NUMRJE+1 CTR FOR AWAITING OUT    MBJ20026 K2209805
CDBOUTLN EQU   *-CDBOUTCT          LENGTH OF COUNTER AREA      MBJ20026 K2209806
CDBXEQCT DS    37F     HEADER ENTRY FOR 36 CLASSES + '*'       MBJ20026 K2209807
CDBXEQLN EQU   *-CDBXEQCT          LENGTH OF COUNTER AREA      MBJ20026 K2209808
CDBBATCH DS    H                   TOTAL BATCH JOBS            MBJ20026 K2209809
CDBSTC   DS    H                   TOTAL STC                   MBJ20026 K2209810
CDBTSU   DS    H                   TOTAL TSU                   MBJ20026 K2209811
CDBQWORK DS    0F        BEGINNING OF AREA FOR QUEUE ENTRIES   MBJ20026 K2209812
         DROP  WF,WB               DROP LOCAL ADDRESSING       MBJ20026 K2209813
HASPCOMA CSECT           REVERT TO CSECT HASPCOMA              MBJ20026 K2209820
++SRC(MBQJ) DISTLIB(HASPSRC).
*        COPY  MBQJ                                            MBJ20026 K2771006
************************************************************** MBJ20026 K2771006
*                                                            * MBJ20026 K2771009
*        DISPLAY JOBCARD AND JES CONTROL CARDS FOR A JOB     * MBJ20026 K2771012
*        $QJX    $QJX-X   $QJX,X,X,X,X                       * MBJ20026 K2771015
*                                                            * MBJ20026 K2771018
************************************************************** MBJ20026 K2771021
CQJ      DS    0H                                              MBJ20026 K2771024
         STM   WA,WE,COMREGSV+4    SAVE REGISTERS.             MBJ20026 K2771027
         MVI   COMMAND,X'40'       CLEAR FIRST CHACACTER       MBJ20026 K2771030
         MVC   COMMAND+1(L'COMMAND-1),COMMAND CLEAR REST.      MBJ20026 K2771033
         MVC   COMMAND(3),=C'JOB'  SHOW JOB.                   MBJ20026 K2771036
         LH    R0,JQEJOBNO         GET JOB NO.                 MBJ20026 K2771039
         $CFCVE VALUE=(R0)         CONVERT IT.                 MBJ20026 K2771042
         MVC   COMMAND+3(5),COMDWORK MOVE TO MESSAGE.          MBJ20026 K2771045
         MVC   COMMAND+10(8),JQEJNAME MOVE IN JOBNAME          MBJ20026 K2771048
         CLI   JQETYPE,$PURGE     IS IT AWAITING PURGE         MBJ20026 K2771051
         BE    CLCNOTXQ           YES..NO QJ ON IT             MBJ20026 K2771054
         TM    JQETYPE,$XEQ        IS IT IN EXECUTION Q?       MBJ20026 K2771057
         BO    *+8                YES. BYPASS PRT INDICATOR    MBJ20026 K2771060
         MVI   COMMAND+8,C'='     SHOW PRT JOB                 MBJ20026 K2771061
         CLC   JQEJOBNO,=H'10000'  JOB IN NORMAL BATCH RANGE   MBJ20026 K2771063
         BNL   CLCNOTXQ            NO, CANNOT $QJ STC,TSU JOB  MBJ20026 K2771066
*    AT THIS POINT WE HAVE FINALLY AGREED WE HAVE A VALID JQE. MBJ20026 K2771069
         MVI   CLCJOBSW,0          SET TO NO JOBCARD FOUND     MBJ20026 K2771072
         L     WA,=A(CRESAREA)     POINT TO RESIDENT WORK AREA MBJ20026 K2771075
         ST    WA,COMREGSV         SAVE FOR LATER.             MBJ20026 K2771078
         LA    WB,4095             LENGTH TO CLEAR.            MBJ20026 K2771081
         LA    WC,=C' '            SET TO MOVE SPACES.         MBJ20026 K2771084
         LA    WD,1                LENGTH OF FROM FIELD.       MBJ20026 K2771086
         ICM   WD,8,=C' '          FILL CHARACTER.             MBJ20026 K2771089
         MVCL  WA,WC               SPACE OUT CRESAREA.         MBJ20026 K2771092
         CLI   COMMAND+8,C'='     IS IT FOR PRT                MBJ20026 K2771093
         BE    CLCPRT1            YES FORGET JOBCLASS          MBJ20026 K2771094
         MVC   COMMAND+8(1),JQETYPE MOVE IN JOBCLASS           MBJ20026 K2771095
         OI    COMMAND+8,X'80'     MAKE PRINTABLE              MBJ20026 K2771098
CLCPRT1  EQU   *                                               MBJ20026 K2771100
         MVI   COMMAND+18,C' '     BLANK ANOTHER CHARACTER     MBJ20026 K2771101
         LR    WA,R1               SAVE JQE ADDRESS.           MBJ20026 K2771104
         LA    WB,PCEDADCT         POINT TO DA DCT.            MBJ20026 K2771107
         $GETBUF CLCNOBUF          GET A BUFFER FOR I/O        MBJ20026 K2771110
         LR    WC,R1               SAVE BUFFER ADDRESS         MBJ20026 K2771113
         USING BUFDSECT,WC         ADDRESS BUFFER.             MBJ20026 K2771116
         MVI   PCEDEVTP,PCEDARD    INDICATE READ REQUEST       MBJ20026 K2771119
         ST    WC,PCEBUFAD         SET BUFFER ADDRESS          MBJ20026 K2771122
         L     R15,QUETRAK(WA)     GET JCT TRACK ADDRESS       MBJ20026 K2771125
         ST    R15,PCESEEK         SET TRACK ADDRESS           MBJ20026 K2771128
         LA    R15,IOBCCW1         START OF CCW'S              MBJ20026 K2771131
         ST    R15,IOBSTART        STORE IN BUFFER             MBJ20026 K2771134
         $EXCP (WB)                READ IN THE JCT             MBJ20026 K2771137
CLCEXCP1 $WAIT IO                  WAIT FOR COMPLETION         MBJ20026 K2771140
         TM    BUFECBCC,X'7F'      TEST COMPLETION             MBJ20026 K2771143
         BZ    CLCEXCP1            NOT COMPLETE, GO WAIT.      MBJ20026 K2771146
         BM    CLCIOERR            IO ERROR INDICATED          MBJ20026 K2771149
*    AT THIS POINT WE HAVE SUCCESSFULLY READ THE JCT.          MBJ20026 K2771152
         LR    JCT,WC              PUT JCT ADDR IN JCT REG.    MBJ20026 K2771155
         USING JCTDSECT,JCT       ADDRESS THE JCT              MBJ20026 K2771156
         L     R0,$JOBQPTR         GET ADDR OF HASP JOBQ       MBJ20026 K2771158
         AL    R0,JCTJQE           ADD JQE OFFSET FROM JCT     MBJ20026 K2771161
         CLR   R0,WA               TEST JCT VALIDITY.          MBJ20026 K2771164
         BNE   CLCIOERR            BR IF INVALID.              MBJ20026 K2771167
*    AT THIS POINT WE HAVE A VALID JCT FOR THE JOB.            MBJ20026 K2771170
         CLI   COMMAND+8,C'='     IS IT FOR PRINT              MBJ20026 K2771171
         BE    CQJPRT             YES. GO PROCESS JCT          MBJ20026 K2771172
         L     R15,JCTIOT          GET FIRST IOT TRAK ADDR     MBJ20026 K2771173
         ST    R15,PCESEEK         SET FOR READ.               MBJ20026 K2771176
         $EXCP (WB)                READ IN IOT                 MBJ20026 K2771179
CLCEXCP2 $WAIT IO                  WAIT FOR COMPLETION         MBJ20026 K2771182
         TM    BUFECBCC,X'7F'      TEST COMPLETION.            MBJ20026 K2771185
         BZ    CLCEXCP2            NOT COMPLETE GO WAIT AGAIN. MBJ20026 K2771188
         BM    CLCIOERR            IO ERROR INDICATED.         MBJ20026 K2771191
*    AT THIS POINT WE HAVE SUCCESSFULLY READ THE IOT.          MBJ20026 K2771194
*    NOW ATTEMPT TO GET INPUT PDDB S.                          MBJ20026 K2771197
         L     JCT,$IOTPDDB       POINT TO                     MBJ20026 K2771199
         LA    JCT,IOTPDBOJ(JCT,WC)  JCL PDDB                  MBJ20026 K2771200
         L     R15,PDBMTTR-PDBDSECT(JCT) POINT TO JCL TRACK    MBJ20026 K2771203
CLCEXCPL ST    R15,PCESEEK         SET FOR READ                MBJ20026 K2771206
         $EXCP (WB)                READ THE PDDB.              MBJ20026 K2771209
CLCWAIT  $WAIT IO                  WAIT FOR POST.              MBJ20026 K2771212
         TM    BUFECBCC,X'7F'      GOOD COMPLETION.            MBJ20026 K2771215
         BZ    CLCWAIT             NOT COMPLETE GO WAIT.       MBJ20026 K2771218
         BM    CLCIOERR            IO ERROR INDICATED          MBJ20026 K2771221
*   AT THIS POINT WE HAVE A PDDB FOR THE JOB.                  MBJ20026 K2771224
         LA    WD,BUFSTART+10      POINT TO DATA.              MBJ20026 K2771227
         SLR   WE,WE               CLEAR FOR WORK              MBJ20026 K2771230
CLCGETCD IC    WE,0(,WD)           GET LENGTH                  MBJ20026 K2771233
         CLI   CLCJOBSW,1          JOB CARD FOUND?             MBJ20026 K2771236
         BNE   CLCJOBCD            NO, GO DO IT.               MBJ20026 K2771239
         CLC   3(3,WD),=C'//*'     IT JES CONTROL CARD.        MBJ20026 K2771242
         BNE   CLCNEXTC            NO, IGNORE IT.              MBJ20026 K2771245
         LA    R15,CLCTABEN        NO. OF ENTRIES IN TABLE     MBJ20026 K2771248
         LA    R14,CLCTABST        BEGINNING OF TABLE.         MBJ20026 K2771251
*    AT THIS POINT WE HAVE A JES CONTROL CARD. SEARCH TABLE.   MBJ20026 K2771254
CLCLOOP  CLC   6(4,WD),0(R14)      HIT?                        MBJ20026 K2771257
         BE    CLCJESCD            YES, GO PROCESS             MBJ20026 K2771260
         LA    R14,7(,R14)         BUMP POINTER                MBJ20026 K2771263
         BCT   R15,CLCLOOP         TRY AGAIN.                  MBJ20026 K2771266
CLCNEXTC LA    WD,3(WD,WE)         POINT TO NEXT CARD          MBJ20026 K2771269
         CLI   0(WD),X'FF'         END OF BUFFER               MBJ20026 K2771272
         BE    CLCNEXTB            YES, GET NEXT ONE.          MBJ20026 K2771275
         CLI   1(WD),X'FF'         TEST NEXT BYTE FOR END.     MBJ20026 K2771278
         BE    CLCNEXTB            YES, GET NEXT ONE.          MBJ20026 K2771281
         B     CLCGETCD            DO NEXT CARD.               MBJ20026 K2771284
CLCJOBCD DS    0H                                              MBJ20026 K2771287
         MVI   CLCJOBSW,1          SHOW JOB CARD DONE.         MBJ20026 K2771290
CLCJESCD L     R15,COMREGSV        PICKUP OUTPUT POINTER       MBJ20026 K2771293
         BCTR  WE,0                DOWN ONE FOR COMPARE.       MBJ20026 K2771296
         EX    WE,CQJMVCRD         MOVE CARD FOR DESIRED LENGTH BJ20026 K2771299
         LA    WE,1(WE)            BACK UP ONE.                MBJ20026 K2771302
         LA    R15,70(R15)         POINT TO NEXT SLOT.         MBJ20026 K2771305
         ST    R15,COMREGSV        SAVE IT.                    MBJ20026 K2771308
         B     CLCNEXTC            GO GET NEXT CARD.           MBJ20026 K2771311
CLCNEXTB DS    0H                                              MBJ20026 K2771314
         ICM   R15,15,HDBNXTRK      NEXT BUFFER ADDRESS        MBJ20026 K2771317
         BNZ   CLCEXCPL            END OF CHAIN IF ZERO        MBJ20026 K2771320
         L     R15,COMREGSV        GET SAVE POINTER.           MBJ20026 K2771323
         MVI   0(R15),X'FF'        SHOW END OF CARDS.          MBJ20026 K2771326
         L     WD,=A(CRESAREA)     POINT TO BEGINNING OF CARDS MBJ20026 K2771329
         ST    WA,COMREGSV         SAVE Q POINTER.             MBJ20026 K2771332
*    AT THIS POINT WE HAVE PROCESSED ALL CARDS AND ARE READY   MBJ20026 K2771335
*    TO PRINT THEM TO OPERATOR.                                MBJ20026 K2771338
CLCPRTCD MVC   COMMAND+10(70),0(WD) MOVE IN A CARD             MBJ20026 K2771341
         LA    R0,80               MESSAGE LENGTH              MBJ20026 K2771344
         $CWTO L=(R0)              WTO IT.                     MBJ20026 K2771347
         LA    WD,70(WD)           POINT TO NEXT CARD          MBJ20026 K2771350
         CLI   0(WD),X'FF'         END OF CARDS.               MBJ20026 K2771353
         BNE   CLCPRTCD            NO, GO PRINT OTHER CARD     MBJ20026 K2771356
*                                                              MBJ20026 K2771359
CLCCLEAN $FREEBUF (WC)             FREE THE BUFFER.            MBJ20026 K2771362
CQJREST  LM    R1,WE,COMREGSV      RESTORE Q POINTER & REGS 2-6MBJ20026 K2771365
         B     CAJNEXT             GO GET NEXT JOB.            MBJ20026 K2771368
         SPACE 2                                               MBJ20026 K2771371
CLCNOBUF DS    0H                                              MBJ20026 K2771374
         $CRET MSG=CLCBUFNO,L=L'CLCBUFNO RETURN TO BUFFER      MBJ20026 K2771377
         SPACE 1                                               MBJ20026 K2771380
CLCIOERR DS    0H                                              MBJ20026 K2771383
         ST    WA,COMREGSV         SAVE Q POINTER.             MBJ20026 K2771386
         $IOERROR (WC)             IO ERROR MESSAGE.           MBJ20026 K2771389
         MVC   COMMAND+5(L'CLCERROR),CLCERROR MOVE ERROR MSG.  MBJ20026 K2771392
         LA    R0,L'CLCERROR+6     SET LENGTH                  MBJ20026 K2771395
         $CWTO L=(R0)              WTO IT.                     MBJ20026 K2771398
         B     CLCCLEAN            GO CLEAN UP FOR NEXT JOB    MBJ20026 K2771401
         SPACE 1                                               MBJ20026 K2771404
CQJPRT   EQU   *                                               MBJ20026 K2771407
         MVC   COMMAND+19(21),PRTMSG MOVE SKELETON RESPONSE    MBJ20026 K2771410
         MVC   COMMAND+42(21),PUNMSG MOVE SKELETON RESPONSE    MBJ20026 K2771413
         L     R15,JCTLINES       GET # OF LINES FROM JCT      MBJ20026 K2771416
         CVD   R15,QJWORK         CONVERT TO DECIMAL           MBJ20026 K2771419
         ED    COMMAND+19(10),QJWORK+4 EDIT INTO MSG AREA      MBJ20026 K2771422
         L     R15,JCTPUNCH       GET # OF CARDS FROM JCT      MBJ20026 K2771425
         CVD   R15,QJWORK         CONVERT TO DECIMAL           MBJ20026 K2771428
         ED    COMMAND+42(10),QJWORK+4 EDIT INTO MSG AREA      MBJ20026 K2771431
         LA    R0,80              INDICATE LENGTH              MBJ20026 K2771434
         $CWTO L=(R0)             WTO IT                       MBJ20026 K2771437
         B     CLCCLEAN           GO RETURN                    MBJ20026 K2771440
CLCNOTXQ DS    0H                                              MBJ20026 K2771507
         ST    R1,COMREGSV         SAVE Q POINTER.             MBJ20026 K2771510
         MVC   COMMAND+19(L'CLCNOTEX),CLCNOTEX ERROR MESSAGE   MBJ20026 K2771513
         LA    R0,L'CLCNOTEX+19    SET LENGTH                  MBJ20026 K2771516
         $CWTO L=(R0)              WTO IT.                     MBJ20026 K2771519
         B     CQJREST             GO CLEANUP AND LEAVE.       MBJ20026 K2771522
         SPACE 3                                               MBJ20026 K2771525
PRTMSG   DC    X'40206B2020206B202120',CL11'PRINT LINES'       MBJ20026 K2771526
PUNMSG   DC    X'40206B2020206B202120',CL11'PUNCH CARDS'       MBJ20026 K2771527
CLCJOBSW EQU   COMEWORK,1          JOB CARD SWITCH.            MBJ20026 K2771528
QJWORK   EQU   COMDWORK,8         JCT VALUE WORK AREA          MBJ20026 K2771530
CLCTABST DS    0H                  TABLE START.                MBJ20026 K2771531
         DC    CL7'ROUTE'          POSSIBLE                    MBJ20026 K2771534
         DC    CL7'MESSAGE'          CURRENT                   MBJ20026 K2771537
         DC    CL7'OUTPUT'             JES2                    MBJ20026 K2771540
         DC    CL7'JOBPARM'              SHRSPL                MBJ20026 K2771543
         DC    CL7'CNTL'                   CONTROL             MBJ20026 K2771546
         DC    CL7'BEFORE'                   CARD              MBJ20026 K2771549
         DC    CL7'AFTER'                      TABLE           MBJ20026 K2771552
         DC    CL7'SETUP'                         NAMES        MBJ20026 K2771553
CLCTABEN EQU   (*-CLCTABST)/7      NO. OF ENTRIES IN TABLE.    MBJ20026 K2771555
CLCERROR DC    C'I/O ERROR, $QJ ABORTED *' ERROR MESSAGE       MBJ20026 K2771558
CLCBUFNO DC    C'NO BUFFER AVAILABLE, TRY $QJ AGAIN' NOBUF MSG MBJ20026 K2771561
CLCNOTEX DC    C' IS TSU, STC, OR PURGE !!!'                   MBJ20026 K2771564
*                                                              MBJ20026 K2771567
*                                                              MBJ20026 K2771570
*     *********   EXECUTE ONLY.     $$$$$$$$$$$$$$             MBJ20026 K2771573
CQJMVCRD MVC   0(*-*,R15),3(WD)    MOVE IN CARD.               MBJ20026 K2771576
         DROP  WC                  GIVE UP ADDRESS.            MBJ20026 K2771579
         DROP  JCT                GIVE UP ADDRESS              MBJ20026 K2771580
         EJECT                                                 MBJ20026 K2771582
++SRC(MBMULT) DISTLIB(HASPSRC).
*        COPY  MBMULT      MELLON BANK CMDS (DP QS QA QD DC)   MBJ20026 K4697510
         LTORG                                             MBJ20061 026 K5430100
         TITLE 'HASP CMD PROCESSOR - HASPCRES - RESOURCE CNTRL CMDS' 26 K5430300
HASPCRES $COMGRUP DC,DR,QA,QD  RESOURCE TABLE COMMANDS         MBJ20026 K5430304
************************************************************** MBJ20026 K5430306
*                                                            * MBJ20026 K5430308
*        RESOURCE TABLE SUBPROCESSOR                         * MBJ20026 K5430310
*                                                            * MBJ20026 K5430312
* FORM 1-$QX RES,SID                                         * MBJ20026 K5430314
*              = HASP VERB CODE (RESOURCE Q)                 * MBJ20026 K5430316
*        X     = OPERATION (A-ATTACH,D=DETACH                * MBJ20026 K5430318
*        RES   = RESOURCE (REQ'D) - ANY VALID JES2 RESOURCE  * MBJ20026 K5430320
*        SID   = SYSTEM ID (OPTIONAL) - ANY VALID CPU ID     * MBJ20026 K5430322
*                   IN FORM 68#X                             * MBJ20026 K5430324
*        DEFAULTS                                            * MBJ20026 K5430326
*              SID=SYSTEM IN WHICH COMMAND WAS ISSUED        * MBJ20026 K5430328
*                                                            * MBJ20026 K5430330
* FORM 2-$DX SID                                             * MBJ20026 K5430332
*        $D    = HASP VERB CODE (DISPLAY)                    * MBJ20026 K5430334
*        X     = OPERATION (R-RESOURCE,C=CONFLICT)           * MBJ20026 K5430336
*              = 'C'  DISPLAY JOBS WITH RESOURCE ROUTINGS    * MBJ20026 K5430338
*                     INCOMPATIBLE WITH ANY CPU.             * MBJ20026 K5430340
*              = 'R'  DISPLAY THE RESOURCES ATTACHED TO      * MBJ20026 K5430342
*                     THE SPECIFIED CPU.                     * MBJ20026 K5430344
*        SID   = SAME AS FORM1.(ONLY FOR $DR), OR 'ALL'      * MBJ20026 K5430346
*        DEFAULTS                                            * MBJ20026 K5430348
*              SID=ALL ACTIVE CPUS                           * MBJ20026 K5430350
*                                                            * MBJ20026 K5430352
*        NOTES - $Q COMMAND EXIT NORMALLY WITH A BRANCH      * MBJ20026 K5430354
*                EXIT TO $DR.AND $DC                         * MBJ20026 K5430356
*                                                            * MBJ20026 K5430358
************************************************************** MBJ20026 K5430360
         SPACE 1                                               MBJ20026 K5430362
CQA      DS    0H        $QA RESOURCE                          MBJ20026 K5430364
         OI    CQFLAG,CQATTACH     SET ATTACH RESOURCE FLAG    MBJ20026 K5430366
         B     CQPROC              AND PROCESS                 MBJ20026 K5430368
CQD      DS    0H        $QD RESOURCE                          MBJ20026 K5430370
         OI    CQFLAG,CQDETACH     SET DETACH RESOURCE FLAG    MBJ20026 K5430372
CQPROC   DS    0H        COMMON $RESTAB UPDATE                 MBJ20026 K5430374
         BXH   WD,WE,CQ0OPER       Q. ANY OPERANDS             MBJ20026 K5430376
         LM    WA,WB,0(WD)         A. YES GET THEM IN REGS     MBJ20026 K5430378
         LR    WC,WB                  WC=2ND OPER              MBJ20026 K5430388
         SR    WC,WA                  WC=LENGTH 1ST OPER + 1   MBJ20026 K5430390
         BCTR  WC,0                   WC=LENGTH 1ST OPER       MBJ20026 K5430392
         BCTR  WC,0                   WC=VALUE FOR MVC         MBJ20026 K5430394
         LA    R1,7                MAXIMUM LENGTH              MBJ20026 K5430396
         NR    WC,R1               GUARANTEE LENGTH LE 8       MBJ20026 K5430398
         MVI   CQRESNAM,C' '       CLEAR RESOURCE              MBJ20026 K5430400
         MVC   CQRESNAM+1(7),CQRESNAM  NAME TO BLANKS          MBJ20026 K5430402
         EX    WC,CQRESMVC         MOVE RESOURCE IN            MBJ20026 K5430404
*    NOW HAVE FIRST OPERAND (RESOURCE NAME) AT CQRESNAM        MBJ20026 K5430406
         MVC   CQCPUID(4),$SID     SET DEFAULT SYSTEM ID       MBJ20026 K5430408
         BXH   WD,WE,CQ1OPER       Q. ANOTHER OPERAND          MBJ20026 K5430412
*                                  A. NO - USE DEFAULT         MBJ20026 K5430414
         MVC   CQCPUID(4),0(WB)    A. YES- USE AS CPU ID       MBJ20026 K5430420
         SPACE 1                                               MBJ20026 K5430422
CQ1OPER  SLR   WC,WC               CLEAR WC                    MBJ20026 K5430424
         L     WC,$QSE1            POINT FIRST QSE             MBJ20026 K5430426
         SH    WC,=AL2(QSELEN)     SUB ONE QSE LENGTH FOR LOOP MBJ20026 K5430428
         USING QSEDSECT,WC         QSE ADDRESSABILITY          MBJ20026 K5430430
CQ1LOOP  AH    WC,=AL2(QSELEN)     ADD ONE QSE LENGTH          MBJ20026 K5430432
         CLC   QSESID,CQCPUID      IS THIS THE CPU             MBJ20026 K5430434
         BE    CQ1MATCH            YES  GO PROCESS             MBJ20026 K5430436
         TM    QSEFLAGS,QSELAST    LAST QSE                    MBJ20026 K5430438
         BZ    CQ1LOOP             GET NEXT QSE                MBJ20026 K5430440
         B     CQINVCPU            INVALID CPU                 MBJ20026 K5430442
         SPACE 1                                               MBJ20026 K5430444
CQ1MATCH LA    R15,$NOLEFT         GET # OF RESOURCES          MBJ20026 K5430446
         L     R1,CQHIBIT          GET X'80000000' IN R1       MBJ20026 K5430448
         LA    WA,$RESTAB          GET RESOURCE TABLE          MBJ20026 K5430450
CQRESLOP CLC   CQRESNAM(8),0(WA)   Q. MATCH TABLE ENTRY        MBJ20026 K5430452
         BE    CQRESMAT            A. YES-BRANCH OUT OF LOOP   MBJ20026 K5430454
         SRL   R1,1                A. NO -MOVE BIT OVER 1      MBJ20026 K5430456
         LA    WA,$RESLEN(,WA)        POINT TO NEXT TABLE ENTRYMBJ20026 K5430458
         BCT   R15,CQRESLOP           AND LOOP THROUGH TABLE   MBJ20026 K5430460
         B     CQINVRES            NOT FOUND-INVALID RESOURCE  MBJ20026 K5430462
         SPACE 1                                               MBJ20026 K5430464
CQRESMAT LR    WD,R1               SAVE RESOURCE ID            MBJ20026 K5430466
         L     WE,QSERESTB         GET CURRENT RESOURCES       MBJ20026 K5430468
         TM    CQFLAG,CQATTACH     Q. RESOURCE BEING ATTACHED  MBJ20026 K5430470
         BO    CQADDRES            A. YES - BRANCH             MBJ20026 K5430472
         NR    WD,WE               Q. RESOURCE ALREADY DETACHEDMBJ20026 K5430474
         BZ    CQEXIT              A. YES - DONT ALTER CKPT    MBJ20026 K5430476
         $QSUSE  ,                    GET CKPT RECORD          MBJ20026 K5430478
         X     R1,QSERESTB         TURN OFF RESOURCE BIT       MBJ20026 K5430480
         STCM  R1,8+4+2,QSERESTB   AND PUT BACK IN QSE         MBJ20026 K5430482
         B     CQEXIT              AND EXIT FROM $QD           MBJ20026 K5430484
         SPACE 1                                               MBJ20026 K5430486
CQADDRES NR    WD,WE               Q. RESOURCE ALREADY ATTACHEDMBJ20026 K5430488
         BNZ   CQEXIT              A. YES-DONT ALTER CKPT      MBJ20026 K5430490
         $QSUSE  ,                    GET CKPT RECORD          MBJ20026 K5430492
         O     R1,QSERESTB            TURN ON RESOURCE BIT     MBJ20026 K5430494
         STCM  R1,8+4+2,QSERESTB      AND REPLACE IN QSE       MBJ20026 K5430496
         B     CQEXIT              EXIT FROM $QA               MBJ20026 K5430498
         SPACE 1                                               MBJ20026 K5430502
CQ0OPER  $CRET MSG='NO OPERANDS'                               MBJ20026 K5430504
         SPACE 1                                               MBJ20026 K5430506
CQINVCPU $CRET MSG='INVALID SYSTEM ID'                         MBJ20026 K5430508
         SPACE 1                                               MBJ20026 K5430510
CQINVRES $CRET MSG='INVALID RESOURCE'                          MBJ20026 K5430512
         SPACE 1                                               MBJ20026 K5430514
CQEXIT   $POST $HASPECF,JOB POST CPUS-NEW SYSTEM CONFIGURATION MBJ20026 K5430516
         OI    CQFLAG,CQCMD        TELL $DR THAT WERE COMING   MBJ20026 K5430518
         LR    WD,WC               SETUP ADDR QSE FOR QDR      MBJ20026 K5430519
         B     CDRENTRY            BRANCH ENTER $DR            MBJ20026 K5430520
         DROP  WC                  DROP QSE ADDRESSABILITY     MBJ20026 K5430521
         SPACE 1                                               MBJ20026 K5430522
*                                                              MBJ20026 K5430524
* LOCAL DEFINITIONS FOR $QA AND $QD.                           MBJ20026 K5430526
*                                                              MBJ20026 K5430528
*     EXECUTE INSTRUCTIONS                                     MBJ20026 K5430530
CQRESMVC MVC   CQRESNAM(0),0(WA)   VARIABLE RESOURCE NAME MOVE MBJ20026 K5430532
*                                                              MBJ20026 K5430534
*     FLAGS & FIELDS                                           MBJ20026 K5430536
CQCPUID  EQU   COMEWORK,4          CPU ID                      MBJ20026 K5430538
CQRESNAM EQU   COMDWORK,8          RESOURCE NAME               MBJ20026 K5430540
CQFLAG   EQU   COMNULOP,1          FLAG BYTE                   MBJ20026 K5430542
CQATTACH EQU   128                 BIT0                        MBJ20026 K5430544
CQDETACH EQU   64                  BIT1                        MBJ20026 K5430546
CQCMD    EQU   32                  BIT2                        MBJ20026 K5430548
         DS    0F                                              MBJ20026 K5430550
CQHIBIT  DC    X'80000000'                                     MBJ20026 K5430552
         EJECT                                                 MBJ20026 K5430558
************************************************************** MBJ20026 K5430600
*                                                            * MBJ20026 K5430602
*        DISPLAY RESOURCES ATTACHED TO EACH CPU.             * MBJ20026 K5430604
*                                                            * MBJ20026 K5430606
************************************************************** MBJ20026 K5430608
CDR      DS    0H        DISPLAY RESOURCES                     MBJ20026 K5430610
         MVC   CDRCPULO(4),$SID    THIS SYSTEM DEFAULT         MBJ20026
         BXH   WD,WE,CDRGTQSE      NO OPERAND BR FIND QSE      MBJ20026
         L     WD,0(WD)            GET OPERAND                 MBJ20026
         MVC   CDRCPULO(4),0(WD)   COPY REQEUSTED CPU ID       MBJ20026
CDRGTQSE SLR   WD,WD               CLEAR WC                    MBJ20026
         L     WD,$QSE1            POINT TO FIRST QSE          MBJ20026
         SH    WD,=AL2(QSELEN)     SUBTRACT ONE QSE LENGTH     MBJ20026
         USING QSEDSECT,WD         ADDRESSABILITY QSE          MBJ20026
CDRESLP  AH    WD,=AL2(QSELEN)     ADD  ONE QSE LENGTH         MBJ20026
         CLC   QSESID(4),CDRCPULO  IS THIS THE CPU             MBJ20026
         BE    CDRENTRY            BR YES CPU AND QSE MATCH    MBJ20026
         TM    QSEFLAGS,QSELAST    LAST QSE                    MBJ20026
         BZ    CDRESLP             NO GET NEXT QSE             MBJ20026
         B     CDRINVCP            NO MATCH BR WARN OPER       MBJ20026
         SPACE 1                                               MBJ20026 K5430698
CDRENTRY MVI   COMMAND,C' '             CLEAR                  MBJ20026 K5430642
         MVC   COMMAND+1(133),COMMAND   BUFFER                 MBJ20026 K5430644
         LA    WA,$RESTAB          GET RESOURCE TABLE FIRST    MBJ20026 K5430680
         LA    WB,$NOLEFT*$RESLEN(,WA)  AND LAST ENTRIES       MBJ20026 K5430682
         LR    WC,WA               SAVE TABLE START            MBJ20026 K5430684
CDRLOOP0 MVI   COMMAND+5,C'-'                                  MBJ20026 K5430688
         LA    R15,COMMAND+7       FIRST RESOURCE IN MSG       MBJ20026 K5430690
         MVC   COMMAND(4),CDRCPULO MOVE CPUID IN               MBJ20026 K5430692
         SPACE 1                                               MBJ20026 K5430698
         SLR   R1,R1               CLEAR R1                    MBJ20026 K5430700
         ICM   R1,8+4+2,QSERESTB   GET RESOURCE FLAGS          MBJ20026 K5430710
CDRBRC   BP    CDRNORES            THIS RESOURCE NOT ATTACHED  MBJ20026 K5430712
         BZ    CDRWRITE            NO MORE RESOURCES           MBJ20026 K5430714
         MVC   0(8,R15),0(WA)      MOVE RESOURCE NAME          MBJ20026 K5430716
         LA    R15,$RESLEN+1(,R15) NEXT OUTPUT AREA            MBJ20026 K5430718
CDRNORES LA    WA,$RESLEN(,WA)     NEXT RESOURCE               MBJ20026 K5430720
         SLL   R1,1                CHECK NEXT BIT              MBJ20026 K5430722
         LTR   R1,R1               SET CONDITION CODE.         MBJ20026 K5430723
         B     CDRBRC              BRANCH TO CHECKER           MBJ20026 K5430724
CDRWRITE LA    R1,COMMAND          ADDRESS OF COMMAND          MBJ20026 K5430726
         SR    R15,R1              CALCULATE MSG LENGTH        MBJ20026 K5430728
         LR    R0,R15              LENGTH IN 0                 MBJ20026 K5430730
         $CWTO L=(R0)              REPLY TO OPERATOR           MBJ20026 K5430732
         TM    CDRFLAG,CQCMD       Q. DID WE COME FROM $Q CMD  MBJ20026 K5430738
         BO    CDC                 A. YES - GO ON TO $DC       MBJ20026 K5430740
         $CRET ,                   A. NO - RETURN              MBJ20026 K5430742
CDRINVCP $CRET MSG='INVALID CPU ID'                            MBJ20026 K5430744
         SPACE 3                                               MBJ20026 K5430748
*                                                              MBJ20026 K5430750
*  LOCAL VALUES FOR $DR - DISPLAY RESOURCES                    MBJ20026 K5430752
*                                                              MBJ20026 K5430754
*                                                              MBJ20026 K5430756
CDRCPULO EQU   COMEWORK,4          SID OF START CPU FOR $DR    MBJ20026 K5430758
CDRCPUHI EQU   COMDWORK,4          SID OF END CPU FOR $DR      MBJ20026 K5430760
CDRFLAG  EQU   COMNULOP,1          FLAG BYTE                   MBJ20026 K5430762
         DROP  WD                  DROP QSE ADDRESSABILITY     MBJ20026 K5430521
         EJECT                                                 MBJ20026 K5430800
************************************************************** MBJ20026 K5430802
*                                                            * MBJ20026 K5430804
*        SCAN JOBQ FOR JOBS WHOSE RESOURCE ROUTINGS          * MBJ20026 K5430806
*        CANNOT BE FULFILLED BY ANY CPU.                     * MBJ20026 K5430808
*                                                            * MBJ20026 K5430810
************************************************************** MBJ20026 K5430812
CDC      DS    0H                                              MBJ20026 K5430814
         USING JQEDSECT,R1        ADDRESS THE JQE              MBJ20026 K5430815
         MVI   CDCFLAG,0           SET FLAGS OFF               MBJ20026 K5430816
         $CFJSCAN PROCESS=CDCUSE,NEXT=CDCJQE   SCAN JOB QUEUE  MBJ20026 K5430818
         TM    CDCFLAG,CDCCONF     Q. DID ANY CONFLICTS EXIT   MBJ20026 K5430820
         BO    CDC2RET             A. YES-BRANCH               MBJ20026 K5430822
CDC1RET  $CRET MSG='$ NO CONFLICTS EXIST'                      MBJ20026 K5430824
CDC2RET  $CRET MSG='$ END OF CONFLICTS'                        MBJ20026 K5430826
         SPACE 1                                               MBJ20026 K5430828
CDCUSE   TM    JQEFLAGS,QUEBUSY    Q. IS JOB EXECUTING         MBJ20026 K5430830
         BNZ   CDCJQE              A. YES-NEXT JQE             MBJ20026 K5430832
         TM    JQETYPE,$XEQ        Q. AWAITING XEQ             MBJ20026 K5430834
         BZ    CDCJQE              A. NO-NEXT JQE              MBJ20026 K5430836
         CLI   JQETYPE,$XEQ        JOB IN CONVERTER?           MBJ20026 K5430837
         BE    CDCJQE              YES, GET NEXT JQE.          MBJ20026 K5430838
         SLR   WC,WC               CLEAR FOR COMPARE.          MBJ20026 K5430839
         CLM   WC,14,JQERESRT      ANY RESOURCES FOR JOB?      MBJ20026 K5430840
         BE    CDCJQE              IF EQUAL, NO RESOURCES.     MBJ20026 K5430841
         L     WA,$QSE1            GET FIRST QSE               MBJ20026 K5430842
         TM    JQEFLAG2,QUESYSAF   Q. CPU ROUTINGS             MBJ20026 K5430843
         BZ    CDCNOCPU            A. NO-SET SPECIAL AFFINITY  MBJ20026 K5430844
         IC    WC,JQEFLAG2         GET AFFINITIES              MBJ20026 K5430845
         N     WC,=A(X'0000007F')  TURN OFF QUEINDAF           MBJ20026 K5430846
         B     CDCLOOP2            BRANCH TO CHECKER           MBJ20026 K5430848
CDCNOCPU LA    WC,255-QUEINDAF     SET AFFINITY TO ALL         MBJ20026 K5430850
         SPACE 1                                               MBJ20026 K5430854
         USING QSEDSECT,WB                                     MBJ20026 K5430856
CDCLOOP2 LR    WB,WA               GET FIRST QSE               MBJ20026 K5430858
         B     CDCLOOP0            BYPASS SHIFT ON FIRST PASS  MBJ20026 K5430859
CDCLOOP1 SRL   WC,1                SHIFT IMPORTANT BIT DOWN    MBJ20026 K5430860
CDCLOOP0 STC   WC,CDCTESTC         STORE FOR COMPARE.          MBJ20026 K5430861
         TM    CDCTESTC,X'01'      IS A CPU BIT ON.            MBJ20026 K5430862
         BZ    CDCQSE              IF ZERO, NO CPU BYPASS TEST MBJ20026 K5430863
         BAL   WF,CDCTEST          ELSE, GO CHECK RESOURCES    MBJ20026 K5430864
CDCQSE   TM    QSEFLAGS,QSELAST    CONFLICT EXISTS-WAS IT LAST MBJ20026 K5430866
         BO    CDCONMSG            IF LAST, NO CPU FOR ROUTING MBJ20026 K5430868
         AH    WB,=AL2(QSELEN)     ELSE, GET NEXT QSE          MBJ20026 K5430870
         B     CDCLOOP1            AND CHECK IT.               MBJ20026 K5430872
CDCTEST  DS    0H                  R1=JQE, WB=QSE              MBJ20026 K5430874
         L     WD,JQERESRT         GET JOBS ROUTING            MBJ20026 K5430876
         SRL   WD,8                  INTO BYTES 1-3            MBJ20026 K5430878
         L     WE,QSERESTB         GET CPUS RESOURCES          MBJ20026 K5430880
         SRL   WE,8                  INTO BYTES 1-3            MBJ20026 K5430882
         NR    WE,WD               CLEAR UNIMPORTANT BITS      MBJ20026 K5430884
         CR    WE,WD               Q. ROUTING=RESOURCES        MBJ20026 K5430886
         BE    CDCJQE              A. YES-NEXT JQE             MBJ20026 K5430888
         BR    WF                    ELSE RETURN               MBJ20026 K5430890
         SPACE 1                                               MBJ20026 K5430892
CDCONMSG OI    CDCFLAG,CDCCONF     TURN CONFLICT BIT ON        MBJ20026 K5430894
         $CFJMSG ,                 ISSUE JOB MSG               MBJ20026 K5430896
         B     CDCJQE              NEXT JQE                    MBJ20026 K5430898
         DROP  R1                                              MBJ20026 K5430899
*                                                              MBJ20026 K5430900
*  LOCAL DATA AREAS FOR $DC                                    MBJ20026 K5430902
*                                                              MBJ20026 K5430904
CDCFLAG  EQU   COMNULOP,1          FLAG BYTE                   MBJ20026 K5430906
CDCTESTC EQU   COMNULOP+1,1        CPU TEST BYTE.              MBJ20026 K5430907
CDCCONF  EQU   X'80'               CONFLICT BIT                MBJ20026 K5430908
         LTORG ,                                               MBJ20026 K5430910
++SRC(MBQGET) DISTLIB(HASPSRC).
*        COPY  MBQGET                                          MBJ20026 P0859400
         SPACE 1                                               MBJ20026 P0859400
* * * NOW CHECK FOR RESOURCE ROUTING IN XEQ JOB.               MBJ20026 P0859500
         TM    JQETYPE,$XEQ        IS IT XEQ JOB               MBJ20026 P0860000
         BNO   QGOT                NO, DON'T BOTHER            MBJ20026 P0860010
         CLI   JQETYPE,$XEQ        IS IT FOR CONVERSION        MBJ20026 P0860020
         BNE   QNOTCNV             NO, GO CHECK                MBJ20026 P0860030
         B     QGOT                GO FINISH OUT.          MBJ20027 026 P0860033
QNOTCNV  DS    0H                  CHECK RES, AND CNTL SPECS J20027 026 P0860034
         LR    R0,WA               SAVE WA                     MBJ20053 P0860035
         L     WA,$AQSE            GET THIS SYSTEMS QSE        MBJ20053 P0860040
         LA    WA,0(WA)            HIGH ORDER OFF              MBJ20053 P0860050
         MVC   QRESORCE,QSERESTB-QSEDSECT(WA)  MOVE FOR AND    MBJ20053 P0860060
         LR    WA,R0               RESTORE WA                  MBJ20053 P0860065
         NC    QRESORCE,JQERESRT   TURN OFF UNREQ RESOURCES    MBJ20026 P0860070
         CLC   QRESORCE,JQERESRT   DOES SYSTEM HAVE REQ RESOR  MBJ20026 P0860080
         BNE   QNEXT               NO, IGNORE JOB.             MBJ20026 P0860090
         SPACE 1                                               MBJ20026 P0860100
* * * NOW CHECK FOR BEFORE, AFTER, CNTL SPECIFICATIONS.        MBJ20026 P0860110
         STM   WA,WF,PCEWA         SAVE R2 - 7 FOR WORK        MBJ20026 P0860120
         LA    WA,$JQTYPES*2       SET NUMBER OF QUEUES        MBJ20026 P0860140
         LA    WB,$JQTYPES-7      NUMBER OF QUEUES TO SEARCH   MBJ20026 P0860150
QGET001  DS    0H                  SCAN A JOBQ                 MBJ20026 P0860170
         LA    WC,$JQHEADS-2-(JQECHAIN-JQEDSECT)(WA) PT TO QUE MBJ20026 P0860180
QDEPSRCH DS    0H                  PICK UP NEXT JOB            MBJ20026 P0860190
         LH    WC,JQECHAIN-JQEDSECT(WC) GET NEXT JQE           MBJ20026 P0860200
         N     WC,QGETAFFF         INSURE OFFSET POSITIVE      MBJ20053 P0860210
         BZ    QGET003             END QUE, SEARCH FOR MORE    MBJ20026 P0860220
         SLL   WC,2                COMPUTE ACTUAL OFFSET *4    MBJ20026 P0860230
         AL    WC,$JOBQPTR         COMPUTE JQE ADDRESS         MBJ20026 P0860240
         TM    JQETYPE-JQEDSECT(WC),$XEQ IS IT XEQ Q?          MBJ20026 P0860250
         BNO   QDEPSRCH            NO, GO GET NEXT             MBJ20026 P0860260
*       WE NOW HAVE A JQE IN THE EXECUTION QUE.                MBJ20026 P0860290
         CLR   R1,WC               IS IT OUR JQE?              MBJ20026 P0860300
         BE    QDEPSRCH            GO GET NEXT JQE             MBJ20026 P0860330
         TM    QUEFLAGS(WC),QUEBUSY OTHER ACTIVE               MBJ20053 P0860335
         BZ    QAFTER             NO - SEE IF AFTER            MBJ20053 P0860340
         TM    JQEFLAG3,QUECNTL    DID SELECTED JOB USE CNTL   MBJ20026 P0860350
         BZ    QAFTER              NO, GO SEE IF AFTER CARD    MBJ20026 P0860360
         TM    QUEFLAG3(WC),QUECNTL DID OTHER JOB USE CNTL     MBJ20026 P0860370
         BZ    QAFTER              NO, GO SEE IF AFTER  CARD   MBJ20026 P0860380
*       BOTH JOBS USED CNTL CARD NOW SEE IF SAME NAME          MBJ20026 P0860390
         LA    WD,JQEDNAME        DEPENDENT JOB NAME AREA      MBJ20053 P0860395
         TM    JQEFLAG3,QUEAFT+QUEBEF /*AFTER AND/OR /*BEFORE  MBJ20053 P0860400
         BZ    QCTL1NO            NO - FIRST CNTL NAME         MBJ20053 P0860405
         BM    QCTL1ONE           ONE - SECOND CNTL NAME       MBJ20053 P0860410
         LA    WD,8(0,WD)         THIRD CNTL NAME              MBJ20053 P0860415
QCTL1ONE DS    0H                                              MBJ20053 P0860420
         LA    WD,8(0,WD)         SECOND CNTL NAME             MBJ20053 P0860425
QCTL1NO  DS    0H                                              MBJ20053 P0860430
         SLR   R0,R0              ZERO FOR IC                  MBJ20053 P0860435
         IC    R0,JQEFLAG3        FLAGS AND CNTL COUNT         MBJ20053 P0860440
         SRL   R0,4               SHIFT OUT FLAGS              MBJ20053 P0860445
QCTL1LOP DS    0H                                              MBJ20053 P0860450
         TM    0(WD),X'80'        EXCLUSIVE                    MBJ20053 P0860455
         BO    QCTL1SR1           NO - SHARED                  MBJ20053 P0860460
         OI    JQEFLAG3,QUEEXC    CURRENT NAME IS EXCLUSIVE    MBJ20053 P0860465
         OI    0(WD),X'80'        RESET NAME                   MBJ20053 P0860470
QCTL1SR1 DS    0H                                              MBJ20053 P0860475
         LA    WE,QUEDNAME(WC)    DEPENDENT JOB NAME AREA      MBJ20053 P0860480
         TM    QUEFLAG3(WC),QUEAFT+QUEBEF /*AFTER AND/OR /*BEFORE 20053 P0860485
         BZ    QCTL2NO            NO - FIRST CNTL NAME         MBJ20053 P0860490
         BM    QCTL2ONE           ONE - SECOND CNTL NAME       MBJ20053 P0860495
         LA    WE,8(0,WE)         THIRD CNTL NAME              MBJ20053 P0860500
QCTL2ONE DS    0H                                              MBJ20053 P0860505
         LA    WE,8(0,WE)         SECOND CNTL NAME             MBJ20053 P0860510
QCTL2NO  DS    0H                                              MBJ20053 P0860515
         SLR   WF,WF              ZERO FOR IC                  MBJ20053 P0860520
         IC    WF,QUEFLAG3(WC)    FLAGS AND CNTL COUNT         MBJ20053 P0860525
         SRL   WF,4               SHIFT OUT FLAGS              MBJ20053 P0860530
QCTL2LOP DS    0H                                              MBJ20053 P0860535
         TM    0(WE),X'80'        EXCLUSIVE                    MBJ20053 P0860540
         BO    QCTL2SR1           NO - SHARED                  MBJ20053 P0860545
         OI    QUEFLAG3(WC),QUEEXC CURRENT NAME IS EXCLUSIVE   MBJ20053 P0860550
         OI    0(WE),X'80'        RESET NAME                   MBJ20053 P0860555
QCTL2SR1 DS    0H                                              MBJ20053 P0860560
         CLC   0(8,WD),0(WE)      SAME CNTL NAME               MBJ20053 P0860565
         BNE   QCTL2NXT           NO - SET UP NEXT OTHER       MBJ20053 P0860570
         TM    JQEFLAG3,QUEEXC    THIS ONE EXCLUSIVE           MBJ20053 P0860575
         BO    QHOLDCTL           YES - SELECT ANOTHER JQE     MBJ20053 P0860580
         TM    QUEFLAG3(WC),QUEEXC OTHER ONE EXCLUSIVE         MBJ20053 P0860585
         BO    QHOLDCTL           YES - SELECT ANOTHER JQE     MBJ20053 P0860590
QCTL2NXT DS    0H                                              MBJ20053 P0860595
         TM    QUEFLAG3(WC),QUEEXC EXCLUSIVE                   MBJ20053 P0860600
         BZ    QCTL2SR2           NO - SHARED                  MBJ20053 P0860605
         NI    QUEFLAG3(WC),255-QUEEXC RESET CURRENT EXCLUSIVE MBJ20053 P0860610
         NI    0(WE),X'7F'        SET NAME TO EXCLUSIVE        MBJ20053 P0860615
QCTL2SR2 DS    0H                                              MBJ20053 P0860620
         LA    WE,8(0,WE)         NEXT NAME                    MBJ20053 P0860625
         BCT   WF,QCTL2LOP        LOOP TO LAST NAME            MBJ20053 P0860630
         TM    JQEFLAG3,QUEEXC    EXCLUSIVE                    MBJ20053 P0860635
         BZ    QCTL1SR2           NO - SHARED                  MBJ20053 P0860640
         NI    JQEFLAG3,255-QUEEXC RESET CURRENT EXCLUSIVE     MBJ20053 P0860645
         NI    0(WD),X'7F'        SET NAME TO EXCLUSIVE        MBJ20053 P0860650
QCTL1SR2 DS    0H                                              MBJ20053 P0860655
         LA    WD,8(0,WD)         NEXT NAME                    MBJ20053 P0860660
         BCT   R0,QCTL1LOP        LOOP TO LAST NAME            MBJ20053 P0860661
QAFTER   DS    0H                                              MBJ20053 P0860662
         TM    JQEFLAG3,QUEAFT    /*AFTER SPECIFIED            MBJ20053 P0860664
         BZ    QBEFORE            NO - CHK OTHR 1 FOR /*BEFORE MBJ20053 P0860666
         CLC   JQEDNAME(8),QUEJNAME(WC) IS IT OTHER ONE        MBJ20053 P0860668
         BE    QRESTORE           YES - SELECT ANOTHER JQE     MBJ20053 P0860670
QBEFORE  DS    0H                                              MBJ20053 P0860672
         TM    QUEFLAG3(WC),QUEBEF OTHER ONE USE /*BEFORE      MBJ20053 P0860674
         BZ    QDEPSRCH           NO - CONTINUE SEARCH         MBJ20053 P0860676
         LR    WE,WC               USE WE TO SAVE WC           MBJ20053 P0860677
         TM    QUEFLAG3(WC),QUEAFT /*AFTER ALSO SPECIFIED      MBJ20053 P0860678
         BZ    QBEF2              NO - DONT ACCOUNT FOR /*AFTER BJ20053 P0860680
         LA    WE,8(0,WC)         ACCOUNT FOR /*AFTER          MBJ20053 P0860682
QBEF2    DS    0H                                              MBJ20053 P0860684
         CLC   JQEJNAME(8),QUEDNAME(WE) BEFORE THIS ONE        MBJ20053 P0860686
         BNE   QDEPSRCH           NO - CONTINUE SEARCH         MBJ20053 P0860688
         B     QRESTORE           SELECT ANOTHER JQE           MBJ20053 P0860690
QHOLDCTL DS    0H                                              MBJ20053 P0860692
         TM    QUEFLAG3(WC),QUEEXC EXCLUSIVE                   MBJ20053 P0860694
         BZ    QHLDCTL1           NO - SHARED                  MBJ20053 P0860696
         NI    QUEFLAG3(WC),255-QUEEXC RESET CURRENT EXCLUSIVE MBJ20053 P0860698
         NI    0(WE),X'7F'        SET NAME TO EXCLUSIVE        MBJ20053 P0860700
QHLDCTL1 DS    0H                                              MBJ20053 P0860702
         TM    JQEFLAG3,QUEEXC    EXCLUSIVE                    MBJ20053 P0860704
         BZ    QRESTORE           NO - SHARED                  MBJ20053 P0860706
         NI    JQEFLAG3,255-QUEEXC RESET CURRENT EXCLUSIVE     MBJ20053 P0860708
         NI    0(WD),X'7F'        SET NAME TO EXCLUSIVE        MBJ20053 P0860709
         SPACE 1                                               MBJ20026 P0860710
*    HERE WE HAVE DETERMINED THAT SELECTED JOB IS INELIGIBLE   MBJ20026 P0860720
*    TO BE STARTED  BECAUSE OF ONE OF THE PREVIOUS CHECKS.     MBJ20026 P0860730
*    WILL NOW RETURN TO ATTEMPT NEW SELECTION.                 MBJ20026 P0860740
         SPACE 1                                               MBJ20026 P0860750
QRESTORE DS    0H                                              MBJ20026 P0860760
         LM    WA,WF,PCEWA        RESTORE WA-WF                MBJ20053 P0860770
         B     QNEXT               GO SELECT NEW JOB.          MBJ20026 P0860780
         SPACE 1                                               MBJ20026 P0860790
QGET003  BCT   WB,QGET004          CONTINUE IF NOT ZERO        MBJ20026 P0860800
         LM    WA,WF,PCEWA        RESTORE WA-WF                MBJ20053 P0860810
         B     QGOT                SELECTED A JOB, CONTINUE.   MBJ20026 P0860820
QGET004  DS    0H                                              MBJ20026 P0860830
         BCTR  WA,0                COMPUTE NEXT LOWER          MBJ20026 P0860840
         BCTR  WA,0                QUEUE OFFSET.               MBJ20026 P0860850
         B     QGET001             GO TRY NEXT Q               MBJ20026 P0860860
