Retro1.org codex

          IDENT  QREC1,FWA,QREC,01,00
          ABS
          SST
          SYSCOM B1
*COMMENT  QREC - QUEUE RECOVERY PROCESSOR.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
          TITLE  QREC - QUEUE RECOVERY PROCESSOR.
          SPACE  4
***       QREC - QUEUE RECOVERY PROCESSOR.
*         D. A. COAPSTICK    74/09/16.
*         R. A. JAPS.        75/02/19.
          SPACE  4,4
***       *QREC* IS A QUEUE RECOVERY UTILITY PROGRAM THAT ACTIVATES OR
*         DEACTIVATES QUEUED FILES AND/OR PROVIDES A LIST OF RELATIVE
*         INFORMATION PERTAINING TO INACTIVE QUEUES.
          SPACE  4
***       *QREC* MAY BE CALLED BY THE QUEUED FILE SUPERVISOR PROGRAM OR
*         COMMAND.  *QREC* WILL ALSO BE CALLED BY A
*         COMMAND CALL TO *QLIST*.  THE FOLLOWING PARAMETERS ARE
*         VALID FOR *QREC*.
*
*         MI=MACHINE ID.
*         FM=FAMILY NAME.
*         DN=DEVICE NUMBER (FAMILY ENTRY MUST BE SPECIFIED).
*         FU=FAMILY NAME FOR USER INDEX REQUEUING.
*         UI=USER INDEX RANGE (E.G., UI=3-177).
*         DA=REQUEUING DATE.  MAY BE A SINGLE ENTRY (DA=740916) OR A
*            RANGE ENTRY (DA=740911-740916) OR (DA=ALL).
*         FS=FILE SIZE RANGE (0-777777B).
*            IF 777777B IS SPECIFIED, ALL SIZES LARGER ARE INCLUDED.
*         I  = ALTERNATE DIRECTIVE INPUT FILE. THIS IS A
*                COMMAND PARAMETER SPECIFYING WHAT FILE SHOULD
*                BE READ FOR INPUT DIRECTIVES.  THESE DIRECTIVES
*                CONSIST OF ANY LEGAL K-DISPLAY INPUT OR COMMANDS.
*                THESE DIRECTIVES WILL BE PROCESSED AFTER THE
*                COMMAND DIRECTIVES BUT BEFORE ANY
*                K-DISPLAY INPUT IS ACCEPTED.
*         JSN=JOB SEQUENCE NUMBER.  UP TO FIVE JSN-S.
*         ID=BATCH ID RANGE.
*         LA = LOWER SECURITY ACCESS LEVEL.
*         UA = UPPER SECURITY ACCESS LEVEL.
*         TUI=DESTINATION USER INDEX RANGE FOR SELECTING FILES
*             IN THE REMOTE BATCH QUEUE (*TF* MUST BE SPECIFIED).
*         TF=DESTINATION FAMILY FOR TERMINAL FOR SELECTING FILES
*            IN THE REMOTE BATCH QUEUE.
*         FC=FORMS CODE.  MAY BE A SINGLE ENTRY (FC=F1), A LIST
*            (FC=F1/F2/F3), OR A RANGE (FC=F1-F2) WHERE F1 IS 2
*            CHARACTERS, ALL, OR NULL (SPECIFIED BY **).
*         L=LFN.  FILE TO RECEIVE OUTPUT.
*         OP=XX.  REQUEUING OPTIONS.
*            RP - REQUEUE SPECIFIED FILES, PURGE OTHERS.
*            RI - REQUEUE SPECIFIED FILES, IGNORE OTHERS.
*            PI - PURGE SPECIFIED FILES, IGNORE OTHERS.
*            DI - DEQUEUE SPECIFIED FILES, IGNORE OTHERS.
*         DS=DT.  SELECT FILE DESTINATION BY DISPOSITION TYPE.
*                FILE DESTINATION TYPES INCLUDE -
*                BC - BATCH.
*                RB - REMOTE BATCH.
*                DISPOSITION TYPES INCLUDE-
*                SF  SPECIAL INSTALLATION DEFINED QUEUE FILES
*                IN  INPUT
*                PU  PUNCH
*                PL  PLOT
*                PR  PRINT - ANY PRINTER
*                P2  PRINT - 512 PRINTER
*                LR  PRINT - 580-12 PRINTER
*                LS  PRINT - 580-16 PRINTER
*                LT  PRINT - 580-20 PRINTER
*                LX  PRINT - 5870 NIP
*                LY  PRINT - 5970 NIP
*                WT  WAIT
*                PRINT  ALL PRINT TYPES
*                ALL  ALL TYPES
*                NONE  NO TYPES
*
*         DEFAULT VALUES DEFINED IN *QFSP*
          SPACE  4
**        ENTRY CONDITIONS.
*
*                *QREC* IS ENTERED VIA A *RJ* FROM *QFSP*.
*
*         *TARA* = FWA OF THE PARAMETER TABLE.
*         *QFTA* = *QFTP* WORD FROM CENTRAL MEMORY RESIDENT.
*         *TDAA* = FWA OF DEVICE ACCESS LEVEL TABLE.
*         *TEQA* = MASS STORAGE EQUIPMENT TABLE.
*         *TMSA* = MASS STORAGE DESCRIPTION TABLE.
*         *FOTA* = FAMILY ORDINAL TABLE.
          SPACE  4
***       DAYFILE MESSAGES.
*
*
*         * QFT THRESHOLD LIMIT.* = QFT HAS REACHED THE LIMIT
*         ALLOCATED FOR QUEUED FILES. RETRY WHEN SYSTEM IS NOT AS BUSY.
*
*         * DNYY  FM AAAAAAA   NO IQFT FILE.* = NO IQFT
*         FILE EXISTS FOR SPECIFIED DEVICE.
*
*         * DNYY  FM AAAAAAA   INCORRECT ACCESS LEVEL.*
*         THE JOB DOING THE *QREC* IS NOT VALIDATED FOR THE
*         ACCESS LEVELS OF THE DEVICE.
*
*         * DNYY  FM AAAAAAA   IQFT INTERLOCKED.* = IQFT
*         FILE TRACK INTERLOCK SET. COULD MEAN IQFT
*         IS CURRENTLY BEING USED BY ANOTHER UTILITY. RETRY AT A
*         LATER TIME.
*
*         * DNYY  FM AAAAAAA   FNT/QFT FULL.* = THE FNT OR QFT WAS
*         FILLED WHILE RECOVERING SPECIFIED DEVICE.
*         RETRY WHEN SYSTEM IS NOT AS BUSY.
*
*         * DNYY  FM AAAAAAA   MS ERROR.* = MASS
*         STORAGE ERROR ON IQFT FILE THIS DEVICE.
*
*         * DNYY  FM AAAAAAA   IGNORED - ERROR IDLE.* = QUEUES ON
*         THE SPECIFIED DEVICE WERE NOT PROCESSED BECAUSE THE DEVICE
*         HAD AN ERROR IDLE CONDITION.
*
*         * DNYY  FM AAAAAAA   IGNORED - REMOVABLE.* = QUEUES ON
*         SPECIFIED DEVICE WERE NOT PROCESSED BECAUSE THE DEVICE IS
*         REMOVABLE.
*
*         * DNYY  FM AAAAAAA   IGNORED - UNAVAILABLE.* = QUEUES ON
*         SPECIFIED DEVICE WERE NOT PROCESSED BECAUSE THE DEVICE IS
*         UNAVAILBLE.
*
*         * DNYY  FM AAAAAAA   UNDEFINED ERROR.*
*
*         * FOT FULL - FILES IGNORED.* - SOME OF THE QUEUED FILES
*         WERE NOT PROCESSED BECAUSE THERE WAS NO FOT ENTRY FOR THE
*         CREATION AND/OR THE DESTINATION FAMILY AND THE FOT WAS
*         FULL (MESSAGE ISSUED BY *COMCVQF*).
*
*         * QREC/QLIST ABORTED.*
*
*         * QUEUE STATUS INDEFINITE.* = REFLECTS QUEUE
*         STATUS IN EVENT OF ABNORMAL ABORT.
*
*         * XXXX FILES ACTIVATED DNYY FM AAAAAAA.* = NUMBER
*         OF QUEUED FILES ACTIVATED THIS DEVICE.
*
*         * XXXX FILES DEQUEUED  DNYY FM AAAAAAA.* = NUMBER
*         OF QUEUED FILES DEQUEUED THIS DEVICE.
*
*         * XXXX FILES IGNORED   DNYY FM AAAAAAA.* = NUMBER
*         OF QUEUED FILES REMAINING INACTIVE THIS DEVICE.
*
*         * XXXX FILES PURGED    DNYY FM AAAAAAA.* = NUMBER
*         OF QUEUED FILES PURGED THIS DEVICE.
*
*         * QUEUES UNRECOVERABLE THIS DEVICE.* = SOME OR ALL
*         QUEUE FILES LOST DUE TO A MASS STORAGE ERROR ON
*         THE IQFT FILE (ACCOMPANIES MS ERROR MESSAGE).
*
*         * JSN      EQNNNN TRACK TTTT LENGTH ERROR.* = PHYSICAL EOI
*         AND LOGICAL EOI(TRT) ARE NOT IDENTICAL.
*
*         * NO INACTICE QUEUES PRESENT.* = NO INACTIVE WERE FOUND WHEN
*         PROCESSING A LIST COMMAND. (TO CONTROL POINT DAYFILE ONLY).
*
*         * FILE NAME CONFLICT.* = FILE TO RECEIVE OUTPUT CAN
*         NOT BE NAMED *IQF*, OR *NIQFT*.
          SPACE  4
