&LBL     PROC  &P,0,                                                   @00000000
               &DISC=,                                                 @00000100
               &PFQ=,                                                  @00000200
               &QHOLD=,                                                @00000300
               &TYPE=                                                   00000400
XQUEUE   NAME  X                                                        00000500
QUEUE    NAME  0   9700 ICAM - QUEUE CONTROLS                  73/03/29 00000600
TN#IQ    NAME  1                        INTERCEPT QUEUE - INTERNAL CALL 00000700
TN#PQ    NAME  2   PROCESS FILE QUEUES - INTERNAL CALL                  00000800
.* .                                                                    00000900
.* . * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ** 00001000
.* .                                                                  * 00001100
.* . THIS AND ALL RELATED PROGRAMS ARE PROPERTY OF                    * 00001200
.* .                                                                  * 00001300
.* . UNIVAC CONTAINING ITS CONFIDENTIAL INFORMATION                   * 00001400
.* .                                                                  * 00001500
.* . * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ** 00001600
         GBL   &TN#DSCQ            . DISC QUEUING IN CCA                00001700
         GBL   &TN#LNE             LABEL OF LINE                        00001800
         GBL   &TN#LNDX            . INDEX # OF LINE                    00001900
         GBL   &CRJE                                                    00002000
.* .                                                                    00002100
         DO    &CRJE                                                    00002200
         PNOTE *,'RBP DOES NOT REQUIRE QUEUE TABLES'                    00002300
         GOTO  .CCCC                                                    00002400
         ENDO                                                           00002500
         GBL   &TN#QIDX            . INDEX # THIS QUEUE                 00002600
         GBL   &TN#NUMQ                 # QUEUES DEFINED IN LINE        00002700
         GBL   &TN#LSTQ            . LABEL OF LAST QUEUE                00002800
         GBL   &TS#QUEU            . TOTAL NUMBER OF QUEUES             00002900
         GBL   &CTCIYES,&CTCIPUT                                        00003000
         GBL   &TRANS                                                   00003100
         GBLA  &TN#DQCT            . COUNT FOR PROCESS FILE QUEUES      00003150
         LCL   &LCLA                                                    00003200
         LCL   &LCLB                                                    00003300
         LCL   &LCLC                                                    00003400
         LCL   &LCLD                                                    00003500
.* .                                                                    00003600
         DO    '&CTCIYES'=''                                            00003700
&CTCIYES SET   0                                                        00003800
         ENDO                                                           00003900
         DO    '&CTCIPUT'=''                                            00004000
&CTCIPUT SET   0                                                        00004100
         ENDO                                                           00004200
         DO    '&TN#QIDX'=''                                            00004300
&TN#QIDX SET   0                                                        00004400
         ENDO                                                           00004500
         DO    &CTCIYES                                                 00004600
         DO    &TRANS                                                   00004700
         PNOTE '*','NO QCTS ARE REQUIRED '                              00004800
         GOTO  .CCCC                                                    00004900
         ENDO                                                           00005000
         ENDO                                                           00005100
&TS#QUEU SET   &TS#QUEU+1                                               00005200
&J       DO    (&P(0)<2)+((&P(0)=2)*(1+('&PFQ(3)'=''=0)+('&PFQ(4)'=''=0*00005300
               ))) ONCE FOR REGULAR OR INTERCEPT CALL, FOR EACH PRCS Q  00005400
         DS    0F                                                       00005500
         DO    &P(0)<2                  INTERCEPT OR REGULAR QUEUE      00005600
&LBL     DC    CL4'&LBL '          . NAME OF QUEUE = QNNN, NNN = PRI    00005700
         DO    '&DISC'=''=0                                             00005800
&LBL.D   EQU   X'01'               . DISC QUEUEING FLAG FOR TERMINAL    00005900
         GOTO  .AA10                                                    00006000
         ENDO                                                           00006100
