QFTLIST 
          IDENT  QFTLST1,FWA,QFTLIST,01,00
          ABS 
          SST 
          SYSCOM B1 
*COMMENT  QFTLIST - LIST ACTIVE QUEUED FILES. 
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
          TITLE  QFTLIST - LIST ACTIVE QUEUED FILES.
          SPACE  4
*****     QFTLIST - LIST ACTIVE QUEUED FILES. 
*         R. A. JAPS         78/01/27.
*         B. M. SLIWINSKI.   81/10/15.  (MODIFIED)
          SPACE  4
***       *QFTLIST* IS A QUEUE UTILITY PROGRAM THAT PROVIDES A LIST 
*         OF INFORMATION PERTAINING TO ACTIVE QUEUED FILES. 
          SPACE  4
***       *QALTER* IS A QUEUE UTILITY PROGRAM THAT ALLOWS AN OPERATOR 
*         TO ALTER OUTPUT FILE CHARACTERISTICS. 
          SPACE  4
***       *QFTLIST* IS CALLED BY THE QUEUED FILE SUPERVISOR PROGRAM 
*         *QFSP* OR BY CONTROL STATEMENT.  THE FOLLOWING PARAMETERS 
*         ARE VALID FOR *QFTLIST*.
* 
*         FM = FAMILY NAME FOR DEVICES. 
*         DN = DEVICE NUMBER
*         JSN = JSN OF FILE.
*         UJN = USER JOBNAME. 
*         FC = FORMS CODE.
*         ID = IDENTIFIER NUMBER. 
*         LA = LOWER SECURITY ACCESS LEVEL. 
*         UA = UPPER SECURITY ACCESS LEVEL. 
*         DF = DESTINATION FAMILY NAME. 
*         UN = DESTINATION USER NUMBER. 
*         L  = FILE TO RECEIVE OUTPUT.
*         LO = LIST OPTION. 
*         LD = DESTINATION LOGICAL IDENTIFIER (LID).
*         DS = DT.  SELECT FILE DESTINATION BY DISPOSITION TYPE.
*                BC - SELECT FILES ROUTED TO LOCAL BATCH BY FILE TYPE.
*                RB - SELECT FILES ROUTED TO REMOTE BATCH TERMINAL
*                     BY FILE TYPE. 
*         I  = ALTERNATE DIRECTIVE INPUT FILE. THIS IS A CONTROL
*                STATEMENT PARAMETER SPECIFYING WHAT FILE SHOULD
*                BE READ FOR INPUT DIRECTIVES.  THESE DIRECTIVES
*                CONSIST OF ANY VALID K-DISPLAY INPUT OR COMMANDS.
*                THESE DIRECTIVES WILL BE PROCESSED AFTER THE 
*                CONTROL STATEMENT DIRECTIVES BUT BEFORE ANY
*                K-DISPLAY INPUT IS ACCEPTED. 
* 
*         THE FOLLOWING DIRECTIVES ARE ALSO VALID FOR *QALTER*. 
* 
*         NAL = NEW SECURITY ACCESS LEVEL.
*         NDF = NEW DESTINATION FAMILY NAME.
*         NUN = NEW DESTINATION USER NUMBER.
*         NID = NEW FILE ID.
*         NPR = NEW PRIORITY FOR OUTPUT.
*         NFC = NEW FORMS CODE FOR OUTPUT.
*         NRC = NEW REPEAT COUNT FOR OUTPUT.
*         NDC = NEW DISPOSITION CODE. 
*         NEC = NEW EXTERNAL CHARACTERISTICS FOR OUTPUT FILES.
*         NLD = NEW DESTINATION LOGICAL IDENTIFIER (LID). 
*         OP = ALTER OPTION.
* 
*         SEE *QFSP* FOR A MORE DETAILED DESCRIPTION OF PARAMETERS. 
          SPACE  4
***       DAYFILE MESSAGES. 
* 
* 
*         * NO QUEUED FILES FOUND.* 
*                *QFTLIST* OR *QALTER* WAS NOT ABLE TO FIND ANY 
*                QUEUED FILES THAT SATISFY THE SELECTION
*                CRITERIA.
* 
*         * QFTLIST/QALTER ABORTED.*
*                *QFTLIST* OR *QALTER* HAS BEEN ABORTED BY THE
*                SYSTEM. CONTACT THE SITE ANALYST.
* 
*         * QAC ERROR ENCOUNTERED.* 
*                THIS MESSAGE IS AN EXPLANATORY MESSAGE STATING 
*                THAT *QFTLIST* OR *QALTER* WAS ABORTED.  AN
*                UNEXPECTED ERROR CODE WAS RETURNED BY *QAC*. 
          SPACE  4
***       K-DISPLAY MESSAGES. 
* 
* 
*         * INVALID PAGING ATTEMPT.*
*                AN ATTEMPT WAS MADE TO PAGE THE K-DISPLAY BEFORE 
*                THE *LIST* COMMAND WAS ENTERED.
* 
*         * NO QUEUED FILES FOUND.* 
*                *QFTLIST* OR *QALTER* DID NOT FIND ANY QUEUED
*                FILES THAT MET THE SELECTION CRITERIA. 
* 
*         * QALTER COMPLETE.* 
*                AN INFORMATIVE MESSAGE INDICATING THE *QALTER* 
*                OPERATION IS COMPLETE. 
* 
*         * LIST COMPLETE.* 
*                AN INFORMATIVE MESSAGE INDICATING THE *LIST* 
*                OPERATION IS COMPLETE. 
* 
*         * OUTPUT FILE RELEASED.*
*                AN INFORMATIVE MESSAGE INDICATING THE *OUT*
*                OPERATION IS COMPLETE. 
* 
*         * NEW DESTINATION FAMILY/USER INVALID.* 
*                THIS MESSAGE IS RETURNED BY *QALTER* TO INDICATE THAT
*                EITHER THE NEW DESTINATION FAMILY (*NDF*) OR THE 
*                NEW DESTINATION USER NUMBER (*NUN*) IS NOT VALID.
* 
*         * INCOMPLETE DESTINATION FAMILY/USER.*
*                IF EITHER *DF* OR *UN* IS SPECIFIED, 
*                THE OTHER MUST ALSO BE SPECIFIED,
*                IN ORDER TO COMPLETELY IDENTIFY
*                THE SELECTED REMOTE TERMINAL.
* 
*         * NOT VALIDATED TO CHANGE ACCESS LEVEL.*
*                THE USER MUST HAVE SECURITY ADMINISTRATOR PRIVILEGES 
*                IN ORDER TO BE ALLOWED TO CHANGE THE ACCESS LEVEL
*                OF A QUEUED FILE.
          SPACE  4
***       ENTRY CONDITONS.
* 
*         *TARA* = FWA OF ARGUMENT TABLE. 
*         *QFTA* = *QFTP* WORD FROM CENTRAL MEMORY RESIDENT.
*         *TEQA* = FWA OF MASS STORAGE EQUIPMENT TABLE. 
          SPACE  4
*         COMMON DECKS. 
  
  
*CALL     COMCMAC 
*CALL     COMCDCM 
*CALL     COMCDCP 
*CALL     COMSJIO 
*CALL     COMSMLS 
*CALL     COMSQAC 
          LIST   X
*CALL     COMSQFS 
          LIST   -X 
          TITLE  MACRO DEFINTIONS.
 LINE     SPACE  4,10 
**        LINE - GENERATE LINE. 
* 
*         LINE   CHAR 
*                CHAR        CHARACTER STRING. IF NULL, END OF LINE.
  
  
          PURGMAC  LINE 
  
 LINE     MACRO  C
 .1       MICRO  1,,$C$ 
          IFC    NE,$C$$
          DATA   H$".1"$
          ELSE
          DATA   L*  *
          ENDIF 
          ENDM
 SCLASS   SPACE  4,15 
**        SCLASS - DEFINE SERVICE CLASS TABLE.
* 
*         SCLASS NM,MN,DF,ST,TX 
* 
*         ENTRY  *NM* = SERVICE CLASS NAME. 
*                *MN* = TWO CHARACTER MNEMONIC. 
*                *DF* = DAYFILE MESSAGE CHARACTER.
*                *ST* = SHORT TEXT FOR *QFTLIST*. 
*                *TX* = TEXT OF SERVICE CLASS NAME FOR BANNER PAGE. 
* 
*         NOTE - THE CALL TO *COMSSCD* MUST FOLLOW THE DEFINITION OF
*                THIS MACRO.
  
  
          PURGMAC SCLASS
  
 SCLASS   MACRO  NM,MN,DF,ST,TX 
 .SCL     RMT 
          TABLE  NM,DF       TX 
 .SCL     RMT 
 .SCL1    RMT 
          TABLE  NM,ST       TX 
 .SCL1    RMT 
 SCLASS   ENDM
  
  
 SCL$     EQU    1           PROCESS ALL CLASSES
*CALL     COMSSCD 
 TABLE    SPACE  4,10 
**        TABLE - GENERATE TABLE ENTRY. 
* 
*         TABLE  A,B
* 
*                A = NUMERIC VALUE. 
*                B = CHARACTER VALUE. 
* 
*         A ONE WORD TABLE ENTRY IS GENERATED.
*T,       18/ A, 42/ B
  
  
          PURGMAC TABLE 
  
 TABLE    MACRO  A,B
 .1       MICRO  1,7,$B$
          VFD    18/A,42/0H".1" 
          ENDM
 TABLEN   SPACE  4,10 
**        TABLEN - GENERATE NUMERIC TABLE ENTRY.
* 
*         TABLEN A,B
* 
*         A = NUMERIC VALUE.
*         B = NUMERIC VALUE.
* 
*         A ONE WORD TABLE ENTRY IS GENERATED.
*T,       18/ A, 42/ B
  
  
          PURGMAC  TABLEN 
  
 TABLEN   MACRO  A,B
          VFD    18/A,42/B
          ENDM
 TSDI     SPACE  4
**        TSDI - *SDI* TABLE ENTRY MACRO. 
* 
*         TSDI   PA,BA,FW,RI,ADDR1,ADDR2,TADDR
* 
*T,       24/ , 18/ PR , 6/BA , 6/ FW , 6/ RI 
*T,       6/ , 18/ ADDR1 , 18/ ADDR2 , 18/ TADDR
* 
*                PR = PROCESSOR ADDRESS.
*                BA = FIRST BIT ADDRESS OF FIELD TO EXTRACT.
*                FW = FIELD WIDTH OF FIELD TO EXTRACT.
*                RI = INDEX INTO REPLY ENTRY. 
*                ADDR1 = K-DISPLAY ADDRESS FOR PROCESSED INFORMATION. 
*                ADDR2 = OUTPUT BUFFER ADDRESS FOR PROCESSED
*                INFORMATION. 
*                TADDR = TABLE ADDRESS. 
  
  
          PURGMAC TSDI
  
 TSDI     MACRO  P,B,F,R,A1,A2,TA 
          VFD    24/0,18/P,6/B,6/F,6/R
          VFD    6/0,18/A1,18/A2,18/TA
          ENDM
  
          TITLE  ASSEMBLY CONSTANTS.
****      ASSEMBLY CONSTANTS. 
  
  
 LRPY     EQU    16B         LENGTH OF *QAC* REPLY BLOCK
 BQACL    MAX    ALLB,PKLB   LENGTH OF PARAMETER BLOCK BUFFER 
 TARG     EQU    TARA        FWA OF *QFSP* ARGUMENT TABLE 
 LINE     EQU    TPPA+PPLN   LINE NUMBER
 PDFE     EQU    TPPA+PPPD   PRINT DENSITY FORMAT EFFECTOR
 TEQP     EQU    TEQA        FWA OF *QFSP* EQUIPMENT TABLE
 DSPBL    EQU    7           *DSP* PARAMETER BLOCK LENGTH 
 KBUFL    EQU    KMLL*7      K-DISPLAY BUFFER LENGTH
 OBUFL    EQU    1001B       OUTPUT BUFFER SIZE 
 SBUFL    EQU    80          STRING BUFFER SIZE 
****
  
          SPACE  4,10 
*         *DSP* FLAG BIT EQUIVALENCES.
  
  
 FRDC     EQU    20B         DISPOSITION CODE 
          TITLE  TABLES.
          ORG    OVLA 
 FWA      BSS    0           FIRST WORD ADDRESS OF BINARY 
 TDCM     SPACE  4,10 
**        TDCM - TABLE OF DISPOSITION CODE MAPPINGS.
  
  
 TDCM     BSS    0
          VFD    18/2LTT,42/1            TERMINAL OUTPUT
          VFD    18/2LLY,42/2            5970 PRINTER 
          VFD    18/2LLX,42/4            5870 PRINTER 
          VFD    18/2LLT,42/10B      580-20 PRINTER 
          VFD    18/2LLS,42/20B      580-16 PRINTER 
          VFD    18/2LLR,42/40B      580-12 PRINTER 
          VFD    18/2LP2,42/100B     512 PRINTER
          VFD    18/2LLP,42/200B     ANY PRINTER
          VFD    18/2LPL,42/400B     PLOT 
          VFD    18/2LPU,42/1000B    PUNCH
          VFD    18/2LIN,42/2000B    INPUT
          VFD    18/2LNO,42/2000B    INPUT - NO OUTPUT
          VFD    18/2LTO,42/2000B    INPUT - TERMINAL OUTPUT
          VFD    18/2LSF,42/4000B    INSTALLATION DISPOSITION CODE
          CON    0           END OF TABLE 
 TECH     SPACE  4,10 