**        COMMON DECKS.
 
*CALL     COMCCMD
*CALL     COMCMAC
*CALL     COMSACC
*CALL     COMSDSP
*CALL     COMSJIO
          LIST   X
*CALL     COMSIOQ
*CALL     COMSQFS
*CALL     COMSSFM
          LIST   -X
*CALL     COMSMLS
*CALL     COMSSCD
          TITLE  PROGRAM CONSTANTS.
*         PROGRAM CONSTANTS.
 
 BUFL     EQU    1001B       BUFFER LENGTHS
 LLIM     EQU    TPPA+PPPL   LINE LIMIT
 PDFE     EQU    TPPA+PPPD   PRINT DENSITY FORMAT EFFECTOR
          TITLE  RESERVED LOCATIONS AND FETS.
*         RESERVED LOCATIONS.
 
          ORG    OVLA
 
 FWA      BSS    0
 
*         INACTIVE QUEUED FILE ENTRY. (WORKING BUFFER).
 
 IQFE     BSS    QFEWL
          SPACE  4
*         FETS.
 
 IQ       BSS    0           OLD IQFT FILE
 "RFIQ"   RFILEB IBUF,BUFL,EPR,(FET=8)
 
 NIQ      BSS    0           NEW IQFT FILE
 "RFNI"   FILEB  NBUF,BUFL,(FET=9)
 
 O        BSS    0           OUTPUT FILE
 OUTPUT   FILEB  OBUF,BUFL,(FET=7)
 
 R        BSS    0           REACTIVATE FILE
 RECV     FILEB  RBUF,BUFL,(FET=8)
 
 P        BSS    0           PURGE FILE
 PUR      FILEB  PBUF,BUFL,(FET=8)
 RPVB     SPACE  4,10
*         REPRIEVE BLOCK.
 
 RPVB     VFD    36/0,12/31B,12/0
          VFD    30/0,30/ERR
          BSSZ   27B
          TITLE  MAIN LOOP.
**        MAIN LOOP.
*
*         ENTRY  PARAMETER BLOCK DEFINED IN *COMSQFS* (TARA)
*                MASS STORAGE TABLE (TEQA)
*
*         EXIT   (X2) = K - DISPLAY ADDRESS.
*                (X5) = TERMINATING MESSAGE.
*
*         USES   X - 0, 1, 2, 3, 4, 5, 6.
*                A - 1, 2, 3, 4, 6.
*                B - 1, 3.
*
*         CALLS  CTF, PRS.
*
*         MACROS MESSAGE, RECALL.
 
 
*         RETURN FROM PROCESSORS.
 
 QRE5     BX2    X2-X2       SET PRIMARY RIGHT SCREEN DISPLAY
 
 QREC     SUBR               ENTRY/EXIT
          SB1    1
          SA1    QFTS        QFT LENGTH
          NZ     X1,QRE1     IF PRESET UNNECESSARY
          RJ     PRS         PRESET
 
*         DETERMINE FUNCTIONAL ROUTINE.
 
 QRE1     SA2    TARA+ARFC
          MX0    -12
          BX2    -X0*X2
          SA3    X2+TFCN
          SX6    X3+         SAVE PROCESSOR ADDRESS
          SA6    QREB
          SX1    X3-PAG
          ZR     X1,QRE4     IF PAGE OPTION
 
*         SET OUTPUT FILE NAME.
 
          RECALL O
          MX0    42
          SA4    O           GET CURRENT FILENAME
          BX6    X6-X6
          SA2    TARA+ARLL
          BX1    X4-X2
          BX4    X0*X1
          ZR     X4,QRE2     IF NO FILE NAME CHANGE
          SA1    IQ          CHECK FOR FILE NAME CONFLICTS
          BX4    X1-X2
          BX4    X0*X4
          ZR     X4,QRE1.1   IF FILE NAME CONFLICT
          SA1    NIQ
          BX4    X1-X2
          BX4    X0*X4
          NZ     X4,QRE1.2   IF NO FILE NAME CONFLICT
 QRE1.1   SX5    =C* FILE NAME CONFLICT.*
          MESSAGE  X5
          MX2    1           NO K - DISPLAY CHANGE
          JP     QRECX       RETURN
 
 QRE1.2   SA6    LSTA        INITIALIZE LIST FLAGS
          SA6    GRDE
 QRE2     SX1    3           SET FILENAME IN FET
          BX6    X1+X2
          SA6    A4
 
*         DETERMINE IF REQUEUE/DEQUEUE FUNCTION.
 
          SX1    X3-GRD
          NZ     X1,QRE4     IF NOT GO COMMAND PROCESSOR
 
*         SET PROPER PROCESSING ROUTINE.
 
          SA2    TARA+AROP   OPTION PARAMETER
          SX3    DEIG
          IX3    X2-X3
          ZR     X3,QRE3     IF DEQUEUE OPTION
          SX3    PGIG
          IX2    X2-X3
          ZR     X2,QRE2.1   IF NOT REQUEUE
          RJ     CTF         CREATE TABLE OF ACTIVE FAMILIES
          BX6    X6-X6       CLEAR FOT FULL FLAG
          SA6    FOTF
 QRE2.1   SX3    B1
 QRE3     SA3    X3+QREA
          BX6    X3
          SA6    GRDA
 QRE4     SA3    QREB
          SB3    X3+
          JP     B3          JUMP TO PROCESSOR
 
*         FUNCTION TABLE.
 
 TFCN     BSS    0
          LOC    0
          CON    GRD         GO COMMAND PROCESSOR
          CON    PAG         PAGE K-DISPLAY PROCESSOR
          CON    LST         LIST INACTIVE QUEUES PROCESSOR
          CON    OUT         DISPOSE OUTPUT FILE PROCESSOR
          LOC    *O
 TFCNL    EQU    *-TFCN
 
 
 QREA     BSS    0
+         RJ     DEQ         DEQUEUE FILES
+         RJ     PIQ         PROCESS INACTIVE QUEUE FILES
 
 QREB     CON    0           PROCESSOR ADDRESS
          TITLE  REQUEUE/DEQUEUE PROCESSOR.
 GRD      SPACE  4,20
**        GRD - REQUEUE AND DEQUEUE.
*
*         *GRD* PERFORMS THE COMMON FUNCTIONS OF REQUEUING AND
*         DEQUEUING.
*
*         EXIT   TO *QRE5*.
*                (X5) = TERMINATING MESSAGE.
*
*         USES   X - 2, 3, 5, 6, 7.
*                A - 2, 3, 6, 7.
*                B - 0.
*
*         CALLS  DEQ, DND, EMG, IDM, PIQ, RAF.
*
*         MACROS CLOCK, DATE, REPRIEVE, RETURN, REWIND, SETFS,
*                SKIPEI, WRITER.
 
 
 GRD      BSS    0
 
*         PRESET MULTIPLE EQUIPMENT INDEX.
 
          SX7    NOPE-1      INITIALIZE EST ORDINAL FOR SEARCH
          SA7    CEQP
 
*         WRITE REPORT PAGE HEADER.
 
          DATE   WPHC1       SET DATE IN HEADER
          CLOCK  WPHC2       SET TIME IN HEADER
          REWIND O
          SKIPEI O
          SX7    B1
          SA7    LSTB        INITIALIZE LINE NUMBER
          BX6    X6-X6
          SA7    WPHA        INITIALIZE PAGE COUNT
          SA6    WPHB        CLEAR LINE COUNT
          SA7    PDFE+1      SET PRINT DENSITY FORMAT CONTROL FLAG
          SA6    NAQS        CLEAR NUMBER OF AVAILABLE QFT SLOTS
 
*         CLEAN UP FILES.
 
 GRD2     SX3    IQ          RETURN ATTACHED FILE
          RJ     RAF
          RETURN NIQ
          RETURN IQF
          REWIND NIQ
 
*         DETERMINE NEXT DEVICE.
 
 GRD3     RJ     DND         DETERMINE NEXT DEVICE
          ZR     X4,GRD6     IF END OF OPERATION
          SA3    X6+TMSA     CHECK ERROR IDLE STATUS
          BX7    X4
          LX3    59-11
          SA7    GRDD        *TEQA* TABLE ENTRY
          PL     X3,GRD4     IF NO ERROR IDLE ON DEVICE
          SX5    EIDE*2000B  *IGNORED - ERROR IDLE.*
          RJ     EMG
          EQ     GRD3        DETERMINE NEXT DEVICE
 
 GRD4     REPRIEVE  RPVB,SET,237B  SET REPRIEVE PROCESSING
 
*         BEGIN QUEUE OPERATION.
 
 GRDA     RJ     PIQ         PROCESS IQFT FILE
*         RJ     DEQ         DEQUEUE
 
          REPRIEVE  RPVB,SET,0  CLEAR REPRIEVE PROCESSING
 
          RJ     IDM         ISSUE DAYFILE MESSAGES.
 