&LBL.D   EQU   X'00'               . NO DISC QUEUEING FLAG FOR TERMINA  00006200
.AA10    LABEL                                                          00006300
&TN#QIDX SET   &TN#QIDX+1          . INDEX # FOR THIS QUEUE             00006400
&TN#LNE.Q&TN#QIDX EQU &LBL         . STANDARD QUEUE LABEL               00006500
         DO    '&LBL'='&TN#LSTQ'   . LAST QUEUE DEFINED FOR LINE        00006600
         DC    F'0'                     NULL LINK TO NEXT QUEUE         00006700
         GOTO  .AAAA                                                    00006800
         ENDO                                                           00006900
&TN#QIDX SET   &TN#QIDX+1                                               00007000
         DC    A(&TN#LNE.Q&TN#QIDX) . LINK TO NEXT QUEUE                00007100
&TN#QIDX SET   &TN#QIDX-1                                               00007200
.AAAA    LABEL                                                          00007300
         DC    A(0)                     POST-QUEUE HDR ADDR             00007400
         DC    Y(&LBL-TN#L&TN#LNDX) . DISPL FROM LINE TO QUEUE CTL      00007500
         GOTO  .BBBB                                                    00007600
         ENDO                           FOLLOWING IS FOR PRCS FILE ONLY 00007700
PRFQ#&TN#DQCT DC    CL4'#&TN#DQCT' . QUEUE MARKER                       00007800
&TN#DQCT SETA  &TN#DQCT+1          . INCR PROCESS FILE QUEUE COUNTER
         DC    2A(0)                    NULL LINK, POST-QUEUE HDR ADDR  00007900
         DC    Y(*-(TN#QLCTD-TN#QNAME)-&PFQ(1)) DISPL - PRCS TO Q CTL   00008000
.BBBB    LABEL                          FOLLOWING COMMON FOR ALL QUEUES 00008100
         DC    H'0'                     # TERMS USING QUEUE             00008200
&LCLA    SET   '&QHOLD'='YES'                                           00008300
&LCLB    SET   '&TYPE'='TERM'                                           00008400
&LCLC    SET   '&DISC'=''=0                                             00008500
&LCLD    SET   (('&PFQ(&J+1)'='MAIN')++('&PFQ(&J+1)'='')=0)             00008600
         DC    YL1(TN#QHOLD*&LCLA++TN#QTERM*&LCLB++TN#QPROC*(&P(0)=2)++@00008700
               TN#QDISC*(&LCLC+&LCLD)++TN#QINTR*(&P(0)=1))              00008800
         DC    XL1'0'                                                   00008900
         DC    2H'0'                    CORE - COUNT ON, COUNT OFF      00009000
         DC    H'0'                . UNUSED                             00009100
         DC    3A(0)                    CORE - FIRST, LAST, NEXT        00009200
         DO    ('&DISC'=''=0)+(('&PFQ(&J+1)'='MAIN')++('&PFQ(&J+1)'='')*00009300
               =0)                                                      00009400
&TN#DSCQ SET   1                   . INDICATES DISC QUEUEING FOR CCA    00009500
         DC    H'0'                . # MSG'S GOING TO DISC
         DC    X'0'                . I/O STATUS
         DC    X'0'                . I/O ERROR STATUS
         DC    F'0'                . DISC ADDR HEAD OF QUEUE
         DC    F'0'                . DISC ADDR TAIL OF QUEUE
         DC    F'0'                . NEXT ENQUE HEADER DISC ADDR
         DC    F'0'                . DISC ADDR OF QUEUE CHECKPOINT
         DO    '&DISC'=''=0                                             00009800
         DC    A(&DISC)            . A(DISCFILE-DTF)                    00009900
         ENDO                                                           00010000
         DO    (('&PFQ(&J+1)'='MAIN')++('&PFQ(&J+1)'=''))=0             00010100
         DC    A(&PFQ(&J+1))       . A(DISCFILE-DTF)                    00010200
         ENDO                                                           00010300
         ENDO                                                           00011200
         ENDO                                                           00011300
.CCCC    LABEL                                                          00011400
         END                                                            00011500