**        TECH - TABLE OF EXTERNAL CHARACTERISTICS FOR PUNCH FILES. 
  
  
 TECH     BSS    0
          TABLE  DFFR,PU     DEFAULT PUNCH
          TABLE  PBFR,SB     SYSTEM BINARY
          TABLE  P8FR,80COL  80 COLUMN BINARY 
          TABLE  PHFR,O26    O26 PUNCH
          TABLE  P9FR,O29    O29 PUNCH
          TABLE  ASFR,ASCII  ASCII PUNCH
          CON    0           END OF TABLE 
 TECL     SPACE  4,10 
**        TECL - TABLE OF EXTERNAL CHARACTERISTICS FOR PLOT FILES.
  
  
 TECL     BSS    0
          TABLE  DFEX,PL     DEFAULT
          TABLE  T6EX,T6     TRANSPARENT 6-BIT PLOTTER
          TABLE  T8EX,T8     TRANSPARENT 8-BIT PLOTTER
          TABLE  A4EX,A4     ASCII 48 CHARACTER 
          CON    0
 TECP     SPACE  4
**        TECP - TABLE OF EXTERNAL CHARACTERISTICS FOR PRINT FILES. 
  
  
 TECP     BSS    0
          TABLE  DFEX,LP     DEFAULT
          TABLE  A4EX,A4     ASCII 48 CHARACTER 
          TABLE  B4EX,B4     BCD 48 CHARACTER 
          TABLE  B6EX,B6     BCD 64 CHARACTER 
          TABLE  A6EX,A6     ASCII 64 CHARACTER 
          TABLE  A9EX,A9     ASCII 96 CHARACTER 
          CON    0
 TICC     SPACE  4,10 
**        TICC - TABLE OF INTERNAL CHARACTERISTICS CODES. 
  
  
 TICC     BSS    0
          TABLE  DCIC,DIS    DISPLAY CODE 
          TABLE  ASIC,ASCII  ASCII
          TABLE  BNIC,BIN    BINARY 
          TABLE  A6IC,ASCII6 6/12 ASCII 
          CON    0           END OF TABLE 
 TINT     SPACE  4
**        TINT - TABLE OF INTERRUPT STATUSES. 
  
  
 TINT     BSS    0
          TABLE  0,NO 
          TABLE  1,YES
          CON    0           END OF TABLE 
 TLVM     SPACE  4,10 
**        TLVM - TABLE OF SECURITY ACCESS LEVEL MAPPINGS. 
  
  
 TLVM     BSS    0
          TABLE  0,"ALM0"    ACCESS LEVEL 0 
          TABLE  1,"ALM1"    ACCESS LEVEL 1 
          TABLE  2,"ALM2"    ACCESS LEVEL 2 
          TABLE  3,"ALM3"    ACCESS LEVEL 3 
          TABLE  4,"ALM4"    ACCESS LEVEL 4 
          TABLE  5,"ALM5"    ACCESS LEVEL 5 
          TABLE  6,"ALM6"    ACCESS LEVEL 6 
          TABLE  7,"ALM7"    ACCESS LEVEL 7 
          CON    0           END OF TABLE 
 TNDC     SPACE  4,10 
**        TNDC - TABLE OF NEW DISPOSITION CODES.
  
  
 TNDC     BSS    0
          TABLE  LPQF,LP     ANY PRINTER
          TABLE  P2QF,P2     512 PRINTER
          TABLE  LRQF,LR     580-12 PRINTER 
          TABLE  LSQF,LS     580-16 PRINTER 
          TABLE  LTQF,LT     580-20 PRINTER 
          TABLE  LXQF,LX     5870 NIP 
          TABLE  LYQF,LY     5970 NIP 
          CON    0           END OF TABLE 
 TNEC     SPACE  4,10 
**        TNEC - TABLE OF SHIFT COUNTS FOR NEW EXTERNAL 
*                CHARACTERISTICS. 
  
  
 TNEC     BSS    0
          CON    12          PRINT
          CON    24          PUNCH
          CON    0           PLOT 
 TNUL     SPACE  4,10 
**        TNUL - NULL TABLE.
  
  
 TNUL     CON    0           END OF TABLE 
 TOOP     SPACE  4
**        TOOP - TABLE OF ALTER OPTIONS.
  
  
 TOOP     BSS    0
          TABLE  BCOP,BC
          TABLE  RBOP,RB
          TABLE  NCOP,NC
          TABLE  PROP,PR
          CON    0           END OF TABLE 
 TQTC     SPACE  4,10 
**        TQTC - TABLE OF QUEUE TYPES.
  
  
 TQTC     BSS    0
          TABLE  INQQ,IN     INPUT
          TABLE  PRQQ,PR     PRINT
          TABLE  PHQQ,PH     PUNCH
          TABLE  PLQQ,PL     PLOT 
          TABLE  WTQQ,WT     WAIT 
          CON    0           END OF TABLE 
 TQTN     SPACE  4
**        TQTN - TABLE OF QUEUE TYPE NAMES. 
  
  
 TQTN     BSS    0
          TABLE  INQQ,INPUT 
          TABLE  PRQQ,PRINT 
          TABLE  PHQQ,PUNCH 
          TABLE  PLQQ,PLOT
          TABLE  WTQQ,WAIT
          CON    0           END OF TABLE 
 TSCC     SPACE  4,10 
**        TSCC - TABLE OF SERVICE CLASS CODES.
  
  
 TSCC     BSS    0
          LIST   D
 .SCL     HERE
          LIST   *
          CON    0           END OF TABLE 
 TSCN     SPACE  4,10 
**        TSCN - TABLE OF SERVICE CLASS NAMES.
  
  
 TSCN     BSS    0
          LIST   D
 .SCL1    HERE
          LIST   *
          CON    0           END OF TABLE 
          TITLE  WORKING STORAGE. 
*         WORKING STORAGE.
  
  
 NRPY     CON    0           NUMBER OF ENTRIES IN REPLY BUFFER
 MRPY     CON    0           MAXIMUM NUMBER OF ENTRIES FOR REPLY BUFFER 
 BLKS     DATA   H*          *  WORD OF BLANKS
 CHCT     CON    0           CHARACTER COUNT PER LINE 
 CIND     CON    0           CURRENT INDEX INTO REPLY BUFFER
 INDX     CON    0           INDEX INTO K-DISPLAY BUFFER
 ENPG     CON    0           ENTRY PER PAGE 
 NMPG     CON    0           NUMBER OF ENTRIES PER PAGE 
 FUNC     CON    0           FUNCTION CODE
 PAGE     CON    0           PAGE NUMBER
          SPACE  4
*         FETS AND PARAMETER BLOCKS.
  
  
 BQAC     BSS    BQACL       *QAC* PARAMETER BLOCK BUFFER 
  
 BQACA    BSS    2           CURRENT DESTINATION FAMILY/USER/UI 
 BQACB    BSS    2           NEW DESTINATION FAMILY/USER
  
 O        BSS    0           OUTPUT FILE FET
 OUTPUT   FILEB  OBUF,OBUFL,(FET=7) 
          TITLE  MAIN ROUTINE.
*         QFTLIST - MAIN ROUTINE. 
  
  
 QFTLIST  SUBR               ENTRY/EXIT 
          SA1    MRPY 
          NZ     X1,QFT1     IF REPLY BUFFER SET UP 
          RJ     PRS         PRESET 
 QFT1     SA1    TARG+ARFC   SET FUNCTION CODE
          MX0    -12
          BX7    -X0*X1 
          LX1    48 
          SA7    FUNC 
          BX6    -X0*X1      EXTRACT LIST ORDINAL 
          SB5    X7-FUN1
          SB6    X7-FUN2
          ZR     B5,QFT3     IF *PAGE* FUNCTION 
          NZ     B6,QFT2     IF NOT *LIST* OPTION 
          ZR     X6,QFT2     IF NO *LIST* ORDINAL 
          SX7    FUN4        SET *DETAILED LIST* OPTION 
          SA7    FUNC 
          SA6    DLTA        SAVE ORDINAL 
 QFT2     RJ     CIP         CHECK INCOMPLETE PARAMETERS
          NZ     X5,QFT4     IF ERROR 
          RJ     FRB         FILL REPLY BUFFER
          RJ     SRB         SORT REPLY BUFFER
          RJ     ERB         EDIT REPLY BUFFER
 QFT3     SA1    FUNC        SET PROCESSOR ADDRESS
          SA1    TFAD+X1
          SX5    =C* INVALID PAGING ATTEMPT.                   *
          NZ     X1,QFT5     IF NOT *PAGE* PROCESSOR
 QFT4     SX2    -1          INDICATE NOT TO CHANGE K-DISPLAY 
          EQ     QFTLISTX    RETURN 
  
 QFT5     SB7    X1+
          RJ     ICE
          EQ     QFTLISTX    RETURN 
 TFAD     SPACE  4,10 
**        TFAD - TABLE OF FUNCTION PROCESSOR ADDRESSES. 
* 
*         42/  , 18/ FWA OF PROCESSOR 
  
  
 TFAD     BSS    0
          LOC    0
 FUN0     CON    ALT         *GO* PROCESSOR 
 FUN1     CON    0           *PAGE* PROCESSOR 
 FUN2     CON    LST         *LIST* PROCESSOR 
 FUN3     CON    OUT         *OUT* PROCESSOR
 FUN4     CON    DLT         *DETAILED LIST* PROCESSOR
          LOC    *O 
          TITLE  FUNCTION PROCESSORS. 
 ALT      SPACE  4,20 
**        ALT - ALTER QUEUED FILES. 
* 
*         ENTRY  (NRPY) = NUMBER OF ENTRIES IN *RBUF*.
* 
*         EXIT   (X2) = 0.
*                (X5) = FWA OF K-DISPLAY MESSAGE. 
* 
*         USES   A - 0, 1, 2, 5, 6, 7.
*                X - 0, 1, 2, 5, 6, 7.
* 
*         CALLS  AQF, CDD, CFS, SDI.
* 
*         MACROS CLOCK, DATE, MESSAGE, SETFS, WRITER, WRITEW. 
  
  
 ALT      SUBR               ENTRY/EXIT 
          SA2    NRPY 
          ZR     X2,ALT4     IF REPLY ENTRY EMPTY 
          SA1    TARG+ARLL   SET OUTPUT FILE NAME 
          MX0    42 
          BX1    X0*X1
          SX7    B1 
          BX6    X1+X7
          SA6    O
          SA7    PAGE        SET PAGE COUNT 
          SX6    B0+         SET REPLY BUFFER INDEX 
          SA6    CIND 
          SA7    LINE        SET LINE COUNT 
          SA1    LINE+1      NUMBER OF LINES PER PAGE 
          SX7    X1-13
          SX6    6
          IX7    X7/X6       NUMBER OF ENTRIES PER PAGE 
          SA7    NMPG 
          SA2    TARG+ARNU   SET NEW DESTINATION USER 
          SA1    TARG+ARND   SET NEW DESTINATION FAMILY 
          SX7    X7+B1
          SA7    ENPG 
          BX6    X1 
          BX7    X2 
          SA6    BQACB
          SA7    A6+B1
          DATE   GBUFA+1     SET DATE AND TIME IN PAGE HEADER 
          CLOCK  GBUFA+2
          SX6    1           SET PRINT DENSITY FORMAT CONTROL FLAG
          SA6    PDFE+1 
  
*         SET NEW DESTINATION INFORMATION IN HEADER.
  
          SA5    TOAI-1 
          SA0    TARG 
          RJ     SDI         SET DETAILED INFORMATION 
  