*         DETERMINE IF END OF OPERATION.
 
          SA3    TARA+AROP
          SX2    X3-PGIG
          ZR     X2,GRD5     IF PURGE/IGNORE OPTION
          SA2    NAQS        CHECK NUMBER OF AVAILABLE QFT SLOTS
          SX5    PIQA        * QFT THRESHOLD LIMIT.*
          PL     X2,GRD5     IF THRESHOLD NOT REACHED
          BX6    X5          FLAG OPERATOR ACTION REQUIRED
          SA6    OPAM
          EQ     GRD7        CONTINUE
 
 GRD5     SA2    TARA+ARDN
          ZR     X2,GRD2     IF NO SPECIFIC DEVICE
 GRD6     SB0    0
          SX5    =C* QREC COMPLETE.                         *
 GRD7     WRITER O           FLUSH OUTPUT BUFFER
          SX6    B1
          SA6    GRDE        FLAG FILE WRITTEN
          BX7    X7-X7
          SA7    LSTA        CLEAR LIST FILE WRITTEN FLAG
          SA3    TARA+ARFC
          PL     X3,QRE5     IF NOT COMMAND CALL
          SETFS  O,0
          JP     QRE5        RETURN - COMPLETE
 
 
 
 GRDD     BSS    1           *TEQA* TABLE ENTRY
 GRDE     CON    0           *REQUEUE/DEQUEUE* FLAG
 
          TITLE  RECOVER/DEQUEUE SUBROUTINES.
 DEQ      SPACE  4,15
**        DEQ - DEQUEUE DEVICE.
*
*         *DEQ* DEACTIVATES ALL QUEUES THAT MATCH THE PARAMETERS
*         FOR A SPECIFIC DEVICE.
*
*         ENTRY  (X7) AND (GRDD) = *TEQA* TABLE ENTRY.
*
*         USES   X - ALL.
*                A - 1, 2, 3, 4, 5, 6, 7.
*                B - 3, 5, 6.
*
*         CALLS  ATT, CAF, CLD, DAL, EMG, RQT, SPF, VQE, WOF.
*
*         MACROS MOVE, QCALL,  READ, READW, RECALL, REWIND,
*                SKIPEI, WRITER, WRITEW.
 
 
 DEQ10    RJ     EMG         ISSUE ERROR MESSAGES
 
 DEQ      SUBR               ENTRY/EXIT
          SX5    RDVE*2000B
          LX7    59-1
          NG     X7,DEQ10    IF REMOVABLE DEVICE
          LX7    59-0-59+1
          SX2    X2+7000B    SET ASSIGN-BY-ORDINAL FLAG
          SX5    FNFE*2000B
          PL     X7,DEQ10    IF NO IQFT FILE ON DEVICE
          SA2    CEQP        EST ORDINAL
          SX3    IQ          ATTACH IQFT FILE AS *IQ*
          RJ     ATT
          NZ     X5,DEQ10    IF ERROR IN ATTACH
          SKIPEI X3,R        POSITION FILE
 
*         DEQUEUING LOOP.
 
          REWIND NIQ
          RJ     RQT         READ QFT INTO *RBUF*
          SA2    QFTS
          SB5    RBUF
          SB6    X2+RBUF     END OF QFT
          RECALL NIQ
 
*         BUILD CANDIDATE ENTRIES.
 
 DEQ3     SB5    B5+QFTE     ADDRESS OF QFT ENTRY
          BX6    X6-X6       CLEAR RERUN FLAG
          SA6    DEQA
          LE     B6,B5,DEQ5  IF END OF QFT
          SA5    B5+         READ QFT ENTRY
          MX0    -12         CLEAR LINKAGE FIELD
          BX1    X0*X5
          ZR     X1,DEQ3     IF EMPTY QFT SLOT
          LX5    59-1
          NG     X5,DEQ3     IF ATTACHED TO A JOB
          SX4    B1          SET CHECK FOR LID IN TABLE
          SA3    B5+2        CHECK LOGICAL IDENTIFIER
          RJ     CLD
          NZ     X3,DEQ3     IF NO MATCH
          SA1    TARA+AROP   SELECT ORIGIN TYPE ACCESS LEVEL CHECK
          SB2    B0+         PRESET NO ORIGIN TYPE CHECK
          SX1    X1-2
          PL     X1,DEQ3.0   IF NOT REQUEUE
          SB2    B1+         SET ORIGIN TYPE CHECK
 DEQ3.0   SA1    TARA+ARUA   SET ACCESS LEVEL LIMITS
          SA2    TARA+ARLA
          SA3    B5+INSQ     GET *INSQ* WORD OF QFT ENTRY
          RJ     CAF         CHECK ACCESS LEVEL OF FILE
          NZ     X1,DEQ3     IF FILE NOT SELECTED
          SX1    B5+
          BX5    X1
          RJ     VQE         VERIFY QFT ENTRY
          SB5    X5+
          NZ     X1,DEQ3     IF ENTRY DOES NOT MATCH
          SA3    CEQP        CHECK EST ORDINAL
          BX1    X3-X2
          NZ     X1,DEQ3     IF NOT THIS EQUIPMENT
 
*         FILE MATCHES CRITERIA - CREATE PSEUDO IQFT ENTRY.
 
          SA4    NIQ+2       IN POINTER
          SX6    X4+QFEWL    ADVANCE IN POINTER
          SA3    A4+2        LIMIT
          SX3    X3
          IX2    X3-X6       LIMIT - (IN+QFEWL)
          SB3    X2
          LE     B3,DEQ4     IF NO ROOM IN BUFFER
          SA6    A4
          SX6    B5-RBUF     SET QFT ORDINAL IN ENTRY
          SX1    QFTE
          IX6    X6/X1
          SA6    X4+QFEWL-1
          SB3    QFEWL-QFTE-1  NUMBER OF WORDS TO CLEAR
          BX6    X6-X6
 DEQ3.1   SB3    B3-B1
          SA6    A6-B1
          NZ     B3,DEQ3.1   IF MORE WORDS TO CLEAR
          MOVE   QFTE,B5,X4  MOVE QFT ENTRY TO *NBUF*
          JP     DEQ3        LOOP FOR NEXT ENTRY
 
*         SET RERUN THIS DEVICE - NEW IQFT BUFFER FULL.
 
 DEQ4     SX3    B6          SAVE (B5) AND (B6)
          SX6    B5
          LX6    18
          BX6    X3+X6
          SA6    DEQA
 
*         QFT ENTRYS PROCESSED - SET *QFM* PARAMETERS.
 
 DEQ5     SA1    NIQ
          RJ     SPF
 
*         *QFM* BUILDS IQFT ENTRIES FOR SELECTED FILES.
 
          QCALL  DEQF,NIQ    DEQUEUE LIST
 
*         COPY DEQUEUED ENTRIES TO IQFT.
 
          READ   NIQ,*
 
 DEQ6     READW  NIQ,IQFE,QFEWL
          NZ     X1,DEQ7     IF END OF BUFFER
          SA2    IQFE
          ZR     X2,DEQ6     IF ENTRY NOT AVAILABLE
          WRITEW IQ,IQFE,QFEWL
          SA5    IDMB
          SA3    DEQC
          SX7    X5+B1       INCREMENT COUNT
          SA7    A5
          SX5    WPHG        SET FWA OF PAGE HEADER
          RJ     WOF         WRITE OUTPUT FILE
 
          JP     DEQ6
 
 DEQ7     SA5    IDMB
          ZR     X5,DEQ8     IF NO FILES DEQUEUED
          WRITER IQ,R
 DEQ8     SA3    DEQA
          SB6    X3
          LX3    -18
          SB5    X3-QFTE
          NZ     X3,DEQ3     IF MORE QFT-S TO PROCESS THIS DEVICE
 
*         RETURN EXISTING IQFT FILE/SET TRACK POINTER FOR NEW FILE.
 
          QCALL  DTQF,IQ     DETACH IQFT FILE
          BX6    X6-X6
          SA6    ATTA        CLEAR ATTACHED FLAG
          JP     DEQX        RETURN
 
 
 DEQA     BSS    1           RERUN INDICATOR
 DEQB     BSS    1           RETURN/PURGE FUNCTION
 DEQC     DATA   H*DEQUEUED*
 PIQ      SPACE  4,20
**        PIQ - PROCESS IQFT FILE.
*
*         *PIQ* PERFORMS WHATEVER OPTION IS SELECTED ON THE IQFT
*         FILE FOR A PARTICULAR DEVICE.
*
*         ENTRY  (X7) = *TEQA* TABLE ENTRY.
*                (CEQP) = EST ORDINAL.
*
*         USES   X - ALL.
*                A - 0, 1, 2, 3, 5, 6, 7.
*                B - 3.
*
*         CALLS  ATT, CAF, CAS, CIN, CLD, CME, EMG, PLE, RFB, VIE.
*
*         MACROS QCALL, READEI, READW, RECALL, REQUEST, REWIND
*                WRITER, WRITEW.
 
 
 PIQ12    RJ     EMG         ISSUE ERROR MESSAGES
 
 PIQ      SUBR               ENTRY/EXIT
          LX7    59-0
          PL     X7,PIQX     IF NO IQFT FILE ON THIS DEVICE
          LX7    59-1-59+0
          SX5    RDVE*2000B
          NG     X7,PIQ12    IF REMOVABLE DEVICE
 PIQ1     RJ     CAS         CALCULATE NUMBER OF AVAILABLE QFT SLOTS
          SA1    NIQ+1       CREATE NEW IQFT FILE
          SA2    CEQP        FORCE NEW IQFT FILE TO SAME DEVICE
          SA3    TDAA+X2     GET ACCESS LEVEL
          MX0    12
          SX2    X2+7000B    SET ASSIGN-BY-ORDINAL FLAG
          BX1    -X0*X1
          LX2    48
          BX6    X2+X1
          SX4    B1          SET SPECIAL PROCESSING FLAG
          LX4    39
          BX6    X6+X4
          SA6    A1
          RJ     DAL         DETERMINE VALID ACCESS LEVEL
          SX5    NSEE*1S10   * INCORRECT ACCESS LEVEL.*
          NG     X3,PIQ12    IF NO VALID ACCESS LEVEL
          SA1    NIQ+4       SET ACCESS LEVEL
          MX0    -3
          LX3    36
          LX0    36
          BX1    X0*X1
          BX6    X1+X3
          SA6    A1
          REQUEST NIQ,U      NEW IQFT FILE
 
*         ATTACH IQFT FILE.
 
          SA2    CEQP        EST ORDINAL
          SX3    IQ          ATTACH AS *IQ*
          RJ     ATT
          NZ     X5,PIQ12    IF ERROR ON ATTACH
 
*         READ IQFT FILE.
 
          READEI X3,R
          RECALL P
          SA5    IDMC
 PIQ2     ZR     X5,PIQ2.1   IF END OF IGNORED FILES
          READW  IQ,IQFE,QFEWL
          WRITEW NIQ,IQFE,QFEWL
          SX5    X5-1
          EQ     PIQ2        CHECK FOR MORE IGNORED FILES
 
*         PROCESSING MAIN LOOP.
 
 PIQ2.1   READW  IQ,IQFE,QFEWL
          RJ     CME         CHECK FOR MASS STORAGE ERROR
          NZ     X5,PIQ8.1   IF MASS STORAGE ERROR
          NZ     X1,PIQ8.1   IF EOF/EOI
          SA2    IQFE+8
          PL     X2,PIQ3     IF NO LENGTH ERROR
          RJ     PLE         PROCESS LENGTH ERROR
          SX2    WIE         SET IGNORE OPTION
          JP     PIQ5
 
*         VALIDATE IQFT ENTRY.
 
 PIQ3     SA3    IQFE+2      CHECK LOGICAL IDENTIFIER
          SX4    B1+         SET CHECK FOR LID IN TABLE
          RJ     CLD
          ZR     X3,PIQ3.1   IF MATCH
          SX2    WIE         SET IGNORE OPTION
          EQ     PIQ5        PROCESS IGNORE OPTION
 
 PIQ3.1   SA1    TARA+AROP   SELECT ORIGIN TYPE ACCESS LEVEL CHECK
          SB2    B0+         PRESET NO ORIGIN TYPE CHECK
          SX1    X1-2
          PL     X1,PIQ3.2   IF NOT REQUEUE
          SB2    B1+         SET ORIGIN TYPE CHECK
 PIQ3.2   SA1    TARA+ARUA   SET ACCESS LEVEL LIMITS
          SA2    TARA+ARLA
          SA3    IQFE+INSQ   GET *INSQ* WORD OF QFT ENTRY
          RJ     CAF         CHECK ACCESS LEVEL OF FILE
          ZR     X1,PIQ3.3   IF FILE SELECTED
          SX2    WIE
          EQ     PIQ5        IGNORE FILE
 
 PIQ3.3   SA3    TARA+AROP   GET OPTION
          MX0    -12
          BX6    -X0*X3
          SA6    PIQC        SAVE OPTION
          SX6    X6-PGIG     (X6) .EQ. 0 IF NOT REACTIVATE
          RJ     VIE
          PL     X1,PIQ4     IF NO FAMILY OPTION ERROR
          SX2    WIE         SET IGNORE OPTION
          JP     PIQ5        PROCESS IGNORE OPTION
 
 PIQ4     SA3    PIQC
          LX3    1           MULTIPLY BY TWO
          IX1    X1+X3       INDEX INTO TABLE
          SA2    X1+QDPT     PROCESSING ROUTINE
 PIQ5     SA0    PIQ6        SET RETURN ADDRESS
          SB3    X2+         PROCESSING ROUTINE
          JP     B3          JUMP TO PROCESSING ROUTINE
 
*         PROCESSING ROUTINES RETURN TO THIS POINT.
 
 PIQ6     ZR     X1,PIQ2.1   IF PROCESS COMPLETED SATISFACTORILY
 
*         LAST ENTRY NOT PROCESSED - BUFFER FULL/QFT THRESHOLD LIMIT.
 
          NG     X1,PIQ7     IF QFT THRESHOLD LIMIT REACHED
 
*         SET RERUN THIS DEVICE.
 
          SX7    B1+
          SA7    PIQB
 
 PIQ7     RJ     CIN         COPY REMAINING OLD IQFT TO NEW IQFT
 
*         REQUEUE FILES.
 
 PIQ8.1   SA1    IDMA        REACTIVATED COUNT
          ZR     X1,PIQ9     IF NO FILES TO REQUEUE
          RJ     RFB         REQUEUE FILES
 
*         PURGE FILES.
 
 PIQ9     SA1    IDMD
          ZR     X1,PIQ10    IF NO FILES PURGED
          QCALL  RLLF,P      PURGE QUEUED FILES
 
*         COMPLETE NEW IQFT FILE.
 
 PIQ10    WRITER NIQ,R
          QCALL  STQF,NIQ    SET NEW IQFT IN MST
 
 PIQ11    REWIND P
          REWIND R
          SA5    PIQB
          ZR     X5,PIQX     IF NO RERUN THIS DEVICE
 
          BX6    X6-X6       CLEAR RERUN FLAG
          SA6    A5
          JP     PIQ1
 
 PIQA     DATA   C* QFT THRESHOLD LIMIT.           *
 PIQB     BSSZ   1           RERUN DEVICE FLAG
 PIQC     CON    0           OPTION
 
*         QUEUE DISPOSITION PROCESSOR TABLE.
 
 QDPT     CON    REQ,PGQ     REQUEUE/PURGE
          CON    REQ,WIE     REQUEUE/IGNORE
          CON    PGQ,WIE     PURGE/IGNORE
          TITLE  LIST/PAGING PROCESSORS.
 LST      SPACE  4,15
**        LST - LIST INACTIVE QUEUES.
*
*         *LST* PRODUCES A ONE RECORD OUTPUT FILE FOR EACH LIST
*         COMMAND ENTERED.  THE OUTPUT RECORD IS READ BACK TO PRODUCE
*         A RIGHT SCREEN K-DISPLAY.  THE OUTPUT FILE POSITION IS
*         MAINTAINED TO PROPERLY ALLOW FOR SCREEN PAGING.
*
*         EXIT   (X5) = TERMINATING MESSAGE.
*
*         USES   X - 1, 2, 3, 4, 5, 6, 7.
*                A - 1, 2, 3, 6, 7.
*
*         CALLS  ATT, CLD, CME, DND, EMD, GKD, RAF, VIE, WOF.
*
*         MACROS BKSP, CLOCK, DATE, MESSAGE, READEI, READW,
*                REPRIEVE, REWIND, SETFS, SKIPEI, WRITER.
 
 
 LST      BSS    0
 
*         PRESET MULTIPLE EQUIPMENT INDEX.
 
          SX7    NOPE-1      INITIALIZE EST ORDINAL FOR SEARCH
          SX6    B1
          SA7    CEQP
          SA6    WPHA        PAGE COUNT
          SA6    LSTB        LINE NUMBER
          SA6    PDFE+1      SET PRINT DENSITY FORMAT CONTROL FLAG
 
*         SET UP FILES.
 
          REWIND O
          SKIPEI O
 
*         SET UP PAGE HEADER.
 
 LST1     DATE   WPHC1       SET DATE IN HEADER
          CLOCK  WPHC2       SET TIME IN HEADER
          BX6    X6-X6       CLEAR LINE COUNT
          SA6    WPHB
          SA6    LSTA        CLEAR LIST FILE WRITTEN FLAG
 
*         DETERMINE NEXT DEVICE TO PROCESS.
 
 LST2     RJ     DND
          ZR     X4,LST6     IF END OF DEVICES
          BX7    X4
          SA7    GRDD        *TEQA* TABLE ENTRY
          LX7    59-0
          NG     X7,LST3     IF QUEUES THIS DEVICE
          SA2    TARA+ARDN
          ZR     X2,LST2     IF NO SPECIFIC DEVICE
          SX5    =C* NO INACTIVE QUEUES ON DEVICE.   *
          JP     QRE5
 
*         ATTACH IQFT FILE.
 
 LST3     REPRIEVE  RPVB,SET,237B  SET REPRIEVE PROCESSING
          SA2    CEQP        EST ORDINAL
          SX3    IQ          ATTACH IQFT FILE
          RJ     ATT
          NZ     X5,LST4.1   IF ERROR IN ATTACHING FILE
          READEI X3,R        READ IQFT FILE
 
*         PROCESSING LOOP.
 
 LST4     READW  IQ,IQFE,QFEWL
          RJ     CME         CHECK FOR MASS STORAGE ERROR
          NZ     X5,LST5     IF MASS STORAGE ERROR
          NZ     X1,LST5     IF EOF/EOI
 
*         VERIFY FILE AGAINST PARAMETERS.
 
          SA3    IQFE+2      CHECK LOGICAL IDENTIFIER
          SX4    B1+         SET CHECK FOR LID IN TABLE
          RJ     CLD
          NZ     X3,LST4     IF NO MATCH
          SX6    B0+
          RJ     VIE
          NZ     X1,LST4     IF FILE DOES NOT MATCH
 
*         WRITE OUTPUT FILE.
 
          SA3    WPHE        SET BLANK DISPOSITION CODE
          SX5    WPHI        SET FWA OF PAGE HEADER
          RJ     WOF         WRITE OUTPUT FILE
          SX7    B1+         SET LIST FILE WRITTEN FLAG
          SA7    LSTA
          JP     LST4
 