*         ALTER SELECTED QUEUED FILES.
  
 ALT1     SA1    CIND        SET FWA OF REPLY ENTRY 
          SX2    LRPY 
          IX2    X2*X1
          SA0    X2+RBUF
          RJ     CFS         CHECK FILE STATUS
          NZ     X1,ALT3     IF FILE NOT SELECTED 
          RJ     AQF         ALTER QUEUED FILE
          MI     X2,ALTX     IF ERROR IN FAMILY/USER
          SX1    X2-2 
          ZR     X1,ALT4.1   IF ERROR ON ALTERING ACCESS LEVEL
          NZ     X2,ALT3     IF FILE NOT ALTERED
          SA1    NMPG 
          SA2    ENPG 
          SX6    X1+B1
          SA6    A1+
          IX6    X6-X2
          NZ     X6,ALT2     IF NOT BOTTOM OF PAGE
          SA6    A1+
          SA1    PAGE        INCREMENT PAGE COUNT 
          SX6    X1+B1
          SA6    A1 
          RJ     CDD         CONVERT TO DECIMAL DISPLAY CODE
          SA6    GBUFA+4
          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,GBUF,GBUFL 
          WRITEW O,IBUF,IBUFL 
  
 ALT2     SA1    LINE        ADVANCE LINE NUMBER
          SX6    X1+B1
          SA6    A1 
          RJ     CDD         CONVERT TO DECIMAL DISPLAY CODE
          SX1    2R. -1R     INSERT PERIOD
          LX6    12 
          BX6    X6+X1
          SA6    DLNM 
          SA5    TORI-1 
          RJ     SDI         SET DETAILED INFORMATION 
          WRITEW O,DBUF,DBUFL 
  
 ALT3     SA1    CIND        ADVANCE REPLY BUFFER INDEX 
          SA2    NRPY 
          SX6    X1+B1
          SA6    A1 
          BX7    X6-X2
          NZ     X7,ALT1     IF NOT END OF BUFFER 
          SA1    LINE 
          SX1    X1-1 
          NZ     X1,ALT5     IF FILE WRITTEN
 ALT4     SX5    =C* NO QUEUED FILES FOUND.                 * 
 ALT4.1   MESSAGE  X5,3 
          BX2    X2-X2
          EQ     ALTX        RETURN 
  
 ALT5     WRITER O,R
          SETFS  O,0
          SX5    =C* QALTER COMPLETE.                       * 
          BX2    X2-X2
          EQ     ALTX        RETURN 
 DLT      SPACE  4,10 
**        DLT - DETAILED LIST PROCESSOR.
* 
*         ENTRY  (CIND) = CURRENT INDEX INTO REPLY BUFFER.
*                (DLTA) = 0, IF PAGE FUNCTION.
*                       = QFT ORDINAL TO DISPLAY. 
* 
*         EXIT   (CIND) = CURRENT INDEX INTO REPLY BUFFER.
*                (X2) = FWA OF K-DISPLAY BUFFER.
*                (X5) = FWA OF K-DISPLAY MESSAGE. 
* 
*         USES   A - 0, 1, 3, 4, 5, 6, 7. 
*                X - ALL. 
* 
*         CALLS  SDI. 
  
  
 DLT4     BX2    X2-X2       CLEAR RIGHT SCREEN K-DISPLAY 
          SX5    =C* NO QUEUED FILES FOUND.                *
  
 DLT      SUBR               ENTRY/EXIT 
  
*         CONVERT QFT ORDINAL TO BUFFER INDEX.
  
          SX2    LRPY 
          SA3    NRPY 
          SA1    DLTA 
          ZR     X1,DLT2     IF ORDINAL NOT SPECIFIED 
          MX0    -12
          SX6    -B1         PRESET BUFFER INDEX
 DLT1     SX6    X6+B1
          BX4    X6-X3
          ZR     X4,DLT4     IF FILE NOT FOUND
          IX5    X6*X2
          SA4    X5+RBUF     CHECK QFT ORDINAL
          LX4    -24
          BX4    X4-X1
          BX4    -X0*X4 
          NZ     X4,DLT1     IF NO MATCH
          SA6    CIND        SET BUFFER INDEX 
  
*         DISPLAY FILE INFORMATION. 
  
 DLT2     SA1    CIND        DETERMINE FWA OF REPLY ENTRY 
          IX2    X1*X2
          SX6    X1+B1       UPDATE INDEX TO NEXT REPLY ENTRY 
          SA0    RBUF+X2
          SA6    A1+
          BX7    X6-X3
          NZ     X7,DLT3     IF NOT END OF REPLY BUFFER 
          SA7    A1          SET INDEX TO FIRST ENTRY 
 DLT3     SA5    TORI-1 
          RJ     SDI         SET DETAILED INFORMATION 
          SX5    =C* LIST COMPLETE.                         * 
          SX2    LBUF        SET FWA OF K-DISPLAY 
          SX6    DLT         SET PAGE PROCESSOR 
          SA6    TFAD+FUN1
          SX6    B0+         CLEAR QFT ORDINAL
          SA6    DLTA 
          EQ     DLTX        RETURN 
  
 DLTA     CON    0           QFT ORDINAL
 LST      SPACE  4,10 
**        LST - FULL K-DISPLAY LIST PROCESSOR.
* 
*         ENTRY  (CIND) = CURRENT INDEX INTO REPLY BUFFER.
* 
*         EXIT   (CIND) = CURRENT INDEX INTO REPLY BUFFER.
*                (X5) = FWA OF K-DISPLAY MESSAGE. 
*                (X2) = FWA OF K-DISPLAY BUFFER.
* 
*         USES   A - 0, 1, 2, 5, 6, 7.
*                X - 1, 2, 3, 5, 6, 7.
* 
*         CALLS  BDL, CFS, SLB. 
* 
*         MACROS MESSAGE, MOVE. 
  
  
 LST6     SX5    =C* LIST COMPLETE.                         * 
          SX2    KBUF        SET K-DISPLAY BUFFER 
          SX6    LST         SET PAGE PROCESSOR 
          SA6    TFAD+FUN1
  
 LST      SUBR               ENTRY/EXIT 
          MOVE   LSTCL,LSTC,KBUF+1  SET DISPLAY HEADER
          SX6    KMLL-6      PRESET LINE COUNT
          SA6    LINE 
          SX6    KBUF+1+LSTCL  PRESET WORD ADDRESS INTO *KBUF*
          SA6    INDX 
          SX7    B0+         CLEAR WRAP AROUND FLAG 
          SA7    LSTD 
          SA2    NRPY 
          ZR     X2,LST5     IF NO REPLY ENTRIES IN BUFFER
  
*         CHECK NEXT REPLY ENTRY IN BUFFER. 
  
 LST1     SA1    CIND        DETERMINE FWA OF REPLY ENTRY 
          SX2    LRPY 
          IX2    X1*X2
          SA0    RBUF+X2
          RJ     CFS         CHECK FILE STATUS
          NZ     X1,LST3     IF FILE NOT SELECTED 
          SA1    LINE        DECREMENT LINE COUNT 
          SX6    X1-1 
          SA6    A1+
          NZ     X6,LST2     IF NOT END OF DISPLAY
          SA5    INDX 
          MOVE   LSTAL,LSTA,X5
          EQ     LST6        SET EXIT CONDITIONS
  
*         SET NEXT LINE IN DISPLAY. 
  
 LST2     RJ     BDL         BUILD K-DISPLAY LINE 
          RJ     SLB         SET LINE IN BUFFER 
  
*         UPDATE CURRENT INDEX INTO REPLY BUFFER. 
  
 LST3     SA1    CIND        UPDATE CURRENT INDEX 
          SA2    NRPY 
          SX6    X1+B1
          BX7    X6-X2
          SA6    A1+
          NZ     X7,LST1     IF NOT END OF REPLY BUFFER 
          SA7    A1+         SET INDEX TO FIRST ENTRY 
          SA1    LINE 
          SX3    X1-KMLL+6
          ZR     X3,LST4     IF NO FILE FOUND 
          SA5    INDX 
          MOVE   LSTBL,LSTB,X5
          EQ     LST6        SET EXIT CONDITIONS
  
 LST4     SA1    FUNC 
          SX2    X1-FUN1
          NZ     X2,LST5     IF NOT *PAGE* FUNCTION 
          SA1    LSTD 
          NZ     X1,LST5     IF DISPLAY WRAP AROUND NOT POSSIBLE
          SX6    B1 
          SA6    A1 
          EQ     LST1        CHECK BEGINNING REPLY BUFFER 
  
 LST5     SX5    =C* NO QUEUED FILES FOUND.                 * 
          MESSAGE X5,3
          BX2    X2-X2       CLEAR RIGHT SCREEN K-DISPLAY 
          EQ     LSTX        RETURN 
  
 LSTA     LINE
          LINE   ( MORE ) 
          BSSZ   2           TERMINATE DISPLAY
 LSTAL    EQU    *-LSTA 
  
 LSTB     LINE
          LINE   ( END OF DISPLAY.) 
          LINE
          BSSZ   2           TERMINATE DISPLAY
 LSTBL    EQU    *-LSTB 
  
 LSTC     LINE
          LINE   (               ACTIVE QUEUE FILE LIST    )
          LINE
          LINE
  
 LSTE     BSS    0
          LINE   ( ORD   JSNS  DT LID FAMILY  USERNAM TUI/ID  FC    ) 
          LINE   (EC  LENGTH  ) 
          LINE
  
          LINE
  
 LSTCL    EQU    *-LSTC 
 LSTEL    EQU    *-LSTE 
  
 LSTD     CON    0           WRAP AROUND FLAG 
 OUT      SPACE  4,10 
**        OUT - HARD COPY LIST PROCESSOR. 
* 
*         ENTRY  (CIND) = CURRENT INDEX INTO REPLY BUFFER.
*                (NRPY) = NUMBER OF ENTRIES IN REPLY BUFFER.
* 
*         EXIT   OUTPUT FILE WRITTEN. 
*                OUTPUT FILE ROUTED TO PRINTER IF NOT CONTROL 
*                STATEMENT CALL.
*                (X5) = FWA OF K-DISPLAY MESSAGE. 
*                (X2) = 0.
* 
*         USES   A - 0, 1, 2, 5, 6, 7.
*                X - 0, 1, 2, 5, 6, 7.
*                B - 6. 
* 
*         CALLS  BDL, CDD, CFS, SDI.
* 
*         MACROS CLOCK, DATE, MESSAGE, ROUTE, SETFS,
*                WRITEO, WRITER, WRITES, WRITEW.
  
  
 OUT      SUBR               ENTRY/EXIT 
          SA2    NRPY 
          ZR     X2,OUT7     IF NO REPLY ENTRIES IN BUFFER
          SA1    TARG+ARLL   SET FILE NAME IN FET 
          MX0    42 
          SX7    B1 
          BX6    X0*X1
          BX6    X6+X7
          SA6    O
          SA7    PAGE        SET PAGE COUNT 
          SA7    PDFE+1      SET PRINT DENSITY FORMAT CONTROL FLAG
          SX6    B0+         SET REPLY BUFFER ORDINAL 
          SA6    OUTA 
          SA6    LINE        SET LINE COUNT 
          SA5    LINE+1      SET NUMBER OF ENTRIES PER PAGE 
          SX7    X5-7 
          SA2    OUTC 
          SA1    TARG+ARLO
          ZR     X1,OUT1     IF NOT FULL LIST 
          SA2    OUTB 
          SX6    6           LINES PER ENTRY
          IX7    X7/X6       ENTRIES PER PAGE 
 OUT1     SA7    NMPG 
          SX7    X7+B1
          BX6    X2 
          SA7    ENPG 
          SA6    HBUFC+1
          DATE   HBUFA+1     SET DATE AND TIME IN PAGE HEADER 
          CLOCK  HBUFA+2
  
*         CHECK NEXT REPLY ENTRY. 
  
 OUT2     SA1    OUTA        SET FWA OF REPLY ENTRY 
          SX2    LRPY 
          IX2    X2*X1
          SA0    X2+RBUF
          RJ     CFS         CHECK FILE STATUS
          NZ     X1,OUT6     IF FILE NOT SELECTED 
          SA1    NMPG 
          SA2    ENPG 
          SX6    X1+B1
          SA6    A1 
          IX6    X6-X2
          NZ     X6,OUT4     IF NOT BOTTOM OF PAGE
          SA6    A1          RESET ENTRY/PAGE COUNT 
          SA1    PAGE        INCREMENT PAGE COUNT 
          SX6    X1+B1
          SA6    A1 
          RJ     CDD         CONVERT DECIMAL DISPLAY CODE 
          SA6    HBUFA+4
          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,HBUF,HBUFL 
          SA1    TARG+ARLO
          NZ     X1,OUT3     IF FULL LIST 
          SA1    BLKS 
          BX6    X1 
          WRITEO O
          WRITEW O,LSTE,LSTEL 
          EQ     OUT4        BUILD OUTPUT FILE ENTRY
  
 OUT3     WRITEW O,IBUF,IBUFL 
  
*         BUILD OUTPUT FILE ENTRY.
  
 OUT4     SA1    LINE        ADVANCE LINE NUMBER
          SX6    X1+B1
          SA6    A1 
          SA1    TARG+ARLO
          NZ     X1,OUT5     IF FULL LIST 
          SA1    BLKS 
          BX6    X1 
          WRITEO O
          RJ     BDL         BUILD OUTPUT LINE
          SA5    CHCT 
          SX5    X5-2 
          WRITES  O,SBUF,X5 
          EQ     OUT6        PROCESS NEXT REPLY ENTRY 
  
 OUT5     SA5    TORI-1 
          RJ     SDI         SET DETAILED INFORMATION 
          SA1    LINE        SET LINE NUMBER
          RJ     CDD         CONVERT DECIMAL DISPLAY CODE 
          SX1    2R. -1R
          LX6    12 
          BX6    X6+X1
          SA6    DLNM 
          WRITEW O,DBUF,DBUFL 
  