*         PROCESS DEVICE COMPLETE.
 
 LST4.1   RJ     EMG         ISSUE ERROR MESSAGE
 LST5     SX3    IQ          RETURN FILE
          RJ     RAF
          REPRIEVE  RPVB,SET,0  CLEAR REPRIEVE PROCESSING
          SA2    TARA+ARDN
          ZR     X2,LST2     IF NO SPECIFIC DEVICE
 
*         CLEAN UP OUTPUT FILE.
 
 LST6     SA1    LSTA
          NZ     X1,LST7     IF LIST WRITTEN
          SX5    =C* NO INACTIVE QUEUED FILES PRESENT.     *
          MESSAGE X5,3
          JP     QRE5
 
 LST7     WRITER O
          SA3    TARA+ARFC
          PL     X3,LST8     IF NOT COMMAND CALL
          SETFS  O,0
          SX5    B0          NO MESSAGE FOR *QFSP*
          JP     QRE5
 
*         SET UP K-DISPLAY.
 
 LST8     BKSP   O
 
 LST9     READEI O,R
          BX6    X6-X6
          SA6    WPHB        RESET LINES/PAGE COUNT
 
*         PRODUCE K- DISPLAY.
 
          RJ     GKD         GENERATE K-DISPLAY
          NZ     X5,QRECX    IF ERROR STATUS SET
          SX5    =C* LIST COMPLETE.                 *
          JP     QRECX       RETURN
 
 LSTA     CON    0           LIST FILE WRITTEN FLAG
 LSTB     CON    0           LINE NUMBER
 PAG      SPACE  4,15
**        PAG - PAGE RIGHT SCREEN K-DISPLAY.
*
*         *PAG* ADVANCES THE RIGHT SCREEN K-DISPLAY.
*
*         EXIT   (X5) = TERMINATING MESSAGE.
*
*         USES   X - 2, 5, 6.
*                A - 2, 6.
*
*         CALLS  GKD.
*
*         MACROS BKSP, READEI.
 
 
 PAG      BSS    0
          SA2    LSTA
          NZ     X2,PAG1     IF LAST RECORD PROPER FORMAT
          SX5    =C* INCORRECT PAGING ATTEMPT.          *
          JP     QRECX
 
*         REPOSITION OUTPUT FILE.
 
 PAG1     SA2    GKDE
          ZR     X2,PAG3     IF NOT END OF DISPLAY
 
          BKSP   O
 
 PAG2     READEI O,R
          BX6    X6-X6
          SA6    WPHB        PRESET LINES/PAGE COUNT
 
*         CREATE K-DISPLAY.
 
 PAG3     RJ     GKD
          NZ     X5,QRECX    IF ERROR STATUS SET
          SX5    =C* PAGING COMPLETE.              *
          JP     QRECX       RETURN
          TITLE  RELEASE PROCESSOR.
 OUT      SPACE  4,15
**        OUT - RELEASE OUTPUT FILE.
*
*         *OUT* RELEASES THE OUTPUT FILE GENERATED BY THE *LIST*
*         COMMAND.
*
*         EXIT   (X5) = APPROPRIATE COMPLETION MESSAGE.
*
*         USES   X - 2, 3, 5, 6, 7.
*                A - 2, 3, 6, 7.
*
*         CALLS  CBL.
*
*         MACROS ROUTE.
 
 
 OUT      BSS    0           ENTRY
          SA2    LSTA        LIST FILE WRITTEN FLAG
          SA3    GRDE        REQUEUE/DEQUEUE REPORT FLAG
          IX2    X3+X2
          ZR     X2,OUT1     IF NO FILE
          BX6    X6-X6
          SA6    A2          CLEAR FLAGS
          SX7    -B1
          SA6    A3
          SA7    A2+B1       LINE NUMBER
          RJ     CBL         CLEAR *DSP* PARAMETER BLOCK
          SA2    O           SET UP *DSP* PARAMETER BLOCK
          MX6    42
          BX6    X6*X2
          SA6    BLOCK
          SA2    OUTA        SET FLAG BITS
          BX6    X2
          SA6    A6+B1
          ROUTE  BLOCK,RECALL
          SX5    =C* OUTPUT FILE RELEASED.         *
          BX2    X2-X2
          JP     QRECX
 
 OUT1     SX5    =C* ERROR ON OUTPUT FILE.         *
          JP     QRECX       RETURN
 
 
 OUTA     VFD    24/0,12/2HPR,6/0,18/FRDC
          TITLE  UTILITY SUBROUTINES.
 CME      SPACE  4,15
**        CME - CHECK FOR MASS STORAGE ERROR.
*
*         ENTRY  (X1) = DATA TRANSFER STATUS.
*
*         EXIT   (X1) = UNCHANGED.
*                (X5) .NE. 0, IF MASS STORAGE ERROR.
*
*         USES   X - 0, 1, 3, 5, 6.
*                A - 1, 3, 6.
*
*         CALLS  EMG.
*
*         MACROS QCALL.
 
 
 CME      SUBR               ENTRY/EXIT
          SA3    IQ
          MX0    -4
          AX3    10
          BX6    -X0*X3      ERROR STATUS BITS
          SX3    11B
          IX6    X3-X6
          BX5    X5-X5
          NZ     X6,CMEX     IF NOT MASS STORAGE ERROR
          BX6    X1          SAVE DATA TRANSFER STATUS
          SA6    CMEA
          QCALL  PGQF,IQ     PURGE IQFT FILE
          SX5    RMSE*2000B
          BX6    X6-X6       CLEAR FILE ATTACHED FLAG
          SA6    ATTA
          RJ     EMG
          MESSAGE  (=C* QUEUES UNRECOVERABLE THIS DEVICE.*)
          SA1    CMEA        RESTORE DATA TRANSFER STATUS
          EQ     CMEX        RETURN
 
 CMEA     CON    0           DATA TRANSFER STATUS
 CIN      SPACE  4,15
**        CIN - COPY OLD IQFT TO NEW IQFT.
*
*         *CIN* COPIES REMAINING ENTRIES ON THE OLD IQFT FILE TO THE
*         NEW IQFT FILE.
*
*         ENTRY  (IDMC) = CURRENT COUNT OF INACTIVE QUEUES.
*
*         EXIT   (IDMC) = UPDATED COUNT OF INACTIVE QUEUES.
*
*         USES   X - 2, 3, 5, 7.
*                A - 2, 3, 7.
*
*         CALLS  CME, WOF.
*
*         MACROS READW, WRITEW.
 
 
 CIN      SUBR               ENTRY/EXIT
          WRITEW NIQ,IQFE,QFEWL  LAST ENTRY NOT PROCESSED
          EQ     CIN2        CHECK THRESHOLD LIMIT
 
*         COPY OLD IQFT FILE TO NEW IQFT.
 
 CIN1     READW  IQ,IQFE,QFEWL
          RJ     CME
          NZ     X5,CINX     IF MASS STORAGE ERROR
          NZ     X1,CINX     IF EOF/EOI
          WRITEW NIQ,IQFE,QFEWL
 
*         DETERMINE IF PROCESSING THRESHOLD LIMIT.
 
 CIN2     SA3    NAQS
          PL     X3,CIN1     IF NOT THRESHOLD LIMIT
 
*         INCREMENT *IGNORED* COUNT.
 
          SA2    IDMC
          SX7    X2+B1
          SA7    A2
 
*         WRITE ENTRY TO OUTPUT FILE.
 
          SA3    WIEA        *IGNORED*
          SX5    WPHG        SET FWA OF HEADER
          RJ     WOF
          EQ     CIN1        COPY NEXT ENTRY
 EMG      SPACE  4,20
**        EMG - ERROR MESSAGE ISSUED.
*
*         *EMG* ISSUES AN APPROPRIATE ERROR MESSAGE.
*
*         ENTRY  (X5) = ERROR STATUS BITS (10-13).
*
*         EXIT   MESSAGE ISSUED.
*                (X1) = MESSAGE ADDRESS.
*
*         USES   X - 0, 1, 2, 4, 5, 6.
*                A - 2, 5, 6.
*                B - 2, 5.
*
*         CALLS  COD, SFN.
*
*         MACROS MESSAGE.
 
 
 EMG      SUBR               ENTRY/EXIT
          AX5    10          SET ERROR CODE
          SB5    X5-1
          MX0    -6
          SA5    GRDD        FAMILY/DEVICE
          LX5    48
          BX1    -X0*X5      CONVERT DEVICE NUMBER
          RJ     COD
          MX0    42
          LX5    12
          BX1    X0*X5       FAMILY
          MX0    -12
          BX4    -X0*X6
          SB2    B5-EMGAL
          LE     B2,EMG1     IF LEGAL ERROR CODE
          SB5    EMGAL       UNDEFINED CODE
 EMG1     SA5    EMGA+B5     SPACE FILL NAME
          RJ     SFN
          LX4    30
          SA2    X5
          LX0    30
          SA6    X5+B1
          BX2    X0*X2       CLEAR OLD FAMILY
          IX6    X2+X4
          SA6    A6-B1       DEVICE NUMBER
 
          MESSAGE X5
          BX1    X5
          EQ     EMGX        RETURN
 
 