*         ADVANCE REPLY BUFFER INDEX. 
  
 OUT6     SA1    OUTA        ADVANCE CURRENT INDEX
          SA2    NRPY 
          SX6    X1+1 
          SA6    A1 
          BX7    X6-X2
          NZ     X7,OUT2     IF MORE ENTRIES IN BUFFER
  
*         COMPLETE OUTPUT FILE. 
  
          SA1    LINE 
          NZ     X1,OUT8     IF FILE WRITTEN
 OUT7     SX5    =C* NO QUEUED FILES FOUND.                 * 
          MESSAGE X5,3
          BX2    X2-X2
          EQ     OUTX        RETURN 
  
 OUT8     WRITER O,R
          SETFS  O,0
          SA1    TARG+ARFC
          PL     X1,OUT9     IF NOT CONTROL STATEMENT CALL
          SX5    B0          NO K-DISPLAY MESSAGE 
          BX2    X2-X2
          EQ     OUTX        RETURN 
  
 OUT9     SX6    B0+         CLEAR *DSP* PARAMETER BLOCK
          SB5    DSPBL-1
 OUT10    SA6    DSPB+B5
          SB5    B5-1 
          PL     B5,OUT10    IF NOT END OF TABLE
          SA2    O           SET UP *DSP* PARAMETER BLOCK 
          MX0    42 
          BX6    X0*X2
          SA6    DSPB 
          SA2    OUTD        SET FLAG BITS
          BX6    X2 
          SA6    A6+B1
          ROUTE  DSPB,RECALL
          SX5    =C* OUTPUT FILE RELEASED.                  * 
          SX2    B0+         SET PRIMARY RIGHT SCREEN DISPLAY 
          EQ     OUTX        RETURN 
  
 OUTA     CON    0           REPLY BUFFER INDEX 
 OUTB     DATA   10HFULL. 
 OUTC     DATA   10HSHORT.
 OUTD     VFD    24/0,12/2HPR,6/0,18/FRDC 
          TITLE  REPLY BUFFER PROCESSING ROUTINES.
 ERB      SPACE  4,10 
**        ERB - EDIT REPLY BUFFER.
* 
*         ENTRY  (NRPY) = NUMBER OF ENTRIES IN REPLY BUFFER.
* 
*         EXIT   ALL REPLY ENTRIES EDITED.
* 
*         USES   A - 1, 5, 6. 
*                X - 0, 1, 2, 3, 5, 6.
*                B - 4, 6, 7. 
* 
*         MACROS MOVE.
  
  
 ERB      SUBR               ENTRY/EXIT 
          SA1    NRPY 
          SB2    RBUF-LRPY
          SB4    X1+
  
*         ADVANCE TO NEXT REPLY ENTRY.
  
 ERB1     SB4    B4-B1       DECREMENT NUMBER OF ENTRIES
          SB2    B2+LRPY
          MX0    -12
          LT     B4,B0,ERBX  IF END OF REPLY BUFFER 
          SA5    TERB-1 
 ERB2     SA5    A5+1 
          NZ     X5,ERB3     IF MORE INFORMATION TO EDIT
          MOVE   LRPY,OBUF,B2 
          EQ     ERB1        EDIT NEXT REPLY ENTRY
  
*         SET EDIT INFORMATION. 
  
 ERB3     BX1    -X0*X5      FIELD WIDTH
          LX5    48 
          SB6    LRPY-1      SET LENGTH OF BLOCK TO EDIT
          SB7    X1-1 
          BX2    -X0*X5      BLOCK INDEX
          LX5    48          POSITION INFORMATION NUMBER
  
*         SEARCH REPLY ENTRY FOR INFORMATION. 
  
          MX3    -6          COMPARE INFORMATION NUMBER 
 ERB4     BX6    X6-X6
          LT     B6,ERB5     IF NO MORE TO SEARCH 
          SA1    B2+B6
          BX6    X1-X5
          BX6    -X3*X6 
          SB6    B6-1 
          NZ     X6,ERB4     IF NO COMPARE
          MX5    1           EDIT INFORMATION 
          AX5    B7 
          BX6    X5*X1
 ERB5     SA6    OBUF+X2     SET EDITED DATA
          EQ     ERB2        LOOP FOR NEXT INFORMATION WORD 
 TERB     SPACE  4,10 
**        TERB - TABLE OF EDIT INFORMATION. 
* 
*T,       30/  , 6/ IN , 12/ INDEX , 12/ WIDTH
* 
*                IN = INFORMATION NUMBER
*                INDEX = INDEX INTO REPLY BUFFER
*                WIDTH = FIELD WIDTH OF INFORMATION 
* 
*         TABLE IS TERMINATED BY A ZERO WORD. 
  
  
 TERB     BSS    0
          LOC    0
          VFD    30/0,6/JSPI,12/0,12/48D   JSN, ORDINAL, QUEUE
          VFD    30/0,6/OTPI,12/1,12/42D   OUTPUT CHARACTERISTICS 
          VFD    30/0,6/PRPI,12/2,12/12D   PRIORITY 
          VFD    30/0,6/FMPI,12/3,12/42D   DESTINATION FAMILY 
          VFD    30/0,6/UNPI,12/4,12/48D   DEST. UN, BATCH ID 
          VFD    30/0,6/OFPI,12/5,12/42D   OWNER FAMILY 
          VFD    30/0,6/OUPI,12/6,12/48D   OWNER UN, BATCH ID 
          VFD    30/0,6/FUPI,12/7,12/48D   DEST. UI, OWNER UI 
          VFD    30/0,6/UJPI,12/8,12/42D   USER JOBNAME 
          VFD    30/0,6/SCPI,12/9,12/48D   OUTPUT CHARACTERISTICS 
          VFD    30/0,6/DTPI,12/10,12/48D  EQ. NO., CREATION DATE 
          VFD    30/0,6/FLPI,12/11,12/24D  FILE LENGTH
          VFD    30/0,6/LDPI,12/12,12/48D  LOGICAL IDENTIFIER 
          VFD    30/0,6/ALPI,12/13,12/48D  ACCESS LEVEL 
          CON    0           END OF TABLE 
          LOC    *O 
 FRB      SPACE  4,10 
**        FRB - FILL REPLY BUFFER.
* 
*         ENTRY  MEMORY FOR *RBUF* ALLOCATED. 
*                (MRPY) = MAXIMUM ENTRIES ALLOWED IN *RBUF*.
* 
*         EXIT   *RBUF* CONTAINS REPLY ENTRIES. 
*                (NRPY) = NUMBER OF REPLY ENTRIES IN *RBUF*.
*                (CIND) = 0.
* 
*         ERROR  TO *PSE*, IF ERROR ENCOUNTERED.
* 
*         USES   X - ALL. 
*                A - 1, 3, 4, 5, 6. 
*                B - 2, 7.
* 
*         CALLS  CQP. 
* 
*         MACROS SYSTEM.
  
  
 FRB      SUBR               ENTRY/EXIT 
          SX6    B0+         PRESET NUMBER OF REPLY ENTRIES 
          SA6    NRPY 
          SA6    CIND        SET CURRENT INDEX TO BEGINNING OF BUFFER 
  
*         BUILD *QAC* PARAMETER BLOCK.
  
          SB2    PKLB-1      SET PARAMETER BLOCK LENGTH 
          RJ     CQP         CLEAR *QAC* PARAMETER BLOCK BUFFER 
          SX6    PKFC*2      SET FUNCTION CODE
          SX7    RBUF 
          SA6    BQAC+FCNQ
          SA7    BQAC+INAQ   SET *IN* 
          SA7    BQAC+OUTQ   SET *OUT*
          SX6    PKLB-5      SET LENGTH OF BLOCK
          LX6    18 
          BX6    X6+X7
          SA6    BQAC+FIRQ   SET *FIRST*
          SA3    MRPY        SET *LIMIT*
          SX4    LRPY 
          IX6    X3*X4
          IX6    X6+X7
          SX7    INQQ+PRQQ+PHQQ+PLQQ+WTQQ  SET QUEUE TYPES
          LX7    48 
          SA6    BQAC+LIMQ
          SA7    BQAC+LNKQ
          SX6    ZPSF+DLSF*10000B  SELECT ZERO PRIORITY AND DLID
          SA6    BQAC+SELQ
          MX6    12          SET INFORMATION BITS 13 - 1
          LX6    13 
          SX7    LDPB        SET LID INFORMATION BIT
          SX5    ALPB        SET ACCESS LEVEL INFORMATION BIT 
          LX7    12 
          BX6    X6+X7
          LX5    24 
          BX6    X6+X5
          SA6    BQAC+PIBQ
          MX6    12          SET COUNT FIELDS 
          SA6    BQAC+ENLQ
          MX7    60 
          SA7    BQAC+CNTQ
          SX7    3R***       SET ALL LID SELECTION
          LX7    24 
          SA7    BQAC+LIDQ
  
*         CALL *QAC*. 
  
          SYSTEM QAC,R,BQAC 
          SA1    BQAC+FCNQ   CHECK FOR ERROR
          MX0    -8 
          AX1    10 
          BX1    -X0*X1 
          SX2    X1-ER07
          ZR     X1,FRB2     IF NO ERROR
          ZR     X2,FRBX     IF NO FILE FOUND 
          SX1    EMQC        * QAC ERROR ENCOUNTERED.*
          RJ     PSE         PROCESS SYSTEM ERROR 
  
*         COUNT NUMBER OF ENTRIES RETURNED. 
  
 FRB2     MX0    -12
          SA3    NRPY 
          SA4    BQAC+CNTQ
          BX1    -X0*X4      PLOT FILE COUNT
          IX3    X1+X3
          LX4    48 
          BX1    -X0*X4      PUNCH FILE COUNT 
          LX4    48 
          IX3    X1+X3
          BX1    -X0*X4      PRINT FILE COUNT 
          LX4    36 
          IX3    X1+X3
          BX1    -X0*X4      INPUT FILE COUNT 
          IX3    X1+X3
          SA4    BQAC+ENLQ   TERMINAL OUTPUT FILE COUNT 
          LX4    12 
          BX4    -X0*X4 
          IX6    X3+X4
          SA6    A3+
          EQ     FRBX        RETURN 
 SRB      SPACE  4,10 
**        SRB - SORT REPLY BUFFER.
* 
*         ENTRY  *RBUF* CONTAINS REPLY ENTRIES. 
*                (NRPY) = NUMBER OF ENTRIES IN REPLY BUFFER.
* 
*         EXIT   REPLY ENTRIES SORTED BY QFT ORDINAL. 
* 
*         USES   A - 1, 2.
*                X - 0, 1, 2. 
*                B - 2, 3, 4, 5.
* 
*         MACROS MOVE.
  
  
 SRB      SUBR               ENTRY/EXIT 
          MX0    -12
          LX0    24 
          SB2    RBUF-LRPY   FWA OF FIRST ENTRY IN BUFFER 
          SA1    NRPY        SET LWA+1 OF LAST REPLY ENTRY
          SX1    X1-1 
          SX2    LRPY 
          IX2    X1*X2
          SB4    B1          SORT FLAG
          SB3    X2+RBUF
 SRB1     ZR     B4,SRBX     IF REPLY BUFFER SORTED 
          SB4    B0 
          SB5    B2 
 SRB2     SB5    B5+LRPY
          LE     B3,B5,SRB1  IF END OF REPLY BUFFER 
          SA1    B5          COMPARE QFT ORDINALS 
          SA2    A1+LRPY
          BX1    -X0*X1 
          BX2    -X0*X2 
          IX1    X2-X1
          PL     X1,SRB2     IF SWITCH NOT NECESSARY
          MOVE   LRPY,B5,OBUF  MAKE SWITCH
          MOVE   LRPY,B5+LRPY,B5
          MOVE   LRPY,OBUF,LRPY+B5
          SB4    B1          SET SORT FLAG
          EQ     SRB2        CONTINUE SORT
          TITLE  SUBROUTINES. 
 AQF      SPACE  4,20 
**        AQF - ALTER QUEUED FILE.
* 
*         ENTRY  (A0) = FWA OF *PEEK* REPLY ENTRY.
* 
*         EXIT   (X2) = 0, IF FILE ALTERED. 
*                (X2) = -1, INVALID FAMILY/USER SPECIFIED.
* 
*         ERROR  TO *PSE*, IF ERROR.
* 
*         USES   X - ALL. 
*                A - 1, 2, 3, 4, 5, 6, 7. 
*                B - 2, 4, 5, 7.
* 
*         CALLS  CQP. 
* 
*         MACROS GETUSV, SYSTEM.
  
  
 AQF      SUBR               ENTRY/EXIT 
          SB2    ALLB-1      SET BLOCK LENGTH 
          RJ     CQP         CLEAR CONTENTS OF PARAMETER BLOCK
  