*         TABLE OF ERROR MESSAGE ADDRESSES.
 
 EMGA     BSS    0
          LOC    1
 FNFE     CON    EMGB        NO IQFT FILE
 FAIE     CON    EMGC        IQFT INTERLOCKED
 TASE     CON    0
 FTHE     CON    EMGD        FNT/QFT FULL
 INSE     CON    0
 RMSE     CON    EMGE        MASS STORAGE ERROR
 RRAE     CON    0
 NRAE     CON    0
 DUNE     CON    EMGI        IGNORED - UNAVAILABLE
 RDVE     CON    EMGF        IGNORED - REMOVABLE
          CON    0
 FTFE     CON    0
 EIDE     CON    EMGH        IGNORED - ERROR IDLE
 DFNE     CON    0
 NSEE     CON    EMGAB       INCORRECT DEVICE ACCESS LEVEL
          LOC    *O
 EMGAL    EQU    *-EMGA
          CON    EMGZ        UNDEFINED ERROR
 
 EMGB     DATA   C* DNYY  FM AAAAAAA   NO IQFT FILE.*
 EMGC     DATA   C* DNYY  FM AAAAAAA   IQFT INTERLOCKED.*
 EMGD     DATA   C* DNYY  FM AAAAAAA   FNT/QFT FULL.*
 EMGE     DATA   C* DNYY  FM AAAAAAA   MS ERROR.*
 EMGF     DATA   C* DNYY  FM AAAAAAA   IGNORED - REMOVABLE.*
 EMGH     DATA   C* DNYY  FM AAAAAAA   IGNORED - ERROR IDLE.*
 EMGI     DATA   C* DNYY  FM AAAAAAA   IGNORED - UNAVAILABLE.*
 EMGZ     DATA   C* DNYY  FM AAAAAAA   UNDEFINED ERROR.*
 EMGAB    DATA   C* DNYY  FM AAAAAAA   INCORRECT ACCESS LEVEL.*
 ERR      SPACE  4,15
**        ERR - ERROR EXIT PROCESSING.
*
*         *ERR* RELEASES THE ATTACHED IQFT FILE AND ISSUES
*         APPROPRIATE MESSAGES INDICATING ABORT CONDITION.
*
*         ENTRY  QREC ABORTED.
*
*         USES   X - 3.
*
*         CALLS  RAF.
*
*         MACROS ABORT, MESSAGE.
 
 
 ERR      BSS    0
          SX3    IQ
          RJ     RAF         RETURN ATTACHED FILE
 
*         ISSUE MESSAGES.
 
          MESSAGE (=C* QREC/QLIST ABORTED.*)
          MESSAGE (=C* QUEUE STATUS INDEFINITE.*)
 
          ABORT
 GKD      SPACE  4,15
**        GKD - GENERATE K - DISPLAY.
*
*         *GKD* PRODUCES THE K-DISPLAY IN A SCRATCH BUFFER AND
*         RETURNS THE ADDRESS OF THE DISPLAY.
*
*         ENTRY  OUTPUT FILE APPROPRIATELY POSITIONED.
*
*         EXIT   (X2) = DISPLAY ADDRESS.
*                (X5) = ERROR MESSAGE ADDRESS, IF APPLICABLE.
*
*         USES   X - 1, 2, 3, 4, 5, 6, 7.
*                A - 1, 2, 3, 4, 5, 6, 7.
*
*         MACROS MOVE, READW, RECALL.
 
 
 GKD      SUBR               ENTRY/EXIT
          SA2    LSTA
          NZ     X2,GKD1     IF FILE PRESENT
          SX5    =C* NO OUTPUT FILE PRESENT.        *
          EQ     GKDX        RETURN
 
 GKD1     RECALL O
 
*         SETUP DISPLAY HEADING.
 
          MOVE   WPHDL,WPHD,DBUF+1
          MOVE   WPHEL,WPHE,DBUF+1+WPHDL
          MOVE   WPHFL,WPHF,DBUF+1+WPHDL+WPHEL
 
          SX6    KMLL-8      NUMBER OF DISPLAY LINES PER PAGE
          SA6    GKDA
          SA3    WPHB
          SX6    DBUF+WPHDL+WPHEL+WPHFL
          SA6    A6+1        NEXT LINE ADDRESS
          NZ     X3,GKD4     IF NOT AT PAGE HEADING
 
*         BYPASS PAGE HEADING.
 
 GKD2     READW  O,WPHC-1,WPHCL
          NZ     X1,GKD6     IF EOF/EOI
          SA1    LLIM        GET LINE LIMIT
          SX7    X1-7
          SA7    WPHB        LINES/PAGE COUNT
 
*         PROCESS INDIVIDUAL LINES.
 
 GKD4     READW  O,FQOA,FQOAL
          NZ     X1,GKD6     IF EOF/EOI
          BX6    X6-X6       SET END OF LINE
          SA6    FQOA+8
          SA4    GKDB        INCREMENT NEXT LINE ADDRESS
          SX7    X4+FQOAL-2
          SA7    A4+
          MOVE   FQOAL-2,FQOA+2,X4
 
*         DECREMENT PAGE COUNTS.
 
          SA5    WPHB
          SA3    GKDA
          SX7    X5-1
          SX6    X3-1
          SA7    A5
          SA6    A3
          NZ     X6,GKD5     IF NOT END OF DISPLAY PAGE
          SA4    GKDB
          MOVE   GKDCL,GKDC,X4  *MORE*
          BX6    X6-X6
          SA6    GKDE        CLEAR END OF DISPLAY INDICATOR
          EQ     GKD7        SET EXIT CONDITIONS
 
 GKD5     NZ     X7,GKD4     IF NOT END OF OUTPUT PAGE
          EQ     GKD2        PROCESS NEXT LINE
 
*         END OF DISPLAY.
 
 GKD6     SA4    GKDB
          MOVE   GKDDL,GKDD,X4  *END OF DISPLAY.*
          SX6    B1+
          SA6    GKDE        SET END OF DISPLAY INDICATOR
 
*         SET EXIT CONDITIONS.
 
 GKD7     SA3    GKDF        ENSURE BLANK FILL ON *K-DISPLAY*
          BX6    X3
          BX5    X5-X5       CLEAR ERROR FLAG
          SA6    FQOA
          SX2    DBUF        SET DISPLAY ADDRESS
          EQ     GKDX        RETURN
 
 
 GKDA     BSS    1           DISPLAY LINE COUNT
 GKDB     BSS    1           NEXT LINE ADDRESS
 
 GKDC     DATA   C*  *
          DATA   C* MORE *
          CON    0           TERMINATE DISPLAY
 GKDCL    EQU    *-GKDC
 
 GKDD     DATA   C*  *
          DATA   C* END OF DISPLAY.*
          CON    0           TERMINATE DISPLAY
 GKDDL    EQU    *-GKDD
 
 GKDE     BSSZ   1           END OF DISPLAY FLAG
 GKDF     DATA   H* *        BLANK FILL FOR *K-DISPLAY*
 IDM      SPACE  4,20
**        IDM - ISSUE DAYFILE MESSAGES.
*
*         *IDM* FORMATS AND ISSUES MESSAGES APPLICABLE TO THE
*         COMPLETED QUEUE OPERATION.
*
*         ENTRY  (IDMA) = QUEUED FILES REACTIVATED COUNT.
*                (IDMB) = QUEUED FILES DEQUEUED COUNT.
*                (IDMC) = QUEUED FILES IGNORED COUNT.
*                (IDMD) = QUEUED FILES PURGED COUNT.
*
*         EXIT   MESSAGES ISSUED.
*
*         USES   X - ALL.
*                A - 1, 2, 3, 4, 5, 6, 7.
*                B - 6, 7.
*
*         CALLS  CDD, COD, SFN.
*
*         MACROS MESSAGE.
 
 
 IDM      SUBR               ENTRY/EXIT
 
*         ISSUE FILE COUNT MESSAGES.
 
          SB7    B0+
          SB6    TFCRL
 IDM1     SA1    B7+TFCR
          ZR     X1,IDM2     IF NO FILE COUNT
          BX6    X6-X6
          SA6    A1          CLEAR FILE COUNT
          RJ     CDD         CONVERT FILE COUNT
          SA2    B7+TFCM
          LX6    30
          SA5    X2
          MX0    -30
          BX6    X0*X6
          SA4    GRDD
          BX5    -X0*X5
          MX0    42
          IX6    X6+X5
          BX1    X0*X4       FAMILY NAME
          SA6    A5
          RJ     SFN         SPACE FILL FAMILY NAME
          MX0    48
          SA2    A5+3
          LX4    48
          LX6    54
          BX2    -X0*X2      CLEAR PREVIOUS FAMILY
          BX6    X0*X6
          MX0    -6
          IX6    X6+X2       APPEND *.*
          BX1    -X0*X4
          SA6    A2+
          RJ     COD         CONVERT DEVICE NUMBER
          MX0    -12
          SA3    A6-B1
          BX6    -X0*X6      CLEAR SPACES
          LX0    24
          BX3    X0*X3       CLEAR OLD DEVICE NUMBER
          LX6    24
          IX7    X6+X3
          SA7    A3
 
          MESSAGE A5         ISSUE MESSAGE
 
 IDM2     SB7    B7+1
          NE     B7,B6,IDM1  IF MESSAGES NOT COMPLETE
          EQ     IDMX        RETURN
 
 TFCR     BSS    0           FILE COUNT RESULT TABLE
 IDMA     BSS    1           REACTIVATED
 IDMB     BSS    1           INACTIVATED
 IDMC     BSS    1           LEFT INACTIVE
 IDMD     BSS    1           PURGED
 TFCRL    EQU    *-TFCR
 
 TFCM     BSS    0           FILE COUNT MESSAGE TABLE
          CON    MSG1
          CON    MSG2
          CON    MSG3
          CON    MSG4
 TFCML    EQU    *-TFCM
 
 
 MSG1     DATA   C* XXXX FILES ACTIVATED DNYY  FM AAAAAAA.*
 MSG2     DATA   C* XXXX FILES DEQUEUED  DNYY  FM AAAAAAA.*
 MSG3     DATA   C* XXXX FILES IGNORED   DNYY  FM AAAAAAA.*
 MSG4     DATA   C* XXXX FILES PURGED    DNYY  FM AAAAAAA.*
 PGQ      SPACE  4,20
**        PGQ - PURGE QUEUED FILE.
*
*         *PGQ* ENTERS THE IQFT ENTRY INTO THE LIST OF FILES TO BE
*         PURGED.
*
*         ENTRY  (IQFE - IQFE+15) = IQFT ENTRY.
*                (IDMD) = CURRENT PURGED FILE COUNT.
*                (A0) = RETURN ADDRESS.
*
*         EXIT   (X1) .EQ. 0, IF ENTRY MADE.
*                (X1) .NE. 0, IF BUFFER FULL.
*                (IDMD) INCREMENTED.
*
*         USES   X - 1, 3, 5, 6.
*                A - 1, 3, 6.
*                B - 6.
*
*         CALLS  EQB, WOF.
 
 
 PGQ      BSS    0
          SA1    P           SET FET ADDRESS
          RJ     EQB         ENTER IQFT ENTRY INTO BUFFER
          NZ     X1,PGQ1     IF BUFFER FULL
          SA3    IDMD        INCREMENT PURGED COUNT
          SX6    X3+B1
          SA6    A3
          SA3    PGQA        *PURGED*
          SX5    WPHG        SET FWA OF HEADER
          RJ     WOF
          BX1    X1-X1
 PGQ1     SB6    A0          SET RETURN ADDRESS
          JP     B6          RETURN
 
 PGQA     DATA   H*PURGED*
 EQB      SPACE  4,15
**        EQB - ENTER IQFT ENTRY INTO BUFFER.
*
*         ENTRY  (IQFE - IQFE+15) = IQFT ENTRY.
*                (CEQP) = EST ORDINAL.
*                (A1) = ADDRESS OF FET.
*
*         EXIT   (X1) .EQ. 0, IF ENTRY MADE.
*                (X1) .GT. 0, IF BUFFER FULL.
*
*         USES   X - 0, 1, 2, 5, 6.
*                A - 1, 2, 5, 6.
*                B - 3.
*
*         MACROS MOVE.
 
 
 EQB1     SX1    B1          SET ERROR CONDITION
 
 EQB      SUBR               ENTRY/EXIT
          SA5    A1+2
          SA2    A5+2
          SX6    X5+QFEWL    ADVANCE IN
          SX2    X2          LIMIT
          IX2    X2-X6
          SB3    X2
          LE     B3,EQB1     IF BUFFER FULL
          MX0    12          UPDATE EQUIPMENT FIELD IN IQFT
          SA6    A5+         UPDATE IN
          SA1    IQFE+1
          SA2    CEQP
          BX1    -X0*X1      CLEAR OLD EST ORDINAL
          LX2    48
          BX6    X1+X2
          SA6    A1
          MOVE   QFEWL,IQFE,X5
          BX1    X1-X1
          EQ     EQBX        RETURN
 REQ      SPACE  4,25
**        REQ - REQUEUE FILE.
*
*         *REQ* ENTERS THE IQFT ENTRY INTO THE BUFFER FOR
*         REQUEUING.
*
*         ENTRY  (A0) = RETURN ADDRESS.
*                (IQFE - IQFE+15) = IQFT ENTRY.
*                (IDMA) = CURRENT REQUEUED COUNT.
*                (NAQS) = AVAILABLE QFT SLOTS.
*
*         EXIT   (X1) .EQ. 0, IF ENTRY MADE.
*                (X1) .LT. 0, IF THRESHOLD LIMIT REACHED.
*                (X1) .GT. 0, IF BUFFER FULL.
*                (IDMA) INCREMENTED.
*                (NAQS) DECREMENTED.
*
*         USES   X - 1, 2, 3, 5, 6, 7.
*                A - 1, 2, 3, 6, 7.
*                B - 6.
*
*         CALLS  EQB, WOF.
*
*         MACROS MESSAGE.
 
 
 REQ      BSS    0
 
*         DECREMENT THRESHOLD COUNT.
 
          SA3    NAQS        NUMBER OF AVAILABLE QFT SLOTS
          SX7    X3-1
          SA7    A3+
          PL     X7,REQ1     IF THRESHOLD NOT REACHED
          MESSAGE PIQA       * QFT THRESHOLD LIMIT.*
          MX1    1           SET THRESHOLD LIMIT REACHED
          JP     REQ2        SET RETURN ADDRESS
 
 REQ1     SA1    R           SET FET ADDRESS
          RJ     EQB         ENTER IQFT ENTRY INTO BUFFER
          NZ     X1,REQ2     IF BUFFER FULL
          SA2    IDMA        INCREMENT REACTIVATED COUNT
          SX6    X2+B1
          SA6    A2
 
*         WRITE OUTPUT LINE.
 
          SA3    REQA        *ACTIVATED*
          SX5    WPHB        SET FWA OF PAGE HEADER
          RJ     WOF
          BX1    X1-X1
 REQ2     SB6    A0          SET RETURN ADDRESS
          JP     B6
 
 REQA     DATA   H*ACTIVATED*
 RFB      SPACE  4,15
**        RFB - REQUEUE FILES IN BUFFER.
*
*         *RFB* ISSUES THE APPROPRIATE REQUEST TO REQUEUE THOSE
*         FILES THAT ARE IN THE BUFFER (RBUF).
*
*         EXIT   (X5) = 0, IF REQUEUED SUCCESSFULLY.
*                FILES NOT REQUEUED ARE REPLACED IN *NBUF*.
*
*         USES   X - 0, 1, 2, 3, 5, 6, 7.
*                A - 1, 2, 3, 5, 6, 7.
*                B - 2, 3, 4.
*
*         CALLS  EMG.
*
*         MACROS MOVE, QCALL, REWIND, WRITEW.
 
 
 RFB2     SA3    R+6
          ZR     X3,RFB3     IF NO FILES IGNORED
          SA2    IDMA        DECREMENT NUMBER OF FILES ACTIVATED
          IX6    X2-X3
          SA6    A2
          SA1    IDMC        INCREMENT NUMBER OF FILES IGNORED
          IX7    X1+X3
          SA7    A1
 RFB3     REWIND R,R         REWIND POINTERS
 
 RFB      SUBR               ENTRY/EXIT
          SA5    R
          SX0    36000B
          BX6    -X0*X5      CLEAR ERRORS AND STATUS
          SA6    A5+
          BX7    X7-X7       CLEAR FILE IGNORE COUNT IN FET
          SA7    R+6
          QCALL  RQLF,R      REQUEUE LIST
 
          SA5    A5
          BX5    X0*X5
          ZR     X5,RFB2     IF NO ERRORS
          RJ     EMG         ISSUE ERROR MESSAGES
 
*         BACK OUT UNREACTIVATED QUEUES.
 
          SA2    R+3         OUT POINTER
          SX6    X2          FIRST ENTRY NOT REQUEUED (SET BY *QFM*)
          SA3    A2-B1       IN
          SA6    RFBA
          BX7    X3
          SA7    A6+B1
 RFB1     IX1    X6-X3
          PL     X1,RFB2     IF END OF BUFFER
          MOVE   QFEWL,X6,IQFE
          WRITEW NIQ,IQFE,QFEWL
 
*         ADJUST FILE COUNTS.
 
          SA2    IDMA        DECREMENT REQUEUE FILE COUNT
          SX7    X2-1
          SA3    IDMC
          SA7    A2
          SX6    X3+B1       INCREMENT LEFT INACTIVE COUNT
          SA6    A3+
 
*         SEARCH FOR NEXT ENTRY NOT PROCESSED BY *QFM*.
 
          SA1    RFBA
          SX6    X1+QFEWL
          SA3    A1+B1
          SA6    A1
          EQ     RFB1        LOOP TO END OF BUFFER
 
 
 RFBA     BSS    1           CURRENT ENTRY IN REQUEUE BUFFER
          BSS    1           LWA RECOVERY BUFFER
 WIE      SPACE  4,20
**        WIE - WRITE INACTIVE ENTRY TO NEW IQFT.
*
*         *WIE* WRITES THE IQFT ENTRY TO THE NEW IQFT FILE.
*
*         ENTRY  (IQFE - IQFE+15) = IQFT ENTRY.
*                (IDMC) = IGNORED COUNT.
*                (A0) = RETURN ADDRESS.
*
*         EXIT   ENTRY WRITTEN TO *NIQ*.
*                (IDMC) INCREMENTED.
*
*         USES   X - 1, 3, 5, 6.
*                A - 3, 6.
*                B - 6.
*
*         CALLS  WOF.
*
*         MACROS WRITEW.
 
 
 WIE      BSS    0
          SA3    IDMC        INCREMENT LEFT INACTIVE COUNT
          SX6    X3+B1
          SA6    A3
 
          WRITEW NIQ,IQFE,QFEWL
          SA3    WIEA        *IGNORED*
          SX5    WPHG        SET FWA OF PAGE HEADER
          RJ     WOF
          SB6    A0          RESTORE RETURN ADDRESS
          BX1    X1-X1
          JP     B6          RETURN
 
 WIEA     DATA   H*IGNORED*
 WPH      SPACE  4,20