*         SET SELECTION CRITERIA FOR FILE.
  
          SX6    ALFC*2      SET FUNCTION CODE
          SX7    ALLB-5      SET PARAMETER BLOCK LENGTH 
          LX7    18 
          SB4    B0          SET DESTINATION *FM,UN* SPECIFIED
          SA6    BQAC+FCNQ
          SA7    BQAC+FIRQ
          MX0    -15
          LX0    21 
          SA5    A0+B1       SET ORIGIN TYPE
          BX1    -X0*X5      SAVE DISPOSITION CODE AND EC 
          MX0    6
          LX0    54 
          SA3    A0+4        GET DEST. UN, BATCH ID 
          BX5    X0*X5
          AX5    48 
          MX2    42 
          BX2    X2*X3
          NZ     X2,AQF1     IF DESTINATION *FM,UN* SPECIFIED 
          SB4    B1+         INDICATE BATCH ID SPECIFIED
          SB5    IDSF        SET BATCH ID SELECTION FLAG
          LX0    -36
          BX2    X2-X2       CLEAR USER NUMBER
          EQ     AQF2        SET INFORMATION INTO PARAMETER BLOCK 
  
 AQF1     SB5    FMSF        SET DEST. *FM,UN* SELECTION FLAG 
          SA3    A0+3        GET FAMILY NAME
          MX0    -18
          SA2    A0+4        GET USER NUMBER
          BX2    X0*X2
 AQF2     BX3    X0*X3
          BX6    X3+X5       SET FAMILY NAME, BATCH ID, ORIGIN
          SA6    BQAC+FAMQ
          BX7    X2          SET USER NUMBER
          SA7    A6+DUNQ-FAMQ 
          SA4    A0          GET JSN, ORDINAL, QUEUE TYPE 
          SA5    AQFB        SET JSN, SELECTION FLAGS 
          MX0    24 
          SX7    B5 
          BX7    X5+X7
          BX3    X0*X4
          BX7    X7+X3
          SX0    DLSF*10000B SET LID SELECTION
          BX7    X7+X0
          MX0    12          SET QFT ORDINAL
          SA7    BQAC+SELQ
          SX7    3R***       SET ALL LIDS SELECTED
          LX7    24 
          SA7    BQAC+LIDQ
          LX0    36 
          BX6    X0*X4
          LX6    12 
          LX0    48          SET QUEUE TYPE 
          SA6    BQAC+LIMQ
          BX7    X0*X4
          LX7    36 
          BX7    X7+X1       SET DISPOSITION CODE AND EC
          SA7    BQAC+LNKQ
          LX7    9           SAVE QUEUE TYPE
          SB7    X7 
  
*         SET INFORMATION TO BE ALTERED.
  
          SA4    TARG+AROP
          SX7    B1          PRESET ROUTING INFORMATION REQUIRED
          BX5    X5-X5       CLEAR *ALTER* FLAGS
          SX3    X4-BCOP
          ZR     X3,AQF4     IF ALTER TO LOCAL BATCH
          SX3    X4-RBOP
          ZR     X3,AQF6     IF ALTER TO REMOTE BATCH 
          SX7    B0+         SET ROUTING INFORMATION NOT REQUIRED 
          SX3    X4-NCOP
          ZR     X3,AQF3     IF NO CHANGE IN FILE DESTINATION 
          SX5    AJAF        SET EVICT FLAG 
          EQ     AQF9        FINISH PARAMETER BLOCK 
  
 AQF3     ZR     B4,AQF6     IF REMOTE BATCH FILE 
 AQF4     SX2    B0+         CLEAR FAMILY NAME
          SA2    TARG+ARNI
          NG     X2,AQF5     IF NEW ID SPECIFIED
          ZR     X7,AQF7     IF NEW ID NOT REQUIRED 
 AQF5     MX0    -6          SET NEW ID 
          SX5    X5+IDAF     SET LOCAL BATCH ID *ALTER* FLAG
          BX3    -X0*X2 
          EQ     AQF7        SET IN PARAMETER BLOCK 
  
 AQF6     SA2    TARG+ARND
          SA3    TARG+ARNU
          BX4    X2+X3
          BX4    X4+X7
          ZR     X4,AQF8     IF NEW FAMILY AND USER NUMBER NOT REQUIRED 
          SX5    FMAF        SET *ALTER* FLAG 
 AQF7     BX6    X2          ENTER ROUTING INFORMATION INTO BLOCK 
          BX7    X3 
          SA6    BQAC+NDFQ
          SA7    A6+NUNQ-NDFQ 
 AQF8     SA2    TARG+ARAL
          SX6    B0+         PRESET NEW FILE CHARACTERISTICS
          NG     X2,AQF8.2   IF NEW ACCESS LEVEL NOT SPECIFIED
          GETUSV AQFC        GET SECURITY VALIDATIONS 
          SA3    AQFC 
          NG     X3,AQF8.1   IF SECURITY ADMINISTRATOR PRIVILEGES 
          SX5    =C* NOT VALIDATED TO CHANGE ACCESS LEVEL. *
          SX2    2           SET ERROR ENCOUNTERED
          EQ     AQFX        RETURN 
  
 AQF8.1   SA2    TARG+ARAL
          MX0    -3 
          BX6    -X0*X2 
          LX6    18 
          SX5    X5+LVAF     SET *ALTER* FLAG 
 AQF8.2   SA2    TARG+ARNP
          PL     X2,AQF9     IF NEW PRIORITY NOT SPECIFIED
          MX0    -12
          BX2    -X0*X2 
          LX2    48 
          BX6    X6+X2
          SX5    X5+PRAF     SET *ALTER* FLAG 
 AQF9     SA1    TARG+ARNC
          ZR     X1,AQF11    IF NEW FORMS CODE NOT SPECIFIED
          SX0    2R** 
          LX0    59-11
          BX2    X0-X1
          NZ     X2,AQF10    IF NOT NULL FORMS CODE 
          SX1    B0+
 AQF10    LX1    48 
          BX6    X1+X6
          SX5    X5+FCAF     SET *ALTER* FLAG 
 AQF11    SA1    TARG+ARNR
          PL     X1,AQF12    IF NO REPEAT COUNT 
          SX1    X1 
          BX6    X1+X6
          SX5    X5+RCAF     SET *ALTER* FLAG 
 AQF12    SA1    TARG+ARDC
          ZR     X1,AQF13    IF NEW DISPOSITION CODE NOT SPECIFIED
          LX1    42 
          SA2    TNDC-1 
          RJ     STE         SEARCH FOR TABLE ENTRY 
          ZR     X2,AQF13    IF INVALID CHANGE
          AX3    6
          MX0    -12
          LX0    24 
          BX3    -X0*X3 
          BX6    X3+X6
          SX5    X5+DSAF     SET *ALTER* FLAG 
 AQF13    SA1    TARG+ARNE   CHECK FOR NEW EXTERNAL CHARACTERISTICS 
          SA2    B7+TNEC     GET SHIFT COUNT
          SB4    X2 
          LX1    B4,X1
          PL     X1,AQF14    IF NEW EC NOT SPECIFIED
          MX0    -3          SET NEW EC INTO PARAMETER BLOCK
          LX1    12 
          BX1    -X0*X1 
          LX1    21 
          BX6    X1+X6
          SX5    X5+ECAF     SET *ALTER* FLAG 
 AQF14    SA1    TARA+ARNL   CHECK *NLD*
          LX1    18 
          MX3    -18
          BX1    -X3*X1 
          SX7    1L0
          BX7    X7-X1
          ZR     X1,AQF16    IF NO *NLD* SPECIFIED
          ZR     X7,AQF15    IF *NLD* OF *0* SPECIFIED
          SA2    BQAC+NDFQ   MASK NEW LID INTO *QAC* BLOCK
          BX7    X3*X2
          BX7    X1+X7
          SA7    A2+
 AQF15    SX7    DLAF        SET *ALTER* FLAG 
          LX7    12 
          BX5    X5+X7
 AQF16    BX7    X5          SET *ALTER FLAGS* INTO PARAMETER BLOCK 
          ZR     X7,AQF18    IF NO *ALTER* FLAGS SET
          SA6    BQAC+NFCQ   SET NEW FILE CHARACTERISTICS 
          SA7    A6+SSWQ-NFCQ 
          CX1    X7 
          SX1    X1-1 
          NZ     X1,AQF17    IF MORE THAN ONE *ALTER FLAG* SET
          SX2    DSAF        CHECK FOR *NDC*
          BX1    X2*X7
          ZR     X1,AQF17    IF NOT DISPOSITION CODE TO BE ALTERED
          SA1    BQAC+LNKQ   CHECK FOR PRINT FILE 
          AX1    48 
          SX1    X1-PRQQ
          NZ     X1,AQF18    IF NOT PRINT FILE
  
*         CALL *QAC* TO ALTER FILE. 
  
 AQF17    SYSTEM QAC,R,BQAC 
          MX0    -8          CHECK ERROR CODE 
          SA1    BQAC+FCNQ
          AX1    10 
          BX2    -X0*X1 
          SX3    X2-ER07
          SX4    X2-ER02
          ZR     X2,AQFX     IF NO ERROR
          SX1    X2-ER21
          SX2    B1+         SET FILE NOT ALTERED 
          ZR     X3,AQFX     IF FILE NOT FOUND
          ZR     X1,AQFX     IF INVALID ACCESS LEVEL
          SX5    -AQFA       * NEW DESTINATION FAMILY/USER INVALID.*
          SX2    -1 
          ZR     X4,AQFX     IF INVALID ROUTING INFORMATION 
          SX1    EMQC        * QAC ERROR RETURNED.* 
          RJ     PSE         PROCESS SYSTEM ERROR 
  
 AQF18    SX2    B1          CLEAR FILE ALTERED 
          EQ     AQFX        RETURN 
  
 AQFA     DATA   C* NEW DESTINATION FAMILY/USER INVALID.* 
  
*         SET SPECIFIC ORDINAL, ZERO PRIORITY, ORIGIN, JSN, 
*         DISPOSITION CODE AND EXPLICIT EXTERNAL CHARACTERISTICS
*         SELECTION FLAGS.
  
 AQFB     VFD    24/0,36/SOSF+ZPSF+OTSF+JSSF+DSSF+ECSF
  
 AQFC     CON    0           *GETUSV* REPLY WORD
 AQFD     DATA   C* NOT VALIDATED TO CHANGE ACCESS LEVEL.*
 BDL      SPACE  4,10 
**        BDL - BUILD K-DISPLAY LINE. 
* 
*         ENTRY  (A0) = FWA OF REPLY ENTRY. 
* 
*         EXIT   STRING BUFFER SET. 
* 
*         USES   X - 0, 1, 2, 3, 4, 5, 6. 
*                A - 1, 2, 4, 5.
*                B - 3, 4, 5, 6, 7. 
* 
*         CALLS  COD, ESB, SFN, STE.
  
  
 BDL      SUBR               ENTRY/EXIT 
          SB6    B0          CLEAR BUFFER INDEX 
          SX6    B0          CLEAR CHARACTER COUNT
          SA6    CHCT 
  
*         SET QFT ORDINAL.
  
          MX0    -12
          SA5    A0          GET QFT ORDINAL
          LX5    36 
          BX1    -X0*X5 
          RJ     COD         CONVERT TO DISPLAY CODE
          SB7    6
          LX6    36 
          LX5    12 
          RJ     ESB         ENTER STRING BUFFER
          MX0    -12
          BX6    -X0*X5      SAVE QUEUE TYPE
          LX5    12 
          SB5    X6 
  
*         SET JSN AND SERVICE CLASS.
  
          MX0    24          SET JSN
          BX6    X0*X5
          SB7    4
          RJ     ESB         ENTER STRING BUFFER
          SA4    A0+B1       SET SERVICE CLASS, PERIOD, SPACE 
          LX4    6
          MX0    -6 
          BX1    -X0*X4 
          LX1    42 
          SA2    TSCC-1 
          RJ     STE         SEARCH FOR TABLE ENTRY 
          BX6    X3 
          LX6    18 
          SB7    3
          RJ     ESB         ENTER STRING BUFFER
          MX0    12 
  
*         SET DISPOSITION CODE. 
  
          SA5    A0+B1
          LX5    24 
          BX1    X0*X5
          RJ     SFN         SPACE FILL NAME
          SB7    3
          RJ     ESB         ENTER STRING BUFFER
  
*         SET DESTINATION LOGICAL IDENTIFIER. 
  
          SA1    A0+12
          LX1    6
          MX0    18 
          BX1    X0*X1
          RJ     SFN         SPACE FILL LID 
          SB7    4
          RJ     ESB         ENTER STRING BUFFER
  
*         SET DESTINATION FAMILY, USER NUMBER AND UI/ID.
  
          SA1    A0+3 
          RJ     SFN         SPACE FILL FAMILY NAME 
          SB7    8
          RJ     ESB         ENTER STRING BUFFER
          SA1    A0+4 
          MX0    42 
          BX2    X0*X1
          ZR     X2,BDL1     IF NO DESTINATION USER NAME
          RJ     SFN         SPACE FILL USER NUMBER 
          SB7    8
          RJ     ESB         ENTER STRING BUFFER
          MX0    -18         SET DESTINATION USER INDEX 
          SA1    A0+7 
          LX1    -36
          EQ     BDL2        ENTER INTO LINE
  
 BDL1     BX1    X1-X1       CLEAR USER NUMBER FIELD
          RJ     SFN         SPACE FILL NAME
          SB7    8
          RJ     ESB         ENTER STRING BUFFER
          MX0    -6          SET BATCH ID 
          SA1    A0+4 
          LX1    -12
 BDL2     BX1    -X0*X1 
          RJ     COD         CONVERT TO DISPLAY CODE
          SB7    8
          LX6    24 
          RJ     ESB         ENTER STRING BUFFER
  
*         SET FORMS CODE. 
  
          SX2    B5-INQQ
          NZ     X2,BDL2.1   IF NOT INPUT FILE
 BDL2.0   BX1    X1-X1       CLEAR FORMS CODE AND EXTERNAL CHAR.
          RJ     SFN         SPACE FILL NAME
          SB7    9
          RJ     ESB         ENTER STRING BUFFER
          EQ     BDL4        PROCESS FILE LENGTH
  
 BDL2.1   SA5    A0+B1       SET FORMS CODE 
          MX0    12 
          LX5    12 
          BX1    X0*X5
          RJ     SFN
          SB7    3
          RJ     ESB         ENTER STRING BUFFER
  
  
*         SET EXTERNAL CHARACTERISTICS. 
  
          SB3    B5-PHQQ
          MX0    -3 
          LX5    27 
          BX1    -X0*X5 
          LX1    42 
          SA2    TECH-1 
          ZR     B3,BDL3     IF PUNCH FILE
          SA2    TECP-1 
          SB3    B5-PRQQ
          ZR     B3,BDL3     IF PRINT FILE
          SA2    TECL-1 
          SB3    B5-PLQQ
          ZR     B3,BDL3     IF PLOT FILE 
          SA2    TNUL-1      SET TO NULL TABLE
 BDL3     RJ     STE         SEARCH FOR TABLE ENTRY 
          SX2    3R 
          LX2    42 
          MX0    18 
          BX2    X0*X2
          BX6    X2+X3
          SB7    6
          RJ     ESB         ENTER STRING BUFFER
  
*         SET FILE LENGTH.
  
 BDL4     SA1    A0+11
          LX1    24 
          MX0    -24
          BX1    -X0*X1 
          RJ     COD         CONVERT TO DISPLAY CODE
          SB7    6
          LX6    24 
          RJ     ESB         ENTER STRING BUFFER
  
*         SET END OF K-DISPLAY LINE.
  
          SB7    2
          SX6    B0+
          RJ     ESB         ENTER STRING BUFFER
          EQ     BDLX        RETURN 
 CFS      SPACE  4,10 
**        CFS - CHECK FILE STATUS.
* 
*         ENTRY  *TARG* SET UP BY *QFSP*. 
*                (A0) = FWA OF EDITED REPLY ENTRY.
* 
*         EXIT   (X1) = 0, IF FILE SELECTED.
*                (X1) .NE. 0, IF FILE NOT SELECTED. 
* 
*         USES   X - 0, 1, 2, 3, 4, 5, 6. 
*                A - 1, 2, 3, 4, 5. 
*                B - 2, 4, 5. 
* 
*         CALLS  CSD, STE.
  
  
 CFS16    SX1    B1+         CLEAR FILE SELECTED
  
 CFS      SUBR               ENTRY/EXIT 
  
*         CHECK FILE RESIDENCE. 
  
          SA1    TARG+ARFM
          ZR     X1,CFS1     IF ALL FAMILIES SPECIFIED
          SA2    A0+10       GET EST ORDINAL FROM REPLY ENTRY 
          MX0    -12
          LX2    12 
          BX2    -X0*X2 
          SA5    TEQP+X2
          MX0    42 
          BX2    X1-X5
          BX2    X0*X2
          NZ     X2,CFSX     IF FILE NOT SELECTED 
          SA1    TARG+ARDN
          ZR     X1,CFS1     IF ALL DEVICES SPECIFIED 
          LX5    36 
          MX0    -6 
          BX2    X1-X5
          LX2    12 
          BX2    -X0*X2 
          NZ     X2,CFSX     IF FILE NOT SELECTED 
  
*         CHECK JSN.
  
 CFS1     SA1    A0          GET JSN FROM REPLY ENTRY 
          MX0    -12         SAVE QUEUE TYPE
          LX1    48 
          BX3    -X0*X1 
          LX1    12 
          SB5    X3 
          SB4    ARJNL
          MX0    24 
          BX1    X0*X1
          SA3    TARG+ARJN-1
          SB2    B0 
 CFS2     SB4    B4-B1
          SA3    A3+B1
          ZR     X3,CFS3     IF NO ENTRY
          SB2    B2+B1
          BX6    X3-X1
          ZR     X6,CFS4     IF MATCH ON JSN
          BX3    -X0*X3 
          NZ     X3,CFS3     IF NOT BANNER NAME 
          BX6    X0*X6
          ZR     X6,CFS4     IF MATCH ON BANNER NAME
 CFS3     NE     B4,CFS2     IF NOT END OF JSN-S
          NE     B2,CFS16    IF JSN SPECIFIED 
  
*         CHECK USER JOBNAME. 
  
 CFS4     SA1    TARG+ARUJ
          ZR     X1,CFS5     IF NO USER JOBNAME SPECIFIED 
          MX0    42 
          SA5    A0+8 
          BX5    X1-X5
          BX5    X0*X5
          NZ     X5,CFSX     IF FILE NOT SELECTED 
  
*         CHECK DISPOSITION CODE. 
  
 CFS5     SA5    A0+B1       GET DISPOSITION CODE 
          LX5    24 
          MX0    12 
          BX1    X0*X5
          SA5    A0+3        CHECK FOR DESTINATION FAMILY 
          SB2    ARRB 
          NZ     X5,CFS6     IF REMOTE ROUTING
          SB2    ARBC 
 CFS6     SA5    TARG+B2
          LX5    12 
          SA2    TDCM-1 
          RJ     STE         SEARCH FOR TABLE ENTRY 
          ZR     X2,CFS16    IF NOT FOUND 
          BX1    X5*X3
          ZR     X1,CFS16    IF NO MATCH ON DISPOSITION CODE
  
*         CHECK DESTINATION FAMILY NAME AND DESTINATION USER NUMBER.
  
 CFS7     SA5    A0+3 
          MX0    42 
          BX5    X0*X5
          ZR     X5,CFS8     IF NO DESTINATION FAMILY 
          SA1    TARG+ARDF
          ZR     X1,CFS9     IF DESTINATION FAMILY NOT SPECIFIED
          BX5    X5-X1
          BX5    X0*X5
          NZ     X5,CFSX     IF FILE NOT SELECTED 
          SA1    A0+4        CHECK DESTINATION USER NUMBER
          SA5    TARG+ARUN
          BX5    X5-X1
          BX5    X0*X5
          NZ     X5,CFS16    IF FILE NOT SELECTED 
          EQ     CFS9        CHECK FORMS CODE 
  
*         CHECK BATCH ID CODE.
  
 CFS8     SA1    A0+4 
          MX0    -6 
          LX1    -12
          SA5    TARG+ARID
          BX1    -X0*X1 
          IX2    X1-X5
          NG     X2,CFS16    IF BELOW MINIMUM 
          SA5    TARG+ARI1
          IX2    X5-X1
          NG     X2,CFS16    IF ABOVE MAXIMUM 
  
*         CHECK FORMS CODE. 
  
 CFS9     SX1    B5-INQQ
          ZR     X1,CFS15    IF INPUT FILE
          SX1    B0+         SET NO ERROR 
          SA4    TARG+ARFR
          ZR     X4,CFS15    IF NO FORMS CODES SPECIFIED
          SA5    A0+B1       EXTRACT FORMS CODE FROM REPLY ENTRY
          MX0    12 
          LX5    12 
          BX5    X0*X5
          SB4    59 
          LX2    B4,X4
          NG     X2,CFS12    IF RANGE SPECIFIED 
          SB4    3-1
 CFS10    BX2    X0*X4
          ZR     X2,CFS16    IF END OF FORMS CODE LIST
          BX3    X2-X0
          NZ     X3,CFS11    IF NOT NULL FORMS CODE 
          BX2    X2-X2       SET NULL FORMS CODE
 CFS11    BX3    X2-X5
          ZR     X3,CFS15    IF MATCH ON FORMS CODE 
          LX4    12 
          SB4    B4-1 
          PL     B4,CFS10    IF MORE FORMS CODE 
          EQ     CFS16       CLEAR FILE SELECTED
  
 CFS12    BX2    X0*X4       CHECK FORMS CODE RANGE 
          BX3    X2-X0
          ZR     X3,CFS13    IF NULL FORMS CODE 
          IX3    X5-X2
          NG     X3,CFS16    IF BELOW MINIMUM 
 CFS13    LX4    12 
          BX2    X0*X4
          BX3    X2-X0
          NZ     X3,CFS14    IF NOT NULL FORMS CODE 
          SX2    B0+
 CFS14    IX3    X2-X5
          NG     X3,CFS16    IF ABOVE MAXIMUM 
  
*         CHECK LOGICAL IDENTIFIER. 
  
 CFS15    SA5    TARA+AROL   CHECK IF *LD* SPECIFIED
          MX0    18 
          ZR     X5,CFS15.1  IF *LD* NOT SPECIFIED
          SX3    1R0         CHECK FOR *LD* = *0* 
          SA2    A0+12
          LX3    -6 
          BX3    X5-X3
          LX2    6
          BX2    X0*X2
          BX3    X3+X2
          ZR     X3,CFS15.1  IF *LD* = *0* .AND. LID = ZERO 
          BX1    X2-X5       CHECK FOR FILE SELECTED
          NZ     X1,CFSX     IF FILE NOT SELECTED 
  
*         CHECK ACCESS LEVELS.
  
 CFS15.1  BX1    X1-X1       PRESET FILE SELECTED 
          MX0    -3 
          SA5    TARA+ARLA
          NG     X5,CFS15.2  IF ACCESS LEVEL NOT SELECTED 
          SA2    A0+13       GET FILE ACCESS LEVEL
          LX2    -12
          BX3    -X0*X2 
          SA2    TARA+ARUA
          BX5    -X0*X5 
          BX2    -X0*X2 
          IX5    X3-X5
          IX3    X2-X3
          NG     X5,CFS16    IF FILE ACCESS LEVEL IS TOO LOW
          NG     X3,CFS16    IF FILE ACCESS LEVEL IS TOO HIGH 
  
*         CHECK FILE SIZE.
  
 CFS15.2  MX0    -24
          SA5    TARA+ARFS
          SA2    A0+11
          LX2    24 
          BX3    -X0*X2 
          SA2    TARA+ARF1
          IX5    X3-X5
          IX3    X2-X3
          NG     X5,CFS16    IF FILE SIZE TOO SMALL 
          NG     X3,CFS16    IF FILE SIZE TOO LARGE 
          BX1    X1-X1
          EQ     CFSX        RETURN 
 CIP      SPACE  4,10 
**        CIP - CHECK INCOMPLETE PARAMETERS.
* 
*         EXIT   (X5) = 0 IF NO ERROR.
*                     = MESSAGE ADDRESS IF *DF* OR *UN* 
*                       SPECIFIED WITHOUT THE OTHER.
* 
*         USES   A - 1, 2.
*                X - 1, 2, 5. 
  
  
 CIP      SUBR               ENTRY/EXIT 
          SA1    TARG+ARDF
          SA2    TARG+ARUN
          ZR     X1,CIP2     IF *DF* NOT SELECTED 
          ZR     X2,CIP3     IF *UN* NOT SELECTED 
 CIP1     BX5    X5-X5       SET NO ERROR 
          EQ     CIPX        RETURN 
  
 CIP2     ZR     X2,CIP1     IF NEITHER SELECTED
 CIP3     SX5    -=C* INCOMPLETE DESTINATION FAMILY/USER.*
          EQ     CIPX        RETURN 
 CQP      SPACE  4,10 
**        CQP - CLEAR CONTENTS OF *QAC* PARAMETER BLOCK BUFFER. 
* 
*         ENTRY  (B2) = REQUIRED PARAMETER BLOCK LENGTH-1.
* 
*         EXIT   *BQAC* CLEARED.
* 
*         USES   X - 6. 
*                A - 6. 
*                B - 2. 
  
  
 CQP      SUBR               ENTRY/EXIT 
          SX6    B0+
 CQP1     SA6    BQAC+B2
          SB2    B2-1        DECREMENT COUNT
          PL     B2,CQP1     IF NOT END OF BLOCK
          EQ     CQPX        RETURN 
 ESB      SPACE  4,10 