**        WPH - WRITE PAGE HEADER.
*
*         *WPH* WRITES A NEW PAGE HEADER ON FILE *OUTPUT*.
*
*         ENTRY  (X5) = ADDRESS OF PAGE HEADER.
*                (WPHC1) = DATE.
*                (WPHC2) = TIME.
*                (PDFE+1) = SET IF PRINT DENSITY FORMAT EFFECTOR
*                           NOT YET WRITTEN.
*
*         EXIT   PAGE HEADER WRITTEN.
*                LINE COUNT RESET.
*
*         USES   X - 0, 1, 2, 6, 7.
*                A - 1, 6, 7.
*
*         CALLS  CDD.
*
*         MACROS RECALL, WRITEW.
 
 
 WPH      SUBR               ENTRY/EXIT
          SA1    WPHA        INCREMENT PAGE NUMBER
          SX7    X1+B1
          SA7    A1
          RJ     CDD
          MX0    36          SET PAGE NUMBER IN HEADER
          SA1    WPHC3
          BX1    X0*X1
          BX6    -X0*X6
          BX6    X1+X6
          SA6    WPHC3
          RECALL O
          SA1    PDFE+1      GET PRINT DENSITY FORMAT CONTROL FLAG
          BX7    X7-X7
          SA7    A1
          WRITEW O,A1-B1,X1  CONDITIONALLY WRITE FORMAT EFFECTOR
          WRITEW O,WPHH,WPHHL
          SX2    WPHI
          IX2    X5-X2
          NZ     X2,WPH1     IF REQUEUE REPORT
          WRITEW O,WPHI,WPHIL HEADER FOR *LIST*
          EQ     WPH2        SKIP REQUEUE/DEQUEUE HEADER
 
 WPH1     WRITEW O,WPHG,WPHGL HEADER FOR REQUEUE/DEQUEUE
 WPH2     SA1    LLIM
          SX7    X1-7        INITIALIZE LINE COUNT
          SA7    WPHB
          EQ     WPHX        RETURN
 
 
 WPHA     BSS    1           PAGE COUNT
 WPHB     BSS    1           LINE/PAGE COUNT
 
 WPHH     BSS    0
 WPHC     DATA   C*1         QREC/QLIST PROCESSOR.          YY/MM/DD. HH
,.MM.SS.  PAGE      *
 WPHC1    EQU    *-4         DATE
 WPHC2    EQU    *-3         TIME
 WPHC3    EQU    *-2         PAGE
 WPHHL    EQU    *-WPHH
 
 WPHI     DATA   H*0*        CARRIAGE CONTROL
 
 WPHD     DATA   C*  *
          DATA   C*                       INACTIVE QUEUES LIST*
          DATA   C*  *
 WPHDL    EQU    *-WPHD
 
          DATA   H*  *       CARRIAGE CONTROL
 
 WPHE     DATA   C*                                              LENGTH
,ACCESS*
 WPHEL    EQU    *-WPHE
 
          DATA   H*  *       CARRIAGE CONTROL
 WPHF     DATA   C*   NUM  JSNS MID FAMILY  DN DT DS   DATE      (PRUS)
,LEVEL  DISPOSITION*
          DATA   C*  *
 WPHCL    EQU    *-WPHC
 WPHIL    EQU    *-WPHI
          CON    0           TERMINATE DISPLAY
 WPHFL    EQU    *-WPHF
 
 WPHG     DATA   H*0*
          DATA   H*                              QUEUE DISPOSITION*
          DATA   C*  *
          DATA   H*  *       CARRIAGE CONTROL
 
          DATA   C*                                              LENGTH
,ACCESS*
          DATA   H*  *       CARRIAGE RETURN
          DATA   C*   NUM  JSNS MID FAMILY  DN DT DS   DATE      (PRUS)
,LEVEL  DISPOSITION*
          DATA   C*  *
 WPHGL    EQU    *-WPHG
 WOF      SPACE  4,15
**        WOF - WRITE OUTPUT FILE.
*
*         *WOF* WRITES AN ENTRY TO THE OUTPUT
*         REPORT FOR THE REQUEUE AND DEQUEUE ROUTINES.
*
*         ENTRY  (X3) = DISPOSITION DESCRIPTOR.
*                (X5) = FWA OF PAGE HEADER.
*
*         USES   X - 1, 2, 3, 6.
*                A - 1, 3, 6.
*                B - 7.
*
*         CALLS  FQO, WPH.
*
*         MACROS WRITEW.
 
 
 WOF      SUBR               ENTRY/EXIT
          SA1    WPHB
          NZ     X1,WOF1     IF NOT END OF PAGE
          BX6    X3          SAVE DISPOSITION DESCRIPTOR
          SA6    WOFA
          RJ     WPH         WRITE PAGE HEADER
          SA3    WOFA
 WOF1     SB7    GRDD        ADDRESS OF FAMILY/DEVICE
          SA1    LSTB        INCREMENT LINE NUMBER
          SX6    X1+B1
          SA6    A1
          SX5    IQFE        SET IQFT ENTRY ADDRESS
          RJ     FQO         FORMAT OUTPUT LINE
          WRITEW O,B3,B2
          SA3    WPHB        DECREMENT LINE/PAGE COUNT
          SX6    X3-1
          SA6    A3
          EQ     WOFX        RETURN
 
 WOFA     CON    0           SCRATCH
          TITLE  COMMON DECKS.
*         COMMON DECKS.
 
*CALL     COMCCDD
*CALL     COMCCIO
*CALL     COMCCOD
*CALL     COMCCPM
*CALL     COMCEDT
*CALL     COMCFQO
*CALL     COMCIQP
*CALL     COMCLFM
*CALL     COMCMVE
*CALL     COMCQFM
*CALL     COMCQFP
*CALL     COMCRDW
*CALL     COMCSCB
*CALL     COMCSFM
*CALL     COMCSFN
*CALL     COMCSYS
*CALL     COMCVLC
*CALL     COMCVQF
*CALL     COMCZTB
*CALL     COMCWTW
          TITLE  BUFFERS.
 
          USE    LITERALS
 
*         BUFFERS.
 
 BLOCK    BSS    EPBL        *DSP* PARAMETER BLOCK
 
 DBUF     VFD    11/0,1/1,1/1,5/0,18/KTIA,24/0  K-DISPLAY BUFFER
 NBUF     EQU    DBUF+BUFL   NEW IQFT BUFFER
 TACF     EQU    NBUF+BUFL   TABLE OF ACTIVE FAMILIES
 OBUF     EQU    TACF+ESMX+1 OUTPUT BUFFER
 IBUF     EQU    OBUF+BUFL   IQFT FILE BUFFER
 
*         QFT READ INTO FIELD LENGTH STARTING AT *RBUF*.
 
 RBUF     EQU    IBUF+BUFL   RECOVERED FILES BUFFER
 PBUF     EQU    RBUF+BUFL   PURGED FILES BUFFER
 
 BUFLL    EQU    PBUF+BUFL-DBUF  LENGTH OF BUFFERS
 BUFFL    EQU    *+BUFLL     END OF BUFFERS
          TITLE  PRESET.
 PRS      SPACE  4,20
**        PRS - PRESET.
*
*         PRESET ADJUSTS FIELD LENGTH, PERFORMS THRESHOLD
*         CALCULATION FOR A GIVEN SIZE QFT, AND SETS UP A
*         CONTROL WORD TO READ THE QFT.
*
*         ENTRY  (QFTA) = *QFTP* WORD IN CMR.
*
*         EXIT   (QFTS) = LENGTH OF QFT.
*                (QFTT) = QFT THRESHOLD.
*                (RQTA) = *RSB* CONTROL WORD FOR QFT READ.
*
*         USES   X - 0, 1, 2, 3, 4, 6, 7.
*                A - 2, 6, 7.
*
*         MACROS MEMORY.
 
 
 PRS      SUBR               ENTRY/EXIT
          MEMORY CM,,R,BUFFL
 
*         SET QFT FWA AND LENGTH.
 
          SA2    QFTA        *QFTP* WORD
          MX0    -24         GET FWA OF QFT
          LX2    24
          BX7    -X0*X2
          LX2    12          GET MAXIMUM NUMBER OF QFT ENTRIES
          MX0    -12
          BX2    -X0*X2
          SX3    QFTE
          IX6    X2*X3       NUMBER OF ENTRIES * ENTRY LENGTH
          SA6    QFTS        QFT LENGTH
 
*         SET UP *RSB* CONTROL WORD TO READ QFT.
 
          SX4    100B        WORD COUNT
          LX4    18
          BX7    X4+X7       ADD ON QFT FWA
          SX1    RBUF        BUFFER ADDRESS
          LX7    18
          BX7    X7+X1
          SA7    RQTA
 
*         CALCULATE NUMBER OF RESERVED QFT ENTRIES.
 
          SX3    SQTL        STATIC QFT THRESHOLD LIMIT
          SX7    100
          IX3    X7-X3
          IX3    X2*X3       NUMBER OF QFT ENTRIES * 100-*SQTL*
          IX6    X3/X7
          BX7    X7-X7       CLEAR LID TABLE FULL FLAG
          SA7    LTFL
          SA6    QFTT
          EQ     PRSX        RETURN
          SPACE  4,10
          ERRPL  *-RFL       IF DEFAULT FIELD LENGTH TOO SMALL
 
 
          END    QREC