**        ESB - ENTER STRING BUFFER.
* 
*         ENTRY  (X6) = DATA TO ENTER STRING BUFFER (LEFT JUSTIFIED). 
*                (B7) = NUMBER OF CHARACTERS TO ENTER.
*                (B6) = CURRENT STRING BUFFER ADDRESS.
* 
*         EXIT   (B6) = CURRENT STRING BUFFER ADDRESS.
*                (X0) = -77.
* 
*         USES   X - 0, 1, 6, 7.
*                A - 1, 7.
*                B - 6, 7.
  
  
 ESB      SUBR               ENTRY/EXIT 
          MX0    -6 
          SA1    CHCT 
          SX7    X1+B7
          SA7    A1+
 ESB1     ZR     B7,ESBX     IF ALL CHARACTERS ENTERED
          LX6    6
          BX7    -X0*X6 
          SA7    SBUF+B6
          SB7    B7-B1       DECREMENT CHARACTER COUNT
          SB6    B6+B1       INCREMENT BUFFER INDEX 
          EQ     ESB1        LOOP FOR ALL CHARACTERS
 ICE      SPACE  4,10 
**        ICE - INDEXED CODE EXECUTION. 
* 
*         ENTRY  (B7) = SUBROUTINE ENTRY ADDRESS. 
* 
*         EXIT   TO SUBROUTINE WITH RETURN ADDRESS SET. 
* 
*         USES   A - 1, 6.
*                X - 1, 6.
  
  
 ICE      SUBR               ENTRY
          SA1    ICEX        SET RETURN ADDRESS 
          BX6    X1 
          SA6    B7 
          JP     B7+1        JUMP TO SUBROUTINE 
 STE      SPACE  4,10 
**        STE - SEARCH FOR TABLE ENTRY. 
* 
*         ENTRY  (X1) = SEARCH ELEMENT. 
*                (A2) = FWA-1 OF TABLE ENTRY. 
* 
*         EXIT   (X2) = 0, IF ENTRY NOT FOUND.
*                (X3) = EDITED TABLE ENTRY. 
* 
*         USES   A - 2. 
*                X - 0, 2, 3. 
  
  
 STE      SUBR               ENTRY/EXIT 
          MX0    18 
 STE1     SA2    A2+B1
          ZR     X2,STE2     IF END OF TABLE
          BX3    X2-X1
          BX3    X0*X3
          NZ     X3,STE1     IF NO MATCH
          BX3    -X0*X2 
          EQ     STEX        RETURN 
  
 STE2     SA2    =7R         RETURN BLANKS
          BX3    X2 
          BX2    X2-X2
          EQ     STEX        RETURN 
 SDI      SPACE  4,10 
**        SDI - SET DETAILED INFORMATION. 
* 
*         ENTRY  (A0) = FWA OF REPLY ENTRY. 
*                (A5) = FWA-1 OF INFORMATION TABLE. 
* 
*         EXIT   INFORMATION SET IN REQUESTED LOCATIONS.
* 
*         USES   A - 1, 2, 3, 5, 6. 
*                X - 0, 1, 2, 3, 4, 5, 6. 
*                B - 2, 3, 4, 5, 6, 7.
* 
*         CALLS  COD, SFN, STE. 
* 
*         MACROS EDATE. 
  
  
 SDI      SUBR               ENTRY/EXIT 
  
*         EXTRACT INFORMATION.
  
 SDI1     SA5    A5+B1       SET NEXT TABLE ENTRY 
          ZR     X5,SDIX     IF ALL INFORMATION SET 
          MX0    -6 
          BX2    -X0*X5      TABLE INDEX
          LX5    54 
          SB4    X2 
          BX2    -X0*X5      FIELD WIDTH
          LX5    54 
          SB2    X2-1 
          BX2    -X0*X5      BIT ADDRESS
          LX5    54 
          SB3    X2+B1
          SB7    X5          SET PROCESSOR ADDRESS
          SA5    A5+B1
          SX4    X5          SET TABLE ADDRESS
          MX0    1           BUILD MASK 
          SA2    A0+B4       (X2) = INFORMATION WORD FROM TABLE 
          AX0    B2 
          LX0    B3 
          BX1    X0*X2
          BX6    X1          SAVE OPTION ENTRY
          SB6    B3-B2       (B6) = SHIFT COUNT TO RIGHT JUSTIFY DATA 
          SA6    SDIB 
          SB6    B6-60-1
          SB5    B3-60       (B5) = SHIFT COUNT TO LEFT JUSTIFY DATA
          JP     B7          JUMP TO PROCESSOR
  
*         PROCESS ALPHANUMERIC DATA.
  
 SDI2     NZ     X1,SDI4     IF DATA PRESENT
 SDI3     SA1    SDIA        SET *--N/A--*
          SB5    B0+
 SDI4     AX1    B5          LEFT JUSTIFY DATA
          RJ     SFN         SPACE FILL WORD
          EQ     SDI13       SET DATA IN DISPLAY
  
*         PROCESS RESIDENT FAMILY NAME AND DEVICE NUMBER. 
  
 SDI5     AX1    B6 
          SA1    TEQP+X1
          MX0    42 
          BX1    X0*X1
          ZR     X4,SDI4     IF RESIDENT FAMILY NAME
          SA1    A1 
          MX0    -6 
          AX1    12 
          BX1    -X0*X1 
          EQ     SDI8        PROCESS NUMERIC DATA 
  
*         PROCESS NUMERIC DATA. 
  
 SDI6     PL     X2,SDI3     IF FIELD NOT USED
 SDI7     AX1    B6 
 SDI8     RJ     COD         CONVERT TO DISPLAY CODE
          BX6    X4 
          EQ     SDI13       SET IN DISPLAY 
  
*         PROCESS DATE. 
  
 SDI9     AX1    B6          RIGHT JUSTIFY DATA 
          EDATE  X1 
          SX1    1R.-1R 
          IX6    X6-X1
          LX6    6
          EQ     SDI13       SET DATA IN DISPLAY
  
*         PROCESS EXTERNAL CHARACTERISTICS CODE.
  
 SDI10    SA2    A0          GET QUEUE TYPE 
          MX0    -12
          LX2    48 
          BX2    -X0*X2 
          SA3    BLKS 
          BX6    X3 
          SX0    X2-INQQ
          ZR     X0,SDI13    IF INPUT FILE
          SX0    X0-WTQQ+INQQ 
          ZR     X0,SDI13    IF WAIT QUEUE
          SX0    X0-PHQQ+WTQQ 
          ZR     X0,SDI12    IF PUNCH FILE
          SX4    TECL        PROCESS PLOT FILE
          SX0    X0-PLQQ+PHQQ 
          ZR     X0,SDI12    IF PLOT FILE 
          SX4    TECP        PROCESS PRINT FILE 
          EQ     SDI12       PROCESS TABLE SEARCH 
  
*         PROCESS DISPOSITION CODE. 
  
 SDI11    SA2    A0 
          MX0    12 
          LX2    -12
          BX3    -X0*X2 
          SX2    X3-INQQ
          NZ     X2,SDI2     IF NOT INPUT FILE
          SX1    2RIN        SET DISPOSITION TO *IN*
          LX1    48 
          EQ     SDI2        PROCESS ENTRY
  
*         PROCESS TABLE SEARCH. 
  
 SDI11.1  ZR     X1,SDI3     IF NO NEW DISP. CODE SPECIFIED 
 SDI12    SA2    X4-1 
          AX1    B6 
          LX1    42 
          RJ     STE         SEARCH FOR TABLE ENTRY 
          LX3    18 
          BX1    X3 
          RJ     SFN         SPACE FILL NAME
  
*         SET DATA IN DISPLAY.
  
 SDI13    LX5    42 
          SX1    2R=         INSERT *= *
          MX0    48 
          BX6    X0*X6
          BX6    X6+X1
          LX6    48 
          SA6    X5          SET DATA IN DISPLAYS 
          LX5    42 
          SA6    X5 
          EQ     SDI1        LOOP FOR ALL DATA
  
*         PROCESS NEW EXTERNAL CHARACTERISTICS. 
  
 SDI14    SA3    TARG+ARNE
          ZR     X3,SDI3     IF NO NEW EXTERNAL CHARACTERISTICS 
          MX0    1
          BX1    X0*X3
          SX4    TECL        PROCESS PLOT FILES 
          NG     X1,SDI14.1  IF NEW EC FOR PLOT FILE
          LX3    12 
          BX1    X0*X3
          SX4    TECP        PROCESS PRINT FILES
          NG     X1,SDI14.1  IF NEW EC FOR PRINT FILE 
          LX3    12 
          SX4    TECH        PROCESS PUNCH FILES
 SDI14.1  BX1    -X0*X3 
          LX1    6
          EQ     SDI12       PROCESS AS TABLE ENTRY 
  
*         PROCESS DESTINATION USER INDEX. 
  
 SDI15    SA3    A0+3        CHECK FOR DESTINATION FAMILY 
          NZ     X3,SDI7     IF DEFINED - DISPLAY DEST. USER INDEX
          EQ     SDI1        PROCESS NEXT TABLE ENTRY 
  
*         PROCESS BATCH ID. 
  
 SDI16    SA3    A0+3        CHECK FOR DESTINATION FAMILY 
          ZR     X3,SDI7     IF NOT DEFINED - DISPLAY BATCH ID
          EQ     SDI1        PROCESS NEXT TABLE ENTRY 
  
*         PROCESS NEW ACCESS LEVEL. 
  
 SDI17    PL     X2,SDI12    IF DATA PRESENT
          EQ     SDI3        PROCESS NEXT ENTRY 
  
*         PROCESS ACCESS LEVEL FOR DISPLAY. 
  
 SDI18    SA2    SECA 
          MX0    -3 
          LX2    12 
          BX2    -X0*X2 
          NZ     X2,SDI12    IF SECURE SYSTEM - DISPLAY ACCESS LEVEL
          SA3    BLKS 
          BX6    X3 
          EQ     SDI13       DISPLAY BLANKS 
  
 SDIA     VFD    60/10H--N/A--
 SDIB     CON    0
 TOAI     SPACE  4
**        TOAI - TABLE OF ALTER INFORMATION.
  
  
 TOAI     BSS    0
          LOC    0
          TSDI   SDI2,59,42,ARND,DHND+3,DHND+3        *NDF* 
          TSDI   SDI2,59,42,ARNU,DHNU+3,DHNU+3        *NUN* 
          TSDI   SDI2,59,12,ARNC,DHNC+2,DHNC+2        *NFC* 
          TSDI   SDI6,11,12,ARNP,DHNP+2,DHNP+2        *NPR* 
          TSDI   SDI6,5,6,ARNI,DHNI+2,DHNI+2          *NID* 
          TSDI   SDI12,11,12,AROP,DHOP+2,DHOP+2,TOOP  *OP*
          TSDI   SDI6,17,18,ARNR,DHNR+2,DHNR+2        *NRC* 
          TSDI   SDI14,58,5,ARNE,DHNE+2,DHNE+2        *NEC* 
          TSDI   SDI11.1,11,12,ARDC,DHNS+3,DHNS+3,TNDC  *NDC* 
          TSDI   SDI2,59,18,ARNL,DHNL+3,DHNL+3        *NLD* 
          TSDI   SDI17,2,3,ARAL,DHAL+2,DHAL+2,TLVM    *NAL* 
          CON    0
          LOC    *O 
 TORI     SPACE  4,20 
**        TORI - TABLE OF REPLY INFORMATION.
* 
*         TABLE IS TERMINATED BY A ZERO WORD. 
  
  
 TORI     BSS    0
          LOC    0
          TSDI   SDI4,59,24,0,KLFN+2,DLFN+1         JSN 
          TSDI   SDI12,59,6,1,KLSC+2,DLSC+1,TSCN    SERVICE CLASS 
          TSDI   SDI12,23,12,0,KLQT+2,DLQT+1,TQTN   QUEUE TYPE
          TSDI   SDI7,35,12,0,KLOR+2,DLOR+1         ORDINAL 
          TSDI   SDI4,59,42,3,KLDF+2,DLDF+1         DESTINATION FAMILY
          TSDI   SDI4,59,42,5,KLCF+2,DLCF+1         CREATION FAMILY 
          TSDI   SDI4,59,42,4,KLDU+2,DLDU+1         DESTINATION USER
          TSDI   SDI4,59,42,6,KLCU+2,DLCU+1         CREATION USER 
          TSDI   SDI15,53,18,7,KLDD+2,DLDD+1        DEST. USER INDEX
          TSDI   SDI16,17,6,4,KLDD+2,DLDD+1         BATCH ID
          TSDI   SDI7,29,18,7,KLCD+2,DLCD+1         CREATION USER INDEX 
          TSDI   SDI4,47,12,1,KLFC+2,DLFC+1         FORMS CODE
          TSDI   SDI4,59,42,8,KLJC+2,DLJC+1         USER JOBNAME
          TSDI   SDI11,35,12,1,KLDV+2,DLDV+1        DISPOSITION CODE
          TSDI   SDI9,47,18,10,KLDT+2,DLDT+1        CREATION DATE 
          TSDI   SDI10,23,3,1,KLEC+2,DLEC+1,TECH    EXTERNAL CHAR.
          TSDI   SDI7,59,24,11,KLLN+2,DLLN+1        FILE LENGTH 
          TSDI   SDI12,20,3,1,KLIC+2,DLIC+1,TICC    INTERNAL CHAR.
          TSDI   SDI7,40,5,9,KLRP+2,DLRP+1          REPEAT COUNT
          TSDI   SDI12,47,1,9,KLIN+2,DLIN+1,TINT    INTERRUPT STATUS
          TSDI   SDI5,59,12,10,KLRF+2,DLRF+1,0      RESIDENT FAMILY 
          TSDI   SDI5,59,12,10,KLRN+2,DLRN+1,1      RESIDENT DEVICE 
          TSDI   SDI7,59,12,2,KLPR+2,DLPR+1         PRIORITY
          TSDI   SDI18,14,3,13,KLAL+2,DLAL+1,TLVM   ACCESS LEVEL
          TSDI   SDI4,53,18,12,KLLD+2,DLLD+1        CREATION LID
          TSDI   SDI4,29,18,12,KLSD+2,DLSD+1        DESTINATION LID 
          CON    0           END OF TABLE 
          LOC    *O 
 SLB      SPACE  4,10 
**        SLB - SET LINE IN K-DISPLAY BUFFER. 
* 
*         ENTRY  *SBUF* CONTAINS K-DISPLAY LINE.
*                (INDX) = ADDRESS OF NEXT WORD IN K-DISPLAY BUFFER. 
* 
*         EXIT   (INDX) = ADDRESS OF NEXT WORD IN K-DISPLAY BUFFER. 
* 
*         USES   A - 1, 2, 6, 7.
*                X - 0, 1, 2, 6, 7. 
*                B - 2, 3.
  
  
 SLB      SUBR               ENTRY/EXIT 
          SB2    -1          PRESET BUFFER INDEX
          SA1    INDX 
 SLB1     SB3    54          PRESET NEW ASSEMBLY WORD 
          SX6    B0+
 SLB2     SB2    B2+1        GET NEXT CHARACTER 
          SA2    SBUF+B2
          ZR     X2,SLB3     IF END OF LINE 
          LX2    B3 
          BX6    X2+X6
          SB3    B3-6 
          GE     B3,SLB2     IF MORE TO ASSEMBLE
          SA6    X1          SET WORD IN K-DISPLAY BUFFER 
          SX1    X1+B1
          EQ     SLB1        LOOP FOR NEXT ASSEMBLY WORD
  
 SLB3     SA6    X1+
          MX0    -12
          BX6    -X0*X6 
          ZR     X6,SLB4     IF END OF LINE SET 
          SX1    X1+B1       SET END OF LINE
          BX6    X6-X6
          SA6    X1+
 SLB4     SX7    X1+B1
          SA7    A1 
          EQ     SLBX        RETURN 
          TITLE  ERROR PROCESSOR. 
 PSE      SPACE  4,10 
**        PSE - PROCESS SYSTEM ERRORS.
* 
*         ENTRY  (X1) = FWA OF ERROR MESSAGE. 
* 
*         EXIT   CONTROL POINT ABORTED. 
* 
*         MACROS ABORT,MESSAGE. 
  
  
 PSE      SUBR               ENTRY
          MESSAGE  X1 
          MESSAGE  PSEA      * FNTLIST/QALTER ABORTED.* 
          ABORT 
  
 PSEA     DATA   C* QFTLIST/QALTER ABORTED.*
  
 EMQC     DATA   C* QAC ERROR ENCOUNTERED.* 
          TITLE  COMMON DECKS.
*         COMMON DECKS. 
  
  
*CALL     COMCCDD 
*CALL     COMCCIO 
*CALL     COMCCOD 
*CALL     COMCCPM 
*CALL     COMCEDT 
*CALL     COMCLFM 
*CALL     COMCMVE 
*CALL     COMCSFN 
*CALL     COMCSYS 
*CALL     COMCWTO 
*CALL     COMCWTS 
*CALL     COMCWTW 
          TITLE  BUFFERS. 
 KBUF     SPACE  4
**        DETAILED K-DISPLAY BUFFER.
  
 LBUF     BSS    0
          VFD    11/0,1/0,1/0,5/0,18/KTIA,24/0  K-DISPLAY CONTROL WORD
          KDL    20,T,(    ACTIVE QUEUE LIST    ) 
 KLFN     KDL    6,,(            JSN =         )
 KLOR     KDL    31,K,(        ORDINAL =         )
 KLSC     KDL    6,,(        SERVICE =        ) 
 KLQT     KDL    31,H,(          QUEUE =         )
          KDL    11,,(      DESTINATION)
          KDL    37,H,(      CREATION)
 KLDF     KDL    6,,(         FAMILY =         )
 KLCF     KDL    31,K,(         FAMILY =         )
 KLLD     KDL    6,,(            LID =      ) 
 KLSD     KDL    31,K,(            LID =       )
 KLDU     KDL    6,,(           USER =         )
 KLCU     KDL    31,K,(           USER =         )
 KLDD     KDL    6,,(         TUI/ID =         )
 KLCD     KDL    31,K,(     USER INDEX =       )
 KLFC     KDL    6,,(          FORMS =         )
 KLJC     KDL    31,K,(   USER JOBNAME =        ) 
          KDL    4,,( D)
 KLDV     KDL    6,,(ISPOSITION CODE =         )
 KLDT     KDL    31,K,(           DATE =         )
 KLEC     KDL    6,,( EXTERNAL CHAR. =         )
 KLLN     KDL    31,K,(         LENGTH =         )
 KLIC     KDL    6,,( INTERNAL CHAR. =         )
 KLRP     KDL    31,H,(         REPEAT =         )
          KDL    22,H,(      RESIDENCE) 
 KLRF     KDL    6,,(         FAMILY =        ) 
 KLIN     KDL    31,K,(      INTERRUPT =         )
 KLRN     KDL    6,,(         DEVICE =         )
 KLPR     KDL    31,K,(       PRIORITY =         )
 KLAL     KDL    6,K,(   ACCESS LEVEL =       ) 
          CON    0           END OF DISPLAY 
          TITLE  HARD COPY LIST BUFFER. 
 DBUF     SPACE  4
**        DETAILED LIST BUFFER. 
  
  
 IBUF     BSS    0
  
          LINE   (          ) 
          LINE   (      CURRENT       ) 
          LINE   (            DESTINAT) 
          LINE   (ION                 ) 
          LINE   (               CREAT) 
          LINE   (ION                 ) 
          LINE   (      RESIDENCE     ) 
          LINE
  
          LINE   (          ) 
          LINE   ( ****************** ) 
          LINE   ( *******************) 
          LINE   (******************* ) 
          LINE   ( *******************) 
          LINE   (******************* ) 
          LINE   ( ****************** ) 
          LINE
  
  
 IBUFL    EQU    *-IBUF 
  
 DBUF     BSS    0
  
          LINE
  
 DLNM     LINE   (     NNN. ) 
 DLFN     LINE   ( JSN      =         ) 
 DLDF     LINE   ( FAMILY   =         ) 
 DLFC     LINE   ( FORMS    =         ) 
 DLCF     LINE   ( FAMILY   =         ) 
 DLJC     LINE   ( USR JOBNM  =       ) 
 DLRF     LINE   ( FAMILY   =         ) 
          LINE
  
          LINE   (          ) 
 DLSC     LINE   ( SERVICE  =         ) 
 DLDU     LINE   ( USER     =         ) 
 DLDV     LINE   ( DEVICE   =         ) 
 DLCU     LINE   ( USER     =         ) 
 DLDT     LINE   ( DATE     =         ) 
 DLRN     LINE   ( DEVICE   =         ) 
          LINE
  
          LINE   (          ) 
 DLQT     LINE   ( QUEUE    =         ) 
 DLDD     LINE   ( TUI/ID   =         ) 
 DLEC     LINE   ( EXT.CHR. =         ) 
 DLCD     LINE   ( USR INDX =         ) 
 DLIN     LINE   ( INTERRUPT=         ) 
 DLPR     LINE   ( PRIORITY =         ) 
          LINE
  
          LINE   (          ) 
 DLOR     LINE   ( ORDINAL  =         ) 
 DLLD     LINE   ( DLID     =         ) 
 DLIC     LINE   ( INT.CHR. =         ) 
 DLSD     LINE   ( SLID     =         ) 
 DLRP     LINE   ( REPEAT   =         ) 
 DLLN     LINE   ( LENGTH   =         ) 
          LINE
  
          LINE   (          ) 
          LINE   (                    ) 
          LINE   (                    ) 
          LINE   (                    ) 
          LINE   (                    ) 
          LINE   (                    ) 
 DLAL     LINE   ( ACCESS LV=         ) 
          LINE
  
 DBUFL    EQU    *-DBUF      LENGTH OF BUFFER 
  
  
 HBUF     BSS    0
          LINE   (1    QFTLIST - LIST ACTIVE QUEUED FILES.          ) 
 HBUFC    LINE   (   LIST =           ) 
 HBUFA    LINE   (          YY/MM/DD.  HH.MM.SS.      PAGE      NNNN) 
          LINE
  
          LINE
  
          LINE
  
          LINE
  
 HBUFL    EQU    *-HBUF      LENGTH OF BUFFER 
 GBUF     SPACE  4
 GBUF     BSS    0
  
          LINE   (1    QALTER - ALTER/PURGE ACTIVE QUEUED FILES.    ) 
          LINE   (                    ) 
 GBUFA    LINE   (          YY/MM/DD.  HH.MM.SS.      PAGE      NNNN) 
          LINE
  
          LINE
  
          LINE
  
          LINE
  
  
          LINE   (          ) 
 DHOP     LINE   (             OPTION =         ) 
          LINE   (          ) 
 DHND     LINE   (  NEW DESTINATION FAMILY NAME =         ) 
          LINE   (          ) 
 DHNE     LINE   (  NEW EXTERNAL CHAR =         ) 
          LINE
  
          LINE   (          ) 
 DHNC     LINE   (     NEW FORMS CODE =         ) 
          LINE   (          ) 
 DHNU     LINE   (    NEW DESTINATION USER NAME =          )
 DHNI     LINE   (  NEW FILE ID       =         ) 
          LINE
  
          LINE   (          ) 
 DHNP     LINE   (       NEW PRIORITY =         ) 
          LINE   (          ) 
 DHNS     LINE   (         NEW DISPOSITION CODE =         ) 
          LINE   (          ) 
 DHAL     LINE   (  NEW ACCESS LEVEL  =         ) 
          LINE
  
          LINE   (          ) 
 DHNR     LINE   (   NEW REPEAT COUNT =         ) 
          LINE   (          ) 
 DHNL     LINE   (          NEW DESTINATION LID =         ) 
          LINE
  
          LINE
  
 GBUFL    EQU    *-GBUF 
          SPACE  4
          USE    BUFFERS
  
**        BUFFERS.
  
  
  
  
 DSPB     EQU    *           *DSP* PARAMETER BLOCK
 SBUF     EQU    DSPB+DSPBL  STRING BUFFER
 KBUF     EQU    SBUF+SBUFL  K-DISPLAY BUFFER 
 OBUF     EQU    KBUF+KBUFL  OUTPUT FILE BUFFER 
 RBUF     EQU    OBUF+OBUFL  REPLY BUFFER 
          TITLE  PRESET.
 PRS      SPACE  4,10 
**        PRS - PRESET ROUTINE. 
* 
*         EXIT   (MRPY) = MAXIMUM NUMBER OF ENTRIES FOR *RBUF*. 
*                FIELD LENGTH REQUESTED FOR BUFFERS.
* 
*         USES   A - 1, 6.
*                X - 0, 1, 6. 
* 
*         MACROS MEMORY.
  
  
 PRS      SUBR               ENTRY/EXIT 
          MX0    -12
          SA1    QFTA 
          LX1    36 
          BX6    -X0*X1 
          SX1    LRPY 
          IX1    X6*X1
          SA6    MRPY        SET MAXIMUM NUMBER OF QFT ENTRIES
          SX1    X1+RBUF
          MEMORY CM,,R,X1    REQUEST MEMORY FOR REPLY BUFFER
          SA1    PRSA        SET K-DISPLAY CONTROL WORD 
          BX6    X1 
          SX3    PRSB 
          SA6    KBUF 
          RJ     PRK         PRESET K-DISPLAY Y-COORDINATES 
          EQ     PRSX 
  
 PRSA     VFD    11/0,1/1,1/1,5/0,18/KTIA,24/0  K-DISPLAY CONTROL WORD
 PRSB     KDL    *           K-DISPLAY Y-COORDINATE TABLE 
  
 PRK      HERE               SUBROUTINE FROM *COMCDCP*
          SPACE  4,10 
          ERRPL  *-RFL       IF DEFAULT FIELD LENGTH TOO SMALL
          SPACE  4
          END 
