DSP 
          IDENT  DSP,DSP
          PERIPH
          BASE   MIXED
          SST 
 SSJ$     EQU    1           ALLOW *SSJ=* JOBS SYSTEM PRIVILEGES
 QUAL$    EQU    1           FORCE UNQUALIFIED COMMON DECKS 
*COMMENT  DSP - DISPOSE FILE TO I/O QUEUE.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
          TITLE  DSP - DISPOSE FILE TO I/O QUEUE. 
          SPACE  4
***       DSP - DISPOSE FILE TO I/O QUEUE.
*         R. A. JAPS.        76/01/12.
*         M. J. CARIDDI.     81/08/16.
*         P. C. SMITH.       82/04/01.
          SPACE  4
***       *DSP* PLACES A FILE IN THE INPUT OR OUTPUT QUEUE. 
*         THE SYSTEM SECTOR IS FORMATTED WITH INFORMATION SUPPLIED
*         BY THE CALLER.
          SPACE  4
***       CALL. 
* 
*T        18/ *DSP*, 6/ 20B, 18/ 0, 18/ FET.
* 
*                FET = FWA OF PARAMETER BLOCK.
* 
* 
*         PARAMETER BLOCK FORMAT. 
* 
*T FET0   42/ LFN,6/ ERR,1/F,4/ ,6/ OT,1/C
*T,FET1   6/ TF, 6/ 0, 12/ F1, 12/ DIS, 3/ EC, 1/S, 2/ IC, 18/ FLAGS
*T,FET2   18/ SLID, 18/ DLID, 24/ TID 
*T,FET3   42/ UJN, 6/ RESERVE, 12/ PRIORITY 
*T,FET3   60/ ENTRY TIME (*QMOVE* ONLY) 
*T,FET4   2/ 0,4/ PI,6/ SC,12/ SVC,12/ FA,6/ RESERVE,6/ RC,12/ FNT
*T,FET5   24/ BC, 36/ COUNT 
*T,FET6   42/ EQID, 18/ JSN 
* 
*         EXTENDED PARAMETER BLOCK FORMAT.
* 
*T,FET7   12/ DD,24/ RA,6/0,18/ EFLAGS
*T,FET10  42/ OUN, 18/ IRTADDR
*T,FET11  42/ OFN, 18/ ERTADDR
*T,FET12  42/ CUN, 6/CP, 12/SSID
*T,FET13  42/ CFN, 18/ RESERVED 
*T,FET14  42/ ENCRYPTED PASSWORD, 18/ RESERVED
*T,FET15  60/ RESERVED
*T,FET16  60/ RESERVED FOR INSTALLATIONS
*T,FET17  60/ CHARGE NUMBER 
*T,FET20  60/ PROJECT NUMBER (FIRST 10 CHARACTERS)
*T,FET21  60/ PROJECT NUMBER (LAST 10 CHARACTERS) 
* 
* 
*         LFN =  LOCAL FILE NAME. 
* 
*         ERR =  ERROR CODE RETURNED. (SEE DESCRIPTION OF DAYFILE 
*                MESSAGES FOR ERROR CODES.) 
* 
*         F    = FORCED ORIGIN FLAG (*SYOT* ONLY).
* 
*         OT   = FORCED ORIGIN CODE (*SYOT* ONLY).
* 
*         C   =  COMPLETION BIT. MUST BE 0 ON CALL. SET TO 1 ON 
*                COMPLETION.
* 
*         TF = TERMINATION FLAGS. 
*                IF AT JOB TERMINATION, FLAGS MEAN THE FOLLOWING -
* 
*                BIT 59      DISABLE DEFERRED BATCH VALIDATION. 
*                BIT 57      EOI RANDOM ADDRESS SET IN FET+7. 
* 
*         F1 =   FORMS CODE OR INPUT FLAGS. 
*                IF THE FILE IS TO BE QUEUED TO THE INPUT QUEUE,
*                THE FIELD IS DEFINED AS FOLLOWS- 
* 
*                BIT 47-45   UNUSED 
*                BIT 44      SEND FILE TO INPUT QUEUE IF FORCED ABORT 
*                BIT 43      SEND FILE TO INPUT QUEUE IF JOB
*                            COMMAND ERROR OR USER COMMAND ERROR
*                            (SUBSYSTEM CALLER ONLY). 
*                BIT 42      BINARY CARD SEQUENCE ERROR OR INCORRECT
*                            HOLLERITH CODE DETECTED IN CARD DECK.
*                BIT 41-36   UNUSED 
* 
*         DIS =  DISPOSITION CODE IN DISPLAY CODE. (REFER TO *COMSJIO*
*                TO DETERMINE VALID DISPOSITION CODES.) 
* 
*                PR          ANY PRINTER
*                P1          ANY 501 PRINTER
*                P2          ANY 512 PRINTER
*                LR          ANY 580-12 PRINTER 
*                LS          ANY 580-16 PRINTER 
*                LT          ANY 580-20 PRINTER 
*                LX          ANY 5870 NIP 
*                LY          ANY 5970 NIP 
*                PU          PUNCH CODED
*                PH          PUNCH CODED
*                SB          PUNCH SYSTEM BINARY
*                PB          PUNCH SYSTEM BINARY (SAME AS SB) 
*                P8          PUNCH TO 80 COLUMN BINARY
*                FR          MICROFILM PRINTER (NOT SUPPORTED)
*                FL          MICROFILM PLOTTER (NOT SUPPORTED)
*                HR          HARD COPY PRINTER (NOT SUPPORTED)
*                HL          HARD COPY PLOTTER (NOT SUPPORTED)
*                PL          PLOTTER
*                IN          ROUTE TO INPUT 
*                NO          ROUTE TO INPUT WITH NO OUTPUT OPTION SET 
*                SC          CHANGE TO LOCAL FILE (*LOFT*)
*                TO          ROUTE TO INPUT WITH *TT* OPTION SET
*                TT          ROUTE TO TERMINAL OUTPUT QUEUE 
*                SO          ROUTE TO INPUT WITH *SS* OPTION SET
*                SS          ROUTE TO STATION OUTPUT QUEUE
*                WT          ROUTE TO WAIT QUEUE
* 
*         EC   = EXTERNAL CHARACTERISTICS.
*                THE EC FIELD IS INTERPRETED IN ONE OF THREE WAYS 
*                ACCORDING TO QUEUE TYPE. 
* 
*                PRINT (*PRQT*) FILES.
* 
*                MNEMONIC    VALUE  DESCRIPTION 
*                  ---         0      ANY PRINT TRAIN 
*                  ---         1      RESERVED
*                  A4          2      ASCII 48 CHARACTER PRINT TRAIN
*                  B4          3      BCD 48 CHARACTER PRINT TRAIN
*                  B6          4      BCD 63/4 CHARACTER PRINT TRAIN
*                  A6          5      ASCII 64 CHARACTER PRINT TRAIN
*                  A9          6      ASCII 96 CHARACTER PRINT TRAIN
*                  ---         7      RESERVED FOR INSTALLATIONS
* 
* 
*                PUNCH (*PHQT*) FILES.
*                MNEMONIC    VALUE  DESCRIPTION 
*                  PU OR ---   0      PUNCH CODED(O26/O29)
*                  SB          1      PUNCH SYSTEM BINARY 
*                  80COL       2      PUNCH 80-COLUMN BINARY
*                  ---         3      RESERVED
*                  O26         4      PUNCH O26 MODE
*                  O29         5      PUNCH O29 MODE
*                  ASCII       6      PUNCH ASCII 
*                  ---         7      RESERVED FOR INSTALLATIONS
* 
* 
*                PLOT (*PLQT*) FILES. 
*                MNEMONIC    VALUE  DESCRIPTION 
*                  ---         0      RESERVED
*                  T6          1      TRANSPARENT 6-BIT DATA
*                  T8          2      TRANSPARENT 8-BIT DATA
*                  ---         3      UNUSED
*                  ---         4      UNUSED
*                  ---         5      UNUSED
*                  ---         6      UNUSED
*                  ---         7      RESERVED
* 
* 
*         S =    FORCED SERVICE CLASS FLAG. 
* 
*         IC =   INTERNAL CHARACTERISTICS.
* 
*                MNEMONIC    VALUE  DESCRIPTION 
*                  DIS         0      FILE IS IN DISPLAY CODE 
*                  ASCII       1      FILE IS IN ASCII
*                  BIN         2      FILE IS IN BINARY 
*                  ---         3      RESERVED
* 
*         FLAGS  FLAGS INDICATING WHICH PARAMETERS ARE SPECIFIED. 
* 
*               BIT         DESCRIPTION 
*                17          RETURN JOBNAME IN LFN
*                16          ACCOUNTING 
*                15          SPACING CODE FLAG
*                14          REPEAT COUNT 
*                13          USER JOB NAME (UJN)
*                12          NO DAYFILE MESSAGES, RETURN ERROR
*                            IN ERR FIELD.
*                11          SUBSYSTEM INITIATION 
*                10          FORMS CODE 
*                9           PRIORITY 
*                8           INTERNAL CHARACTERISTICS 
*                7           EXTERNAL CHARACTERISTICS 
*                6           EXTENDED PARAMETER BLOCK 
*                5           RESERVED FOR INSTALLATIONS 
*                4           DISPOSITION CODE 
*                3           DLID/SLID
*                2           TID
*                1           ROUTE TO CENTRAL SITE
*                0           FORCED JSN FLAG (INPUT FILES ONLY) 
*                0           DEFERRED ROUTE (OUTPUT FILES ONLY) 
* 
*                IF THE CENTRAL SITE BIT IS SET, THE FILE IS ROUTED 
*                WITH BATCH ORIGIN TYPE.  IF IT IS CLEAR, AND THE TID 
*                BIT IS SET, THE ORIGIN TYPE IS DETERMINED FROM THE 
*                GIVEN TID.  IF BOTH BITS ARE CLEAR, THE ORIGIN TYPE IS 
*                THAT OF THE JOB (EXCEPT, IT IS THAT OF THE PREVIOUS
*                ROUTING IF THE FILE HAD BEEN DEFERRED ROUTED). 
* 
*         SLID = SOURCE LID.  A 3-CHARACTER ALPHANUMERIC IDENTIFIER 
*                FOR THE MAINFRAME WHICH IS TO BE CONSIDERED THE SOURCE 
*                MAINFRAME FOR THIS FILE.  THE FOLLOWING SPECIAL OCTAL
*                VALUES MAY ALSO BE PLACED IN THIS FIELD. 
*                000000 = GET SLID FROM JOB INPUT FILE SYSTEM SECTOR. 
*                000001 = SET SLID TO ZERO. 
*                000002 = SET SLID TO PHYSICAL ID OF THIS MAINFRAME.
* 
*         DLID = DESTINATION LID.  A 3-CHARACTER ALPHANUMERIC ID
*                FOR THE MAINFRAME WHICH IS THE DESTINATION FOR THIS
*                FILE.  THE FOLLOWING SPECIAL OCTAL VALUES MAY ALSO 
*                BE PLACED IN THIS FIELD. 
*                000000 = SET DLID TO ZERO. 
*                000001 = SET DLID TO ZERO. 
*                000002 = SET DLID TO PHYSICAL ID OF THIS MAINFRAME.
* 
*                NOTE - IF THE *SLID/DLID* FLAG BIT IS NOT SET IN THE 
*                PARAMETER BLOCK, DLID IS SET FROM THE JOB INPUT FILE 
*                SYSTEM SECTOR.  FOR A ROUTE TO INPUT, THE JOB INPUT
*                FILE DLID VALUE IS USED.  FOR A ROUTE TO OUTPUT, THE 
*                JOB INPUT FILE SLID VALUE IS USED. 
* 
*         TID  = TERMINAL ID. 
*                IF THE UPPER SIX BITS ARE EQUAL TO 77B, THE
*                LOWER EIGHTEEN BITS CONTAIN THE COMPLEMENT OF
*                THE CM ADDRESS OF A TWO WORD FAMILY NAME - USER
*                NUMBER AREA. 
*                     TAG+0  42/ FAMILY NAME , 18/ 0
*                     TAG+1  42/ USER NAME , 18/ 0
*                IF THE CM ADDRESS IS ZERO, THE FILE WILL BE ROUTED TO
*                THE REMOTE BATCH QUEUE WITH THE DEFAULT DESTINATION
*                PARAMETERS OF THE JOB. 
*                IF THE UPPER SIX BITS ARE NOT EQUAL TO 77B, THE
*                LOWER EIGHTEEN BITS CONTAINS A TID.
*                IF THE CENTRAL SITE AND TID BITS ARE SET, THE TID MUST 
*                BE A BATCH ID CODE TO AVOID AN ERROR CONDITION.
* 
*         UJN =  USER JOB NAME.  (0 TO 7 ALPHANUMERIC CHARACTERS) 
* 
*         PRIORITY = PRIORITY FOR FILE. 
*                NOTE - IF BOTH THE PRIORITY FLAG (BIT 9 OF THE 
*                FLAGS FIELD) AND THE REQUEUE FLAG (BIT 8 OF THE
*                EXTENDED FLAGS FIELD) ARE SET, THEN WORD 3 OF
*                THE PARAMETER BLOCK CONTAINS THE ENTRY TIME TO 
*                SET IN THE FILE-S QFT ENTRY.  THIS FIELD IS SET
*                TO -1 BY *QMOVE* WHEN ACTIVATING AN INACTIVE FILE
*                SO THAT A NEW ENTRY TIME WILL BE SET.
* 
*         PI =   PRINT IMAGE CODE FOR PRINT FILES.  WHEN THE UPPER BIT
*                IS SET, THE LOWER 3 BITS CONTAIN THE PRINT IMAGE CODE. 
*                MEANINGFUL ONLY FOR 512 OR 580 PRINTERS. 
* 
*         SC   = SPACING CODE FOR PRINT FILES (580-PFC).  THIS IS A 
*                NUMERIC VALUE FROM 0 - 77B.
* 
*         SVC =  FORCED SERVICE CLASS IN DISPLAY CODE.
*                *DF* MAY ALSO BE SELECTED FOR THE SERVICE CLASS. 
*                *DF* WILL SELECT THE USER DEFAULT SERVICE CLASS FOR
*                THE ORIGIN TYPE OF THE FILE. 
* 
*         FA =   FORCED ABORT CODE (IF INPUT FILE)
*                ABORT CODES ARE AS DEFINED IN *COMSDSP*. 
* 
*         FNT =  NFL OFFSET OF FNT ENTRY. 
* 
*         RC  =  REPEAT COUNT.
* 
*         BC =   BINARY CARD SEQUENCE ERROR DATA. 
* 
*         COUNT = NUMBER OF CARDS READ. 
* 
*         EQID = LEFT JUSTIFIED, ZERO FILLED, DISPLAY CODE EQUIPMENT
*                IDENTIFICATION FOR CARD READER.
*                FOR *RBF*, EQID IS A TERMINAL NAME.
*                FOR *BATCHIO*, EQID IS THE MACHINE ID AND
*                EST ORDINAL OF THE CARD READER.
* 
*         JSN =  JOB SEQUENCE NAME.  (ALPHANUMERIC CHARACTERS ONLY.)
*                JSN OF SUBSYSTEM IF *FRSI* FLAG SET, OR JSN TO SET 
*                IF *FRFJ* FLAG SET.
* 
*         RA  =  EOI RANDOM ADDRESS OF FILE.
* 
*         DD =   DATA DECLARATION (DISPLAY CODE).  DEFINES THE
*                DATATYPE OF THE FILE, WHEN THE FILE IS DESTINED FOR
*                A REMOTE MAINFRAME.
* 
*                C6 = 6-BIT CHARACTER DATA. 
*                C8 = 8-BIT CHARACTER DATA. 
*                US = UNDEFINED DATATYPE/STRUCTURED FILE. 
*                UU = UNDEFINED DATATYPE/UNSTRUCTURED FILE. 
* 
*         EFLAGS = FLAGS INDICATING WHICH PARAMETERS ARE SPECIFIED
*                IN THE EXTENDED PARAMETER BLOCK. 
* 
*               BIT         DESCRIPTION 
*                17          RESERVED 
*                16          RESERVED 
*                15          RESERVED 
*                14          RESERVED 
*                13          RESERVED 
*                12          RESERVED 
*                11          RESERVED 
*                10          CHARGE/PROJECT (*SSJ=*)
*                9           DO NOT VALIDATE SERVICE CLASS (*SSJ=*) 
*                8           SPECIAL REQUEUE OPERATION (*SSJ=*) 
*                7           USE ENCRYPTED PASSWORD (*SSJ=*)
*                6           USE ORIGIN DEFAULT SERVICE CLASS (*SSJ=*)
*                5           CONTROL POINT AND SSID SPECIFIED 
*                4           DO NOT VALIDATE PASSWORD (*SSJ=* ONLY) 
*                3           SUBSYSTEM PROCESSING (*SSJ=* ONLY) 
*                2           CREATOR USER/FAMILY NAMES (*SSJ=* ONLY)
*                1           OWNER USER/FAMILY NAMES (*SSJ=* ONLY)
*                0           DATA DECLARATION 
* 
*         IF THE *SUBSYSTEM PROCESSING* BIT IS SET, THE CALLER IS 
*         TREATED AS IF IT WERE A SUBSYSTEM.  IN PARTICULAR, THE
*         FOLLOWING IS TRUE - 
*           - ERROR PROCESSING MAY BE DONE ON USER COMMAND ERRORS,
*             AND ON OTHER ERRORS WHICH DO NOT NORMALLY ALLOW 
*             ERROR PROCESSING. 
*           - THE OWNER USER/FAMILY (AND OTHER SYSTEM SECTOR FIELDS)
*             WILL BE SET FROM THE USER COMMAND, INSTEAD OF BEING 
*             PROPAGATED FROM THE CALLER-S INPUT FILE SYSTEM SECTOR.
*           - THE USER INDEX MAY BE SPECIFIED IN THE TID BLOCK
*             ALONG WITH THE USER NAME. 
*           - BINARY CARD SEQUENCE ERROR DATA MAY BE SPECIFIED. 
* 
*         IF THE *SPECIAL REQUEUE* FLAG IS SET, MOST FIELDS SPECIFIED 
*         IN THE PARAMETER BLOCK AND THE EXTENDED PARAMETER BLOCK WILL
*         BE IGNORED.  THIS OPTION IS USED TO REQUEUE AN ATTACHED QUEUE 
*         FILE WITHOUT CHANGING EXISTING SYSTEM SECTOR AND QFT VALUES.
*         THE ONLY PARAMETERS THAT WILL NOT BE IGNORED ON A *SPECIAL
*         REQUEUE* ARE THE PRIORITY AND THE REPEAT COUNT. 
* 
*         THE *DO NOT VALIDATE SERVICE CLASS* FLAG IS USED ONLY IF THE
*         FORCED SERVICE CLASS FLAG IN FET+1 IS SET.  THE BIT USED TO 
*         SELECT THE ORIGIN DEFAULT SERVICE CLASS WILL OVERRIDE THE 
*         SELECTION OF THE FLAG TO NOT VALIDATE THE SERVICE CLASS.
* 
*         OUN =  OWNER USER NAME (*SSJ=* ONLY). 
* 
*         IRTADDR = IMPLICIT REMOTE TEXT ADDRESS (*SSJ=* ONLY). 
*                ADDRESS OF BLOCK CONTAINING IMPLICIT REMOTE TEXT.
*                THE FIRST WORD OF THE BLOCK CONTAINS THE LENGTH OF 
*                THE TEXT (IN CHARACTERS).  THE REST OF THE BLOCK 
*                CONSISTS OF 1 - 32B WORDS OF DISPLAY-CODE TEXT.
* 
*         OFN =  OWNER FAMILY NAME (*SSJ=* ONLY). 
* 
*         ERTADDR = EXPLICIT REMOTE TEXT ADDRESS. 
*                ADDRESS OF BLOCK CONTAINING EXPLICIT REMOTE TEXT.
*                THE FIRST WORD OF THE BLOCK CONTAINS THE LENGTH OF 
*                THE TEXT (IN CHARACTERS).  THE REST OF THE BLOCK 
*                CONSISTS OF 1 - 32B WORDS OF DISPLAY-CODE TEXT.
* 
*         CUN =  CREATOR USER NAME (*SSJ=* ONLY). 
* 
*         CP =   CONTROL POINT SELECTION (SUBSYSTEM INITIATION).
* 
*         SSID = SUBSYSTEM ID (SUBSYSTEM INITIATION). 
* 
*         CFN =  CREATOR FAMILY NAME (*SSJ=* ONLY). 
* 
*         ENCRYPTED PASSWORD FOR INPUT FILES (*SSJ=* ONLY). 
          SPACE  4,20 
***       ACCOUNT DAYFILE MESSAGES. 
* 
* 
*         *ABLQ, C1, JSN, YYMMDD, HHMMSS, DC.*
*         *ABLQ, C2, XXXXXX.XXXKUNS.* 
*                QUEUED FILE WITH JOB SEQUENCE NAME JSN AND 
*                DISPOSITION CODE DC HAS BEEN ROUTED TO THE 
*                QUEUE ON DATE YYMMDD AT TIME HHMMSS. 
*                THE FILE HAS A DISPOSITION CODE OF DC AND IS 
*                XXXXXX.XXX THOUSAND PRU-S IN LENGTH. 
* 
*         *ARRQ, C1, JSN, YYMMDD, HHMMSS, DC.*
*         *ARRQ, C2, XXXXXX.XXXKUNS.* 
*                QUEUED FILE CREATED ON DATE YYMMDD AT TIME 
*                HHMMSS WITH ORIGINAL JOB SEQUENCE NAME JSN 
*                HAS BEEN REENTERED INTO THE ACTIVE QUEUE.
*                THE FILE HAS A DISPOSITION CODE OF DC AND IS 
*                XXXXXX.XXX THOUSAND PRUS IN LENGTH.
* 
*         *SIUN, USERNAME.* 
*                THE INPUT FILE BEING ROUTED HAS AN INVALID USERNAME. 
          SPACE  4
***       DAYFILE MESSAGES. 
* 
*         THE FOLLOWING ERROR DESCRIPTION WILL CAUSE *DSP* TO ABORT 
*         UNCONDITIONALLY (UNLESS THE CALLER IS A SUBSYSTEM OR
*         HAS THE SUBSYSTEM PROCESSING BIT SET).
* 
*         * DSP - INCORRECT REQUEST.* 
*                CAN INDICATE ONE OF THE FOLLOWING CONDITIONS.
*                1. DSP NOT CALLED WITH RECALL. (DOES NOT APPLY WHEN
*                   CALLED BY A SUBSYSTEM.) 
*                2. PARAMETER LIST ADDRESS OUT OF RANGE.
*                3. AN INCORRECT TEXT LENGTH WAS SPECIFIED IN AN
*                   IMPLICIT OR EXPLICIT REMOTE TEXT BLOCK. 
*                4. A NON-*SSJ=* PROGRAM HAS SPECIFIED ONE OF THE 
*                   FOLLOWING - CUN, CFN, IRTADDR.
*                5. A NON-*SSJ=* AND NON-*SYOT* PROGRAM HAS SPECIFIED 
*                   ONE OF THE FOLLOWING DISPOSITION CODES - SO, SS.
*                6. A JOB WITHOUT SYSTEM ORIGIN PRIVILEGES ATTEMPTED
*                   TO INITIATE A SUBSYSTEM.
*                7. THE SPECIFIED SUBSYSTEM DID NOT EXIST.
*                8. THE SPECIFIED SUBSYSTEM WAS ALREADY ACTIVE. 
*                9. THE SPECIFIED SUBSYSTEM NAME AND SUBSYSTEM ID 
*                   DID NOT MATCH.
*               10. A ZERO SUBSYSTEM ID WAS SPECIFIED ON A SUBSYSTEM
*                   INITIATION. 
*               11. A SUBSYSTEM ID AND/OR A CONTROL POINT WAS SPECIFIED 
*                   WITHOUT SPECIFYING SUBSYSTEM INITIATION.
*               12. THE FORCED JSN SPECIFIED CONTAINED AT LEAST ONE 
*                   NON-ALPHANUMERIC CHARACTER. 
* 
*         * DSP - USER ACCESS NOT VALID.* 
*                THE CALLER WAS NOT VALIDATED TO SPECIFY ONE OF THE 
*                FOLLOWING  - DLID, SLID, DD. 
* 
*         * DSP - COMPLETE BIT ALREADY SET.*
*                THE COMPLETE BIT HAS NOT BEEN CLEARED BEFORE 
*                DSP WAS CALLED.
* 
*         * DSP - I/O SEQUENCE ERROR.*
*                A REQUEST WAS MADE ON A BUSY FILE. 
* 
* 
*         THE FOLLOWING ERROR CONDITIONS WILL CAUSE *DSP* TO ABORT
*         IF CALLED BY A NON-SUBSYSTEM JOB. 
* 
*         * DSP - INCORRECT USER COMMAND.*  (ERR=34)
*                USER ATTEMPTED TO ROUTE AN INPUT FILE WITH AN
*                IMPROPER USER COMMAND. 
* 
*         * DSP - USER SECURITY COUNT EXHAUSTED.* (ERR=47). 
*                THE USER ATTEMPTED TO ROUTE AN INPUT FILE
*                TO A USER NAME WHICH HAS EXHAUSTED IT-S
*                SECURITY COUNT.
* 
* 
*         THE FOLLOWING MESSAGES WILL BE ISSUED IF BIT 12 OF WORD 
*         ONE IS NOT SET. 
* 
*         * ERROR IN ROUTE FUNCTION, LFN = FILENAM.*
*                INFORMATIVE MESSAGE TO SYSTEM DAYFILE STATING AN 
*                ERROR OCCURED WHILE ROUTING *FILENAM*. 
* 
*         * DSP - FILE NAME ERROR.*  (ERR=1). 
*                AN ATTEMPT WAS MADE TO CREATE A FILE WITH AN INCORRECT 
*                FILE NAME. 
* 
*         * DSP - FILE NOT ON MASS STORAGE.*  (ERR=2).
*                AN ATTEMPT WAS MADE TO ROUTE A FILE NOT ON 
*                MASS STORAGE.
* 
*         * DSP - INCORRECT FILE TYPE.*  (ERR=3). 
*                THE FILE BEING PROCESSED IS NOT A QFFT,
*                OR LOFT FILE TYPE. 
* 
*         * DSP - IMMEDIATE ROUTING - NO FILE.*  (ERR=6). 
*                THE SPECIFIED FILE FOR THE IMMEDIATE ROUTE COULD 
*                NOT BE FOUND.
* 
*         * DSP - INCORRECT DISPOSITION CODE.*  (ERR=7).
*                SPECIFIED DISPOSITION CODE IS NOT RECOGNIZED.
* 
*         * DSP - UNDEFINED SERVICE CLASS.*  (ERR=11).
*                THE SPECIFIED SERVICE CLASS IS NOT DEFINED.
* 
*         * DSP - DEFERRED ROUTING NOT ALLOWED.* (ERR=13).
*                A FILE CANNOT BE DEFERRED ROUTED IF ANY ONE OF THE 
*                FOLLOWING IS SPECIFIED - DD, IRTADDR, ERTADDR. 
* 
*         * DSP - INCORRECT DATA DECLARATION.* (ERR=14).
*                THE SPECIFIED DATA DECLARATION IS NOT RECOGNIZED.
* 
*         * DSP - INCORRECT LID.* (ERR=15). 
*                THE SPECIFIED SLID OR DLID IS EITHER AN INCORRECT
*                NAME, OR WAS NOT FOUND IN THE LID TABLE. 
* 
*         * DSP - CANNOT ROUTE JOB INPUT FILE.*  (ERR=16).
*                THE JOB INPUT FILE CAN NOT BE ROUTED.
* 
*         * DSP - FILE ON REMOVABLE DEVICE.*  (ERR=20). 
*                A FILE ON A REMOVABLE DEVICE CAN NOT BE ROUTED.
* 
*         * DSP - INCORRECT TID.*  (ERR=21).
*                CAN INDICATE ONE OF THE FOLLOWING CONDITIONS.
*                1. USER NAME, FAMILY NAME PARAMETERS NOT IN
*                CM FIELD LENGTH. 
*                2. TID IS GREATER THAN OR EQUAL TO *IDLM* FOR
*                BATCH JOBS.
* 
*         * DSP - FORMS CODE NOT ALPHANUMERIC.*  (ERR=22).
*                FORMS CODE MUST CONSIST OF TWO ALPHANUMERIC
*                CHARACTERS.
* 
*         * DSP - INCORRECT INTERNAL CHARACTERISTICS.*  (ERR=23). 
*                THE SPECIFIED INTERNAL CHARACTERISTICS WERE NOT VALID. 
* 
*         * DSP - QUEUED FILE READ ERROR.* (ERR=24).
*                A READ ERROR WAS ENCOUNTERED ON THE SYSTEM SECTOR
*                OF A PREVIOUSLY ROUTED FILE. 
* 
*         * DSP - QFT FULL.*  (ERR=25). 
*                THERE IS NO ROOM IN THE QFT FOR CURRENT USE. 
* 
*         * DSP - THIS ROUTING NOT ALLOWED.*  (ERR = 26). 
*                AN ATTEMPT TO CHANGE THE QUEUE TYPE OF A DEFERRED
*                ROUTED FILE WAS MADE.  (TO CHANGE THE QUEUE TYPE OF A
*                DEFERRED ROUTED FILE, THE FILE MUST FIRST BE CHANGED 
*                TO A LOCAL FILE.)
* 
*         * DSP - DEVICE FULL.*  (ERR=27).
*                THERE IS NO ROOM ON THE DEVICE FOR CURRENT USE.
* 
*         * DSP - MASS STORAGE ERROR.*  (ERR=30). 
*                A MASS STORAGE ERROR WAS ENCOUNTERED ON THE FILE.
* 
*         * JOB COMMAND ERROR. (TWENTY CHARACTERS).*  (ERR=32). 
*                A FILE BEING ROUTED TO THE INPUT FILE HAS AN 
*                ERROR IN ITS JOB COMMAND. THE FIRST TWENTY CHARACTERS
*                ARE DISPLAYED IN THE MESSAGE.
* 
*         * DSP - TOO MANY DEFERRED BATCH JOBS.*  (ERR=33). 
*                USER HAS MORE JOBS IN THE SYSTEM THAN ALLOWED. 
*                THIS CHECK IS IGNORED FOR USERS WITH SYSTEM ORIGIN 
*                PRIVILEGES.
* 
*         * DSP - DEVICE INACCESSIBLE.*  (ERR=35).
*                DSP WAS PREVENTED FROM SUCCESSFUL COMPLETION BECAUSE 
*                OF AN INACCESSIBLE DEVICE CONDITION. 
* 
*         * DSP - INCORRECT FILE MODE.*  (ERR=36).
*                USER ATTEMPTED TO ROUTE A FILE WHICH WAS IN
*                EXECUTE ONLY MODE. 
* 
*         * DSP - INCORRECT EXTERNAL CHARACTERISTICS.* (ERR=37).
*                USER SPECIFIED AN EXTERNAL CHARACTERISITIC VALUE THAT
*                WAS NOT LEGAL FOR THE DISPOSITION CODE SPECIFIED.
*                THE USER SHOULD RETRY USING A DIFFERENT VALUE. 
* 
*         * DSP - INCORRECT ORIGIN TYPE.* (ERR=40). 
*                CAN INDICATE ONE OF THE FOLLOWING CONDITIONS.
*                1. THE ORIGIN TYPE WAS SPECIFIED BY A NON-SYSTEM 
*                   ORIGIN JOB. 
*                2. INTERACTIVE ORIGIN (IAOT) WAS SPECIFIED FOR AN
*                   INPUT FILE. 
*                3. A FORCED JSN WAS SPECIFIED BY A NON-SYSTEM ORIGIN 
*                   JOB.
* 
*         * DSP - INCORRECT SPACING CODE.*  (ERR=41). 
*                SPACING CODE VALUE IS GREATER THAN 77B.
* 
*         * DSP - INCORRECT JOB ABORT CODE.* (ERR=42).
*                JOB ABORT CODE IS NOT IN RANGE.
* 
*         * DSP - INCORRECT SERVICE CLASS.*  (ERR=45).
*                THE USER IS NOT VALIDATED TO SELECT THE SPECIFIED
*                SERVICE CLASS. 
* 
*         * DSP - ALTERNATE FAMILY NOT ALLOWED.*  (ERR=46). 
*                THE USER IS NOT VALIDATED TO ROUTE A JOB 
*                TO A DIFFERENT FAMILY. 
* 
*         * DSP - USER SECURITY COUNT EXHAUSTED.*  (ERR=47).
*                THE SECURITY COUNT FOR THE USER NAME SPECIFIED HAS 
*                BEEN DECREMENTED TO ZERO.
* 
*         * DSP - JSN ALREADY IN SYSTEM.*  (ERR=50).
*                THE FORCED JSN SPECIFIED IS ALREADY IN USE BY ANOTHER
*                JOB IN THE SYSTEM OR IS THE SAME AS A SUBSYSTEM NAME.
* 
*         * DSP - ALTERNATE USER NOT ALLOWED.*  (ERR=51). 
*                THE USER IS NOT VALIDATED TO ROUTE A JOB TO
*                ANOTHER USER NAME. 
          SPACE  4,10 
***       OPERATOR MESSAGES.
* 
*         THE FOLLOWING OPERATOR MESSAGES WILL BE DISPLAYED AT
*         THE USERS CONTROL POINT UPON OCCURANCE OF THE SPECIFIED 
*         EVENT.
* 
*         * QFT FULL.*
*                INDICATES THAT THE SYSTEM HAS NO AVAILABLE QFTS
*                AT THIS TIME.  *DSP* WILL WAIT FOR AN AVAILABLE
*                QFT UNLESS DROPPED BY THE OPERATOR.
* 
*         * TRACK LIMIT.* 
*                INDICATES THAT THE SYSTEM HAS RUN OUT OF TRACK 
*                SPACE.  *DSP* WILL WAIT FOR AVAILABLE TRACK
*                SPACE UNLESS DROPPED BY THE OPERATOR.
          SPACE  4,10 
***       ZERO LEVEL OVERLAYS CALLED. 
* 
* 
*         0AV - VERIFY USER NAME. 
*         0BF - BEGIN FILE. 
*         0DF - DROP FILE.
*         0DQ - DROP QUEUE FILE.
*         0QM - ISSUE QUEUE FILE ACCOUNTING MESSAGE.
*         0VJ - VERIFY JOB/USER STATMENTS.
          EJECT 
*         COMMON DECKS. 
  
  
*CALL     COMPMAC 
*CALL     COMSACC 
*CALL     COMSCPS 
          LIST   X
*CALL     COMSDSP 
          LIST   -X 
*CALL     COMSEJT 
*CALL     COMSEVT 
*CALL     COMSJCE 
*CALL     COMSJIO 
*CALL     COMSLFD 
*CALL     COMSMSP 
*CALL     COMSPFM 
*CALL     COMSPIM 
*CALL     COMSSSD 
          LIST   X
*CALL     COMSSSE 
          LIST   -X 
*CALL     COMSSSJ 
          LIST   X
*CALL     COMSWEI 
          LIST   -X 
*CALL     COMSZOL 
          TITLE  MACRO DEFINITIONS. 
**        DRIN - DEFAULT ROUTING INFORMATION. 
* 
*         DRIN   DC,EX,IC,QT
* 
*         ENTRY  *DC* = DISPOSITION CODE MNENONIC 
*                *EX* = EXTERNAL CHARACTERISTICS CODE.
*                *IC* = INTERNAL CHARACTERISTICS CODE.
*                *QT* = QUEUE TYPE. 
  
  
          PURGMAC  DRIN 
  
 DRIN     MACRO  DC,EX,IC,QT
          MACREF DRIN 
 .A       IF     DEF,DC_$ 
          VFD    12/0L_DC,6/QT,3/EX,3/IC
 .A       ENDIF 
 DRIN     ENDM
 ERROR    SPACE  4
**        ERROR - SET ERROR CODE. 
* 
*         ERROR  ER 
* 
*         ENTRY  *ER* = ERROR CODE. 
  
  
          PURGMAC  ERROR
  
 ERROR    MACRO  E
          MACREF ERROR
          LDN    E
          RJM    ERR
          ENDM
 OVERLAY  SPACE  4
**        OVERLAY - GENERATE OVERLAY CONSTANTS. 
* 
* 
*         OVERLAY  (TEXT),OVL 
* 
*         ENTRY  *TEXT* = TEXT OF SUBTITLE. 
*         *OVL* = ORIGIN OF OVERLAY 
  
  
 .N       SET    0
 OVLB     MICRO  1,, 3D      BASE OVERLAY NAME
  
  
          PURGMAC OVERLAY 
  
 OVERLAY  MACRO  TEXT,OVL 
          MACREF OVERLAY
          QUAL
 .N       SET    .N+1 
 .M       MICRO  .N,1, ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789 
 .O       MICRO  1,3, "OVLB"".M"
          QUAL   ".O" 
          TTL    DSP/".O" - TEXT
          TITLE 
          IDENT  ".O",OVL    TEXT 
*COMMENT  DSP - TEXT
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
          ORG    OVL
          LJM    *
          UJN    *-2
          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 
 .A       IFC    NE,$NM$SSSC$ 
 .SCL     RMT 
          INDEX  NM,1R_DF    TX 
 .SCL     RMT 
 .SCLVSP  RMT 
          INDEX  NM,MN_MK    TX 
 .SCLVSP  RMT 
 .A       ENDIF 
 SCLASS   ENDM
  
  
 SCL$     EQU    0           ONLY PROCESS CLASSES WITH JCB-S
*CALL     COMSSCD 
 SUBSYST  SPACE  4,10 
**        SUBSYST - GENERATE SUBSYSTEM TABLE. 
* 
*         SUBSYST  NAME,ID,PR,PP,AUTO,DEF,DCP,CP,PROC,ABT 
* 
*         ENTRY  *NAME*= 3 CHARACTER SUBSYSTEM NAME.
*                *ID* = SUBSYSTEM ID. 
*                *PP* = PP NAME FOR PP-INITIATED SUBSYSTEM. 
* 
*         GENERATE TABLE OF SUBSYSTEM NAMES AND ID-S FOR
*         NON-PP-INITIATED SUBSYSTEMS.
* 
*T        24/  4LNAME, 12/  SSID
  
  
          PURGMAC  SUBSYST
  
 SUBSYST  MACRO  NM,ID,PT,PP,AU,DF,DC,CP,PR,AB
 .A       IFC    EQ,$PP$$ 
 .SUB     RMT 
 .NM      EQU    *
          VFD    24/4L_NM_ ,12/ID 
 TSUBE    EQU    *-.NM
 .SUB     RMT 
 .A       ENDIF 
 .SSN     RMT 
 .NM_$    EQU    *
          VFD    24/4L_NM 
 TSSNE    EQU    *-.NM_$
 .SSN     RMT 
 SUBSYST  ENDM
  
  
 SUB$     EQU    1           ASSEMBLE *SUBSYST* MACRO 
*CALL     COMSSSD 
          TITLE  DIRECT LOCATION ASSIGNMENTS
**        DIRECT LOCATION ASSIGNMENTS.
  
  
 T8       EQU    16          TEMPORARY STORAGE
 FS       EQU    20 - 24     FST ENTRY (5 LOCATIONS)
 QA       EQU    26          ORDINAL OF QFT ENTRY (*0DQ*) 
 ST       EQU    27          STATUS FLAGS 
 CN       EQU    30 - 34     ASSEMBLE BUFFER (5 LOCATIONS)
 RI       EQU    35 - 36     RANDOM INDEX 
 JF       EQU    35          JOB FIELD LENGTH (USED BY 0VJ) 
 UN       EQU    40 - 44     USER NAME (5 LOCATIONS)
 OT       EQU    46          ORIGIN TYPE
 ER       EQU    47          ERROR STATUS 
 FA       EQU    57          FST ADDRESS
 FN       EQU    60 - 64     FNT ENTRY (5 LOCATIONS)
 FB       EQU    65 - 66     FLAG BITS FROM REQUEST BLOCK (2 LOCATIONS) 
 QT       EQU    67          QUEUE TYPE 
          SPACE  4,20 
**        STATUS WORD (ST) BIT DEFINITIONS. 
* 
*         BIT    SETTING     EXPLAINATION 
* 
*         0      1           NOT A SUBSYSTEM (SSFL) 
*         1      1           FILE PREVIOUSLY ROUTED (DSFL)
*         2      1           ISSUE *UADM* FUNCTION (IUFL) 
*         3      1           FILE CREATION NEEDED (FCFL)
*         4      1           SCHEDULER NEEDED (SCFL)
*         5      1           CONTROL POINT IS *SYOT* (SYFL) 
*         6      1           DISPOSITION CODE SPECIFIED (DCFL)
*         7      1           CALLING PROGRAM IS *SSJ=* (SJFL) 
*         10     1           DESTINATION LID SPECIFIED (DLFL) 
*         11     1           SOURCE LID SPECIFIED (SLFL)
*         12     1           FILE LOCKED (LKFL) 
*         13     1           FILE IS BEING REQUEUED (RQFL)
  
  
 SSFL     EQU    1           SUBSYSTEM FLAG 
 DSFL     EQU    2           PREVIOUSLY ROUTED FLAG 
 IUFL     EQU    4           ISSUE *UADM* FLAG
 FCFL     EQU    10B         FILE CREATION FLAG 
 SCFL     EQU    20B         SCHEDULER NEEDED FLAG
 SYFL     EQU    40B         *SYOT* CONTROL POINT FLAG
 DCFL     EQU    100B        DISPOSITION CODE SPECIFIED FLAG
 SJFL     EQU    200B        *SSJ=* PROGRAM FLAG
 DLFL     EQU    400B        DESTINATION LID FLAG 
 SLFL     EQU    1000B       SOURCE LID FLAG
 LKFL     EQU    2000B       FILE LOCKED FLAG 
 RQFL     EQU    4000B       FILE BEING REQUEUED FLAG 
          SPACE  4,10 
**        SYMBOL DEFINITIONS. 
  
  
 LHLAT    EQU    7000B       LOCAL HOST LID ATTRIBUTES (H, E, V)
          SPACE  4,10 
          TITLE  MAIN PROGRAM.
**        DSP - MAIN PROGRAM. 
  
          ORG    PPFW 
  
  
 DSP      RJM    PRS         PRESET ROUTINE 
          RJM    FFQ         FIND FILE TO QUEUE 
          RJM    DDC         DETERMINE DISPOSITION CODE 
          NJN    DSP1        IF NOT CHANGE TO LOCAL FILE
          EXECUTE  3DD       LOAD *CHANGE TO LOCAL FILE* OVERLAY
          RJM    CLF         CHANGE TO LOCAL FILE 
          LJM    DSP8        RETURN INFORMATION TO PARAMETER BLOCK
  
 DSP1     RJM    VUL         VALIDATE USER LIMITS 
          RJM    SQS         SET QUEUED FILE SYSTEM SECTOR
 DSPG     PSN 
*         UJN    DSP4        (SPECIAL REQUEUE OPERATION)
  
*         PROCESS FILE DESTINATION. 
  
          RJM    SDC         SET DISPOSITION CODE 
          EXECUTE  3DA       LOAD FILE DESTINATION ROUTINES 
          RJM    SFD         SET FILE DESTINATION 
          LDD    FB+1 
          SHN    21-13
          PJN    DSP2        IF NOT SUBSYSTEM INITIATION
          RJM    PSI         PROCESS SUBSYSTEM INITIATION 
 DSP2     LDD    QT 
          LMK    INQT 
          NJN    DSP3        IF NOT ROUTE TO INPUT
          RJM    VIF         VERIFY INPUT FILE
          UJN    DSP4        UPDATE SYSTEM SECTOR AND EOI 
  
 DSP3     EXECUTE  3DB       LOAD FILE ATTRIBUTE ROUTINES 
          RJM    SOD         SET OUTPUT DATA
  
*         UPDATE SYSTEM SECTOR AND EOI. 
  
 DSP4     EXECUTE  3DC       LOAD SYSTEM SECTOR/EOI UPDATE ROUTINES 
 DSPH     PSN 
*         UJN    DSP5        (SPECIAL REQUEUE OPERATION)
          RJM    BSE         CHECK FOR BINARY CARD SEQUENCE ERRORS
          RJM    PUF         PROCESS USER/FAMILY NAMES
          RJM    SCP         SET CHARGE/PROJECT DATA
          RJM    SLI         SET LOGICAL IDENTIFIERS
          RJM    PUP         PROCESS UJN PRESENCE 
          LDD    MA          SET FN IN SYSTEM SECTOR
          CWD    FN 
          CRM    FNSS,ON
 DSP5     LDD    FB+1        CHECK FOR DEFERRED ROUTE 
          SHN    21-0 
          PJN    DSP5.1      IF IMMEDIATE ROUTE 
  
*         PROCESS DEFERRED ROUTE. 
  
          AOD    FS+4        SET FILE NOT BUSY
          AOM    WQSA        DO NOT PRESERVE FILE 
          RJM    AEO         ATTACH QFT TO EJT
 DSP5.1   LDN    IUFL        SET FLAG TO ISSUE *UADM* FUNCTION
          RAD    ST 
  
*         WRITE QUEUED FILE SYSTEM SECTOR.
  
          RJM    WQS         WRITE QUEUED FILE SYSTEM SECTOR
  
*         SAVE SYSTEM SECTOR FIELDS.
  
          LDN    QFTE*5-1    SAVE QFT ENTRY 
          STD    T1 
 DSP6.1   LDM    IOSS,T1
          STM    QBUF,T1
          SOD    T1 
          PJN    DSP6.1      IF MORE TO MOVE
          LDM    IOSS+5*JSNQ+0  SAVE JSN
          STM    DSPD 
          LDM    IOSS+5*JSNQ+1
          STM    DSPE 
          LDD    FB+1 
          SHN    21-0 
          MJN    DSP7        IF DEFERRED ROUTE
 DSPI     PSN 
*         UJN    DSP6.2      (SPECIAL REQUEUE OPERATION)
  
*         WRITE QUEUED FILE EOI SECTOR (IMMEDIATE ROUTE ONLY).
  
          RJM    IES         INITIALIZE EOI SECTOR
          RJM    PRT         PROCESS REMOTE TEXT
          RJM    WES         WRITE EOI SECTOR 
  
*         ISSUE ACCOUNTING MESSAGE FOR IMMEDIATE ROUTE. 
  
 DSP6.2   RJM    IAM         ISSUE ACCOUNTING MESSAGE 
  
*         UPDATE AND RELEASE QFT. 
  
 DSP7     RJM    CLE         COMPLETE LOCAL ENTRY 
          LDN    0
*         LDN    1           (IF ABORTED INPUT FILE)
 DSPF     EQU    *-1
          ZJN    DSP7.1      IF NOT ABORTED INPUT FILE
          STM    QBUF+ENTQ*5+4   SET ABORTED FLAG IN QFT
          LDN    0
          STM    QBUF+ENTQ*5+3
 DSP7.1   LDN    QFTE-1 
          STD    T5 
          SFA    QFT,QA      GET ADDRESS OF QFT ENTRY 
          ADN    1           WRITE QFT DATA 
          CWM    QBUF+5,T5
          SBN    QFTE        WRITE INTERLOCK WORD 
          CWM    QBUF,ON
  
*         REQUEST SCHEDULER IF THIS IS FOR AN INPUT FILE. 
  
          LDD    ST          CHECK IF SCHEDULER NEEDED
          LPN    SCFL 
          ZJN    DSP8        IF SCHEDULER NOT NEEDED
          LDN    ZERL        CLEAR PARAMETERS FOR CALL
          CRD    CM 
          AOD    CM+2        SET SCHEDULER FLAG 
          MONITOR  RSJM      REQUEST SCHEDULER
  
*         RETURN REQUIRED INFORMATION TO PARAMETER BLOCK. 
  
 DSP8     LDD    FB 
          SHN    21-5 
          PJN    DSPX        IF FILE NAME NOT TO BE RETURNED
          LDN    ZERL        RETURN INFORMATION TO CALLER 
          CRD    FN 
          LDC    **          (SET BY PRESET)
 DSPC     EQU    *-1
          STD    FN+4 
          LDC    *           (FIRST PART OF JSN)
 DSPD     EQU    *-1
          STD    FN 
          LDC    *           (SECOND HALF OF JSN) 
 DSPE     EQU    *-1
          STD    FN+1 
          UJN    DSP9        RETURN JSN TO CALLER 
  
*         RETURN HERE FROM ERROR PROCESSOR. 
  
 DSPX     RJM    GFA         READ FIRST WORD OF PARAMETER BLOCK 
          CRD    FN 
 DSP9     LDD    FN+3        SET ERROR FLAG 
          SCN    77 
          LMC    ** 
 DSPB     EQU    *-1         (ERROR CODE SET BY *ERP*)
          STD    FN+3 
          LDD    FN+4        SET FUNCTION COMPLETE
          SCN    1
          LMN    1
          STD    FN+4 
          RJM    GFA         REWRITE FIRST WORD OF PARAMETER BLOCK
          CWD    FN 
          LJM    DPP         DROP PP
          SPACE  4,10 
**        MEMORY LOCATIONS. 
  
 CUAV     CON    0           *COMPCUA* USER ACCESS PRIVILEGES 
 DDEC     CON    0           DATA DECLARATION 
 DLAT     CON    LHLAT       ATTRIBUTES OF DLID 
 DLID     CON    0,0         DESTINATION LOGICAL ID 
 EBIT     CON    0,0         EXTENDED PARAMETER BLOCK FLAG BITS 
 EJTO     CON    0           EJT ORDINAL
 ERTL     CON    0           EXPLICIT REMOTE TEXT LENGTH
 FJSN     BSS    2           FORCED JSN OR SUBSYSTEM NAME 
 FSJS     CON    0           FORCED JSN FLAG
 FSOT     CON    4000        FORCED ORIGIN TYPE 
 FSSC     CON    0           FORCED SERVICE CLASS 
 INFL     CON    0           INPUT FLAGS
 IRTL     CON    0           IMPLICIT REMOTE TEXT LENGTH
 JBOT     CON    0           JOB ORIGIN TYPE
 LFAL     CON    0           LOCAL FILE ACCESS LEVEL
 LFST     CON    0           LOCAL FILE STATUS
 SBCP     CON    0           CP NUMBER FOR SUSBYSTEM INITIATION 
 SBID     CON    0           SUBSYSTEM ID 
 SLAT     CON    LHLAT       ATTRIBUTES OF SLID 
 SLID     CON    0,0         SOURCE LOGICAL ID
          SPACE  4,10 
*         BUFFER DEFINITIONS AND LOAD ADDRESSES.
  
  
 .OVL0    MAX    ZBFL,ZDQL   LENGTH OF *OVL0* BUFFER
  
 OVL0     EQU    EPFW-.OVL0  LOAD ADDRESS FOR *0BF* AND *0DQ* 
 OVL1     EQU    BFMS-ZAVL   LOAD ADDRESS FOR *0AV* 
 OVL2     EQU    EPFW-ZDFL   LOAD ADDRESS FOR *0DF* 
 OVL3     EQU    BFMS-ZVJL   LOAD ADDRESS FOR *0VJ* 
 OVL6     EQU    BFMS-ZDQL   LOAD ADDRESS FOR *0DQ* 
 OVL7     EQU    BFMS-QFTE*5-ZQML  LOAD ADDRESS FOR *0QM* 
  
 QBUF     EQU    BFMS-QFTE*5 QFT ENTRY BUFFER 
 EBUF     EQU    QBUF-502    EOI SECTOR BUFFER
  
 SBUF     EQU    OVL3-5-502  SECTOR BUFFER FOR INPUT FILE 
 STMT     EQU    SBUF+2      JOB/USER COMMAND 
          TITLE  RESIDENT ROUTINES. 
 DPP      SPACE  4,10 
**        DPP - DROP PP.
  
  
 DPP      BSS    0           ENTRY
 DPPA     LDN    0
*         LDN    1           (SET FILE NOT BUSY)
          ZJN    DPP1        IF *FNB* CALL NOT NEEDED 
          RJM    FNB         SET FILE NONBUSY 
 DPP1     LDD    ST          CHECK IF *UADM* TO BE ISSUED 
          LPN    IUFL 
          NJN    DPP2        IF UADM REQUEST PRESENT
          MONITOR DPPM       DROP PPU 
          UJN    DPP3        ENTER PP RESIDENT
  
 DPP2     LDN    1           SET WORD COUNT OF OPTIONS
          STD    CM+1 
          LDN    0           SPECIFY DROP OF PPU
          STD    CM+2 
          LDD    MA          UPDATE PRU LIMIT 
          CWM    DPPB,CM+1
          MONITOR UADM
 DPP3     LJM    PPR         ENTER PP RESIDENT
  
  
 DPPB     CON    CICS 
*         CON    CDCS        (DEFERRED ROUTE) 
          CON    ACLW 
          CON    0D*100+18D 
 DPPC     CON    0
          CON    0
 EER      SPACE  4,15 
**        EER - EVALUATE MASS STORAGE ERROR RETURN. 
* 
*         ENTRY  (T5) = EST ORDINAL.
*                (ST) = STATUS FLAGS. 
* 
*         EXIT   JOB IS ROLLED OUT TO WAIT FOR A DEVICE TO BECOME 
*                ACCESSIBLE IF A NON-SUBSYSTEM JOB ENCOUNTERED A
*                RECOVERABLE READ/WRITE ERROR ON THE DEVICE.
* 
*         USES   FA, IR+4.
* 
*         CALLS  FNB, *1RJ*.
* 
*         MACROS ERROR, EXECUTE, PAUSE. 
  
  
 EER      BSS    0           ENTRY
          LDC    0           CHECK FILE STATUS
 EERA     EQU    *-1
          ZJN    EER1        IF NO HIDDEN FNT ENTRY 
          STD    FA 
 EER1     LDM    RDCT        CHECK ERROR STATUS 
          SHN    21-12
          MJN    EER2        IF UNRECOVERABLE ERROR 
          LDD    ST 
          LPN    SSFL 
          NJN    EER3        IF NOT SUBSYSTEM 
 EER2     ERROR  /ERR/EC30   * MASS STORAGE ERROR.* 
  
 EER3     LDD    T5 
          STD    IR+4        SET EST ORDINAL
          RJM    FNB         CLEAN UP WORKING FILES 
          PAUSE 
          LDD    CM+1 
          NJP    DSPX        IF ERROR FLAG SET
          EXECUTE  1RJ       ROLLOUT JOB
 ERR      SPACE  4,10 
**        ERR - ERROR PROCESSOR.
* 
*         ENTRY  (A) = ERROR CODE.
*                (FA) = NFL FNT ENTRY OFFSET. 
* 
*         EXIT   TO *DSPX* AFTER PROCESSING ERROR.
*                TO *PPR* IF JOB IS TO BE ABORTED.
* 
*         USES   ER.
  
  
 ERR      SUBR               ENTRY
          STD    ER          SAVE ERROR CODE
          EXECUTE  3DE       LOAD ERROR PROCESSING OVERLAY
          RJM    ERP
*         LJM    DSPX        COMPLETE PROCESSING
*         LJM    PPR         COMPLETE PROCESSING
 FNB      SPACE  4,10 
**        FNB - SET FILE NOT BUSY.
* 
*         ENTRY  (FS - FS+4) = FST ENTRY. 
*                (FA) = NFL FNT ENTRY OFFSET. 
*                (QA) = ORDINAL OF QFT TABLE ENTRY. 
*                (FNBA) .NE. 0 IF QFT ENTRY CREATION MODE.
* 
*         EXIT   FILE SET NOT BUSY OR RETURNED IF CREATED BY *DSP*. 
*                QFT ENTRY CLEARED IF CREATION MODE.
*                (FA) = 0.
*                (QA) = 0.
* 
*         USES   FA, QA, FS - FS+4. 
* 
*         CALLS  FQI, *0DF*, *0DQ*. 
* 
*         MACROS EXECUTE, NFA.
* 
*         NOTE   (QA) .NE. 0, ONLY IF THE QFT ENTRY IS INTERLOCKED. 
  
  
 FNB      SUBR               ENTRY/EXIT 
  
*         PROCESS QFT ENTRY.
  
          LDD    QA 
          ZJN    FNB3        IF NO GLOBAL ENTRY 
          LDN    0
*         LDN    1           (CREATION MODE)
 FNBA     EQU    *-1
          ZJN    FNB1        IF NOT CREATION MODE QFT ENTRY 
*         LDN    1           DROP QFT ENTRY ONLY
          STM    OVL0-1 
          EXECUTE  0DQ,OVL0  DROP QFT ENTRY 
          UJN    FNB2        CONTINUE 
  
 FNB1     LDN    40          CLEAR QFT INTERLOCK
          RJM    FQI         FUNCTION INTERLOCK 
 FNB2     LDN    0           CLEAR GLOBAL ENTRY 
          STD    QA 
  
*         PROCESS LOCAL FNT ENTRY.
  
 FNB3     LDD    FA 
          ZJN    FNBX        IF NO FILE 
          LDN    0
*         LDN    1           (IF FILE CREATED BY *DSP*) 
 FNBB     EQU    *-1
          ZJN    FNB4        IF FILE NOT CREATED BY *DSP* 
          LDN    0           RETURN FILE
          STM    OVL2-1 
          EXECUTE  0DF,OVL2  DROP FILE
          UJN    FNB5        CONTINUE 
  
 FNB4     NFA    FA,R        SET FILE NOT BUSY
          ADN    FSTL 
          CRD    FS 
          LDD    FS+4        SET FILE NOT BUSY
          SCN    1
          LMN    1
          STD    FS+4 
          NFA    FA,R 
          ADN    FSTL 
          CWD    FS 
          LDN    0           CLEAR FNT POINTER
          STD    FA 
 FNB5     LJM    FNBX        RETURN 
 FQI      SPACE  4,10 
**        FQI - FUNCTION QFT INTERLOCK. 
* 
*         ENTRY  (A) = 0, SET QFT INTERLOCK.
*                (A) = 40, CLEAR QFT INTERLOCK. 
*                (QA) = QFT ORDINAL.
* 
*         EXIT   QFT INTERLOCK CLEARED. 
*                (A) = 0, IF OPERATION COMPLETE.
* 
*         USES   CM - CM+4. 
* 
*         MACROS DELAY, MONITOR, PAUSE, SFA.
* 
*         NOTE   IF QFT INTERLOCK CANNOT BE SET OR CLEARED, AND 
*                THE OPERATOR OVERRIDES THE JOB, SOME INTERLOCKS
*                MAY NOT BE CLEARED.
  
  
 FQI      SUBR               ENTRY/EXIT 
          STM    FQIA        PRESERVE FUNCTION
 FQI1     LDC    ** 
 FQIA     EQU    *-1
          STD    CM+1 
          LDN    0
          STD    CM+2 
          SFA    QFT,QA      GET QFT ADDRESS
          STD    CM+4 
          SHN    -14
          STD    CM+3 
          MONITOR  UTEM      UPDATE TABLE ENTRY 
          LDD    CM+1        CHECK FOR FUNCTION COMPLETE
          ZJN    FQIX        IF FUNCTION COMPLETE 
          DELAY 
          PAUSE 
          LDD    CM+1        CHECK FOR OPERATOR OVERRIDE
          LMN    ORET 
          NJN    FQI1        IF NO OVERRIDE 
          LDN    1           SET ERROR STATUS 
          LJM    FQIX        RETURN 
 GEA      SPACE  4,10 
**        GEA - GET EJT ADDRESS.
* 
*         ENTRY  (AEOA) = EJT ORDINAL.
* 
*         EXIT   (A) = ADDRESS OF EJT.
* 
*         MACROS SFA. 
  
  
 GEA      SUBR               ENTRY/EXIT 
          LDM    EJTO        LOAD EJT ORDINAL 
          SFA    EJT
          UJN    GEAX        RETURN 
 GFA      SPACE  4,10 
**        GFA - GET PARAMETER BLOCK ADDRESS.
* 
*         ENTRY  (IR+3 - IR+4) = PARAMETER BLOCK ADDRESS. 
* 
*         EXIT   (A) = ABSOLUTE ADDRESS.
  
  
 GFA      SUBR               ENTRY/EXIT 
          LDD    IR+3 
          LPN    37 
          SHN    6
          ADD    RA 
          SHN    6
          ADD    IR+4 
          UJN    GFAX        RETURN 
 RFN      SPACE  4,10 
**        RFN - READ FAMILY NAME. 
* 
*         EXIT   (A) = CM ADDRESS OF FAMILY NAME. 
* 
*         USES   CM - CM+4. 
* 
*         MACROS SFA. 
  
  
 RFN      SUBR               ENTRY/EXIT 
          LDD    CP          READ FAMILY POINTER
          ADN    PFCW 
          CRD    CM 
          SFA    EST,CM+3    READ EST 
          ADK    EQDE 
          CRD    CM 
          LDD    CM+4        SET FAMILY ADDRESS 
          SHN    3
          ADN    PFGL 
          UJN    RFNX        RETURN 
 RMS      SPACE  4,10 
**        RMS - READ MASS STORAGE.
* 
*         ENTRY  (A) = BUFFER ADDRESS.
*                (T5 - T7) = MASS STORAGE PARAMETERS. 
* 
*         EXIT   (A) .GE. 0.
* 
*         ERROR  TO *EER*.
* 
*         CALLS  RDS. 
  
  
 RMS      SUBR               ENTRY/EXIT 
          RJM    RDS
          PJN    RMSX        IF SUCCESSFUL READ 
          LJM    EER         EVALUATE ERROR RETURN
 SQO      SPACE  4,10 
**        SQO - SET QFT OWNERSHIP.
* 
*         EXIT   QFT UPDATED. 
* 
*         USES   CN - CN+4, FN - FN+4, UN - UN+4. 
* 
*         CALLS  GEA, GFO, SSJ. 
* 
*         MACROS SFA. 
  
  
 SQO3     LDD    CN+2        SET FO,UI IN SYSTEM SECTOR 
          STM    IOSS+JSNQ*5+2
          LDD    CN+3 
          STM    IOSS+JSNQ*5+3
  
 SQO      SUBR               ENTRY
          RJM    GEA         GET EJT ADDRESS
          ADK    JSNE        GET *FO,UI* FROM EJT 
          CRD    CN 
          LDD    CN+2        SET *FO,UI* IN SYSTEM SECTOR 
          ADD    CN+3 
          NJN    SQO3        IF FAMILY ORDINAL AND UI .NE. 0
          LDD    MA          SAVE FILE NAME 
          CWD    FN 
          CRD    UN 
          LDD    CP          DETERMINE FAMILY ORDINAL FROM CPA
          ADK    PFCW 
          CRD    CN 
          SFA    EST,CN+3    GET FAMILY EST ORDINAL 
          ADK    EQDE 
          CRD    CN 
          LDD    CN+4        LOAD MST ADDRESS 
          SHN    3
          ADK    PFGL 
          CRD    FN 
          CRM    FOSS,ON
*         LDN    (NONZERO)
          RJM    GFO         GET FAMILY ORDINAL 
          RJM    SSJ         CHECK FOR SSJ= BLOCK 
          ZJN    SQO1        IF NO SSJ= BLOCK PRESENT 
          ADK    UIDS        GET USER INDEX 
          UJN    SQO2        CONTINUE 
  
 SQO1     LDD    CP          GET UI FROM CPA
          ADK    UIDW 
 SQO2     CRD    CN 
          CRM    OASS,ON
          LDD    FN+4        SET FO,UI IN QFT 
          SHN    6
          LMD    CN+3 
          SCN    37          CLEAR CHARGE REQUIRED BIT
          LMD    CN+3 
          STD    CN+2 
          LDD    CN+4 
          STD    CN+3 
          LDD    MA          RESTORE FILE NAME
          CWD    UN 
          CRD    FN 
          LJM    SQO3        CONTINUE 
 SSJ      SPACE  4,10 
**        SSJ - CHECK FOR SSJ= BLOCK. 
* 
*         EXIT   (A) = 0 IF NO SSJ= BLOCK PRESENT.
*                (A) = SSJ= BLOCK ADDRESS IF PRESENT. 
* 
*         USES   CM - CM+4. 
* 
*         MACROS NFA. 
  
  
 SSJ      SUBR               ENTRY/EXIT 
          LDD    CP          CHECK FOR SSJ= 
          ADC    SEPW 
          CRD    CM 
          LDD    CM 
          LPN    4
          ZJN    SSJX        IF NOT SSJ=
          LDD    CM+3        CHECK IF SSJ= BLOCK PRESENT
          LPN    37 
          ADD    CM+4 
          ZJN    SSJX        IF NO SSJ= BLOCK 
          NFA    SSJN        SET SSJ= BLOCK ADDRESS 
          UJN    SSJX        RETURN 
 VCA      SPACE  4,14 
**        VCA - VALIDATE CENTRAL ADDRESS. 
* 
*         ENTRY  (A) = CENTRAL ADDRESS TO VALIDATE. 
* 
*         EXIT   (A) = 0, IF ADDRESS .LE. 1, OR .GE. FL.
*                (A) = CENTRAL ADDRESS IF VALID.
*                (T1 - T2) = CENTRAL ADDRESS. 
* 
*         USES   T1, T2.
  
  
 VCA1     STD    T1          CLEAR UPPER PART OF ADDRESS
 VCA2     LDN    0           SET BAD ADDRESS FLAG 
  
 VCA      SUBR               ENTRY/EXIT 
          STD    T2 
          SCN    1
          ZJN    VCA1        IF ADDRESS .LE. 1
          SCN    77 
          SHN    6
          STD    T1 
          SHN    6
          SBD    FL 
          PJN    VCA2        IF ADDRESS .GE. FL 
          LDD    T1 
          SHN    14 
          LMD    T2 
          UJN    VCAX        RETURN 
 WMS      SPACE  4,10 
**        WMS - WRITE MASS STORAGE. 
* 
*         ENTRY  (A) = BUFFER ADDRESS.
*                (T5 - T7) = MASS STORAGE PARAMETERS. 
* 
*         EXIT   (A) .GE. 0.
* 
*         ERROR  TO *EER*.
* 
*         CALLS  WDS. 
  
  
 WMS      SUBR               ENTRY/EXIT 
          RJM    WDS
          PJN    WMSX        IF SUCCESSFUL WRITE
          LJM    EER         EVALUATE ERROR RETURN
          SPACE  4,10 
**        COMMON DECKS. 
  
  
 EJT$     SET    1           CALCULATE EJT ADDRESS
 IFP$     EQU    1           ASSEMBLE REMOTE INITIALIZATION CODE
 QFT$     SET    1           CALCULATE QFT ADDRESS
*CALL     COMPGFP 
 GFO$     SET    1           CONVERT FAMILY NAME TO FAMILY ORDINAL
 GFM$     SET    1           CONVERT FAMILY ORDINAL TO FAMILY NAME
*CALL     COMPUFT 
          QUAL   MIO
 WDS      EQU    WMS         USE *WMS* IN PLACE OF *WDS*
 WEI$     SET    1           ALLOW *DSP* TO SPECIFY EOI BUFFER
*CALL     COMPWEI 
          QUAL   *
 WEI      EQU    /MIO/WEI 
          SPACE  4,10 
*         THE FOLLOWING SUBROUTINES MAY BE OVERLAID BY *DSP* OVERLAYS.
          SPACE  4,10 
 OVL4     EQU    *+5         LOAD ADDRESS FOR *DSP* OVERLAYS
  
          ERRNG  OVL2-5-*    OVERFLOW INTO *0DF*
          ERRNG  OVL0-5-*    OVERFLOW INTO *0DQ*
          TITLE  FILE INITIALIZATION ROUTINES.
 AMS      SPACE  4,20 
**        AMS - ASSIGN MASS STORAGE.
* 
*         ENTRY  (FS - FS+4) = FST ENTRY. 
*                (FA) = NFL FNT OFFSET. 
* 
*         EXIT   (FS - FS+4) = FST ENTRY. 
*                MASS STORAGE ASSIGNED. 
*                SYSTEM SECTOR AND EOI WRITTEN. 
*                (T5) = EQUIPMENT.
* 
*         USES   T5, T6, CM - CM+4, FS - FS+4.
* 
*         CALLS  PDF, WEI, WSS. 
* 
*         MACROS ENDMS, MONITOR, NFA, SETMS.
  
  
 AMS      SUBR               ENTRY/EXIT 
          LDD    FS+2 
          NJN    AMSX        IF FILE USED 
          LDD    FS+1 
          NJN    AMS2        IF FILE ASSIGNED 
  
*         ASSIGN MASS STORAGE.
  
 AMS1     LDN    ZERL        CLEAR PARAMETERS 
          CRD    CM 
          LDN    OUTS        SET *RTCM* PARAMETER FOR OUTPUT FILE 
          STD    CM+2 
          LDM    LFAL        SET ACCESS LEVEL SELECTION 
          ADN    40 
          SHN    6
          STD    CM+3 
          MONITOR  RTCM      REQUEST TRACK CHAIN
          LDD    CM+1        SET EQUIPMENT
          STD    FS 
          LDD    CM+4 
          NJN    AMS2        IF TRACK ASSIGNED
          RJM    PDF         PROCESS DEVICE FULL
          UJN    AMS1        RETRY MASS STORAGE ALLOCATION
  
*         UPDATE FNT/FST. 
  
 AMS2     STD    FS+1        SET FIRST TRACK
          STD    FS+2 
          STD    T6 
          LDD    FS          SET *EST* ORDINAL
          STD    T5 
          LDN    FSMS        SET FIRST SECTOR 
          STD    FS+3 
          LDN    14          SET FILE BUSY
          STD    FS+4 
          NFA    FA,R        WRITE FST
          ADN    FSTL 
          CWD    FS 
  
*         WRITE SYSTEM SECTOR AND EOI.
  
          SETMS  IO 
          RJM    WSS         WRITE SYSTEM SECTOR
          LDC    BFMS        ADDRESS OF EOI BUFFER
          RJM    WEI         WRITE EOI
          ENDMS 
  
*         UPDATE TRT. 
  
          LDD    T5          SET EQUIPMENT
          STD    CM+1 
          LDD    T6          SET TRACK
          LPC    3777 
          STD    CM+2 
          LDD    T7          SET SECTOR 
          STD    CM+3 
          MONITOR DTKM       DROP TRACKS AND UPDATE TRT 
          LDM    SLM         SET SECTOR COUNT 
          STM    DPPC+1 
          LDN    CDCS        SET DECREMENT FUNCTION 
          STM    DPPB 
          LJM    AMSX        RETURN 
 CSL      SPACE  4,10 
**        CSL - CHECK FOR SPECIAL LID.
* 
*         ENTRY  (A) = LID (MAY BE SPECIAL CODE). 
* 
*         EXIT   (A) = LID, IF NO SPECIAL CODE. 
*                (A) = 0 IF SPECIAL CODE = *LCZR*.
*                (A) = PID IF SPECIAL CODE = *LCPD*.
* 
*         USES   T1, CM - CM+4. 
  
  
 CSL1     SHN    14          RESTORE LID AND EXIT 
          LMD    T1 
  
  
 CSL      SUBR               ENTRY/EXIT 
          STD    T1 
          SHN    -14
          NJN    CSL1        IF NOT SPECIAL CODE
          LDD    T1 
          ZJN    CSLX        IF ZERO LID
          SBN    LCZR 
          ZJN    CSLX        IF *ZERO LID* CODE SPECIFIED 
          ERRNZ  LCPD-2      CODE DEPENDS ON VALUE
          ERRNZ  MXLC-3      CODE DEPENDS ON VALUE
  
*         CREATE HOST PID USING THE MACHINE ID. 
  
          LDK    MMFL        GET MACHINE ID 
          CRD    CM 
          LDN    1RM
          SHN    14 
          LMD    CM          MERGE *M* WITH MACHINE ID
          UJN    CSLX        RETURN 
 EDF      SPACE  4,25 
**        EDF - ENTER DEFERRED FILE.
* 
*         ENTRY  (QT) = QUEUE TYPE. 
*                (ST) = STATUS WORD.
*                (FA) = NFL FNT ENTRY OFFSET. 
* 
*         EXIT   *BFMS* CONTAINS UPDATED SYSTEM SECTOR FOR QUEUED FILE. 
*                (FS - FS+4) = QUEUED FILE FST ENTRY. 
*                (ST) = STATUS WORD.
* 
*         ERROR  TO *ERR*, IF ONE OF THE FOLLOWING OCCURS,
*                THIS ROUTING NOT ALLOWED.
* 
*         USES   QA, ST, FN - FN+4, FS - FS+4.
* 
*         CALLS  FNB, FQI.
* 
*         MACROS ERROR, NFA.
  
  
 EDF4     AOM    DPPA        SET FILE NOT BUSY
          LJM    DPP         DROP PPU 
  
 EDF      SUBR               ENTRY/EXIT 
  
*         USE QUEUE TYPE FROM SYSTEM SECTOR, IF NOT SPECIFIED IN CALL.
  
          LDD    ST          CHECK IF DISPOSITION CODE SPECIFIED
          LPC    DCFL 
          NJN    EDF1        IF DISPOSITION CODE SPECIFIED
          LDM    IOSS+JSNQ*5+4  USE QUEUE TYPE FROM SYSTEM SECTOR 
          SHN    -11
          STD    QT 
  
*         DETERMINE IF QUEUE TYPE HAS CHANGED.
  
 EDF1     LDM    IOSS+JSNQ*5+4
          SHN    -11
          LMD    QT 
          ZJN    EDF2        IF NO CHANGE IN QUEUE TYPE 
          ERROR  /ERR/EC26   * DSP - THIS ROUTING NOT ALLOWED.* 
  
 EDF2     LDN    DSFL        FLAG DATA IN SYSTEM SECTOR 
          RAD    ST 
          LDM    GQSS        GET ORDINAL NUMBER 
          STD    QA 
          LDN    0           SET *INTERLOCK* FUNCTION 
          RJM    FQI         FUNCTION QFT INTERLOCK 
          NJN    EDF4        IF ENTRY NOT INTERLOCKED 
          NFA    FA,R        READ FNT ENTRY OF FILE 
          CRD    FN 
          ADN    FSTL 
          CRD    FS 
          LDM    IOSS+JSNQ*5+4  CLEAR ATTACHED TO EJT BIT 
          SCN    77 
          STM    IOSS+JSNQ*5+4
  
*         DETERMINE IF FILE IS BEING REQUEUED.
  
          LDM    FGSS        CHECK IF FILE BEING REQUEUED 
          LPN    2
          ZJN    EDF3        IF FILE NOT BEING REQUEUED 
          LDC    RQFL        SAVE *FILE BEING REQUEUED* STATUS
          RAD    ST 
 EDF3     LJM    EDFX        RETURN 
 EFN      SPACE  4,15 
**        EFN - ENTER FILE NAME IN FNT TABLE. 
* 
*         ENTRY  (FN - FN+4) = FILE NAME. 
* 
*         EXIT   (FS - FS+4) = FST ENTRY. 
*                (FA) = NFL FNT OFFSET. 
*                (FNBB) INCREMENTED.
*                (LFAL) = ACCESS LEVEL OF NEW FILE. 
* 
*         ERROR  TO *DPP*, IF DUPLICATE FILE ROUND. 
* 
*         USES   FS, CM - CM+4, UN - UN+4.
* 
*         CALLS  *0BF*. 
* 
*         MACROS EXECUTE, MONITOR, NFA. 
  
  
 EFN1     AOM    FNBB        SET FILE CREATED BY *DSP*
          NFA    FA,R 
          ADK    FUTL 
          CRD    CM 
          LDD    CM+2 
          LPN    7
          STM    LFAL 
  
 EFN      SUBR               ENTRY/EXIT 
          LDD    MA          GET FILE NAME
          CWD    FN 
          CRD    UN 
          LDN    NEEQ        SET NO MASS STORAGE ASSIGNMENT 
          STD    FS 
          LDN    0           SELECT NO RETURN WITHOUT FILE CREATED
          STM    OVL0-1 
          EXECUTE 0BF,OVL0   BEGIN FILE 
          UJN    EFN1        NO DUPLICATE ENTRY 
  
*         PROCESS ADVANCE EXIT FROM *0BF* (FILE ALREADY EXISTS).
  
          LDN    SWET        SET SYSTEM SOFTWARE ERROR
          STD    CM+2 
          LDC    *           SET ADDRESS WHERE ERROR DETECTED 
          STD    CM+1 
          MONITOR  CHGM      CONDITIONALLY HANG PP
          LJM    DPP         DROP PP
 EQF      SPACE  4,10 
**        EQF - ENTER QUEUED FILE IN GLOBAL TABLE.
* 
*         EXIT   (QA) = ORDINAL OF ENTRY. 
*                (FNBA) = 1 (CREATION MODE).
*                QFT BUFFER INITIALIZED.
*                *QFT FULL.* MESSAGE ISSUED TO OPERATOR, IF 
*                CANNOT MAKE AN ENTRY IN THE QFT. 
* 
*         USES   QA, CM - CM+7. 
*                TO *RCL* IF QFT FULL.
* 
*         CALLS  CTE, FNB, GEA. 
* 
*         MACROS ERROR, PAUSE, SFA. 
  
  
 EQF      SUBR               ENTRY/EXIT 
          LDM    FJSN        SET FORCED JSN OR SUBSYSTEM NAME 
          STD    CM+3 
          LDM    FJSN+1 
          STD    CM+4 
          LDD    FB          CHECK FOR JOB TERMINATION
          SHN    21-11
          PJN    EQF2        IF NOT FINAL ROUTE FOR TERMINATING JOB 
          RJM    GEA         GET EJT-S JSN
          ADK    JSNE 
          CRD    CM+3 
 EQF1     LDN    0           ZERO FILL JSN
          STD    CM+5 
          STD    CM+6 
          AOM    EQFA        PREVENT ALLOCATION OF NEW JSN
          UJN    EQF4        CONTINUE 
  
 EQF2     LDM    FSJS 
          NJN    EQF1        IF FORCED JSN
          LDD    FB+1 
          SHN    21-13
          PJN    EQF3        IF NOT SUBSYSTEM INITIATION
          LDM    SBID 
          ZJN    EQF1        IF SUBSYSTEM ID NOT SPECIFIED
          SBK    LSSI+1 
          PJN    EQF1        IF SPECIFIED SUBSYSTEM IS IN *SSCT* TABLE
 EQF3     LDN    ZERL        SET UP FOR *CTE* CALL (ASSIGN NEW JSN) 
          CRD    CM+3 
 EQF4     LDN    7           SET CREATION + ATTACH + INTERLOCK
          STD    CM+7 
          LDC    PQFT        REQUEST QFT ENTRY
*         LDC    PQFT+10000  (IF NEW JSN NOT NEEDED)
 EQFA     EQU    *-2
          RJM    CTE         CREATE TABLE ENTRY 
          NJN    EQF6        IF ENTRY MADE
          LDD    CP          CONSOLE MESSAGE = * QFT FULL.* 
          ADK    MS2W 
          CWM    EQFB,TR
          PAUSE 
          LDD    FB          CHECK IF ERROR PROCESSING NEEDED 
          LPN    1
          ADD    CM+1        CHECK FOR ERROR FLAG AT CONTROL POINT
          ZJN    EQF5        IF NO ERROR PROCESSING NEEDED
          ERROR  /ERR/EC25   * DSP - QFT FULL.* 
  
 EQF5     LJM    RCL         RECALL PP
  
 EQF6     LDD    CM+1        SAVE QFT ORDINAL 
          STD    QA 
          AOM    FNBA        SET CREATION MODE QFT ENTRY
          SFA    QFT,QA      GET ASSIGNED JSN 
          ADK    JSNQ 
          CRM    IOSS,ON
          LDN    0           CLEAR INTERLOCK AND CREATION BITS
          STM    IOSS+JSNQ*5+4
          LDD    FS          SET EQUIPMENT
          STM    IOSS+ENTQ*5+0
          LDD    FS+1        SET TRACK
          STM    IOSS+ENTQ*5+1
          LJM    EQFX        RETURN 
  
 EQFB     DATA   C* QFT FULL.*
 GLI      SPACE  4,10 
**        GLI - GET LOGICAL IDENTIFIERS.
* 
*         ENTRY  (QT) = DESTINATION QUEUE TYPE. 
* 
*         EXIT   DLID/SLID SAVED FOR SYSTEM SECTOR AND QFT. 
* 
*         USES   T1, CN - CN+4. 
* 
*         CALLS  CSL, GFA.
  
  
 GLI      SUBR               ENTRY/EXIT 
          LDM    SLSS        PROPAGATE OLD VALUES OF DLID/SLID
          LPN    77 
          STM    SLID 
          LDM    SLSS+1 
          STM    SLID+1 
          LDM    IOSS+INSQ*5+2
          SCN    77 
          SHN    6
          LMM    IOSS+INSQ*5+1
          SHN    6
          STM    DLID+1 
          SHN    -14
          STM    DLID 
          LDD    QT 
          LMK    INQT 
          ZJN    GLI1        IF ROUTE TO INPUT
          LDM    SLID        SET DLID = SLID FOR OUTPUT FILES 
          STM    DLID 
          LDM    SLID+1 
          STM    DLID+1 
 GLI1     LDD    FB+1 
          LPN    FRLD 
          ZJN    GLI4        IF DLID/SLID NOT SPECIFIED 
  
*         GET DLID FROM PARAMETER BLOCK.
  
          RJM    GFA         GET SLID/DLID
          ADN    2
          CRD    CN 
          LDD    CN+1        CHECK DLID 
          LPN    77 
          SHN    14 
          LMD    CN+2 
          RJM    CSL         CHECK FOR SPECIAL LID
          STM    DLID+1      SAVE DLID
          SHN    -14
          STM    DLID 
  
*         GET SLID FROM PARAMETER BLOCK.
  
          LDD    CN+1        CHECK SLID 
          SCN    77 
          SHN    6
          LMD    CN 
          ZJN    GLI4        IF NO CHANGE IN SLID 
          SHN    6
 GLI2     RJM    CSL         CHECK FOR SPECIAL LID
          STM    SLID+1      SAVE SLID
          SHN    -14
          STM    SLID 
 GLI3     UJN    GLI5        SET ATTRIBUTES 
  
*         CHECK IF DEFAULT SLID NEEDED. 
  
 GLI4     LDM    SLID 
          ADM    SLID+1 
          NJN    GLI5        IF SLID NONZERO
          LDN    LCPD 
          UJN    GLI2        SET SLID TO PID
  
*         GET ATTRIBUTES OF DLID/SLID.
  
 GLI5     LDM    DLID        GET DLID ATTRIBUTES
          SHN    14 
          LMM    DLID+1 
          ZJN    GLI6        IF NO DLID 
          RJM    VID         GET ATTRIBUTES FROM LID TABLE
          ZJN    GLI6        IF LID TABLE NOT FOUND 
          STM    DLAT        SAVE ATTRIBUTES
 GLI6     LDM    SLID        GET SLID ATTRIBUTES
          SHN    14 
          LMM    SLID+1 
          ZJN    GLI7        IF NO SLID 
          RJM    VID         GET ATTRIBUTES FROM LID TABLE
          ZJN    GLI7        IF LID TABLE NOT FOUND 
          STM    SLAT        SAVE ATTRIBUTES
 GLI7     LJM    GLIX        RETURN 
 ISS      SPACE  4,25 
**        ISS -  INITIALIZE SYSTEM SECTORS. 
* 
*         ENTRY  (FN - FN+4) = QUEUED FILE FNT ENTRY. 
*                (FS - FS+4) = FST ENTRY
*                (FA) = NFL FNT ENTRY OFFSET. 
*                (ST) = STATUS WORD.
*                (QT) = DESTINATION QUEUE TYPE. 
* 
*         EXIT   *BFMS* CONTAINS SYSTEM SECTOR FOR QUEUED FILE. 
*                (FS - FS+4) = QUEUED FILE FST ENTRY
* 
*         USES   CM - CM+4, T1 - T7.
* 
*         CALLS  EQF, GEA, GLI, RFN, SSJ, SSR.
* 
*         MACROS NFA. 
  
  
 ISS      SUBR               ENTRY
          LDC    FNTN        READ INPUT FILE FNT
          STM    SSRB 
          NFA    FNTN 
          CRD    CM 
          ADN    FSTL 
          CRD    T5 
          LDN    INFT        SET DESIRED FILE TYPE
          STM    SSRA 
          LDD    ST          CHECK IF CALLED BY SUBSYSTEM 
          LPN    SSFL 
          NJN    ISS1        IF NOT CALLED BY A SUBSYSTEM 
          LDD    QT          CHECK IF SUBSYSTEM OUTPUT FILE 
          LMK    INQT 
          NJN    ISS1        IF OUTPUT FROM A SUBSYSTEM 
          AOM    ISSA        SET INPUT FILE NOT READ
          UJN    ISS2        CONTINUE 
  
 ISS1     LDD    T5 
          RJM    SSR         READ INPUT FILE SYSTEM SECTOR
          ZJN    ISS4        IF INPUT FILE SYSTEM SECTOR READ 
 ISS2     LDC    501         CLEAR SYSTEM SECTOR BUFFER 
          STD    T1 
 ISS3     LDN    0
          STM    BFMS,T1
          SOD    T1 
          PJN    ISS3        IF MORE TO CLEAR 
          RJM    GLI         GET SLID/DLID
          LDD    ST          CHECK ORIGIN TYPE OF CALLING CP
          LPN    SYFL 
          ZJN    ISS7        IF CP NOT *SYOT* 
          LCN    0
          STM    VASS+5*AAWC+3
          STM    VASS+5*AAWC+4
          UJN    ISS7        SET DEFAULT TID
  
*         SET DEFAULT DESTINATION TERMINAL ID (TID).
  
 ISS4     RJM    GLI         GET SLID/DLID
          LDN    QFTE*5-1    CLEAR QFT IN SYSTEM SECTOR 
          STD    T1 
 ISS5     LDN    0           CLEAR QFT
          STM    IOSS,T1
          SOD    T1 
          PJN    ISS5        IF NOT FINISHED
          LDN    DDSSL       CLEAR FILE DEPENDENT INFORMATION 
          STD    T1 
 ISS6     LDN    0
          STM    JISS,T1
          SOD    T1 
          PJN    ISS6        IF MORE TO CLEAR 
  
*         SET ROUTING INFORMATION FROM EJT. 
  
 ISS7     LDC    ** 
 ISSA     EQU    *-1         (INPUT FILE NOT READ FLAG) 
          NJN    ISS8        IF INPUT FILE NOT READ 
          RJM    GEA         GET EJT ADDRESS
          ADK    SCLE 
          CRD    CM 
          LDD    CM          SET ORIGIN TYPE OF EJT 
          SCN    60 
          STM    IOSS+SCLQ*5+0
          LDD    CM+1        SET DEFAULT ROUTING INFORMATION
          STM    IOSS+SCLQ*5+1
          LDD    CM+2 
          STM    IOSS+SCLQ*5+2
  
*         SET CREATION DATE AND MACHINE ID. 
*         SET CREATION FAMILY AND USER NAME.
  
 ISS8     LDC    MMFL        SET MACHINE ID 
          CRD    CM 
          LDD    CM 
          STM    CMSS 
          STM    RMSS 
          RJM    RFN         READ CREATION FAMILY NAME
          CRM    FMSS,ON
          RJM    SSJ         CHECK FOR SSJ= BLOCK 
          ZJN    ISS9        IF NO SSJ= ADDRESS 
          ADK    UIDS        USER NAME
          UJN    ISS10       READ USER NAME 
  
 ISS9     LDD    CP          READ USER NAME 
          ADK    UIDW 
 ISS10    CRM    ACSS,ON
          LDM    FMSS+3      ZERO FILL FAMILY NAME
          SCN    77 
          STM    FMSS+3 
          LDN    0
          STM    FMSS+4 
  
*         SET CHARGE AND PROJECT NUMBERS. 
  
          NFA    CHGN 
          CRM    CHSS,TR
          ERRNZ  PJSS-CHSS-5 CHARGE AND PROJECT NUMBER NOT CONTIGUOUS 
          ERRNZ  CHGN-PJ1N-1 CHARGE AND PROJECT NUMBER NOT CONTIGUOUS 
  
*         ENTER FILE INTO QFT.
  
          RJM    EQF         ENTER QUEUED FILE
  
*         SET ORIGINAL AND CREATION JSN-S IN SYSTEM SECTOR. 
  
          LDM    IOSS+JSNQ*5+0
          STM    OJSS 
          LDM    IOSS+JSNQ*5+1
          STM    OJSS+1 
          RJM    GEA         SET CREATION JSN 
          ADK    JSNE 
          CRD    CM 
          LDD    CM 
          STM    CJSS 
          LDD    CM+1 
          STM    CJSS+1 
          LJM    ISSX        RETURN 
 PDF      SPACE  4,15 
**        PDF - PROCESS DEVICE FULL.
* 
*         ENTRY  (FB - FB+1) = FLAG BITS. 
* 
*         ERROR  TO *ERR*, IF ONE OF THE FOLLOWING OCCURS,
*                DEVICE FULL. 
* 
*         USES   CM - CM+4. 
* 
*         EXIT   *DEVICE FULL* MESSAGE ISSUED TO OPERATOR.
* 
*         MACROS ERROR, MONITOR, PAUSE. 
  
  
 PDF      SUBR               ENTRY/EXIT 
 PDFA     LDN    0           CHECK IF ROUTINE PREVIOUSLY CALLED 
*         LDN    1
          NJN    PDF1        IF ROUTINE PREVIOUSLY CALLED 
          AOM    PDFA        SET ROUTINE PREVIOUSLY CALLED
          LDD    CP          CONSOLE MESSAGE = *TRACK LIMIT.* 
          ADK    MS2W 
          CWM    PDFB,TR
          LDN    ZERL        CLEAR PARAMETERS 
          CRD    CM 
          LDK    TKLE        SET TRACK LIMIT EVENT
          STD    CM+4 
*         LDN    0           SET SYSTEM EVENT 
*         STD    CM+3 
          MONITOR  EATM 
 PDF1     PAUSE 
          LDD    FB 
          LPN    1
          ADD    CM+1 
          ZJN    PDFX        IF NO ERROR PROCESSING NEEDED
 PDF2     ERROR  /ERR/EC27   * DSP - DEVICE FULL.*
  
 PDFB     DATA   C*TRACK LIMIT.*
 RCL      SPACE  4,10 
**        RCL - RECALL PP.
  
  
 RCL      BSS    0           ENTRY
          RJM    FNB         SET FILE NOT BUSY
          LDN    ZERL        DEFAULT TO TIMED RECALL
          CRD    CM 
          LDD    MA 
          CWD    IR 
          MONITOR  RECM      RECALL PP
          LJM    PPR         ENTER PP RESIDENT
 SDC      SPACE  4,10 
**        SDC - SET DISPOSITION CODE. 
* 
*         ENTRY  (SDCA) = TABLE INDEX SET BY *DDC*. 
*                       = 0, IF NO DISPOSITION CODE SPECIFIED.
* 
*         EXIT   QFT AND SYSTEM SECTOR UPDATED. 
* 
*         USES   T0, T1.
* 
  
  
 SDC      SUBR               ENTRY EXIT 
          LDD    ST          CHECK IF DISPOSITION CODE SPECIFIED
          LPC    DCFL 
          ZJN    SDCX        IF DISPOSITION CODE NOT SPECIFIED
          LDC    ** 
 SDCA     EQU    *-1         (*TODC* TABLE ENTRY SET BY *DDC*)
          STD    T1 
          LPN    77 
          STD    T0 
          LDC    **          SET DISPOSITION CODE IN SYSTEM SECTOR
 SDCB     EQU    *-1
          STM    DCSS 
          LDM    IOSS+SCLQ*5+3
          SCN    77 
          LMD    T0 
          STM    IOSS+SCLQ*5+3
          LDM    IOSS+JSNQ*5+4  SET DISPOSITION CODE IN QFT 
          LMD    T1 
          LPN    77 
          LMD    T1 
          STM    IOSS+JSNQ*5+4
          UJN    SDCX        RETURN 
 SPR      SPACE  4,10 
**        SPR - SET PRIORITY. 
* 
*         ENTRY  (FB - FB+1) = FLAG BITS. 
*                (QT) = QUEUE TYPE. 
*                (T3) .NE. 0, IF SPECIAL REQUEUE OPERATION. 
* 
*         EXIT   QFT UPDATED. 
*                (FGSS) = FLAG SET IF PRIORITY PRESENT. 
* 
*         USES   CN - CN+4, T1 - T5.
* 
*         CALLS  CET, GFA.
  
  
 SPR      SUBR               ENTRY/EXIT 
          LDD    FB+1        CHECK PRIORITY 
          SHN    21-11
          MJN    SPR2        IF PRIORITY SPECIFIED
          LDD    T3 
          NJN    SPRX        IF SPECIAL REQUEUE OPERATION 
          LDD    FB+1        CHECK IF DEFERRED ROUTE
          SHN    21-0 
          MJN    SPRX        IF DEFERRED ROUTE
          LDM    FGSS        CHECK IF PRIORITY PREVIOUSLY SPECIFIED 
          LPN    4
          NJN    SPR3        IF PRIORITY PREVIOUSLY SPECIFIED 
 SPR0     LDC    RTCL        USE REAL TIME CLOCK
          CRD    T1 
 SPR1     LJM    SPR5        SET ENTRY TIME IN QFT
  
 SPR2     RJM    GFA         READ PRIORITY
          ADN    3
          CRD    CN 
          LDD    T3 
          ZJN    SPR2.1      IF NOT SPECIAL REQUEUE OPERATION 
          LDD    CN+2 
          NJN    SPR0        IF NEW ENTRY TIME NEEDED 
          LDD    CN+3        GET ENTRY TIME 
          STD    T1 
          LDD    CN+4 
          STD    T2 
          UJN    SPR1        SET ENTRY TIME IN QFT ENTRY
  
 SPR2.1   LDD    CN+4 
          STM    PRSS 
          LDM    FGSS        SET PRIORITY FLAG
          SCN    4
          LMN    4
          STM    FGSS 
          LDD    FB+1        CHECK IF DEFERRED ROUTE
          SHN    21-0 
          MJN    SPR6        IF DEFERRED ROUTE
 SPR3     LDM    FGSS        CLEAR PRIORITY SPECIFIED FLAG
          SCN    4
          STM    FGSS 
          LDM    PRSS        CONVERT PRIORITY INTO ENTRY TIME 
          STD    T1 
          LDD    QT          GET QUEUE TYPE 
          LMK    INQT 
          ZJN    SPR4        IF INPUT FILE
          LDN    OTQT        SET OUTPUT QUEUE TYPE
 SPR4     STD    T2 
          LDM    IOSS+SCLQ*5+0
          SCN    77 
          SHN    6
          LMD    T2 
          RJM    CET         CALCULATE ENTRY TIME 
 SPR5     LDD    T2          SET ENTRY TIME IN QFT ENTRY
          STM    IOSS+ENTQ*5+4
          LDD    T1 
          STM    IOSS+ENTQ*5+3
 SPR6     LJM    SPRX        RETURN 
 SQS      SPACE  4,15 
**        SQS - SET QUEUED FILE SYSTEM SECTOR IN *BFMS*.
* 
*         ENTRY  (FS - FS+4) = FST ENTRY. 
*                (ST) = STATUS WORD.
*                (FA) = NFL FNT OFFSET. 
*                (QT) = QUEUE TYPE. 
*                (FN - FN+4) = FILE NAME. 
* 
*         EXIT   (FN - FN+4) = NFL FNT/FST ENTRY. 
*                (FS - FS+4) = NFL FNT/FST ENTRY. 
*                (QT) = QUEUE TYPE. 
*                (QA) = ORDINAL OF GLOBAL *QFT* TABLE ENTRY.
* 
*         USES   FN - FN+4. 
* 
*         USES   AMS, EFN, SPR, USS, VMS. 
* 
*         MACROS NFA. 
  
  
 SQS      SUBR               ENTRY/EXIT 
          LDD    ST          CHECK IF FILE CREATION NEEDED
          LPN    FCFL 
          ZJN    SQS1        IF FILE EXISTS 
          RJM    EFN         ENTER FILE NAME
 SQS1     RJM    AMS         ASSIGN MASS STORAGE
          LDD    FS          SET EQUIPMENT
          RJM    VMS         VALIDATE MASS STORAGE
          NFA    FA,R        READ FNT OF EXISTING FILE
          CRD    FN 
          LDD    FN+4        SET FILE TYPE
          LPN    77 
          LMC    QFFT*100 
          STD    FN+4 
          RJM    USS         SET SYSTEM SECTOR
          RJM    SPR         SET PRIORITY 
          UJN    SQSX        RETURN 
 SSR      SPACE  4,20 
**        SSR - SYSTEM SECTOR READ. 
* 
*         ENTRY  (A) = EST ORDINAL. 
*                (T6) = FIRST TRACK.
*                (CM - CM+4) = FNT ENTRY. 
*                (SSRB) = NFL FNT ENTRY OFFSET. 
* 
*         EXIT   (A) = 0 IF NO ERRORS AND DATA IN SYSTEM SECTOR.
*                    .GT. 0 IF NO DATA IN SYSTEM SECTOR.
*                    .LT. 0 IF ERRORS IN SYSTEM SECTOR DATA.
*                DRIVER PRESET. 
* 
*         USES   T1, T3, T5.
* 
*         CALLS  RSS, SSE.
* 
*         MACROS ENDMS, NFA, SETMS. 
  
  
 SSR2     ENDMS 
*         LDN    0           RETURN (NO ERRORS) 
  
 SSR      SUBR               ENTRY/EXIT 
          STD    T5 
          LMN    NEEQ 
          ZJN    SSR1        IF NO FILE 
          LDD    CM+4 
          SHN    -6 
 SSR1     LMC    QFFT 
*         LMC    INFT        (READ JOB INPUT FILE)
 SSRA     EQU    *-1         (SET BY *ISS*) 
          NJN    SSRX        IF NOT ALREADY QUEUE FILE
          SETMS  IO 
          LDN    0
          RJM    RSS         READ SYSTEM SECTOR 
          ZJN    SSR2        IF NO ERRORS 
  
*         PROCESS SYSTEM SECTOR ERROR.
  
          LDN    0           SET FNT TYPE 
          STD    T3 
          LDC    *
 SSRB     EQU    *-1         (FNT OFFSET OF FILE READ)
          STD    T1 
          NFA    T1,R 
          RJM    SSE         REPORT SYSTEM SECTOR ERROR 
          LCN    1           FLAG SYSTEM SECTOR ERROR 
          UJN    SSRX        RETURN WITH ERROR
 USS      SPACE  4,20 
**        USS - UPDATE SYSTEM SECTOR. 
* 
*         ENTRY  (FN - FN+4) = QUEUED FILE FNT ENTRY. 
*                (FS - FS+4) = FST ENTRY. 
*                (FA) = NFL FNT ENTRY OFFSET. 
* 
*         EXIT   *BFMS* CONTAINS SYSTEM SECTOR FOR QUEUED FILE. 
*                (QT) = QUEUE TYPE. 
*                (T3) .NE. 0, IF VALID SPECIAL REQUEUE FLAG SET.
*                REPEAT COUNT SET, IF VALID SPECIAL REQUEUE FLAG SET. 
* 
*         ERROR  TO *ERR* IF ERROR READING *QFFT* FILE SYSTEM SECTOR. 
* 
*         USES   QT, T3, T6, CM - CM+4. 
* 
*         CALLS  EDF, GFA, GLI, ISS, SQO, SSR.
* 
*         MACROS ERROR, ISTORE, NFA.
  
  
 USS2     RJM    ISS         INITIALIZE SYSTEM SECTOR 
          RJM    SQO         SET QFT OWNERSHIP
 USS3     LDN    0           SET NORMAL EXIT
          STD    T3 
  
 USS      SUBR               ENTRY/EXIT 
  
*         SET QUEUE FILE TYPE.
  
          LDM    SDCA        GET ENTRY FROM *TODC* TABLE
          SHN    -11
          STD    QT 
  
*         READ SYSTEM SECTOR INFORMATION IF IT EXISTS.
  
          LDD    FS+1        SET FIRST TRACK
          STD    T6 
          LDD    FA          READ CURRENT FNT ENTRY 
          STM    SSRB        SAVE FNT OFFSET
          NFA    FA,R 
          CRD    CM 
          LDD    FS 
          RJM    SSR         READ SYSTEM SECTOR 
          MJP    USS1        IF ERROR ON *QFFT* FILE
          NJN    USS2        IF SYSTEM SECTOR NOT READ
  
*         SET FNT/FST FOR DEFERRED ROUTED OR ATTACHED QUEUE FILE
*         (SYSTEM SECTOR INFORMATION IS ALREADY PRESENT). 
  
          RJM    GLI         GET LID INFORMATION
          RJM    EDF         ENTER DEFERRED FILE
  
*         CHECK FOR SPECIAL REQUEUE FLAG. 
  
          LDD    ST 
          LPN    DSFL 
          ZJN    USS3        IF FILE NOT PREVIOUSLY ROUTED
          LDM    EBIT+1 
          LPC    EFRQ 
          STD    T3 
          ZJN    USS0        IF SPECIAL REQUEUE FLAG NOT SPECIFIED
          ISTORE DSPG,(UJN DSP4)
          ISTORE DSPH,(UJN DSP5)
          ISTORE DSPI,(UJN DSP6.2)
  
*         SET REPEAT COUNT FOR SPECIAL REQUEUE OPERATION. 
  
          LDD    FB 
          SHN    21-2 
          PJN    USS0        IF REPEAT COUNT NOT SPECIFIED
          RJM    GFA         READ REPEAT COUNT
          ADN    4
          CRD    CM 
          LDD    CM+3        SET REPEAT COUNT 
          LPN    77 
          STM    IOSS+INSQ*5+4
          STM    RCSS 
 USS0     LJM    USSX        RETURN 
  
 USS1     ERROR  /ERR/EC24   * DSP - QUEUED FILE READ ERROR.* 
 VMS      SPACE  4,10 
**        VMS - VALIDATE MASS STORAGE.
* 
*         ENTRY  (A) = EQUIPMENT. 
* 
*         EXIT   (CM - CM+4) = EST ENTRY. 
*                (T5) = EQUIPMENT.
* 
*         ERROR  TO *ERR*, IF ONE OF THE FOLLOWING OCCURS,
*                FILE NOT ON REMOVABLE DEVICE.
*                FILE NOT ON MASS STORAGE.
* 
*         USES   T5, CM - CM+4. 
* 
*         MACROS ERROR, SFA.
  
  
 VMS1     SHN    21-10-21+13
          PJN    VMSX        IF NOT REMOVABLE DEVICE
          ERROR  /ERR/EC20   * DSP - FILE ON REMOVABLE DEVICE.* 
  
 VMS      SUBR               ENTRY/EXIT 
          STD    T5          SET EQUIPMENT
          SFA    EST         READ EST ENTRY 
          ADK    EQDE 
          CRD    CM 
          LDD    CM          CHECK FOR MASS STORAGE 
          SHN    21-13
          MJN    VMS1        IF MASS STORAGE
          ERROR  /ERR/EC02   * DSP - FILE NOT ON MASS STORAGE.* 
          SPACE  4,10 
**        COMMON DECKS. 
  
  
 CET$     SET    1           CALCULATE ENTRY TIME 
*CALL     COMPCPE 
*CALL     COMPCTE 
*CALL     COMPC2D 
*CALL     COMPRJC 
          QUAL   MIO
 RDS      EQU    RMS         USE *RMS* IN PLACE OF *RDS*
*CALL     COMPRSS 
          QUAL   *
 RSS      EQU    /MIO/RSS 
*CALL     COMPSSE 
*CALL     COMPVID 
          QUAL   MIO3 
 WCS$     SET    1           WRITE CONSECUTIVE SECTORS
 WDS      EQU    WMS         USE *WMS* IN PLACE OF *WDS*
*CALL     COMPWSS 
          QUAL   *
 WSS      EQU    /MIO3/WSS
          SPACE  4,10 
*         THE FOLLOWING SUBROUTINES MAY BE OVERLAID BY ZERO-LEVEL 
*         OVERLAYS. 
          SPACE  4,10 
 OVL5     EQU    *+5         LOAD ADDRESS FOR OVERLAY *3DC* 
          SPACE  4,10 
          ERRNG  OVL0-5-*    OVERFLOW INTO *0BF*
          ERRNG  OVL1-5-*    OVERFLOW INTO *0AV*
          TITLE  FILE INITIALIZATION ROUTINES (OVERLAYABLE).
 CFN      SPACE  4,10 
**        CFN - COMPARE FILE NAMES. 
* 
*         ENTRY  (T1) = FWA OF FNT ENTRY
*                (FN - FN+4) = FILE NAME. 
* 
*         EXIT   (A) = 0, IF FILE FOUND.
*                (A) .GT. 0, FILE ASSIGNED TO CP, BUT NOT DESIRED FILE. 
*                (A) .LT. 0, NO ENTRY.
  
  
 CFN1     LCN    1           NO FILE FOUND
  
 CFN      SUBR               ENTRY/EXIT 
          LDI    T1 
          ZJN    CFN1        IF NO ENTRY
          LMD    FN 
          NJN    CFNX        IF NO COMPARE
          LDM    1,T1 
          LMD    FN+1 
          NJN    CFNX        IF NO COMPARE
          LDM    2,T1 
          LMD    FN+2 
          NJN    CFNX        IF NO COMPARE
          LDM    3,T1 
          LMD    FN+3 
          SCN    77 
          UJN    CFNX        RETURN 
 DDC      SPACE  4,25 
**        DDC - DETERMINE DISPOSTION CODE.
* 
*         ENTRY  (FB - FB+1) = FLAG BITS. 
*                (FN - FN+4) = FNT ENTRY. 
*                (ST) = STATUS WORD.
* 
*         EXIT   (A) = 0, IF *DC=SC*. 
*                (ST) = SET, IF DISPOSITION CODE SPECIFIED. 
* 
*         ERROR  TO *ERR*, IF ONE OF THE FOLLOWING OCCURS,
*                INCORRECT DISPOSITION CODE.
*                *DC=SO* OR *DC=SS* AND CALLER NOT *SYOT* OR *SSJ=*.
* 
*         USES   ST, T1, CM+2.
* 
*         CALLS  CFN. 
* 
*         MACROS ERROR. 
  
  
 DDC      SUBR               ENTRY/EXIT 
 DDC1     LDC    *           SET DISPOSITION CODE 
 DDCB     EQU    *-1         (DISPOSITION CODE SET BY PRESET) 
          STD    CM+2 
          LDD    FB+1 
          SHN    21-4 
          MJN    DDC2        IF DISPOSITION CODE SPECIFIED
          LDD    FN+4        GET FILE TYPE
          SHN    -6 
          LMN    LOFT 
          ZJN    DDC4        IF NOT QUEUED FILE 
          UJN    DDCX        RETURN 
  
*         IF *DC=SO* OR *DC=SS*, VALIDATE CALLER. 
  
 DDC2     LDD    CM+2 
          LMC    2RSO 
          ZJN    DDC3        IF *DC=SO* 
          LMC    2RSO&2RSS
          NJN    DDC7        IF NOT *DC=SS* 
 DDC3     LDD    ST          VALIDATE CALLER
          LPC    SJFL+SYFL
          NJN    DDC7        IF *SYOT* OR *SSJ=*
          ERROR  /ERR/EC12   * DSP - INCORRECT REQUEST.*
  
*         SET DEFAULT DISPOSITION CODE. 
  
 DDC4     LDC    TSFN-TSFNL  PRESET TABLE INDEX 
          STD    T1 
 DDC5     LDN    TSFNL       ADVANCE INDEX
          RAD    T1 
          RJM    CFN         COMPARE FILE NAMES 
          ZJN    DDC6        IF FILE FOUND
          PJN    DDC5        IF NO FILE NAME MATCH
          ERROR  /ERR/EC07   * DSP - INCORRECT DISPOSITION CODE.* 
  
 DDC6     LDM    4,T1        SET DEFAULT DISPOSITION
          STD    CM+2 
  
*         VALIDATE DISPOSITION CODE.
  
 DDC7     LDC    TODC-TODCL  SET TABLE INDEX
          STD    T1 
 DDC8     LDN    TODCL       ADVANCE INDEX
          RAD    T1 
          LDI    T1 
          NJN    DDC9        IF NOT END OF TABLE
          LDD    CM+2 
          LMC    2RSC 
          ZJP    DDCX        IF *DC=SC* 
          ERROR  /ERR/EC07   * DSP - INCORRECT DISPOSITION CODE.* 
  
 DDC9     LMD    CM+2 
          NJN    DDC8        IF NO MATCH
          AOD    T1          SET NEW QUEUE TYPE 
          LDI    T1          SAVE TABLE ENTRY FOR ROUTINE *SDC* 
          STM    SDCA 
          SHN    -11
          LMK    INQT 
          NJP    DDC17       IF NOT INPUT FILE
  
*         VALIDATE FORCED JSN, IF ANY.
  
          LDD    FB+1 
          LPN    FRFJ 
          ZJP    DDC15       IF FORCED JSN FLAG NOT SPECIFIED 
          STM    FSJS        SET FORCED JSN 
          LMD    FB+1        FORCE IMMEDIATE ROUTE FOR INPUT FILE 
          ERRNZ  FRFJ-FRDR   (CODE ASSUMES FRFJ AND FRDR ARE SAME FLAG) 
          STD    FB+1 
          LDD    OT 
          LMK    SYOT 
          NJP    DDC16       IF NOT SYSTEM ORIGIN 
          LDK    EJTP        READ EJT POINTER WORD
          CRD    CM 
          LDN    0           START SEARCH AT ORDINAL 0
          STD    CM 
 DDC10    LDD    CM 
          SBD    CM+2 
          PJN    DDC12       IF END OF EJT
          SFA    EJT,CM      GET EJT ENTRY
          ADK    JSNE 
          CRD    CN 
          AOD    CM          INCREMENT EJT ORDINAL
          LDD    CN 
          ZJN    DDC10       IF BLANK ENTRY 
          LMM    FJSN 
          NJN    DDC10       IF NO MATCH ON FIRST 2 CHARACTERS
          LDD    CN+1        COMPARE REMAINDER OF JSN 
          LMM    FJSN+1 
          NJN    DDC10       IF NOT SAME JSN
 DDC11    ERROR  /ERR/EC50   * DSP - JSN ALREADY IN SYSTEM.*
  
 DDC12    LDC    TSSN        CHECK IF JSN MATCHES A SUBSYSTEM NAME
          STD    T1 
 DDC13    LDI    T1          SEARCH TABLE FOR SUBSYSTEM 
          LMM    FJSN 
          NJN    DDC14       IF NO MATCH
          LDM    1,T1 
          LMM    FJSN+1 
          ZJN    DDC11       IF MATCH 
 DDC14    LDN    TSSNE       GET NEXT TABLE ENTRY 
          RAD    T1 
          LMC    TSSNL
          NJN    DDC13       IF NOT END OF TABLE
          RJM    VJS         VALIDATE JSN SPECIFICATION 
 DDC15    LDM    FSOT        CHECK FOR FORCED ORIGIN TYPE 
          LMK    IAOT 
          LPN    17 
          NJN    DDC17       IF NOT INTERACTIVE ORIGIN TYPE 
 DDC16    ERROR  /ERR/EC40   * DSP - INCORRECT ORIGIN TYPE.*
  
 DDC17    LDC    DCFL        SET DISPOSITION CODE SPECIFIED FLAG
          RAD    ST 
          LDD    CM+2        SAVE FOR ACCOUNTING MESSAGE
          STM    SDCB 
          LJM    DDCX        RETURN 
 TODC     SPACE  4,10 
**        TODC - TABLE OF DEFAULT ROUTING INFORMATION.
* 
*T        12/ DC, 6/ QT, 3/ EC, 3/ IC.
* 
*         DC = DISPOSITION CODE. (DISPLAY CODE) 
*         EC = EXTERNAL CHARACTERISTICS FOR QFT.
*         IC = INTERNAL CHARACTERISTICS FOR QFT.
*         QT = QUEUE TYPE FOR SPECIFIED DISPOSITION CODE. 
  
  
 IN$      EQU    1           ALLOW *DC=IN*
 NO$      EQU    1           ALLOW *DC=NO*
 TO$      EQU    1           ALLOW *DC=TO*
 TT$      EQU    1           ALLOW *DC=TT*
 SO$      EQU    1           ALLOW *DC=SO*
 SS$      EQU    1           ALLOW *DC=SS*
  
 TODC     BSS    0
          DRIN   PR,DFEX,DCIC,LPQF           ANY PRINTER
 TODCL    EQU    *-TODC                      LENGTH OF TABLE ENTRY
          DRIN   LP,DFEX,DCIC,LPQF           ANY PRINTER
          DRIN   P1,DFEX,DCIC,0              505 PRINTER
          DRIN   P2,DFEX,DCIC,P2QF           512 PRINTER
          DRIN   LQ,DFEX,DCIC,0              512 PRINTER
          DRIN   LR,DFEX,DCIC,LRQF           580-12 PRINTER 
          DRIN   LS,DFEX,DCIC,LSQF           580-16 PRINTER 
          DRIN   LT,DFEX,DCIC,LTQF           580-20 PRINTER 
          DRIN   LX,DFEX,DCIC,LXQF           5870 NIP 
          DRIN   LY,DFEX,DCIC,LYQF           5970 NIP 
          DRIN   SB,PBFR,BNIC,PUQF           PUNCH BINARY 
          DRIN   P8,P8FR,BNIC,PUQF           PUNCH 80 COLUMN
          DRIN   PB,PBFR,BNIC,PUQF           PUNCH BINARY 
          DRIN   TT,DFEX,DFEX,TQQF           TERMINAL OUTPUT
          DRIN   SS,DFEX,DFEX,SQQF           STATION OUTPUT 
          DRIN   WT,DFEX,DFEX,TQQF           WAIT QUEUE 
 TODCA    EQU    *
          DRIN   PU,PHFR,DCIC,PUQF           PUNCH CODED
 TODCB    EQU    *
          DRIN   PH,PHFR,DCIC,PUQF           PUNCH CODED
          DRIN   FR,T6EX,0,FRQF              MICROFILM PRINT
          DRIN   FL,T6EX,0,FLQF              MICROFILM PLOT 
          DRIN   PL,T6EX,0,PLQF              PLOTTER
          DRIN   HR,T6EX,0,HRQF              HARD COPY PRINT
          DRIN   HL,T6EX,0,HLQF              HARD COPY PLOT 
          DRIN   IN,0,0,INQF                 INPUT
          DRIN   NO,0,0,NOQF                 INPUT NO OUTPUT
*         DRIN   SC,0,0,LOFT                 SCRATCH
          DRIN   TO,0,0,TOQF                 INPUT, TERMINAL OUTPUT 
          DRIN   SO,0,0,SOQF                 INPUT, STATION OUTPUT
          CON    0                END OF TABLE
 TSFN     SPACE  4,10 
**        TSFN - TABLE OF SPECIAL FILE NAMES AND DISPOSITION CODES. 
* 
*T        48/ FILE NAME ,12/ DC 
* 
*         DC = DISPOSITION CODE.
  
  
 TSFN     BSS    0
          VFD    48/0LOUTPUT,12/2LLP
 TSFNL    EQU    *-TSFN      LENGTH OF ENTRY
          SPACE  4,10 
          VFD    48/0LPUNCH,12/2LPU 
          VFD    48/0LPUNCHB,12/2LSB
          VFD    48/0LP8,12/2LP8
          VFD    48/0,12/2LSC 
 TSSN     SPACE  4,10 
**        TABLE OF SUBSYSTEM NAMES. 
* 
*         ENTRY FORMAT. 
* 
*T        24/ NAME
* 
*         NAME = 3-CHARACTER SUBSYSTEM NAME + BLANK.
  
  
 TSSN     BSS    0
          LIST   G
 .SSN     HERE
          LIST   *
 TSSNL    BSS    0           END OF TABLE 
 FFQ      SPACE  4,20 
**        FFQ - FIND FILE TO QUEUE. 
* 
*         ENTRY  (FB - FB+1) = FLAG BITS. 
*                (FN - FN+4) = (UN - UN+4) = FILE NAME. 
*                (ST) = STATUS WORD.
* 
*         EXIT   (FN - FN+4) = FNT ENTRY. 
*                (FS - FS+4) = FST ENTRY. 
*                (FA) = NFL FNT ENTRY OFFSET. 
*                (ST) = SET, IF FILE CREATION NEEDED. 
*                (LFAL) = LOCAL FILE ACCESS LEVEL.
* 
*         ERROR  TO *ERR*, IF ONE OF THE FOLLOWING OCCURS,
*                FILE NAME ERROR. 
*                IMMEDIATE ROUTE - NO FILE. 
*                CANNOT ROUTE JOB INPUT FILE. 
*                I/O SEQUENCE ERROR.
*                INCORRECT FILE MODE. 
*                INVALID FILE TYPE. 
* 
*         USES   ST, T1, CM - CM+4, FN - FN+4.
* 
*         CALLS  SAF, SFB, VFN, VMS.
* 
*         MACROS ERROR, NFA.
  
  
 FFQ      SUBR               ENTRY/EXIT 
          LDC    **          FNT ADDRESS
 FFQA     EQU    *-1         (SET BY PRESET)
          RJM    SAF         SEARCH FOR ASSIGNED FILE 
          NJN    FFQ3        IF FILE FOUND
          RJM    VFN         VERIFY FILE NAME 
          NJN    FFQ1        IF VALID FILE NAME 
          ERROR  /ERR/EC01   * DSP - FILE NAME ERROR.*
  
 FFQ1     LDC    LOFT*100    SET LOCAL FILE FOR *DDC* 
          STD    FN+4 
          LDN    FCFL        SET FILE CREATION NEEDED 
          RAD    ST 
          LJM    FFQ10       CHECK FOR DEFERRED ROUTE 
  
 FFQ3     LDD    FA 
          LMC    FNTN 
          NJN    FFQ4        IF NOT JOB INPUT FILE
          ERROR  /ERR/EC16   * DSP - CANNOT ROUTE JOB INPUT FILE.*
  
 FFQ4     RJM    SFB         SET FILE BUSY
          ZJN    FFQ5        IF FILE SET BUSY 
          LDN    0           CLEAR NFL FNT OFFSET 
          STD    FA 
          ERROR  /ERR/EC31   * DSP - I/O SEQUENCE ERROR.* 
  
*         CHECK IF FILE CAN BE ROUTED.
  
 FFQ5     NFA    FA,R        READ FNT FROM NFL
          ADK    FNTL 
          CRD    FN 
          ADN    FSTL-FNTL
          CRD    FS 
          ADN    FUTL-FSTL
          CRD    CM 
          LDD    CM+2        SAVE LOCAL FILE ACCESS LEVEL 
          LPN    7
          STM    LFAL 
          LDD    FN+3        CHECK FILE MODE
          SHN    21-2 
          PJN    FFQ7        IF NOT EXECUTE ONLY MODE 
          ERROR  /ERR/EC36   * DSP - INCORRECT FILE MODE.*
  
 FFQ7     SHN    21-0-21+2
          PJN    FFQ7.1      IF FILE NOT LOCKED 
          LDC    LKFL        SET *FILE LOCKED* FLAG 
          RAD    ST 
  
*         VALIDATE FILE TYPE. 
  
 FFQ7.1   LDD    FN+4        SET CURRENT FILE TYPE
          SHN    -6 
          STD    T1 
          LDC    SHNI+21
          SBD    T1 
          STM    FFQB 
          LDC    QMSK 
          SHN    21-0 
 FFQB     EQU    *-1         (MODIFIED *SHN* INSTRUCTION) 
          MJN    FFQ8        IF VALID FILE TYPE 
          ERROR  /ERR/EC03   * DSP - INCORRECT FILE TYPE.*
  
*         VALIDATE FILE-S CURRENT MASS STORAGE ASSIGNMENT.
  
 FFQ8     LDD    FS          CHECK FST ENTRY
          ZJN    FFQ10       IF NULL ENTRY
          RJM    VMS         VALIDATE MASS STORAGE FILE 
          LDD    FS+1 
          ZJN    FFQ10       IF NULL FILE 
          LDD    FS+2 
          ZJN    FFQ10       IF NULL FILE 
 FFQ9     LJM    FFQX        RETURN 
  
*         FOR A NULL OR NONEXISTENT FILE, ONLY ALLOW A DEFERRED ROUTE.
  
 FFQ10    LDD    FB+1 
          LPN    FRDR 
          NJN    FFQ9        IF DEFERRED ROUTE
          ERROR  /ERR/EC06   * DSP - IMMEDIATE ROUTING - NO FILE.*
  
  
 INFT     DECMIC INFT 
 QFFT     DECMIC QFFT 
 LOFT     DECMIC LOFT 
  
 QMSK     EQU    1S"INFT"+1S"QFFT"+1S"LOFT" 
 VJS      SPACE  4,10 
**        VJS - VALIDATE JSN SPECIFICATION. 
* 
*         ENTRY  (FB - FB+1) = FLAG BITS. 
*                (FJSN - FJSN+1) = FORCED JSN TO VALIDATE.
* 
*         EXIT   JSN VALIDATED. 
* 
*         ERROR  TO *ERR* IF AN INVALID JSN WAS SPECIFIED.
* 
*         MACROS ERROR. 
  
  
 VJS      SUBR               ENTRY/EXIT 
          LDM    FJSN        VALIDATE SPECIFIED JSN 
          SHN    -6 
          ZJN    VJS1        IF CHARACTER .LT. *A*
          SBN    1R9+1
          PJN    VJS1        IF CHARACTER .GT. *9*
          LDM    FJSN 
          LPN    77 
          ZJN    VJS1        IF CHARACTER .LT. *A*
          SBN    1R9+1
          PJN    VJS1        IF CHARACTER .GT. *9*
          LDM    FJSN+1 
          SHN    -6 
          ZJN    VJS1        IF CHARACTER .LT. *A*
          SBN    1R9+1
          MJN    VJSX        IF CHARACTER .LE. *9*
 VJS1     ERROR  /ERR/EC12   * DSP - INCORRECT REQUEST.*
 VUL      SPACE  4,10 
**        VUL - VALIDATE USER LIMITS. 
* 
*         ENTRY  (FB - FB+1) = FLAG BITS. 
* 
*         ERROR  TO *ERR*, IF ONE OF THE FOLLOWING OCCURS,
*                TOO MANY DEFERRED BATCH JOBS.
* 
*         USES   T0 - T4, CM - CM+4.
* 
*         CALLS  CDB, DBI, GEA. 
* 
*         MACROS ERROR. 
  
  
 VUL      SUBR               ENTRY/EXIT 
          LDD    FB 
          SHN    21-13
          MJN    VULX        IF JOB TERMINATION AND VALIDATION DISABLED 
          LDD    FB+1 
          SHN    21-0 
          MJN    VULX        IF DEFERRED ROUTE
          LDM    CUAV        CHECK USER ACCESS
          ZJN    VULX        IF USER SYSTEM PRIVILEGES
          RJM    GEA         GET EJT ADDRESS
          CRD    T0 
          RJM    CDB         COUNT DEFERRED BATCH JOBS
          LDD    CP          GET *DB* FIELD FROM CONTROL POINT
          ADN    ALMW 
          CRD    CM 
          LDD    CM+1 
          RJM    DBI         GET DEFERRED BATCH LIMITS
          MJN    VULX        IF UNLIMITED 
          SBD    T4 
          SBN    1
          PJN    VULX        IF LIMIT NOT REACHED 
          ERROR  /ERR/EC33   * DSP - TOO MANY DEFERRED BATCH JOBS.* 
          SPACE  4,10 
**        COMMON DECKS. 
  
  
*CALL     COMPCDB 
 DBI$     SET    1           DEFINE DEFERRED BATCH CONVERSION 
*CALL     COMPCVI 
 SAF$     SET    1           SELECT *COMPSAF* SEARCH FOR ASSIGNED FILE
*CALL     COMPSAF 
*CALL     COMPSFB 
*CALL     COMPVFN 
 PRS      TITLE  PRESET.
**        PRS - PRESET ROUTINE. 
* 
*         EXIT   (FB - FB+1) = FLAG BITS. 
*                (FN - FN+4) = (UN - UN+4) = FILE NAME. 
*                (DDCB) = DISPOSITION CODE. 
*                (EBIT - EBIT+1) = EXTENDED PARAMETER BLOCK FLAG BITS.
*                (SFDA) = FORCED ORIGIN TYPE INSTRUCTION. 
*                (VULA) = SYSTEM ORIGIN PRIVILEGES FLAG.
* 
*         ERROR  TO *ERR*, IF ONE OF THE FOLLOWING OCCURS,
*                INCORRECT *DSP* REQUEST. 
*                COMPLETE BIT ALREADY SET.
*                INCORRECT ORIGIN TYPE. 
* 
*         USES   ER, FA, QA, ST, T7, CM - CM+4, CN - CN+4,
*                FB - FB+1, FN - FN+4.
* 
*         CALLS  CRS, CUA, GFA, IFP, VCA, VLD, VTA. 
* 
*         MACROS ERROR, SFA.
  
  
 PRS      SUBR               ENTRY/EXIT 
          LDN    0           CLEAR ERROR STATUS AND FNT POINTERS
          STD    ER 
          STD    ST 
          STD    FA 
          STD    QA 
          STD    FB 
          STD    FB+1 
          RJM    IFP         INITIALIZE *SFA* CALL
          RJM    CUA         CHECK USER ACCESS
          STM    CUAV 
  
*         CHECK AUTO RECALL STATUS. 
  
          LDD    CP          READ SUBSYSTEM ID
          ADN    JCIW 
          CRD    CM 
          ADN    AACW-JCIW
          CRD    FS 
          ADN    SEPW-AACW   GET SPECIAL ENTRY POINT WORD 
          CRD    CN 
          LDC    LSSI 
          SBD    CM+2 
          MJN    PRS1        IF SUBSYSTEM 
          LDN    SSFL        FLAG NO SUBSYSTEM
          RAD    ST 
          RJM    CRS         CHECK RECALL STATUS
          ZJN    PRS3        IF NOT CALLED WITH RECALL
 PRS1     LDD    CN          CHECK ENTRY POINTS 
          SHN    21-2 
          PJN    PRS2        IF NOT *SSJ=*
          LDC    SJFL        FLAG *SSJ=* PROGRAM
          RAD    ST 
  
*         CHECK ADDRESS OF ARGUMENT TABLE.
  
 PRS2     LDD    IR+3        CHECK PARAMETER ADDRESS
          LPN    37 
          SHN    14 
          LMD    IR+4 
          RJM    VCA         VALIDATE ADDRESS 
          ZJN    PRS3        IF NOT VALID ADDRESS 
          ADN    DPBL-1      CHECK IF PARAMETER BLOCK IS WITHIN FL
          RJM    VCA         VALIDATE ADDRESS 
          NJN    PRS4        IF VALID ADDRESS 
 PRS3     ERROR  /ERR/EC12   * DSP - INCORRECT REQUEST.*
  
 PRS4     ADN    EPBL-DPBL   CHECK IF EXTENDED BLOCK IS WITHIN FL 
          RJM    VCA
          NJN    PRS5        IF ENOUGH SPACE FOR EXTENDED BLOCK 
          AOM    PRSA        SET *NOT ENOUGH SPACE* FLAG
  
*         READ FILE NAME AND FLAG BITS FROM ARGUMENT TABLE. 
  
 PRS5     RJM    GFA         READ FIRST WORD OF PARAMETER BLOCK 
          CRD    FN 
          ADN    1           READ FLAG BITS 
          CRD    CM 
          ADN    3           GET FNT ADDRESS
          CRD    CN 
          LDD    CN+4 
          STM    FFQA 
          LDD    CM+1        SAVE INPUT FLAGS 
          STM    INFL 
          LDD    CM+3        SAVE FLAG BITS 
          LPN    77 
          STD    FB 
          LDD    CM+4 
          STD    FB+1 
          SHN    21-6 
          MJN    PRS6        IF EXTENDED BLOCK SPECIFIED
          LJM    PRS15       BYPASS EXTENDED BLOCK PROCESSING 
  
*         SAVE FLAG BITS FOR EXTENDED PARAMETER BLOCK.
  
 PRS6     LDN    0
*         LDN    1           (NOT ENOUGH SPACE FOR EXTENDED BLOCK)
 PRSA     EQU    *-1
          NJN    PRS7        IF NOT ENOUGH SPACE
          RJM    GFA         GET EXTENDED FLAG BITS 
          ADN    7
          CRD    CN 
          LDD    CN+3 
          LPN    77 
          STM    EBIT 
          LDD    CN+4 
          STM    EBIT+1 
          LPK    EFOU+EFCU+EFSP+EFNV+EFSC+EFEP+EFRQ+EFDS+EFCH 
          ZJN    PRS8        IF NO PRIVILEGED FLAG BITS SET 
          LDD    ST 
          SHN    21-7 
          MJN    PRS7.1      IF CALLER IS *SSJ=*
          SHN    21-0-21+7
          PJN    PRS7.1      IF CALLER IS SUBSYSTEM 
 PRS7     LJM    PRS3        * DSP - INCORRECT REQUEST.*
  
 PRS7.1   LDM    EBIT+1      CHECK FOR SUBSYSTEM PROCESSING 
          LPN    EFSP 
          ZJN    PRS8        IF SUBSYSTEM PROCESSING BIT NOT SET
          LDD    ST          FLAG SUBSYSTEM 
          SCN    SSFL 
          STD    ST 
  
*         VALIDATE REMOTE TEXT ADDRESSES. 
  
 PRS8     RJM    GFA         CHECK IMPLICIT TEXT ADDRESS
          ADN    10 
          CRD    CM 
          RJM    VTA         VALIDATE TEXT ADDRESS
          STM    IRTL        SAVE LENGTH OF IMPLICIT TEXT 
          ZJN    PRS10       IF NO IMPLICIT TEXT SPECIFIED
          LDD    ST          CHECK FOR *SSJ=* 
          SHN    21-7 
          PJN    PRS7        IF NOT *SSJ=*
          LDD    FB+1 
          SHN    21-0 
          PJN    PRS10       IF NOT DEFERRED ROUTE
 PRS9     ERROR  /ERR/EC13   * DSP - DEFERRED ROUTING NOT ALLOWED.* 
  
 PRS10    RJM    GFA         CHECK EXPLICIT TEXT ADDRESS
          ADN    11 
          CRD    CM 
          RJM    VTA         VALIDATE TEXT ADDRESS
          STM    ERTL        SAVE LENGTH OF EXPLICIT TEXT 
          ZJN    PRS11       IF NO EXPLICIT TEXT SPECIFIED
          LDD    FS+3 
          SHN    21-5 
          PJN    PRS12       IF NOT VALIDATED TO SPECIFY LID
          LDD    FB+1 
          SHN    21-0 
          MJN    PRS9        IF DEFERRED ROUTE
  
*         PROCESS DATA DECLARATION. 
  
 PRS11    LDM    EBIT+1 
          SHN    21-0 
          PJN    PRS15       IF DATA DECLARATION NOT SPECIFIED
          LDD    FS+3 
          SHN    21-5 
          MJN    PRS13       IF VALIDATED TO SPECIFY LID
 PRS12    LJM    PRS18       * DSP - USER ACCESS NOT VALID.*
  
 PRS13    LDD    FB+1 
          SHN    21-0 
          MJN    PRS9        IF DEFERRED ROUTE
          RJM    GFA         GET DATA DECLARATION VALUE 
          ADN    7
          CRD    CM 
          LDD    CM          SAVE DATA DECLARATION
          STM    DDEC 
          LDN    TODDL
          STD    T1 
 PRS14    LDD    CM 
          LMM    TODD-1,T1
          ZJN    PRS15       IF LEGAL DATA DECLARATION
          SOD    T1 
          NJN    PRS14       IF MORE LEGAL VALUES TO CHECK
          ERROR  /ERR/EC14   * DSP - INCORRECT DATA DECLARATION.* 
  
*         CLEAR ERROR CODE IN PARAMETER BLOCK.
  
 PRS15    LDD    FN+3        CLEAR ERROR CODE 
          SCN    77 
          STD    FN+3 
          LDD    FN+4        CHECK COMPLETE BIT 
          STM    DSPC 
          LPN    1
          ZJN    PRS16       IF COMPLETE BIT CLEARED
          ERROR  /ERR/EC17   * DSP COMPLETE BIT ALREADY SET.* 
  
*         PROCESS *SLID*/*DLID* PARAMETERS. 
  
 PRS16    LDD    FB+1 
          SHN    21-3 
          MJN    PRS17       IF SLID/DLID SPECIFIED 
          LJM    PRS21       SET OUTPUT FILE DESTINATION
  
 PRS17    LDD    FS+3 
          SHN    21-5 
          MJN    PRS19       IF VALIDATED TO SPECIFY SLID/DLID
 PRS18    ERROR  /ERR/EC10   * DSP - USER ACCESS NOT VALID.*
  
 PRS19    RJM    GFA         GET SLID/DLID
          ADN    2
          CRD    CN 
          LDD    CN+1 
          SCN    77 
          SHN    6
          LMD    CN 
          SHN    6
          ZJN    PRS20       IF SLID NOT SPECIFIED
          RJM    VLD         VALIDATE SLID
          LDC    SLFL        SET *SLID SPECIFIED* FLAG
          RAD    ST 
 PRS20    LDD    CN+1 
          LPN    77 
          SHN    14 
          LMD    CN+2 
          ZJN    PRS21       IF DLID NOT SPECIFIED
          RJM    VLD         VALIDATE DLID
          LDC    DLFL        SET *DLID SPECIFIED* FLAG
          RAD    ST 
  
*         SET OUTPUT FILE DESTINATION, IF END OF JOB. 
  
 PRS21    LDD    CP          DETERMINE IF END OF JOB
          ADK    TFSW 
          CRD    CM 
          LDD    CM 
          STM    EJTO        SAVE EJT ORDINAL 
          SFA    EJT
          ADK    SCHE 
          CRD    T3 
          LDD    CP          GET END OF JOB DESTINATION 
          ADN    EOJW 
          CRD    CN 
          RJM    GFA
          ADN    1
          CRD    CM 
          LDD    T3+2 
          LPC    3000 
          LMK    NOTM*1000
          ZJN    PRS22       IF NOT END OF JOB
          LDD    CN          SET END OF JOB DESTINATION 
          SHN    -6 
          LPN    7
          STD    T7 
          LDM    TOQD,T7     GET CORRESPONDING DISPOSITION CODE 
          STD    T7 
          LDI    T7 
          STM    TSFN+TSFNL-1 
          LDD    CM          SET TERMINATION FLAG BITS
          SCN    77 
          RAD    FB 
 PRS22    LDD    CM+2        SET DISPOSITION CODE 
          STM    DDCB 
  
*         SET DEFAULT PUNCH MODE IN DISPOSITION TABLE.
  
          LDD    CP          CHECK KEYPUNCH MODE OF JOB 
          ADN    SNSW 
          CRD    CM 
          LDD    CM 
          SHN    21-12
          PJN    PRS23       IF O26 
 .A       IF     DEF,PU$
          LDM    TODCA+1
          SCN    70 
          LMN    P9FR*10
          STM    TODCA+1
 .A       ENDIF 
 .B       IF     DEF,PH$
          LDM    TODCB+1
          SCN    70 
          LMN    P9FR*10
          STM    TODCB+1
 .B       ENDIF 
  
*         CHECK FOR FORCED ORIGIN TYPE. 
  
 PRS23    LDM    EJTO        GET ORIGIN TYPE FROM EJT 
          SFA    EJT
          ADK    SCLE 
          CRD    CM 
          LDD    CM          SAVE ORIGIN TYPE OF CALLING JOB
          SCN    60 
          STM    JBOT 
          LPN    17 
          STD    OT 
          LMK    SYOT 
          NJN    PRS26       IF NOT SYSTEM ORIGIN 
          LDN    SYFL        SET *SYOT* CP STATUS 
          RAD    ST 
          LDD    FN+4 
          SHN    21-13
          PJN    PRS26       IF NOT FORCED ORIGIN FLAG
          SHN    -21+13-1 
          LPN    77 
          STD    T7          SAVE FORCED ORIGIN CODE
          SBN    MXOT 
          PJN    PRS24       IF OUT OF RANGE
          LDM    TOOT,T7
          NJN    PRS25       IF LEGAL ORIGIN TYPE 
 PRS24    ERROR  /ERR/EC40   * DSP - INCORRECT ORIGIN TYPE.*
  
 PRS25    LDD    T7 
          STM    FSOT        SAVE FORCED ORIGIN TYPE
  
*         CHECK FOR FORCED SERVICE CLASS. 
  
 PRS26    RJM    GFA         GET FORCED SERVICE CLASS FLAG
          ADN    1
          CRD    CM 
          ADN    3           GET FORCED SERVICE CLASS 
          CRD    CN 
          LDD    CM+3 
          SHN    21-10
          PJN    PRS29       IF NOT FORCED SERVICE CLASS FLAG 
          LCN    0           PRESET USER DEFAULT SELECTED 
          STD    T7 
          LDD    CN+1 
          LMC    2RDF 
          ZJN    PRS28       IF USER DEFAULT SELECTED 
          LDN    MXSC-1      SET TABLE INDEX
          STD    T7 
 PRS27    LDM    TSCC,T7
          LMD    CN+1 
          ZJN    PRS28       IF MATCH 
          SOD    T7          DECREMENT INDEX
          NJN    PRS27       IF NOT END OF TABLE
          ERROR  /ERR/EC11   * DSP - UNDEFINED SERVICE CLASS.*
  
 PRS28    LDD    T7          SAVE FORCED SERVICE CLASS
          STM    FSSC 
  
*         PROCESS SUBSYSTEM INITIATION PARAMETERS.
  
 PRS29    RJM    GFA         GET POSSIBLE SUBSYSTEM NAME / FORCED JSN 
          ADN    6
          CRD    CN 
          LDD    CN+3        SAVE JSN 
          LPN    77 
          SHN    14 
          LMD    CN+4 
          SHN    -6+22
          STM    FJSN 
          SHN    -6 
          SCN    77 
          LMN    1R          SPACE FILL JSN 
          STM    FJSN+1 
          LDM    EBIT+1      CHECK SUBSYSTEM/CONTROL POINT SELECTION
          LPN    EFCP 
          ZJN    PRS30       IF NO SUBSYSTEM/CONTROL POINT SELECTED 
          LDN    NCPL        GET NUMBER OF CONTROL POINTS IN SYSTEM 
          CRD    CM 
          RJM    GFA         GET PARAMETER BLOCK ADDRESS
          ADN    12 
          CRD    CN          READ PARAMETERS
          LDD    CN+3        CHECK CONTROL POINT NUMBER 
          LPN    77 
          SBD    CM+1 
          ZJN    PRS29.1     IF LAST CONTROL POINT NUMBER 
          PJN    PRS31       IF INCORRECT CONTROL POINT NUMBER
 PRS29.1  ADD    CM+1 
          NJN    PRS29.2     IF CONTROL POINT SELECTED
          LDN    77          SELECT ANY AVAILABLE CONTROL POINT 
 PRS29.2  STM    SBCP        PRESET CONTROL POINT SELECTION 
          LDD    CN+4        CHECK SSID 
          ZJN    PRS31       IF NOT SPECIFIED 
          STM    SBID        PRESET SSID
          LDD    FB+1 
          SHN    21-13
          PJN    PRS31       IF SUBSYSTEM INITIATION NOT SET
 PRS30    LJM    PRSX        RETURN 
  
 PRS31    LJM    PRS3        * DSP - INCORRECT REQUEST *
 TSCC     SPACE  4,10 
**        TSCC - TABLE OF SERVICE CLASS CODES.
* 
*         INDEXED BY SERVICE CLASS. 
* 
*T        12/ SVC 
* 
*                SVC = SERVICE CLASS IN DISPLAY CODE. 
  
  
 TSCC     BSS    0
          LOC    0
  
          DATA   H+"NMSC"+
  
          LOC    *O 
 VLD      SPACE  4,15 
**        VLD - VALIDATE LID. 
* 
*         ENTRY  (A) = LID. 
* 
*         EXIT   TO *ERR* IF INCORRECT LID SPECIFIED. 
* 
*         CALLS  VID. 
* 
*         MACROS ERROR. 
  
  
 VLD      SUBR               ENTRY/EXIT 
          MJN    VLD1        IF NOT SPECIAL CODE
          SBN    MXLC 
          MJN    VLDX        IF VALID SPECIAL CODE
          ADN    MXLC 
 VLD1     RJM    VID         VALIDATE LOGICAL ID
          NJN    VLDX        IF VALID LID FOUND 
          ERROR  /ERR/EC15   * DSP - INCORRECT LID.*
 VTA      SPACE  4,15 
**        VTA - VALIDATE TEXT ADDRESS.
* 
*         ENTRY  (CM+3 - CM+4) = ADDRESS OF REMOTE TEXT.
* 
*         EXIT   (A) = LENGTH OF REMOTE TEXT (IN CM WORDS). 
*                (A) = 0 IF NO TEXT.
*                TO *ERR* IF TEXT OUTSIDE FL, OR IF BAD TEXT LENGTH.
* 
*         USES   T3, CN - CN+4. 
* 
*         CALLS  DV5, VCA.
* 
*         MACROS ERROR. 
  
  
 VTA      SUBR               ENTRY/EXIT 
          LDD    CM+3 
          LPN    77 
          SHN    14 
          LMD    CM+4 
          ZJN    VTAX        IF NO TEXT 
          RJM    VCA         VALIDATE CENTRAL ADDRESS 
          ZJN    VTA1        IF TEXT NOT WITHIN FL
          SHN    -6+22       READ LENGTH OF TEXT
          ADD    RA 
          SHN    6
          CRD    CN 
          LDD    CN+4        CHECK TEXT LENGTH
          ZJN    VTA1        IF INCORRECT LENGTH
          ADC    -257D
          PJN    VTA1        IF INCORRECT LENGTH
          ADC    257D+1      ROUND UP 
          SHN    -1          CONVERT CHARACTER LENGTH TO CM WORDS 
          RJM    DV5
          STD    T3 
          LDD    CM+3        ENSURE ENTIRE TEXT IS WITHIN FL
          LPN    77 
          SHN    14 
          LMD    CM+4 
          ADD    T3 
          RJM    VCA         VALIDATE ADDRESS 
          ZJN    VTA1        IF TEXT NOT WITHIN FL
          LDD    T3          RETURN LENGTH OF TEXT
          LJM    VTAX        RETURN 
  
 VTA1     ERROR  /ERR/EC12   * DSP - INCORRECT REQUEST.*
 TODD     SPACE  4,10 
**        TODD - TABLE OF LEGAL DATA DEFINITIONS. 
  
  
 TODD     BSS    0
          CON    2LC6 
          CON    2LC8 
          CON    2LUS 
          CON    2LUU 
 TODDL    EQU    *-TODD 
 TOOT     SPACE  4,10 
**        TOOT - TABLE OF ORIGIN TYPES. 
* 
*T        12/FO 
* 
*         FO = IF NONZERO, THIS ORIGIN TYPE IS VALID AS A 
*                ORIGIN TYPE FOR *SYOT* CALLERS.
  
  
 TOOT     INDEX 
          INDEX  SYOT,2 
          INDEX  BCOT,2 
          INDEX  EIOT,2 
          INDEX  IAOT,2 
          INDEX  MXOT 
 TOQD     SPACE  4,10 
**        TOQD - TABLE OF QUEUE DESTINATIONS. 
* 
*T        12/DC 
* 
*         DC= DESTINATION CODE FOR SPECIFIED QUEUE
  
  
 TOQD     INDEX 
          INDEX  QOJT,(=C*LP*)  QUEUE ALL OUTPUT
          INDEX  NOJT,(=C*SC*)  DROP ALL OUTPUT 
          INDEX  TTJT,(=C*TT*)  OUTPUT TO INTERACTIVE QUEUE 
          INDEX  SSJT,(=C*SS*)  OUTPUT TO STATION OUTPUT QUEUE
          INDEX  MXJT 
          SPACE  4,10 
**        COMMON DECKS. 
  
  
*CALL     COMPCRS 
*CALL     COMPCUA 
 RND$     EQU    1           FORCE ROUNDING ON *DV5* CONVERSION 
*CALL     COMPDV5 
          SPACE  4,10 
 IFP      HERE               REMOTE INITIALIZATION CODE 
          SPACE  4,10 
          OVERFLOW  PPFW,EPFW 
          OVERLAY  (FILE DESTINATION ROUTINES.),OVL4
 CAA      SPACE  4,10 
**        CAA - CHECK ALTERNATE FAMILY/USER ACCESS. 
* 
*         ENTRY  (ST) = STATUS WORD.
* 
*         EXIT   TO *ERR* IF ACCESS NOT ALLOWED.
* 
*         USES   T1, T4 - T7, CM - CM+4, UN - UN+4. 
* 
*         CALLS  CPN, RFN, SSJ. 
* 
*         MACROS ERROR. 
  
  
 CAA      SUBR               ENTRY/EXIT 
          LDD    ST 
          LPN    SYFL 
          NJN    CAAX        IF SYSTEM ORIGIN 
          LDD    ST 
          LPN    SSFL 
          ZJN    CAAX        IF SUBSYSTEM PROCESSING
          RJM    SSJ         CHECK FOR *SSJ=* BLOCK 
          ZJN    CAA1        IF NO *SSJ=* BLOCK 
          ADK    AACS        READ ACCESS WORD 
          CRD    T4 
          ADK    UIDS-AACS
          UJN    CAA2        READ USER NAME 
  
 CAA1     LDD    CP          READ ACCESS WORD 
          ADK    AACW 
          CRD    T4 
          ADK    UIDW-AACW   READ USER NAME 
 CAA2     CRD    UN          READ USER NAME 
          LDD    T4+2 
          SHN    21-6 
          MJN    CAA3        IF ROUTE TO ALTERNATE FAMILY ALLOWED 
          RJM    RFN         READ FAMILY NAME 
          CRD    CM 
          LDN    CM 
          STD    T1          SET CURRENT FAMILY NAME ADDRESS
          LDC    FMSS        SET NEW FAMILY NAME ADDRESS
          RJM    CPN         COMPARE FAMILY NAMES 
          ZJN    CAA3        IF SAME FAMILY 
          ERROR  /ERR/EC46   * DSP - ALTERNATE FAMILY NOT ALLOWED.* 
  
 CAA3     LDD    T4+2 
          SHN    21-5 
          MJN    CAA4        IF ROUTE TO ALTERNATE USER NAME ALLOWED
          LDN    UN          SET CURRENT USER NAME ADDRESS
          STD    T1 
          LDC    ACSS        SET NEW USER NAME ADDRESS
          RJM    CPN         COMPARE USER NAMES 
          NJN    CAA5        IF NOT SAME USER NAME
 CAA4     LJM    CAAX        RETURN 
  
 CAA5     ERROR  /ERR/EC51   * DSP - ALTERNATE USER NOT ALLOWED.* 
 CPN      SPACE  4,10 
**        CPN - COMPARE NAMES.
* 
*         ENTRY  (A) = ADDRESS OF SECOND NAME TO COMPARE. 
*                (T1) = ADDRESS OF FIRST NAME TO COMPARE. 
* 
*         EXIT   (A) = 0 IF NAMES MATCH.
*                (A) .NE. 0 IF NAMES DO NOT MATCH.
* 
*         USES   T1, T2.
  
  
 CPN      SUBR               ENTRY/EXIT 
          STD    T2          SET SECOND NAME ADDRESS
          ADN    3           SET ADDRESS OF LAST BYTE 
          STD    T0 
 CPN1     LDI    T1 
          LMI    T2 
          NJN    CPNX        IF NO MATCH
          AOD    T1 
          AOD    T2 
          LMD    T0 
          NJN    CPN1        IF MORE FULL BYTES TO CHECK
          LDI    T1 
          LMI    T2 
          SCN    77 
          UJN    CPNX        RETURN WITH (A) = 0 IF MATCH 
 VIF      SPACE  4,25 
**        VIF - VERIFY INPUT FILE.
* 
*         ENTRY  (FB - FB+1) = FLAG BITS. 
*                (FS - FS+4) = FST ENTRY. 
*                (OT) = ORIGIN TYPE.
* 
*         EXIT   (FN - FN+4) = FNT ENTRY FOR INPUT FILE.
*                (FS - FS+4) = FST ENTRY. 
* 
*         ERROR  TO *ERR*, IF ONE OF THE FOLLOWING OCCURS,
*                ROUTE TO INPUT NOT IMMEDIATE.
*                IMMEDIATE ROUTE - NO FILE. 
*                INCORRECT USER COMMAND.
*                JOB COMMAND ERROR. 
*                INCORRECT JOB ABORT CODE.
*                INCORRECT SERVICE CLASS. 
*                ALTERNATE FAMILY NOT ALLOWED.
*         ERROR  TO *EER3* IF INACCESSIBLE DEVICE RETURN BY *0VJ*.
* 
*         USES   ST, T1, T3, T5 - T7, FN - FN+4, CM - CM+4, CN - CN+4,
*                UN - UN+4. 
* 
*         CALLS  CAA, CPN, CVS, GFA, GFM, GFO, RFN, RNS, SQO, SSJ, WMS, 
*                *0VJ*. 
* 
*         MACROS ENDMS, ERROR, EXECUTE, SETMS.
  
  
 VIF      SUBR               ENTRY/EXIT 
          LDM    INFL        CHECK INPUT FLAGS
          SHN    21-10
          MJP    VIF15       IF FORCED ABORT FLAG SET 
  
*         READ FIRST SECTOR OF INPUT FILE.
  
          AOM    VIFA        INDICATE FIRST SECTOR OF FILE WAS READ 
          LDD    FS          SET EQUIPMENT
          STD    T5 
          LDD    FS+1        SET FIRST TRACK
          STD    T6 
          LDN    FSMS        SET FIRST SECTOR 
          STD    T7 
          SETMS  IO 
          LDC    SBUF        READ NEXT SECTOR 
          RJM    RNS
          ENDMS 
          LDD    T1 
          NJN    VIF2        IF FILE NOT EMPTY
          ERROR  /ERR/EC06   * DSP - IMMEDIATE ROUTING - NO FILE.*
  
*         VALIDATE JOB COMMAND AND USER COMMAND.
  
 VIF2     LDC    STMT        SET COMMAND BUFFER ADDRESS 
          STD    CN 
          LDM    DLAT        SET DLID ATTRIBUTES
          STD    CN+1 
          LDM    LFAL        SET LOCAL FILE ACCESS LEVEL
          STD    CN+2 
          LDM    EBIT+1      PASS *DO NOT VALIDATE PASSWORD* FLAG 
          LPN    EFNV 
          STM    VIFE+1 
          SHN    13-4 
          ERRNZ  EFNV-20     CODE DEPENDS ON VALUE
          RAD    CN+2 
          LDD    ST 
          LPN    DSFL        IF FILE ROUTED BEFORE, CHECK ENCRYPTED PW
          SHN    12-1 
          ERRNZ  DSFL-2      CODE DEPENDS ON VALUE
          RAD    CN+2 
          LDM    EBIT+1 
          LPK    EFEP 
          ZJN    VIF3        IF ENCRYPTED PASSWORD NOT SPECIFIED
          LDD    CN+2        SET ENCRYPTED PW VALIDATION BIT
          LPC    5777 
          LMC    2000 
          STD    CN+2 
          RJM    GFA         GET PARAMETER BLOCK ADDRESS
          ADN    14 
          CRD    CM 
          LDD    MA          MOVE PASSWORD TO SYSTEM SECTOR 
          CWD    CM 
          CRM    EPSS,ON
 VIF3     LDD    OT 
          LMK    SYOT 
          NJN    VIF3.1      IF NOT ROUTE TO *SYOT* 
          LDC    1000        SET SYSTEM ORIGIN JOB BIT
          RAD    CN+2 
 VIF3.1   LDD    ST 
          LPK    DLFL 
          NJN    VIF4        IF DLID SPECIFIED IN PARAMETER BLOCK 
          LDD    ST 
          LPK    DSFL 
          ZJN    VIF3.2      IF NOT PREVIOUSLY ROUTED FILE
          LDM    DLID 
          ADM    DLID+1 
          NJN    VIF4        IF DLID NONZERO
 VIF3.2   STD    CN+1        CLEAR DLID ATTRIBUTES
 VIF4     EXECUTE 0VJ,OVL3   VERIFY JOB/USER COMMANDS 
          MJP    EER3        IF MASS STORAGE DEVICE INACCESSIBLE
          LDD    ST 
          LPN    SSFL 
          ZJN    VIF4.1      IF SUBSYSTEM CALLER
          LDD    CP          USE DEFERRED BATCH LIMIT OF OWNER USER 
          ADK    ALMW 
          CRD    CM 
          LDD    CM+1 
          LMM    VASS+AHMT*5+1
          SCN    70 
          LMD    CM+1 
          STM    VASS+AHMT*5+1
 VIF4.1   LDD    FN+4 
          LPN    77 
          LMC    INFT*100 
          STD    FN+4 
          LDD    CN 
          ZJN    VIF5        IF DLID NOT SPECIFIED
          STM    DLAT        SET DLID ATTRIBUTES
          LJM    VIF6.3      ALLOW ALTERNATE FAMILY/USER WITH DLID
  
 VIF5     RJM    CAA         CHECK ALTERNATE FAMILY/USER ACCESS ALLOWED 
  
*         VERIFY THAT THE FAMILY AND THE USER INDEX HAVE NOT BEEN 
*         CHANGED IF THE *DO NOT VALIDATE PASSWORD* FLAG IS SET.
  
 VIFE     LDC    **          (*DO NOT VALIDATE PASSWORD* FLAG)
          ZJN    VIF6.3      IF PASSWORD VALIDATION REQUIRED
          RJM    RFN         READ FAMILY NAME 
          CRD    CM 
          LDN    CM          SET CURRENT FAMILY NAME ADDRESS
          STD    T1 
          LDC    FMSS        ADDRESS OF FAMILY IN SYSTEM SECTOR 
          RJM    CPN         COMPARE FAMILY NAMES 
          NJN    VIF6.2      IF DIFFERENT FAMILIES
          RJM    SSJ         CHECK FOR *SSJ=* BLOCK 
          ZJN    VIF6        IF NO *SSJ=* BLOCK 
          ADK    UIDS 
          UJN    VIF6.1      CHECK USER INDEX 
  
 VIF6     LDD    CP          GET CP USER INDEX
          ADK    UIDW 
 VIF6.1   CRD    CM 
          LDD    CM+3 
          LMM    ACSS+3 
          LPN    37 
          SHN    14 
          ADD    CM+4 
          LMM    ACSS+4 
 VIF6.2   NJP    VIF7        IF DIFFERENT USER INDEX
  
*         CHECK FOR USER COMMAND ERROR. 
  
 VIF6.3   LDD    ER          CHECK ERROR STATUS 
          LMN    3
          NJP    VIF9        IF NOT USER COMMAND ERROR
          LDM    DLAT 
          SHN    21-13
          MJN    VIF6.4      IF HOST LID
          SHN    21-11-21+13
          PJN    VIF9        IF VALIDATION NOT REQUIRED FOR DLID
 VIF6.4   LDN    0           CLEAR DLID 
          STM    IOSS+INSQ*5+1
          LDM    IOSS+INSQ*5+2
          LPN    77 
          STM    IOSS+INSQ*5+2
          LDD    OT 
          LMK    SYOT 
          ZJN    VIF10       IF ROUTE TO *SYOT* - IGNORE USER COMMAND 
          LDD    ST 
          LPN    SSFL 
          NJN    VIF6.5      IF NOT SUBSYSTEM CALL
          LDM    INFL 
          SHN    21-7 
          MJN    VIF9        IF FILE TO BE QUEUED 
 VIF6.5   LDM    JASS        CHECK ERROR CODE 
          LMN    UCIE 
          ZJN    VIF8        IF USER SECURITY COUNT EXHAUSTED 
 VIF7     ERROR  /ERR/EC34   * DSP - INCORRECT USER COMMAND.* 
  
 VIF8     ERROR  /ERR/EC47   * DSP - USER SECURITY COUNT EXHAUSTED.*
  
 VIF9     LJM    VIF11       CHECK SERVICE CLASS
  
*         SET *SYSTEMX* LIMITS FOR SYSTEM JOBS WITH NO
*         OR INCORRECT USER COMMANDS. 
  
 VIF10    LDD    MA          SAVE THE FNT ENTRY 
          CWD    FN 
          CRM    VIFB,ON
          LDN    1           GET DEFAULT FAMILY NAME
          RJM    GFM
          LDD    MA          SET UN/UI IN VALIDATION BLOCK
          CWM    VIFC,ON
          CWD    FN 
          ADN    1
          CWM    VIFD,ON
          LDD    MA 
          CRM    VASS+ACCN*5,ON 
          SBN    1
          CRM    ACSS,ON     SET USER NAME
          CRM    FMSS,ON     SET FAMILY NAME
          CRM    VASS+AHMT*5,ON  SET UNLIMITED USER VALIDATION INDICES
          SBN    1
          CRM    VASS+AHDS*5,ON 
          SBN    1
          CRM    VASS+AAWC*5,ON 
          LDD    MA          RESTORE FNT ENTRY
          CWM    VIFB,ON
          SBN    1
          CRD    FN 
  
*         CHECK FOR SERVICE CLASS SPECIFIED IN PARAMETER BLOCK. 
  
 VIF11    LDD    FB+1 
          SHN    21-13
          MJP    VIF15       IF SUBSYSTEM INITIATION
          LDM    EBIT+1 
          LPK    EFSC 
          ZJN    VIF12       IF ORIGIN DEFAULT NOT SELECTED 
          LDM    VIFT,OT
          LJM    VIF14       SET ORIGIN DEFAULT 
  
 VIF12    LDM    FSSC 
          SHN    6
          STD    T1 
          ZJP    VIF15       IF NO SERVICE CLASS SPECIFIED
          PJN    VIF13       IF NOT USER DEFAULT
          LDD    CN+1        USE DEFAULT RETURNED BY *0VJ*
          STM    FSSC 
          SHN    6
          STD    T1 
          ZJP    VIF23       IF INCORRECT USER DEFAULT
 VIF13    RJM    CVS         CHECK FOR VALID SERVICE CLASS
          NJP    VIF23       IF ERROR 
          LDM    IOSS+SCLQ*5 UPDATE SERVICE CLASS IN QFT ENTRY
          LPN    77 
          LMD    T1 
 VIF14    STM    IOSS+SCLQ*5
          LDM    JASS 
          LMN    SCIE 
          ZJN    VIF14.1     IF INCORRECT SERVICE CLASS 
          LMN    USIE&SCIE
          NJN    VIF15       IF NOT UNDEFINED SERVICE CLASS ERROR 
 VIF14.1  STM    JASS        CLEAR ERROR IF SKIPPING VALIDATION 
  
*         CHECK FOR JOB COMMAND ERRORS. 
  
 VIF15    LDM    JASS 
          ZJP    VIF25       IF NO ERROR
          LMN    SCIE 
          ZJN    VIF17       IF INCORRECT SERVICE CLASS 
          LMN    USIE&SCIE
          NJN    VIF18       IF DEFINED SERVICE CLASS 
 VIF17    LDM    VIFT,OT     RESET SERVICE CLASS
          STM    IOSS+SCLQ*5
 VIF18    LDM    INFL        GET INPUT FLAGS
          SHN    21-7 
          PJN    VIF18.1     IF FILE NOT TO BE QUEUED 
          AOM    DSPF        FLAG ABORTED INPUT FILE
          LJM    VIF27       QUEUE THE FILE 
  
 VIF18.1  LDM    JASS        CHECK ERROR FLAG 
          LMN    JCIE 
          NJN    VIF19       IF NOT JOB COMMAND ERROR 
          ERROR  /ERR/EC32   (JOB COMMAND ERROR.) 
  
 VIF19    LMN    IDIE&JCIE
          NJN    VIF20       IF NOT INCORRECT LID 
          ERROR  /ERR/EC15   * DSP - INCORRECT LID.*
  
 VIF20    LMN    STIE&IDIE
          NJN    VIF22       IF NOT INCORRECT ATTEMPT TO SPECIFY *ST* 
 VIF21    ERROR  /ERR/EC10   * DSP - USER ACCESS NOT VALID.*
  
 VIF22    LMN    SCIE&STIE
          NJN    VIF24       IF NOT INCORRECT SERVICE CLASS 
 VIF23    ERROR  /ERR/EC45   * DSP - INCORRECT SERVICE CLASS.*
  
 VIF24    LMN    USIE&SCIE
          NJN    VIF25       IF NOT UNDEFINED SERVICE CLASS ERROR 
          ERROR  /ERR/EC11   * DSP - UNDEFINED SERVICE CLASS.*
  
 VIF25    LDM    IOSS+INSQ*5+1
          NJN    VIF26       IF DLID SPECIFIED ON JOB COMMAND 
          LDD    ST 
          LPC    DLFL 
          ZJN    VIF27       IF DLID NOT SPECIFIED IN PARAMETER BLOCK 
 VIF26    LDD    CP 
          ADK    AACW        CHECK FOR *CUST* VALIDATION
          CRD    CM 
          LDD    CM+3 
          SHN    21-5 
          PJN    VIF21       IF CALLING USER NOT VALIDATED TO USE *ST*
          SHN    21-4-21+5   CHECK FOR *CQLK* VALIDATION
          MJN    VIF27       IF CALLING USER VALIDATED TO USE LCN 
          LDM    DLAT 
          SHN    21-13
          PJP    VIF21       IF DLID DOES NOT HAVE *HOST* ATTRIBUTE 
  
*         SET QUEUE FILE OWNERSHIP. 
  
 VIF27    LDD    ST          CHECK IF SUBSYSTEM CALL
          LPN    SSFL 
          ZJN    VIF28       IF SUBSYSTEM 
          RJM    SQO         SET QFT OWNER
          LJM    VIF29       CONTINUE 
  
 VIF28    LDD    MA          SAVE FILE NAME 
          CWD    FN 
          CRD    UN 
          CWM    ACSS,ON     SET ACCOUNT OF OWNER 
          CWM    FMSS,ON     SET FAMILY OF OWNER
          LDD    MA 
          CRM    OASS,ON
          CRM    FOSS,ON
          SBN    1
          CRD    FN          GET FAMILY ORDINAL 
*         LDN    (NONZERO)
          RJM    GFO         GET FAMILY ORDINAL 
          LDD    FN+4 
          SHN    6
          LMM    OASS+3      SET *FO,UI* OF OWNER 
          SCN    77 
          LMM    OASS+3 
          STM    IOSS+JSNQ*5+2
          LDM    OASS+4 
          STM    IOSS+JSNQ*5+3
          LDD    MA 
          CWD    UN 
          CRD    FN 
  
*         SET ACCOUNTING INFORMATION INTO SYSTEM SECTOR.
  
 VIF29    LDD    FB          CHECK IF NO ACCOUNTING SET 
          SHN    21-4 
          PJN    VIF30       IF NO ACCOUNTING INFORMATION 
          RJM    GFA         SET ACCOUNTING INFORMATION 
          ADN    5
          CRD    CM 
          ADN    1
          CRM    TNSS,ON     READ TERMINAL NAME OR EST ORDINAL
          LDD    CM+3        SET COMMAND COUNT
          STM    CRSS 
          LDD    CM+4 
          STM    CRSS+1 
  
*         SET ABORT CODE IN SYSTEM SECTOR.
  
 VIF30    LDM    INFL        CHECK INPUT FLAGS
          SHN    21-10
          PJN    VIF31       IF FORCED ABORT FLAG NOT SET 
          LDM    JASS 
          NJN    VIF31       IF ERROR STATUS ALREADY SET
          RJM    GFA         GET JOB ABORT CODE 
          ADN    4
          CRD    CM 
          LDD    CM+2        SAVE JOB ABORT CODE
          STM    JASS 
          SBN    MXIE 
          MJN    VIF31       IF VALID JOB ABORT CODE
          ERROR  /ERR/EC42   * DSP - INCORRECT JOB ABORT CODE.* 
  
 VIF31    LDD    FB+1        CHECK FOR SUBSYSTEM INITIATION 
          SHN    21-13
          PJN    VIF32       IF NOT SUBSYSTEM INITIATION
          LDM    SBID        SET SUBSYSTEM ID 
          STM    SISS 
          LDM    SBCP        SET CONTROL POINT NUMBER SPECIFICATION 
          STM    CPSS 
 VIF32    LDN    SCFL        SET REQUEST SCHEDULER FLAG 
          RAD    ST 
  
*         *0VJ* CALLS *0AV* TO VALIDATE THE USER NAME EVEN IF THE 
*         *PRE-VALIDATE* BIT IS NOT SET IN THE LID CONFIGURATION
*         TABLE.  ALSO, *0VJ* ALWAYS DELETES THE PASSWORD FROM THE
*         BUFFER CONTAINING THE FIRST SECTOR OF THE INPUT FILE. 
*         THEREFORE, THE BUFFER CONTAINING THE FIRST SECTOR OF THE
*         INPUT FILE SHOULD NOT BE REWRITTEN TO THE FILE IF BOTH OF 
*         THE FOLLOWING CONDITIONS ARE PRESENT -
*         1) THE PASSWORD WAS NOT VALID, AND
*         2) THE FILE WAS DESTINED FOR ANOTHER MAINFRAME. 
  
 VIFA     LDN    0           CHECK IF FIRST SECTOR HAS BEEN READ
*         LDN    1           (FIRST SECTOR HAS BEEN READ) 
          ZJN    VIF35       IF FIRST SECTOR HAS NOT BEEN READ
          LDM    JASS 
          LMN    UNIE 
          NJN    VIF33       IF USER NAME/PASSWORD VALID
          LDM    DLAT 
          SHN    21-13
          PJN    VIF35       IF NOT HOST LID
 VIF33    LDD    FS          SET DISK ADDRESS 
          STD    T5 
          LDD    FS+1 
          STD    T6 
          LDN    FSMS 
          STD    T7 
          SETMS  IO,RW
          LDC    SBUF+WLSF
          RJM    WMS         WRITE SECTOR 
 VIF34    ENDMS 
 VIF35    LJM    VIFX        RETURN 
  
 VIFB     BSS    5           BUFFER FOR FNT ENTRY 
 VIFC     VFD    42/0,18/SYUI 
 VIFD     VFD    60/-0
  
  
*         TABLE OF DEFAULT ORIGIN TYPE AND SERVICE CLASS DESCRIPTORS
*         FOR INPUT FILES.
  
 VIFT     BSS    0
          LOC    0
          VFD    6/SYSC,6/SYOT  SYSTEM SERVICE CLASS
          VFD    6/BCSC,6/BCOT  BATCH SERVICE CLASS 
          VFD    6/RBSC,6/RBOT  REMOTE BATCH SERVICE CLASS
          VFD    6/BCSC,6/BCOT  INTERACTIVE SERVICE CLASS 
          LOC    *O 
 CRF      SPACE  4,10 
**        CRF - CLEAR REMOTE FAMILY/USER NAME.
* 
*         EXIT (RFSS - RFSS+4) AND (RUSS - RUSS+4) ARE CLEARED. 
  
  
 CRF      SUBR               ENTRY/EXIT 
          LDK    ZERL        CLEAR REMOTE FAMILY
          CRM    RFSS,ON
          SBN    1           CLEAR REMOTE USER NAME 
          CRM    RUSS,ON
          UJN    CRFX        RETURN 
 CVS      SPACE  4,10 
**        CVS - CHECK FOR VALID SERVICE CLASS.
* 
*         ENTRY  (FSSC) = SERVICE CLASS TO BE VALIDATED.
*                (CN+2 - CN+4) = SERVICE CLASS VALIDATION MASK. 
* 
*         EXIT   (A) = ERROR CODE.  ZERO IF NO ERROR. 
* 
*         USES   T3.
* 
*         CALLS  VSP. 
  
  
 CVS3     LDN    0           INDICATE NO ERROR
  
 CVS      SUBR               ENTRY/EXIT 
          LDM    EBIT+1 
          LPK    EFDS 
          NJN    CVS3        IF NOT TO VALIDATE SERVICE CLASS 
          LDN    0           PRESET NON-SUBSYSTEM AND NON-SSJ= JOB
          STD    T3 
          LDM    EBIT+1 
          LPN    EFCU 
          NJN    CVS2        IF CREATION FAMILY/USER SPECIFIED
          LDD    QT 
          LMK    INQT 
          ZJN    CVS2        IF INPUT FILE
          LDD    ST 
          LPN    SSFL 
          ZJN    CVS1        IF SUBSYSTEM 
          LDD    ST 
          LPK    SYFL 
          ZJN    CVS2        IF CALLING JOB IS NOT *SYOT* 
          LDD    ST 
          LPK    SJFL 
          ZJN    CVS2        IF CALLING PROGRAM IS NOT *SSJ=* 
 CVS1     LDN    1           SET SUBSYSTEM OR *SYOT*/*SSJ=* CALLER
          STD    T3 
 CVS2     LDM    FSSC 
          RJM    VSP         VALIDATE SERVICE CLASS 
          UJN    CVSX        RETURN 
          SPACE  4,10 
**        COMMON DECKS. 
  
  
 CUV$     EQU    1           CHECK SERVICE CLASS VALID FOR USER 
*CALL     COMPVSP 
          SPACE  4,10 
          USE    OVL
          ERRNG  SBUF-*      OVERFLOW INTO *0VJ* COMMAND BUFFER 
          TITLE  OVERLAYABLE ROUTINES.
 DFO      SPACE  4,10 
**        DFO - DESTINATION FAMILY ORDINAL. 
* 
*         ENTRY  (FDSS) = DESTINATION FAMILY NAME.
* 
*         EXIT   ROUTING INFORMATION UPDATED. 
* 
*         USES   FN - FN+4, UN - UN+4.
* 
*         CALLS  GFO. 
  
  
 DFO      SUBR               ENTRY/EXIT 
          LDD    MA          PRESERVE FILE NAME 
          CWD    FN 
          CRD    UN 
          CWM    FDSS,ON
          SBN    1
          CRD    FN 
*         LDN    (NONZERO)   DO NOT ADD FAMILY
          RJM    GFO         GENERATE FAMILY ORDINAL
          LDD    FN+4 
          SHN    6
          RAM    IOSS+SCLQ*5+1
          LDD    MA          RESTORE FILE NAME
          CWD    UN 
          CRD    FN 
          UJN    DFOX        RETURN 
 GUD      SPACE  4,10 
**        GUD - GET USER DEFAULT SERVICE CLASS. 
* 
*         ENTRY  (T3) = ADDRESS OF ACCOUNT BLOCK. 
* 
*         EXIT   (FSSC) = USER DEFAULT SERVICE CLASS. 
*                (A) .EQ. SERVICE CLASS VALUE.
*                (A) .EQ. ZERO IF ERROR.
* 
*         USES   T1, T2.
  
  
 GUD      SUBR               ENTRY/EXIT 
          LDN    SYSC        PRESET SYSTEM ORIGIN DEFAULT 
          STD    T2 
          LDD    OT 
          LMK    SYOT 
          ZJP    GUD4        IF SYSTEM ORIGIN 
          LDN    0
          STD    T2 
          LDD    T3          GET ADDRESS OF USER DEFAULT
          ADK    ASC1*5 
          STD    T1 
          LDD    OT          SET BYTE NUMBER WITH USER DEFAULT
          SHN    21 
          STM    GUDA 
          PJN    GUD1        IF UPPER SIX BITS ARE USER DEFAULT 
          LDN    0
          STM    GUDB 
 GUD1     LDM    0,T1        GET USER DEFAULT SERVICE CLASS 
 GUDA     EQU    *-1         (BYTE NUMBER OF USER DEFAULT)
          SHN    -6 
*         SHN    0           (LOWER SIX BITS ARE USER DEFAULT)
 GUDB     EQU    *-1
          LPN    77 
          STD    T1 
 GUD2     LDM    TGUD,T2     GET SERVICE CLASS VALUE
          LMD    T1 
          ZJN    GUD4        IF MATCH 
          AOD    T2 
          SBN    MXSC 
          NJN    GUD2        IF NOT END OF SERVICE CLASSES
 GUD3     LJM    GUDX        RETURN 
  
 GUD4     LDD    T2          SET SERVICE CLASS
          STM    FSSC 
          UJN    GUD3        RETURN 
  
  
**        TGUD - TABLE OF USER DEFAULT SERVICE CLASSES. 
  
 TGUD     INDEX 
          LIST   D
 .SCL     HERE
          LIST   *
          INDEX  MXJC 
 NTS      SPACE  4,15 
**        NTS - NO TID SPECIFIED. 
* 
*         EXIT   FAMILY NAME DETERMINED FROM *FO*.
*                DESTINATION USER INDEX TAKEN FROM EJT. 
* 
*         ERROR  TO *ERR*, IF ONE OF THE FOLLOWING OCCURS,
*                INCORRECT TID. 
* 
*         USES   CN - CN+4, FN - FN+4, UN - UN+4. 
* 
*         CALLS  CRF, GEA, GFM. 
* 
*         MACROS ERROR. 
  
  
 NTS1     LDD    MA          SAVE FAMILY NAME 
          CWD    FN 
          CRM    FDSS,ON
 NTS2     LDD    MA          RESTORE (FN - FN+4)
          CWD    UN 
          CRD    FN 
          LDD    CN+1        SET DESTINATION UI 
          LMM    DASS+3 
          SCN    37 
          LMD    CN+1 
          STM    DASS+3 
          LDD    CN+2 
          STM    DASS+4 
          RJM    CRF         CLEAR REMOTE FAMILY/USER NAME
  
 NTS      SUBR               ENTRY/EXIT 
          LDD    ST 
          LPN    DSFL 
          NJN    NTSX        IF FILE PREVIOUSLY ROUTED
          RJM    GEA         GET *FO,UI* FROM EJT 
          ADK    SCLE 
          CRD    CN 
          LDD    MA          PRESERVE (FN - FN+4) 
          CWD    FN 
          CRD    UN 
          LDD    CN+1 
          SHN    -6 
          ZJN    NTS2        IF NO DESTINATION FAMILY SPECIFIED 
          RJM    GFM         GET FAMILY NAME
          NJP    NTS1        IF FAMILY NAME FOUND 
          ERROR  /ERR/EC21   * DSP - INCORRECT TID.*
 PSI      SPACE  4,15 
**        PSI - PROCESS SUBSYSTEM INITIATION. 
* 
*         ENTRY  (FJSN - FJSN+1) = SUBSYSTEM NAME.
*                (SBID) = SUBSYSTEM ID (IF SPECIFIED IN CALL).
* 
*         EXIT   (SBID) = SUBSYSTEM ID. 
*                TO ERR, IF INCORRECT REQUEST.
* 
*         USES   RI.
* 
*         CALLS  AST. 
* 
*         MACROS ERROR. 
  
  
 PSI      SUBR               ENTRY/EXIT 
          LDM    CUAV        CHECK USER ACCESS
          ZJN    PSI2        IF VALID USER
 PSI1     ERROR  /ERR/EC12   * DSP - INCORRECT REQUEST.*
  
 PSI2     LDD    QT 
          LMK    INQT 
          NJN    PSI1        IF NOT INPUT FILE
          LDD    OT 
          LMK    SYOT 
          NJN    PSI1        IF NOT ROUTE TO SYSTEM ORIGIN
          LDC    TSUB 
          STD    RI 
          LDM    SBID 
          ZJN    PSI3        IF SUBSYSTEM ID NOT SPECIFIED IN CALL
          SBK    LSSI+1 
          MJN    PSIX        IF SUBSYSTEM NOT IN *SSCT* SPECIFIED 
 PSI3     LDI    RI          SEARCH TABLE FOR SUBSYSTEM 
          LMM    FJSN 
          NJN    PSI4        IF NO MATCH
          LDM    1,RI 
          LMM    FJSN+1 
          ZJN    PSI6        IF MATCH 
 PSI4     LDN    TSUBE       GET NEXT TABLE ENTRY 
          RAD    RI 
          LMC    TSUBL
          NJN    PSI3        IF NOT END OF TABLE
 PSI5     LJM    PSI1        * DSP - INCORRECT REQUEST.*
  
 PSI5.1   LDM    SBID        CHECK FOR CYBIS
          LMC    PLSI 
          ZJP    PSIX        IF ALREADY ACTIVE
          UJN    PSI5        SET ERROR
  
 PSI6     LDM    SBID 
          ZJN    PSI6.1      IF SUBSYSTEM ID NOT SPECIFIED IN CALL
          LMM    2,RI 
          NJN    PSI5        IF SUBSYSTEM ID DID NOT MATCH NAME 
 PSI6.1   LDM    2,RI        SAVE SUBSYSTEM ID
          STM    SBID 
          LMC    FEAF*10000  CHECK FOR SUBSYSTEM ALREADY ACTIVE 
          RJM    AST
 PSI6.2   NJN    PSI5.1      IF SUBSYSTEM ALREADY ACTIVE
          LDM    SBID 
          LMC    RDSI 
          NJN    PSI9        IF NOT *RDF* 
          LDC    IFSI+FEAF*10000  CHECK IF *IAF* ACTIVE 
 PSI7     RJM    AST
          NJN    PSI6.2      IF SUBSYSTEM ACTIVE
 PSI8     LJM    PSIX        RETURN 
  
 PSI9     LMC    IFSI&RDSI
          NJN    PSI8        IF NOT *IAF* 
          LDC    RDSI+FEAF*10000
          UJN    PSI7        CHECK IF *RDF* ACTIVE
 TSUB     SPACE  4,10 
**        TABLE OF NON-PP-INITIATED SUBSYSTEMS. 
* 
*         ENTRY FORMAT. 
* 
*T        24/NAME, 12/SSID
* 
*         NAME = 3-CHARACTER SUBSYSTEM NAME + BLANK.
*         SSID = SUBSYSTEM ID.
  
  
 TSUB     BSS    0
          LIST   G
 .SUB     HERE
          LIST   *
 TSUBL    BSS    0           END OF TABLE 
 SBI      SPACE  4,10 
**        SBI - SET BATCH ID. 
* 
*         ENTRY  (CM - CM+4) = SECOND WORD OF ARGUMENT TABLE. 
*                (CM - CM+4) = 0 IF NO BATCH ID IS SPECIFIED. 
*                (FB+1) = FLAG BITS.
*                (OT) = DESTINATION ORIGIN TYPE.
* 
*         EXIT   QFT UPDATED. 
* 
*         ERROR  TO *ERR*, IF ONE OF THE FOLLOWING OCCURS,
*                INCORRECT TID. 
* 
*         USES   T1, T2.
* 
*         CALLS  CRF. 
* 
*         MACROS ERROR. 
  
  
 SBI      SUBR               ENTRY
          LDD    FB+1 
          LPN    4
          NJN    SBI0        IF BATCH ID SPECIFIED
          LDM    IOSS+SCLQ*5+1
          ZJN    SBIX        IF BATCH ID IS ALREADY SET 
 SBI0     LDD    CM+3 
          STM    IOSS+SCLQ*5+1
          ZJN    SBI2        IF VALID TID 
 SBI1     ERROR  /ERR/EC21   * DSP - INCORRECT TID.*
  
 SBI2     LDD    CM+4 
          STM    IOSS+SCLQ*5+2
          SBN    IDLM 
          PJN    SBI1        IF ID .GT. MAXIMUM ALLOWED 
          LDN    ZERL        CLEAR DESTINATION FAMILY 
          CRM    FDSS,ON
          SBN    1           CLEAR DESTINATION USER NAME
          CRM    DASS,ON
          RJM    CRF         CLEAR REMOTE FAMILY/USER NAME
          UJN    SBIX        RETURN 
 SDO      SPACE  4,10 
**        SDO - SET DESTINATION ORIGIN TYPE.
* 
*         ENTRY  (FB - FB+1) = FLAG BITS. 
*                (OT) = ORIGIN TYPE OF CONTROL POINT AREA.
*                (QT) = DESTINATION QUEUE TYPE. 
* 
*         EXIT   (OT) = ORIGIN TYPE.
*                (A) = ORIGIN TYPE OF QUEUED FILE.
* 
*         USES   OT, CM - CM+4. 
* 
*         CALLS  GFA. 
  
  
 SDO      SUBR               ENTRY/EXIT 
  
*         SET ORIGIN TYPE FOR FILE. 
  
          LDD    ST          CHECK IF FILE PREVIOUSLY ROUTED
          LPN    DSFL 
          ZJN    SDO1        IF NOT PREVIOUSLY ROUTED 
          LDM    IOSS+SCLQ*5
          UJN    SDO3        SET FROM QFT ENTRY 
  
 SDO1     LDD    QT 
          LMK    INQT 
          NJN    SDO2        IF NOT INPUT FILE
          LDM    JBOT 
          LPN    17 
          LMK    SYOT 
          NJN    SDO1.1      IF NOT SYSTEM ORIGIN JOB 
          LDN    BCOT        SET BATCH ORIGIN TYPE
          STD    OT 
 SDO1.1   LDM    VIFT,OT     INITIALIZE ORIGIN TYPE AND SERVICE CLASS 
          STM    JBOT 
 SDO2     LDM    JBOT        SET FROM EJT ENTRY OF CALLER 
          STM    IOSS+SCLQ*5
 SDO3     LPN    17 
          STD    OT 
          LDM    FSOT 
          SHN    21-13
          MJN    SDO4        IF NOT FORCED ORIGIN REQUEST 
          SHN    13-21
          STD    OT 
          LDM    SCDT,OT     RESET ORIGIN TYPE AND SERVICE CLASS
          STM    IOSS+SCLQ*5
 SDO4     LDD    FB+1 
          SHN    21-13
          PJN    SDO5        IF NOT SUBSYSTEM INITIATION
          LDM    IOSS+SCLQ*5 RESET SERVICE CLASS
          LPN    17 
          LMC    SSSC*100 
          STM    IOSS+SCLQ*5
 SDO5     UJP    SDOX        RETURN 
  
  
*         TABLE OF DEFAULT ORIGIN TYPE AND SERVICE CLASS DESCRIPTORS
*         FOR OUTPUT FILES. 
  
 SCDT     BSS    0
          LOC    0
          VFD    6/SYSC,6/SYOT  SYSTEM SERVICE CLASS
          VFD    6/BCSC,6/BCOT  BATCH SERVICE CLASS 
          VFD    6/RBSC,6/EIOT  REMOTE BATCH SERVICE CLASS
          VFD    6/TSSC,6/IAOT  INTERACTIVE SERVICE CLASS 
          LOC    *O 
 SFD      SPACE  4,30 
**        SFD - SET FILE DESTINATION. 
* 
*         ENTRY  (FB - FB+1) = FLAG BITS. 
*                (FN - FN+4) = FNT ENTRY. 
*                (FS - FS+4) = FST ENTRY. 
*                (OT) = DEFAULT ORIGIN TYPE.
*                (QT) = QUEUE TYPE. 
* 
*         EXIT   (FN - FN+4) = UPDATED FNT. 
*                (FS - FS+4) = FST ENTRY. 
*                (OT) = ORIGIN TYPE.
*                (QT) = QUEUE TYPE. 
*                (DASS - DASS+4) = DESTINATION USER NAME. 
*                QFT ROUTE INFO UPDATED.
*                (FDSS - FDSS+4) = DESTINATION FAMILY NAME. 
* 
*         ERROR  TO *ERR*, IF ONE OF THE FOLLOWING OCCURS,
*                INCORRECT TID. 
*                INCORRECT SERVICE CLASS. 
*                ALTERNATE FAMILY NOT ALLOWED.
*         ERROR  TO *EER3* IF INACCESSIBLE DEVICE RETURN BY *0AV*.
* 
*         USES   FN+3, FS+2, FS+3, OT, T1, T2, CM - CM+4, 
*                CN - CN+4, UN - UN+4.
* 
*         CALLS  CRF, CVS, DFO, GUD, GFA, NTS, RFN, SBI, SDO, SSJ, VCA. 
*                *0AV*. 
* 
*         MACROS ERROR, EXECUTE.
  
  
 SFD      SUBR               ENTRY/EXIT 
          RJM    SDO         SET DESTINATION ORIGIN TYPE
          LDD    FB+1 
          LPN    6
          NJN    SFD1        IF CENTRAL SITE OR TID SPECIFIED 
          RJM    NTS         NO TID SPECIFIED 
          UJN    SFD4        CHECK FOR FORCED SERVICE CLASS 
  
 SFD1     LPN    4
          NJN    SFD2        IF TID SPECIFIED 
          LDN    ZERL 
          UJN    SFD3        CLEAR ROUTING INFORMATION
  
 SFD2     RJM    GFA         GET TID FROM PARAMETER BLOCK 
          ADN    2
 SFD3     CRD    CM 
          LDD    CM+3 
          NJN    SFD6        IF ADDRESS SPECIFIED 
          RJM    SBI         SET BATCH ID 
 SFD4     LJM    SFD19       CHECK FOR FORCED SERVICE CLASS 
  
 SFD5     ERROR  /ERR/EC21   * DSP - INCORRECT TID.*
  
*         PROCESS TID PARAMETER BLOCK.
  
 SFD6     LDD    QT 
          LMK    INQT 
          NJN    SFD7        IF NOT ROUTE TO INPUT
          LDM    SLAT 
          UJN    SFD8        CHECK SLID ATTRIBUTES (INPUT FILE) 
  
 SFD7     LDM    DLAT        CHECK DLID ATTRIBUTES (OUTPUT FILE)
 SFD8     SHN    21-13
          MJN    SFD9        IF LOCAL HOST
          LDN    PSNI        SET RUSS/RFSS RATHER THAN DASS/FDSS
          STM    SFDA 
          STM    SFDA+1 
          STM    SFDC 
          LDN    ZERL        PRESET SELECTION OF DEFAULT FAMILY 
          CRM    RFSS,ON
 SFD9     LDD    CM+3        VALIDATE ADDRESS OF PARAMETER BLOCK
          SHN    14 
          SCN    77 
          LMD    CM+4 
          LMC    777777 
          NJN    SFD10       IF NONZERO ADDRESS SPECIFIED 
          LJM    SFD12       SET DEFAULT FAMILY AND USER NAME 
  
 SFD10    RJM    VCA         VALIDATE ADDRESS 
 SFD11    ZJP    SFD5        IF INCORRECT ADDRESS 
          ADN    1
          RJM    VCA         VALIDATE CENTRAL ADDRESS 
          ZJN    SFD11       IF INCORRECT ADDRESS 
          SBN    1
 SFDA     LJM    SFD15       PROCESS TID
*         PSN                (SET RUSS/RFSS FROM TID) 
  
*         SET REMOTE FAMILY AND USER NAME FROM TID BLOCK. 
  
          SHN    14          READ REMOTE USER/FAMILY
          ADD    RA 
          SHN    6
          CRM    RFSS,ON
          CRM    RUSS,ON
 SFD11.1  LDN    0           ZERO FILL REMOTE USER/FAMILY 
          STM    RUSS+4 
          STM    RFSS+4 
          LDM    RUSS+3 
          SCN    77 
          STM    RUSS+3 
          LDM    RFSS+3 
          SCN    77 
          STM    RFSS+3 
          LDK    ZERL        CLEAR DESTINATION FAMILY 
          CRM    FDSS,ON
          SBN    1           CLEAR DESTINATION USER NAME
          CRM    DASS,ON
          LJM    SFD19       CHECK FOR FORCED SERVICE CLASS 
  
*         READ DEFAULT FAMILY AND USER NAME FROM CPA. 
  
 SFD12    RJM    SSJ         CHECK IF SSJ= JOB
          ZJN    SFD13       IF NO SSJ= BLOCK 
          ADK    UIDS 
          UJN    SFD14       CONTINUE PROCESSING
  
 SFD13    LDD    CP          READ UI FROM CONTROL POINT AREA
          ADK    UIDW 
 SFD14    CRD    CM 
 SFDC     UJN    SFD14.1     SET DASS/FDSS
*         PSN                (SET RUSS/RFSS)
          CRM    RUSS,ON     READ REMOTE USER NAME
          RJM    RFN         DETERMINE FAMILY NAME
          CRM    RFSS,ON
          LJM    SFD11.1     ZERO FILL REMOTE USER/FAMILY 
  
 SFD14.1  CRM    DASS,ON     READ DESTINATION USER NAME 
          LDD    CM+3        PRESET UI FOR ROUTING FIELD
          LPN    37 
          STD    T1 
          LDD    CM+4 
          STD    T2 
          RJM    RFN         READ DESTINATION FAMILY NAME 
          CRM    FDSS,ON
          LJM    SFD18       DETERMINE FAMILY ORDINAL 
  
*         SET DESTINATION FAMILY AND USER NAME FROM TID BLOCK.
  
 SFD15    SHN    14 
          ADD    RA 
          SHN    6
          CRD    CN          READ FAMILY NAME 
          CRM    FDSS,ON
          CRD    UN          READ USER NAME 
          CRM    DASS,ON
          LDD    CN 
          NJN    SFD16       IF FAMILY NAME PRESENT 
          RJM    RFN         READ FAMILY NAME 
          CRD    CN 
          CRM    FDSS,ON
 SFD16    LDD    ST 
          LPN    SSFL 
          NJN    SFD17       IF NOT SUBSYSTEM CALL
          LDD    UN+3        CHECK IF UI IS SPECIFIED 
          LPN    37 
          STD    T1 
          SHN    14 
          LMD    UN+4 
          STD    T2 
          NJN    SFD18       IF USER INDEX SPECIFIED
  
*         VALIDATE USER NAME. 
  
 SFD17    LDN    0           SET VALIDATE USER NAME FUNCTION
          STD    UN+4 
          EXECUTE  0AV,OVL1 
          MJP    EER3        IF MASS STORAGE DEVICE INACCESSIBLE
          LDD    T1 
          SHN    14 
          LMD    T2 
          NJN    SFD18       IF UI PRESENT
          LJM    SFD5        * DSP - INCORRECT TID.*
  
*         STORE ROUTING INFORMATION IN QFT. 
  
 SFD18    LDD    T1          PRESERVE UI IN QFT 
          STM    IOSS+SCLQ*5+1
          LDM    DASS+3 
          SCN    77 
          LMD    T1 
          STM    DASS+3 
          LDD    T2 
          STM    IOSS+SCLQ*5+2
          STM    DASS+4 
          RJM    DFO         DETERMINE FAMILY ORDINAL 
          RJM    CRF         CLEAR REMOTE FAMILY/USER NAME
  
*         VALIDATE SERVICE CLASS. 
  
 SFD19    LDD    QT 
          LMK    INQT 
          ZJP    SFDX        IF INPUT FILE
          LDM    EBIT+1 
          SHN    21-6 
          ERRNZ  EFSC-100    SHIFT COUNT INCORRECT
          PJN    SFD21       IF ORIGIN DEFAULT NOT SELECTED 
 SFD20    LDM    SCDT,OT
          UJP    SFD30       SET ORIGIN DEFAULT SERVICE CLASS 
  
*         IF CREATION USER NAME IS SPECIFIED, GET SERVICE 
*         CLASS VALIDATION MASK FOR THAT USER.
  
 SFD21    LDM    EBIT+1 
          LPN    EFCU 
          ZJN    SFD22       IF CREATION USER NAME NOT SPECIFIED
          RJM    GFA         GET PARAMETER BLOCK ADDRESS
          ADN    13 
          CRD    CN          GET CREATION FAMILY NAME 
          SBN    1
          UJN    SFD25       GET CREATION USER NAME 
  
 SFD22    LDM    FSSC 
          ZJN    SFD23       IF NO SERVICE CLASS SELECTED 
          SHN    6
          MJN    SFD24       IF USER DEFAULT REQUIRED 
          NFA    SCVN 
          UJP    SFD29       GET VALIDATION MASK
  
*         PROCESS USER DEFAULT SERVICE CLASS SPECIFICATION. 
  
 SFD23    LDM    FSOT 
          SHN    21-13
          MJP    SFDX        IF NO FORCED ORIGIN TYPE 
          SHN    13-21
          LMK    SYOT 
          ZJN    SFD20       IF SYSTEM ORIGIN DEFAULT REQUIRED
          LCN    0           FORCE USER DEFAULT 
          STM    FSSC 
 SFD24    LDN    ZERL        SET NO FAMILY NAME 
          CRD    CN 
          RJM    SSJ         CHECK FOR SSJ= BLOCK 
          ZJN    SFD24.1     IF NO SSJ= BLOCK PRESENT 
          ADK    UIDS 
          UJN    SFD25       GET USER NAME
  
 SFD24.1  LDD    CP          GET USER NAME
          ADK    UIDW 
 SFD25    CRD    UN 
          LDD    UN 
          ZJP    SFD20       IF NO USER NAME FOR *DIS* JOB
          LDD    UN+3 
          SCN    77 
          STD    UN+3 
          LDN    0           SET VALIDATE USER NAME FUNCTION
          STD    UN+4 
          EXECUTE  0AV,OVL1 
          MJP    EER3        IF MASS STORAGE DEVICE INACCESSIBLE
          LDD    T1 
          ADD    T2 
          ZJP    SFD20       IF CREATION USER NOT VALID 
          LDM    FSSC 
          SHN    21-13
          PJN    SFD28       IF USER DEFAULT SERVICE CLASS NOT NEEDED 
          RJM    GUD         GET USER DEFAULT SERVICE CLASS 
          NJN    SFD28       IF FOUND 
 SFD27    ERROR  /ERR/EC45   * DSP - INCORRECT SERVICE CLASS.*
  
 SFD28    LDD    T3          GET VALIDATION MASK
          ADK    ASCV*5 
          STM    SFDB 
          LDD    MA 
          CWM    **,ON
 SFDB     EQU    *-1         (ADDRESS OF VALIDATION MASK) 
          SBN    1
 SFD29    CRD    CN 
          RJM    CVS         CHECK FOR VALID SERVICE CLASS
          NJN    SFD27       IF INCORRECT 
          LDM    IOSS+SCLQ*5 SET SERVICE CLASS
          SHN    21-5 
          SCN    77 
          LMM    FSSC 
          SHN    6
 SFD30    STM    IOSS+SCLQ*5
          LJM    SFDX        RETURN 
          SPACE  4,10 
**        COMMON DECKS. 
  
  
*CALL     COMPAST 
*CALL     COMPCUA 
          QUAL   MIO
 RDS      EQU    RMS         USE *RMS* IN PLACE OF *RDS*
*CALL     COMPRNS 
          QUAL   *
 RNS      EQU    /MIO/RNS 
          SPACE  4,10 
**        DEFINE UNQUALIFIED ENTRY POINTS.
  
          QUAL
 PSI      EQU    /3DA/PSI 
 SFD      EQU    /3DA/SFD 
 VIF      EQU    /3DA/VIF 
          QUAL   *
          SPACE  4,10 
          OVERFLOW  OVL4,BFMS 
          SPACE  4,10 
          USE    OVERFLOW 
          ERRNG  OVL1-5-*    OVERFLOW INTO *0AV*
          OVERLAY  (FILE ATTRIBUTE ROUTINES.),OVL4
 SOD      SPACE  4,20 
**        SOD - SET OUTPUT FILE DATA. 
* 
*         ENTRY  (FB - FB+1) = FLAG BITS. 
*                (FS - FS+4) = FST ENTRY. 
*                (QT) = QUEUE TYPE. 
* 
*         EXIT   (RCSS) = REPEAT COUNT. 
*                QFT FIELDS UPDATED.
* 
*         ERROR  TO *ERR*, IF ONE OF THE FOLLOWING OCCURS,
*                INCORRECT EXTERNAL CHARACTERISTICS.
*                INCORRECT INTERNAL CHARACTERISTICS.
*                FORMS CODE NOT ALPHANUMERIC. 
*                INCORRECT SPACING CODE.
* 
*         USES   CM - CM+4, T0 - T5.
* 
*         CALLS  GEA, GFA, VFC. 
* 
*         MACROS ERROR. 
  
  
 SOD      SUBR               ENTRY/EXIT 
  
*         SET REPEAT COUNT. 
  
          LDD    FB 
          SHN    21-2 
          PJN    SOD1        IF REPEAT COUNT NOT SPECIFIED
          RJM    GFA         READ REPEAT COUNT
          ADN    4
          CRD    CM 
          LDD    CM+3        SET REPEAT COUNT 
          LPN    77 
          STM    IOSS+INSQ*5+4
          STM    RCSS 
  
*         SET RANDOM ADDRESS. 
  
 SOD1     RJM    GFA
          ADN    1           READ INTERNAL AND EXTERNAL CHARACTERISTICS 
          CRD    CM 
          ADN    6           READ RANDOM ADDRESS
          CRD    T1 
          LDD    FB 
          SHN    21-11
          PJN    SOD2        IF RANDOM ADDRESS NOT SET
          LDD    T1+1        SET RANDOM ADDRESS IN SYSTEM SECTOR
          STM    RASS 
          LDD    T1+2 
          STM    RASS+1 
  
*         SET EXTERNAL CHARACTERISTICS. 
  
 SOD2     LDD    CM+3        SET EXTERNAL CHARACTERISTICS 
          SHN    -11
          STD    T1 
          LDM    TDIC,T1     SET DEFAULT INTERNAL CHARACTERISTICS 
          STD    T2 
          LDD    FB+1 
          SHN    21-7 
          MJN    SOD3        IF EXTERNAL CHARACTERISTICS SPECIFIED
          LJM    SOD7        SET INTERNAL CHARACTERISTICS 
  
 SOD3     LDD    T1          SAVE EXTERNAL CHARACTERISTICS
          SHN    3
          STD    T0 
  
*         SET DEFAULT INTERNAL CHARACTERISTICS BASED ON 
*         EXTERNAL CHARACTERISTICS. 
  
          LDD    QT          DETERMINE QUEUE TYPE 
          LMN    PHQT 
          ZJN    SOD5        IF PUNCH FILE
          LMN    PLQT&PHQT
          ZJN    SOD4        IF PLOT FILE 
          LDD    T2          SET IC FOR PRINT FILES 
          SHN    -10
          UJN    SOD6        SET IC 
  
 SOD4     LDD    T2          SET IC FOR PLOT FILES
          UJN    SOD6        SET IC 
  
 SOD5     LDD    T2          SET IC FOR PUNCH FILES 
          SHN    -4 
 SOD6     LPN    17 
          STD    T2 
          RAD    T0 
  
*         SET INTERNAL AND EXTERNAL CHARACTERISTICS.
  
          LDM    IOSS+SCLQ*5+3
          SCN    77 
          LMD    T0 
          STM    IOSS+SCLQ*5+3
          LDD    T2          VALIDATE EXTERNAL CHARACTERISTICS
          LMN    17 
          NJN    SOD7        IF VALID EXTERNAL CHARACTERISTICS
          ERROR  /ERR/EC37   *DSP - INCORRECT EXTERNAL CHARACTERISTICS.*
  
*         SET INTERNAL CHARACTERISTICS. 
  
 SOD7     LDD    FB+1 
          SHN    21-10
          PJN    SOD8        IF INTERNAL CHARACTERISTICS NOT SPECIFIED
          LDD    CM+3        SET INTERNAL CHARACTERISTICS 
          SHN    -6 
          LPN    3
          STD    T0 
          LDM    IOSS+SCLQ*5+3
          SCN    7
          LMD    T0 
          STM    IOSS+SCLQ*5+3
          LPN    7
          SBN    MXIC 
          MJN    SOD8        IF VALID INTERNAL CHARACTERISTICS
          ERROR  /ERR/EC23   *DSP - INCORRECT INTERNAL CHARACTERISTICS.*
  
*         CHECK IF FILE NEEDS *SOST* STATUS.
  
 SOD8     LDD    T1 
          LMN    A9EX 
          NJN    SOD9        IF EC .NE. A9
          LDM    IOSS+SCLQ*5+3
          LPN    7
          LMK    DCIC 
          ZJN    SOD9        IF IC .EQ. DIS 
          LMK    A6IC&DCIC
          ZJN    SOD9        IF IC .EQ. ASCII6
          LDD    QT          DETERMINE IF PRINT FILE
          LMN    PRQT 
          NJN    SOD9        IF NOT PRINT FILE
          LDD    FB+1 
          SHN    21-0 
          PJN    SOD9        IF NOT DEFERRED ROUTE
          LDN    SOST        SET *SOST* STATUS
          STM    LFST 
  
*         SET FORMS CODE. 
  
 SOD9     LDD    FB+1 
          SHN    21-12
          PJN    SOD10       IF FORMS CODE NOT SELECTED 
          LDD    CM+1 
          STM    IOSS+SCLQ*5+4
          RJM    VFC         VALIDATE FORMS CODE
          PJN    SOD10       IF VALID FORMS CODE
          ERROR  /ERR/EC22   * DSP - FORMS CODE NOT ALPHANUMERIC.*
  
*         SET PRINT IMAGE CODE FOR PRINT FILES. 
  
 SOD10    RJM    GFA         GET PARAMETER BLOCK ADDRESS
          ADN    4
          CRD    CM 
          LDD    CM 
          SHN    21-11
          PJN    SOD10.1     IF NO PRINT IMAGE SPECIFIED
          LDM    SCSS        CLEAR PRINT IMAGE PRESERVING SPACING CODE
          LPN    77 
          STM    SCSS 
          LDD    CM 
          LPC    1700        PRINT IMAGE FLAG AND CODE
          RAM    SCSS 
  
*         SET SPACING CODE FOR PRINT FILES. 
  
 SOD10.1  LDD    FB 
          SHN    21-3 
          PJN    SOD11       IF SPACING CODE NOT SPECIFIED
          LDM    SCSS        CLEAR SPACING CODE PRESERVING PRINT IMAGE
          SCN    77 
          STM    SCSS 
          LDD    CM          SET SPACING CODE 
          LPN    77 
          RAM    SCSS 
          LDD    CM 
          SHN    -6 
          ZJN    SOD11       IF VALID SPACING CODE
          LPN    10          CHECK PRINT IMAGE FLAG 
          NJN    SOD11       IF PRINT IMAGE SPECIFIED 
          ERROR  /ERR/EC41   * DSP - INCORRECT SPACING CODE.* 
  
*         SET ACCESS LEVEL INTO QFT ENTRY.
  
  
 SOD11    LDM    LFAL        GET LOCAL FILE ACCESS LEVEL
          SHN    3
          LMM    IOSS+INSQ*5+3
          LPN    70 
          LMM    IOSS+INSQ*5+3
          STM    IOSS+INSQ*5+3
  
*         SET UP ACCOUNTING LIMITS FOR PRINT, PUNCH AND PLOT FILES. 
  
          LDD    CP          READ FILE SIZE LIMITS
          ADK    ALMW 
          CRD    CM 
          LDD    QT          DETERMINE QUEUE TYPE 
          LMN    PHQT 
          ZJN    SOD13       IF PUNCH FILE
          LMN    PLQT&PHQT
          ZJN    SOD12       IF PLOT FILE 
          LDD    CM+4        SET PRINT FILE LIMIT 
          SHN    -6 
          UJN    SOD14       SET LIMIT
  
 SOD12    LDD    CM          SET PLOT FILE LIMIT
          UJN    SOD14       SET LIMIT
  
 SOD13    LDD    CM+4        SET PUNCH FILE LIMIT 
 SOD14    LPN    77 
          STM    LCSS 
          UJP    SODX        RETURN 
          SPACE  4,10 
**        TDIC - TABLE OF DEFAULT INTERNAL CHARACTERISTICS. 
* 
*         INDEXED BY EXTERNAL CHARACTERISTICS CODE. 
* 
*T        4/ PRIC, 4/PHIC, 4/ PLIC
*                PHIC = PUNCH INTERNAL CHARACTERISTICS. 
*                PRIC = PRINT INTERNAL CHARACTERISTICS. 
*                PLIC = PLOT INTERNAL CHARACTERISTICS.
*                17B = INCORRECT INTERNAL CHARACTERISTICS.
  
  
 TDIC     BSS    0
          LOC    0
*                                      PRINT     PUNCH     PLOT 
          VFD    4/DCIC,4/DCIC,4/17B   DISPLAY   DISPLAY   INVALID
          VFD    4/17B,4/BNIC,4/BNIC   INVALID   BINARY    BINARY 
          VFD    4/ASIC,4/BNIC,4/ASIC  ASCII     BINARY    ASCII
          VFD    4/DCIC,4/17B,4/17B    DISPLAY   INVALID   INVALID
          VFD    4/DCIC,4/DCIC,4/17B   DISPLAY   DISPLAY   INVALID
          VFD    4/DCIC,4/DCIC,4/17B   DISPLAY   DISPLAY   INVALID
          VFD    4/ASIC,4/ASIC,4/17B   ASCII     ASCII     INVALID
          VFD    4/17B,4/17B,4/17B     INVALID   INVALID   INVALID
          LOC    *O 
          SPACE  4,10 
**        COMMON DECKS. 
  
  
*CALL     COMPVFC 
          SPACE  4,10 
**        DEFINE UNQUALIFIED ENTRY POINTS.
  
  
          QUAL
 SOD      EQU    /3DB/SOD 
          QUAL   *
          SPACE  4,10 
          OVERFLOW  OVL4,BFMS 
          SPACE  4,10 
          USE    OVERFLOW 
          ERRNG  OVL1-5-*    OVERFLOW INTO *0AV*
          OVERLAY  (SYSTEM SECTOR/EOI UPDATE ROUTINES.),OVL4
 AEO      SPACE  4,10 
**        AEO - ATTACH EJT ORDINAL. 
* 
*         *AEO* DETERMINES THE EJT ORDINAL OF THE CONTROL 
*         POINT AND THEN INSERTS THE ORDINAL INTO THE QFT.
* 
*         EXIT   APPROPRIATE FLAGS SET IN QFT SAYING QFT
*                IS ATTACHED TO AN EJT. 
  
  
 AEO      SUBR               ENTRY/EXIT 
          LDM    EJTO        GET EJT ORDINAL
          STM    IOSS+ENTQ*5+4
          LDM    IOSS+JSNQ*5+4  FLAG FILE ASSIGNED TO EJT 
          SCN    37 
          LMN    2           FLAG FILE ASSIGNED TO EJT
          STM    IOSS+JSNQ*5+4
          UJN    AEOX        RETURN 
 BSE      SPACE  4,15 
**        BSE - CHECK FOR BINARY CARD SEQUENCE ERROR. 
* 
*         ENTRY  (ST) = STATUS WORD.
*                (QT) = QUEUE TYPE. 
* 
*         EXIT   SYSTEM SECTOR UPDATED. 
* 
*         USES   CM - CM+6. 
* 
*         CALLS  GFA. 
  
  
 BSE      SUBR               ENTRY/EXIT 
          LDD    QT 
          LMK    INQT 
          NJN    BSEX        IF NOT ROUTE TO INPUT
          LDD    ST          DETERMINE IF SUBSYSTEM 
          LPN    SSFL 
          NJN    BSEX        IF NOT SUBSYSTEM 
          LDM    INFL        GET INPUT FLAGS
          SHN    21-6 
          PJN    BSEX        IF NOT ERRORS
          RJM    GFA         READ BINARY CARD DATA
          ADN    5
          CRD    CM 
          SBN    1           READ ABORT CODE
          CRD    CM+2 
          LDD    CM+2+2      SET ABORT CODE 
          STM    JASS 
          LDD    CM          SET RECORD NUMBER
          STM    RNSS 
          LDD    CM+1        SET CARD NUMBER
          STM    CNSS 
          UJN    BSEX        RETURN 
 CLE      SPACE  4,10 
**        CLE - COMPLETE LOCAL ENTRY. 
* 
*         ENTRY  (FB - FB+1) = FLAG BITS. 
*                (FN - FN+4) = NFL FNT ENTRY. 
*                (FS - FS+4) = NFL FST ENTRY. 
* 
*         EXIT   (FS - FS+4) = WRITTEN TO NFL.
*                (FN - FN+4) = WRITTEN TO NFL.
* 
*         USES   FN+4, FS+4, CM - CM+4. 
* 
*         MACROS MONITOR, NFA.
  
  
 CLE2     LDN    ZERL        CLEAR PARAMETERS 
          CRD    CM 
          LDN    DLFS        DROP LOCAL ENTRY 
          STD    CM+1 
          LDC    *           (LOCAL FNT ORDINAL)
 CLEB     EQU    *-1
          STD    CM+4 
          MONITOR  PLFM 
  
 CLE      SUBR               ENTRY/EXIT 
          LDD    FB+1 
          SHN    21-0 
          PJN    CLE2        IF IMMEDIATE ROUTE 
          LDD    FS+4        SET FILE NOT BUSY
          SCN    1
          LMN    1
          STD    FS+4 
          LDM    LFST        SET FILE STATUS
          NJN    CLE1        IF FILE STATUS CHANGED 
          LDD    FN+4        GET CURRENT FILE STATUS
          LPN    77 
 CLE1     LMC    QFFT*100 
          STD    FN+4 
          NFA    CLEB,R      REWRITE NFL FNT/FST ENTRY
          CWD    FN 
          ADN    FSTL 
          CWD    FS 
          UJN    CLEX        RETURN 
 IAM      SPACE  4,10 
**        IAM - ISSUE ACCOUNTING MESSAGES.
* 
*         EXIT   *ABLQ* OR *ARRQ* MESSAGES ISSUED TO ACCOUNT FILE.
* 
*         CALLS  *0QM*. 
* 
*         MACROS EXECUTE. 
  
  
 IAM      SUBR               ENTRY/EXIT 
          LDD    ST 
          LPC    RQFL 
          NJN    IAM1        IF FILE BEING REQUEUED 
          LDC    2RAB        SET *ABLQ* MESSAGE 
          STM    OVL7-2 
          LDC    2RLQ 
          UJN    IAM2        SET MESSAGE IDENTIFIER 
  
 IAM1     LDC    2RAR        SET *ARRQ* MESSAGE 
          STM    OVL7-2 
          LDC    2RRQ 
 IAM2     STM    OVL7-1 
          EXECUTE  0QM,OVL7  ISSUE MESSAGES 
          UJN    IAMX        RETURN 
 IES      SPACE  4,15 
**        IES - INITIALIZE EOI SECTOR.
* 
*         ENTRY  (FS - FS+4) = FST ENTRY. 
*                (QT) = DESTINATION QUEUE TYPE. 
* 
*         EXIT   *EBUF* INITIALIZED AS EOI SECTOR.
* 
*         USES   T1, T5 - T5+4. 
* 
*         CALLS  RMS, SEI.
* 
*         MACROS ENDMS, ERROR, NFA, SETMS.
  
  
 IES      SUBR               ENTRY/EXIT 
          LDD    ST 
          LPN    DSFL 
          ZJN    IES1        IF FILE NOT ALREADY A QUEUE FILE 
          LDD    ST 
          LPC    LKFL 
          NJN    IES5        IF FILE IS LOCKED
 IES1     LDD    ST 
          LPN    SSFL 
          NJN    IES4        IF NOT CALLED BY SUBSYSTEM 
          LDD    QT 
          LMK    INQT 
          NJN    IES4        IF NOT ROUTE TO INPUT QUEUE
  
*         INITIALIZE EOI FOR ROUTE TO INPUT QUEUE FROM SUBSYSTEM. 
  
          LDC    501         CLEAR EOI BUFFER 
          STD    T1 
 IES2     LDN    0
          STM    EBUF,T1
          SOD    T1 
          PJN    IES2        IF MORE TO CLEAR 
 IES3     UJN    IESX        RETURN 
  
*         READ EOI FROM JOB INPUT FILE. 
  
 IES4     NFA    FNTN        READ JOB INPUT FILE FST
          ADN    FSTL 
          CRD    T5 
          UJN    IES6        READ EOI SECTOR
  
*         IF FILE IS *QFFT* AND LOCKED, IT IS A QUEUED FILE ATTACHED
*         BY *QAC*/*GET*.  READ EXISTING EOI SECTOR FROM FILE.
  
 IES5     LDD    FS 
          STD    T5 
          LDD    FS+1 
          STD    T6 
 IES6     LDN    0           FIND EOI SECTOR
          RJM    SEI
          SETMS  IO          READ EOI SECTOR
          LDC    EBUF 
          RJM    RMS
          ENDMS 
          UJN    IES3        RETURN 
 PRT      SPACE  4,10 
**        PRT - PROCESS REMOTE TEXT.
* 
*         ENTRY  (FB - FB+1) = FLAG BITS. 
*                (EBUF) = EOI SECTOR. 
* 
*         EXIT   IMPLICIT/EXPLICIT TEXTS SET IN EOI.
*                DATA DECLARATION SET IN EOI. 
* 
*         USES   T1, CM - CM+4, CN - CN+4.
* 
*         CALLS  GFA. 
  
  
 PRT      SUBR               ENTRY/EXIT 
          LDD    ST          CHECK IF SLID SPECIFIED
          SHN    21-11
          PJN    PRT2        IF SLID NOT SPECIFIED
          LDN    0           CLEAR IMPLICIT TEXT IN EOI 
          STM    EBUF+ILEI
          LDC    TXLEI-1
          STD    T1 
 PRT1     LDN    0
          STM    EBUF+ITEI,T1 
          SOD    T1 
          PJN    PRT1        IF MORE TEXT TO CLEAR
  
*         SET IMPLICIT AND EXPLICIT TEXT IN EOI.
  
 PRT2     LDD    FB+1 
          SHN    21-6 
          PJN    PRTX        IF NO EXTENDED BLOCK 
          RJM    GFA         GET TEXT ADDRESSES 
          ADN    10 
          CRD    CM 
          ADN    1
          CRD    CN 
          LDM    IRTL        LENGTH OF IMPLICIT TEXT
          ZJN    PRT3        IF IMPLICIT TEXT NOT SPECIFIED 
          STD    T1 
          LDD    CM+3 
          LPN    77 
          SHN    6
          ADD    RA 
          SHN    6
          ADD    CM+4 
          CRD    CM 
          ADN    1
          CRM    EBUF+ITEI,T1  READ TEXT
          LDD    CM+4 
          STM    EBUF+ILEI   SET CHARACTER LENGTH OF TEXT 
 PRT3     LDM    ERTL        LENGTH OF EXPLICIT TEXT
          ZJN    PRT4        IF EXPLICIT TEXT NOT SPECIFIED 
          STD    T1 
          LDD    CN+3 
          LPN    77 
          SHN    6
          ADD    RA 
          SHN    6
          ADD    CN+4 
          CRD    CN 
          ADN    1
          CRM    EBUF+EXEI,T1  READ TEXT
          LDD    CN+4 
          STM    EBUF+ELEI   SET CHARACTER LENGTH OF TEXT 
  
*         SET DATA DECLARATION IN EOI.
  
 PRT4     LDM    DDEC        DATA DECLARATION VALUE 
          ZJN    PRT5        IF DATA DECLARATION NOT SPECIFIED
          STM    EBUF+DDEI
 PRT5     LJM    PRTX        RETURN 
 PUF      SPACE  4,15 
**        PUF - PROCESS USER/FAMILY NAMES.
* 
*         EXIT   (FN - FN+4) PRESERVED. 
*                SYSTEM SECTOR UPDATED. 
*                QFT ENTRY UPDATED. 
* 
*         ERROR  TO *EER3* IF INACCESSIBLE DEVICE RETURN BY *0AV*.
* 
*         USES   CN - CN+4, FN - FN+4, UN - UN+4. 
* 
*         CALLS  GFA, GFO, *0AV*. 
* 
*         MACROS EXECUTE. 
  
  
 PUF      SUBR               ENTRY/EXIT 
  
*         SET AND VALIDATE SPECIFIED CREATOR USER/FAMILY
*         (SKIP FOR INPUT FILES). 
  
          LDM    EBIT+1 
          LPN    EFCU 
          ZJN    PUF1        IF CREATOR USER/FAMILY NOT SPECIFIED 
          LDD    QT 
          LMK    INQT 
 PUF1     ZJP    PUF2        IF INPUT QUEUE TYPE
          RJM    GFA         SET SPECIFIED USER/FAMILY IN SYSTEM SECTOR 
          ADN    12 
          CRD    UN 
          CRM    ACSS,ON
          CRD    CN 
          CRM    FMSS,ON
          LDD    UN+3        CLEAR LOWER 18 BITS OF USER NAME 
          SCN    77 
          STD    UN+3 
          LDN    0           VALIDATE CREATOR USER/FAMILY 
          STD    UN+4 
          EXECUTE  0AV,OVL1 
          MJP    EER3        IF MASS STORAGE DEVICE INACCESSIBLE
          LDD    T2          SET CREATOR USER INDEX IN SYSTEM SECTOR
          STM    ACSS+4 
          LDM    ACSS+3 
          SCN    77 
          LMD    T1 
          STM    ACSS+3 
  
*         SET AND VALIDATE SPECIFIED OWNER USER/FAMILY. 
  
 PUF2     LDM    EBIT+1 
          LPN    EFOU 
          ZJP    PUFX        IF OWNER USER/FAMILY NOT SPECIFIED 
          RJM    GFA         SET SPECIFIED USER/FAMILY IN SYSTEM SECTOR 
          ADN    10 
          CRD    UN 
          CRM    OASS,ON
          CRD    CN 
          CRM    FOSS,ON
          LDD    UN+3 
          SCN    77 
          STD    UN+3 
          LDN    0           VALIDATE OWNER USER/FAMILY 
          STD    UN+4 
          EXECUTE  0AV,OVL1 
          MJP    EER3        IF MASS STORAGE DEVICE INACCESSIBLE
          LDD    T2          SET OWNER USER INDEX IN SYSTEM SECTOR
          STM    OASS+4 
          STM    PUFB+1      SAVE OWNER USER INDEX FOR QFT
          LDM    OASS+3 
          SCN    77 
          LMD    T1 
          STM    OASS+3 
          STM    PUFA+1 
  
*         SET OWNER FO/UI IN QFT.  IF SPECIFIED OWNER USER/FAMILY 
*         WAS NOT VALID, USE FO/UI OF CREATOR USER/FAMILY.
  
          LDD    T1 
          ADD    T2 
          NJN    PUF3        IF SPECIFIED OWNER USER/FAMILY VALID 
          LDD    MA          SET FAMILY = CREATOR FAMILY
          CWM    FMSS,ON
          SBN    1
          CRD    CN 
          LDM    ACSS+3      SET USER INDEX = CREATOR USER INDEX
          STM    PUFA+1 
          LDM    ACSS+4 
          STM    PUFB+1 
 PUF3     LDD    MA          SAVE (FN - FN+4) 
          CWD    FN 
          CRD    UN 
          CWD    CN          SET FAMILY NAME
          CRD    FN 
*         LDN    (NONZERO)
          RJM    GFO         GET FAMILY ORDINAL 
          LDD    FN+4        SET OWNER FAMILY ORDINAL IN QFT ENTRY
          SHN    6
          STM    IOSS+JSNQ*5+2
 PUFA     LDC    *           SET OWNER USER INDEX IN QFT ENTRY
          LPN    77 
          RAM    IOSS+JSNQ*5+2
 PUFB     LDC    *
          STM    IOSS+JSNQ*5+3
          LDN    0           CLEAR BOTTOM OF FAMILY NAME
          STM    FOSS+4 
          LDM    FOSS+3 
          SCN    77 
          STM    FOSS+3 
          LDD    MA          RESTORE (FN - FN+4)
          CWD    UN 
          CRD    FN 
          LJM    PUFX        RETURN 
 PUP      SPACE  4,10 
**        PUP - PROCESS UJN PRESENCE. 
* 
*         ENTRY  (FB - FB+1) = FLAG BITS. 
* 
*         EXIT   (JNSS - JNSS+4) = UJN IF PRESENT.
* 
*         CALLS  GFA. 
  
  
 PUP      SUBR               ENTRY/EXIT 
          LDD    FB          CHECK FOR UJN SPECIFIED
          SHN    21-1 
          PJN    PUPX        IF NO UJN SPECIFIED
          RJM    GFA         MOVE UJN TO SYSTEM SECTOR
          ADN    3
          CRM    JNSS,ON
          LDN    0           ZERO FILL UJN FIELD
          STM    JNSS+4 
          LDM    JNSS+3 
          SCN    77 
          STM    JNSS+3 
          UJN    PUPX        RETURN 
 SCP      SPACE  4,10 
**        SCP - SET SPECIFIED CHARGE AND PROJECT NUMBERS. 
* 
*         EXIT   CHARGE/PROJECT NUMBERS SET IF SPECIFIED. 
* 
*         CALLS  GFA. 
  
  
 SCP      SUBR               ENTRY/EXIT 
          LDM    EBIT+1 
          LPK    EFCH 
          ZJN    SCPX        IF CHARGE/PROJECT NUMBERS NOT SPECIFIED
          RJM    GFA
          ADN    17 
          CRM    CHSS,TR
          ERRNZ  PJSS-CHSS-5 CHARGE AND PROJECT NUMBER NOT CONTIGUOUS 
          UJN    SCPX        RETURN 
 SLI      SPACE  4,10 
**        SLI - SET LOGICAL IDENTIFIERS.
* 
*         ENTRY  (QT) =  QUEUE TYPE.
*                (SLID) = SOURCE LID. 
*                (DLID) = DESTINATION LID.
* 
*         EXIT   SLID/DLID SET IN SYSTEM SECTOR AND QFT.
  
  
 SLI      SUBR               ENTRY/EXIT 
  
*         SET DLID IN QFT / SYSTEM SECTOR.
  
          LDD    ST 
          LPC    DLFL 
          NJN    SLI1        IF DLID SPECIFIED IN PARAMETER BLOCK 
          LDD    QT 
          LMK    INQT 
          NJN    SLI1        IF NOT ROUTE TO INPUT
          LDM    IOSS+INSQ*5+1
          NJN    SLI2        IF DLID SET IN SYSTEM SECTOR BY *0VJ*
 SLI1     LDM    DLID 
          SHN    14 
          LMM    DLID+1 
          SHN    -6+22
          STM    IOSS+INSQ*5+1
          SHN    -6 
          LMM    IOSS+INSQ*5+2
          SCN    77 
          LMM    IOSS+INSQ*5+2
          STM    IOSS+INSQ*5+2
  
*         SET SLID IN SYSTEM SECTOR.
  
 SLI2     LDM    IOSS+INSQ*5+1
          NJN    SLI3        IF DLID PRESENT
          STM    SLID        CLEAR SLID 
          STM    SLID+1 
 SLI3     LDM    SLID+1      SET SLID 
          STM    SLSS+1 
          LDM    SLSS 
          SCN    77 
          LMM    SLID 
          STM    SLSS 
          LJM    SLIX        RETURN 
 UFS      SPACE  4,15 
**        UFS - UPDATE FILE STATE.
* 
*         ENTRY  (FB - FB+1) = FLAG BITS. 
*                (FS - FS+4) = FST STATUS.
*                (ST) = STATUS BITS.
* 
*         EXIT   (T5) = EQUIPMENT.
*                FILE LENGTH DETERMINED.
*                IF IMMEDIATE ROUTE, GET DATA FOR *UADM* MESSAGE. 
*                IF FILE BEING REQUEUED BY SUBSYSTEM, RANDOM INDEX SET. 
* 
*         USES   T5, T6, T7.
* 
*         CALLS  SEI, SRA.
  
  
 UFS      SUBR               ENTRY/EXIT 
          LDD    FS          SET EQUIPMENT
          STD    T5 
          LDD    ST 
          SHN    21-13
          ERRNZ  RQFL-4000   CODE DEPENDS ON VALUE
          PJN    UFS2        IF NOT REQUEUEING FILE 
          SHN    21-0-21+13 
          ERRNZ  SSFL-1      CODE DEPENDS ON VALUE
          MJN    UFS2        IF NOT SUBSYSTEM CALLER
          LDD    QT 
          LMK    INQT 
          ZJN    UFS2        IF INPUT FILE
          LDD    FS+2        SET RANDOM ADDRESS 
          STD    T6          SET CURRENT TRACK
          LDD    FS+3        SET CURRENT SECTOR 
          STD    T7 
          LDD    FS+1        SET FIRST TRACK
          RJM    SRA         SET RANDOM ADDRESS 
          ZJN    UFS1        IF TRACK AND SECTOR IN TRACK CHAIN 
          LDN    SWET        SET SYSTEM SOFTWARE ERROR
          STD    CM+2 
          LDC    *           SET ADDRESS WHERE ERROR DETECTED 
          STD    CM+1 
          MONITOR  CHGM      CONDITIONALLY HANG PP
          LJM    DPP         DROP PP
  
*         SET INTERRUPT RANDOM ADDRESS IN SYSTEM SECTOR.
  
 UFS1     LDD    RI          SET RANDOM ADDRESS IN SYSTEM SECTOR
          STM    RTSS 
          LDD    RI+1 
          STM    RTSS+1 
 UFS2     LDD    FS+1        SET FIRST TRACK
          STD    T6 
*         LDN    (NONZERO)   (DO NOT REQUIRE CURRENT TRT) 
          RJM    SEI         SEARCH FOR END OF INFORMATION
  
*         SET DATA FOR *UADM* FUNCTION. 
  
          LDD    T2          SET FILE LENGTH
          STM    FLSS 
          LDD    T3 
          SBN    1
          STM    FLSS+1 
          PJN    UFS2.1      IF NO UNDERFLOW
          AOM    FLSS+1 
          SOM    FLSS 
 UFS2.1   LDD    FB+1 
          SHN    21-0 
          MJN    UFS3        IF DEFERRED ROUTE
          LDD    T2          ROUND UP SECTOR COUNT
          SHN    14 
          LMD    T3 
          SBD    T7 
          ADM    SLM         (*COMPWEI* LOADED CORRECT DRIVER)
          STM    DPPC+1 
          SHN    -14
          STM    DPPC 
 UFS3     LJM    UFSX        RETURN 
 WES      SPACE  4,15 
**        WES - WRITE EOI SECTOR. 
* 
*         ENTRY  (FS - FS+4) = FST ENTRY. 
*                (EBUF) = EOI SECTOR. 
* 
*         EXIT   EOI SECTOR WRITTEN.
* 
*         USES   T5, T6.
* 
*         CALLS  SEI, WEI.
* 
*         MACROS ENDMS, ERROR, SETMS. 
  
  
 WES      SUBR               ENTRY/EXIT 
          LDD    FS          SET EQUIPMENT AND FIRST TRACK
          STD    T5 
          LDD    FS+1 
          STD    T6 
          STM    EBUF+FTEI
          LDN    0           FIND EOI 
          RJM    SEI
          SETMS  IO 
          LDC    EBUF        WRITE EOI SECTOR 
          RJM    WEI
          ENDMS 
          UJN    WESX        RETURN 
WQS       SPACE  4,20 
**        WQS - WRITE QUEUED FILE SYSTEM SECTOR.
* 
*         ENTRY  (WQSA) .NE. 0, DO NOT PRESERVE FILE. 
*                (FA) = NFL FNT ENTRY OFFSET. 
*                (QA) = ORDINAL OF QFT ENTRY. 
*                (FS - FS+4) = FST ENTRY. 
* 
*         EXIT   SYSTEM SECTOR WRITTEN. 
*                FILE PRESERVED, IF REQUESTED.
*                (FASS) = LOCAL FNT ENTRY OFFSET. 
*                (GQSS) = ORDINAL OF QFT ENTRY. 
* 
*         USES   FA, T6, CM - CM+4. 
* 
*         CALLS  RFI, UFS, WSS. 
* 
*         MACROS ENDMS, MONITOR, SETMS. 
  
  
 WQS      SUBR               ENTRY/EXIT 
  
*         IF *DC=SO* OR *DC=SS*, DO NOT PRESERVE FILE.
  
          LDM    DCSS        CHECK DISPOSITION CODE 
          LMC    2RSO 
          ZJN    WQS1        IF *DC=SO* 
          LMN    2RSS&2RSO
          NJN    WQS2        IF NOT *DC=SS* 
 WQS1     AOM    WQSA        DO NOT PRESERVE FILE 
 WQS2     LDM    WQSA 
          NJN    WQS3        IF FILE NOT TO BE REQUEUED 
          LDM    FGSS        CHECK FOR FILE BEING REQUEUED
          LPN    2
          STM    WQSB 
          LDM    FGSS        SET FILE IN QUEUE AND ACTIVE STATUS
          SCN    3
          LMN    3
          STM    FGSS 
          LDC    0
*         LDC    2           (FILE BEING REQUEUED)
 WQSB     EQU    *-1
          NJN    WQS3        IF FILE BEING REQUEUED 
          LDN    PDTL        SET QUEUED FILE CREATION DATE AND TIME 
          CRD    CM 
          LDD    CM+2 
          STM    CDSS+2 
          LDD    CM+3 
          STM    CDSS+3 
          LDD    CM+4 
          STM    CDSS+4 
 WQS3     RJM    UFS         UPDATE FILE STATE
          LDC    FLSS        ADDRESS OF SYSTEM SECTOR FILE LENGTH 
          RJM    RFI         SET FILE SIZE INDEX IN QFT ENTRY 
  
*         COMPLETE SYSTEM SECTOR. 
  
          LDD    FA          SET FNT POINTERS 
          STM    FASS 
          STM    EERA 
          STM    CLEB 
          LDD    QA 
          STM    GQSS 
          LDN    0           INDICATE PRESET SYSTEM SECTOR FNT
          STD    FA 
          LDD    FS+1        SET FIRST TRACK
          STD    T6 
          SETMS  IO,RW
          RJM    WSS         WRITE SYSTEM SECTOR
          ENDMS 
  
*         PRESERVE QUEUED FILE. 
  
          LDC    0
*         LDC    1           (IF FILE NOT TO BE PRESERVED)
 WQSA     EQU    *-1
          NJN    WQS4        IF FILE NOT TO BE PRESERVED
          LDD    T5          CONDITIONALLY SET PROTECT BIT, CHECKPOINT
          LMC    6000 
          STD    CM+1 
          LDD    T6 
          STD    CM+2 
          LDN    SPFS        SET PRESERVED FILE BIT 
          STD    CM+3 
          MONITOR  STBM 
 WQS4     LJM    WQSX        RETURN 
          SPACE  4,10 
**        COMMON DECKS. 
  
  
*CALL     COMPRFI 
 SEI$     SET    1           GUARANTEE CURRENT TRT FOR *COMPSEI*
*CALL     COMPSEI 
*CALL     COMPSFE 
*CALL     COMPSRA 
          QUAL   MIO
 WDS      EQU    WMS         USE *WMS* IN PLACE OF *WDS*
*CALL     COMPWSS 
          QUAL   *
 WSS      EQU    /MIO/WSS 
          SPACE  4,10 
**        DEFINE UNQUALIFIED ENTRY POINTS.
  
  
          QUAL
 AEO      EQU    /3DC/AEO 
 BSE      EQU    /3DC/BSE 
 CLE      EQU    /3DC/CLE 
 IAM      EQU    /3DC/IAM 
 IES      EQU    /3DC/IES 
 PRT      EQU    /3DC/PRT 
 PUF      EQU    /3DC/PUF 
 PUP      EQU    /3DC/PUP 
 RFI      EQU    /3DC/RFI 
 SCP      EQU    /3DC/SCP 
 SLI      EQU    /3DC/SLI 
 WES      EQU    /3DC/WES 
 WQS      EQU    /3DC/WQS 
 WQSA     EQU    /3DC/WQSA
          QUAL   *
          SPACE  4,10 
          OVERFLOW  OVL4,EBUF 
          SPACE  4,10 
          USE    OVERFLOW 
          ERRNG  OVL1-5-*    OVERFLOW INTO *0AV*
          ERRNG  OVL7-5-*    OVERFLOW INTO *0QM*
          ERRNG  QBUF-*      OVERFLOW INTO QFT ENTRY BUFFER 
          OVERLAY  (CHANGE TO LOCAL FILE.),OVL5 
 CLF      SPACE  4,15 
**        CLF - CHANGE TO LOCAL FILE. 
* 
*         ENTRY  (FN - FN+4) = LOCAL FNT ENTRY. 
*                (FS - FS+4) = LOCAL FST ENTRY. 
*                (UN - UN+4) = FILE NAME, IF *FCFL* IS SET IN (ST). 
*                (FA) = NFL FNT OFFSET. 
* 
*         EXIT   QFT ENTRY DROPPED. 
*                FILE UNPRESERVED.
*                LOCAL FILE CREATED IF NONE EXISTS. 
* 
*         ERROR  TO *EER3* IF INACCESSIBLE DEVICE RETURN BY *0DQ*.
* 
*         USES   FN+4, FS+4, QA, T5, T6, CM - CM+4. 
* 
*         CALLS  AMS, EFN, WSS, *0DQ*.
* 
*         MACROS ENDMS, EXECUTE, MONITOR, NFA, SETMS, SFA.
  
  
 CLF      SUBR               ENTRY/EXIT 
          LDD    ST          CHECK IF FILE EXISTS 
          LPN    FCFL 
          ZJN    CLF1        IF FILE EXISTS 
          RJM    EFN         ENTER FILE NAME
          RJM    AMS         ASSIGN MASS STORAGE
          UJN    CLF3        CHANGE FILE TYPE 
  
 CLF1     STD    QA          SET TO SEARCH FOR QFT ENTRY
          LDD    FS 
          ZJN    CLF3        IF NO EQUIPMENT
          LDD    FS+1 
          ZJN    CLF3        IF NO TRACK
          LDN    1           DROP QFT ENTRY ONLY
          STM    OVL6-1 
          EXECUTE  0DQ,OVL6  CLEAR QFT ENTRY
          MJP    EER3        IF MASS STORAGE DEVICE INACCESSIBLE
 CLF3     AOD    FS+4        SET FILE NOT BUSY
          LDD    FN+4        SET LOCAL FILE TYPE
          LPN    77 
          LMC    LOFT*100 
          STD    FN+4 
          LDD    FN+3        CLEAR LOCK (READ-ONLY) BIT 
          SCN    1
          STD    FN+3 
  
*         DETERMINE IF FILE WAS A PRESERVED FILE. 
  
          LDD    FS          CHECK FOR EQUIPMENT ASSIGNMENT 
          ZJP    CLF4        IF NO EQUIPMENT ASSIGNED 
          SFA    EST,FS      READ EST ENTRY 
          ADK    EQDE 
          CRD    CM 
          LDD    FS+1        GET TRACK
          LPC    3777        SET TRT WORD NUMBER
          SHN    21-1 
          STD    T2 
          SHN    1-21 
          ADC    SHNI+21-13 
          STM    CLFA 
          LDD    CM+4        GET FWA OF TRT 
          SHN    3
          ADN    TRLL 
          CRD    CM 
          LDD    CM+3 
          LPN    77 
          SHN    14 
          LMD    CM+4 
          ADD    T2          READ TRT WORD
          CRD    CM 
          LDD    CM+4        SET TRACK BITS 
 CLFA     SHN    0
          PJN    CLF4        IF FILE NOT PRESERVED
          LDD    FS          SET EQUIPMENT
          STD    T5 
          STD    CM+1 
          LDD    FS+1        SET TRACK
          STD    T6 
          STD    CM+2 
          LDN    CPFS        SET CLEAR PRESERVED FILE BIT FUNCTION
          STD    CM+3 
          MONITOR  STBM 
          SETMS  IO,RW
          RJM    WSS         REWRITE SYSTEM SECTOR
          ENDMS 
 CLF4     NFA    FA,R        REWRITE LOCAL FNT/FST
          CWD    FN 
          ADN    FSTL 
          CWD    FS 
          LDN    0           CLEAR JSN IN PARAMETER BLOCK 
          STM    DSPD 
          STM    DSPE 
          LJM    CLFX        RETURN 
          SPACE  4,10 
**        DEFINE UNQUALIFIED ENTRY POINTS.
  
          QUAL
 CLF      EQU    /3DD/CLF 
          QUAL   *
          SPACE  4,10 
*         COMMON DECKS. 
  
  
*CALL     COMPSFI 
          QUAL   MIO2 
 WDS      EQU    WMS         USE *WMS* IN PLACE OF *WDS*
*CALL     COMPWSS 
          QUAL   *
 WSS      EQU    /MIO2/WSS
          SPACE  4,10 
          OVERFLOW  OVL5,BFMS 
          SPACE  4,10 
          USE    OVERFLOW 
          ERRNG  OVL0-5-*    OVERFLOW INTO *0BF*
          ERRNG  OVL6-5-*    OVERFLOW INTO *0DQ*
          OVERLAY  (ERROR PROCESSOR.),OVL3
 ERP      SPACE  4,15 
**        ERP - ERROR PROCESSOR.
* 
*         ENTRY  (ER) = ERROR CODE. 
*                (FA) = FST ADDRESS.
*                (DSPB) = ERROR CODE. 
* 
*         EXIT   TO *PPR* IF JOB IS TO BE ABORTED.
*                TO *DSPX* IF ERROR CODE IS TO BE RETURNED. 
* 
*         USES   T2, FN - FN+4. 
* 
*         CALLS  FEM, FNB, GFA, IDM, PUE, SQE.
* 
*         MACROS MONITOR. 
  
  
 ERP      SUBR               ENTRY/EXIT 
          LDD    ER 
          LMN    /ERR/EC24
          NJN    ERP1        IF NOT * QUEUED FILE READ ERROR* 
          RJM    SQE         SET QFT ERROR
          UJN    ERP2        CONTINUE 
  
 ERP1     RJM    FNB         SET FILE NOT BUSY
 ERP2     LDD    ER 
          LMN    /ERR/EC34
          ZJN    ERP3        IF USER NAME ERROR 
          LMN    /ERR/EC47&/ERR/EC34
          NJN    ERP4        IF NOT USER SECURITY COUNT EXHAUSTED ERROR 
 ERP3     RJM    PUE         PROCESS USER NAME ERROR
 ERP4     LDD    ST 
          LPN    SSFL 
          ZJN    ERP6        IF SUBSYSTEM CALL
  
*         CHECK IF ERROR PROCESSING ALLOWED.
  
          LDN    0
          STD    T2 
 ERP5     LDM    TABT,T2
          ZJN    ERP6        IF END OF TABLE
          LMD    ER 
          ZJN    ERP7        IF JOB SHOULD BE ABORTED 
          AOD    T2          INCREMENT INDEX
          UJN    ERP5        CHECK NEXT TABLE ENTRY 
  
 ERP6     LDD    FB 
          SHN    21-0 
          PJN    ERP7        IF ERROR PROCESSING NOT SELECTED 
          LDD    ER 
          STM    DSPB 
          LJM    DSPX        RETURN 
  
 ERP7     LDD    ER          CHECK FOR JOB COMMAND ERROR
          SBN    /ERR/EC32
          NJN    ERP8        IF NOT JOB COMMAND ERROR 
          RJM    FEM         FORMAT ERROR MESSAGE 
 ERP8     LDM    TDFM,ER
          RJM    IDM         ISSUE DAYFILE MESSAGES 
          LDD    ER          CHECK ERROR STATUS 
          LMN    /ERR/EC12
          ZJN    ERP9        IF INCORRECT REQUEST 
          RJM    GFA         GET PARAMETER BLOCK ADDRESS
          CRD    FN 
          LDD    FN+4        SET FUNCTION COMPLETE
          SCN    1
          LMN    1
          STD    FN+4 
          RJM    GFA         WRITE COMPLETE BIT 
          CWD    FN 
 ERP9     MONITOR  ABTM      ABORT CONTROL POINT
          LJM    PPR
          SPACE  4
**        TABT - TABLE OF ERROR CODES TO ABORT UNCONDITIONALLY. 
  
  
 TABT     BSS    0
          CON    /ERR/EC12   * DSP - INCORRECT REQUEST.*
          CON    /ERR/EC10   * DSP - USER ACCESS NOT VALID.*
          CON    /ERR/EC17   * DSP - COMPLETE BIT ALREADY SET.* 
          CON    /ERR/EC31   * DSP - I/O SEQUENCE ERROR.* 
          CON    0           END OF TABLE 
 FEM      SPACE  4,10 
**        FEM - FORMAT ERROR MESSAGE. 
* 
*         EXIT   ERROR MESSAGE FORMATTED AND PLACED IN *FEMA*.
* 
*         USES   T1.
  
  
 FEM      SUBR               ENTRY
          LDD    MA          SET-UP ERROR MESSAGE 
          CWM    STMT,TR
          SBD    TR 
          CRM    FEMB,TR
          LDC    FEMB-1 
          STD    T1 
 FEM1     AOD    T1          SET END OF JOB COMMAND ERROR MESSAGE 
          LMC    FEMC 
          ZJN    FEM2        IF END OF MESSAGE BUFFER 
          LDI    T1 
          ZJN    FEM2        IF END OF JOB COMMAND
          LPN    77 
          NJN    FEM1        IF NOT END OF JOB COMMAND
          LDN    1R)
          RAI    T1 
          UJN    FEM3        SET END OF MESSAGE 
  
 FEM2     LDC    2R)
          STI    T1 
 FEM3     LDN    0
          STM    1,T1 
          UJN    FEMX        RETURN 
 TDFM     SPACE  4
**        TDFM - TABLE OF DAYFILE MESSAGE ADDRESSES.
  
  
 TDFM     INDEX 
          INDEX  /ERR/EC01,(=C* DSP - FILE NAME ERROR.*)
          INDEX  /ERR/EC02,(=C* DSP - FILE NOT ON MASS STORAGE.*) 
          INDEX  /ERR/EC03,(=C* DSP - INCORRECT FILE TYPE.*)
          INDEX  /ERR/EC05,(=C* DSP - ROUTE TO INPUT NOT IMMEDIATE.*) 
          INDEX  /ERR/EC06,(=C* DSP - IMMEDIATE ROUTING - NO FILE.*)
          INDEX  /ERR/EC07,(=C* DSP - INCORRECT DISPOSITION CODE.*) 
          INDEX  /ERR/EC10,(=C* DSP - USER ACCESS NOT VALID.*)
          INDEX  /ERR/EC11,(=C* DSP - UNDEFINED SERVICE CLASS.*)
          INDEX  /ERR/EC12,(=C* DSP - INCORRECT REQUEST.*)
          INDEX  /ERR/EC13,(=C* DSP - DEFERRED ROUTING NOT ALLOWED.*) 
          INDEX  /ERR/EC14,(=C* DSP - INCORRECT DATA DECLARATION.*) 
          INDEX  /ERR/EC15,(=C* DSP - INCORRECT LID.*)
          INDEX  /ERR/EC16,(=C* DSP - CANNOT ROUTE JOB INPUT FILE.*)
          INDEX  /ERR/EC17,(=C* DSP - COMPLETE BIT ALREADY SET.*) 
          INDEX  /ERR/EC20,(=C* DSP - FILE ON REMOVABLE DEVICE.*) 
          INDEX  /ERR/EC21,(=C* DSP - INCORRECT TID.*)
          INDEX  /ERR/EC22,(=C* DSP - FORMS CODE NOT ALPHANUMERIC.*)
          INDEX  /ERR/EC23,(=C* DSP - INCORRECT INTERNAL CHARACTERISTICS
,.*)
          INDEX  /ERR/EC24,(=C* DSP - QUEUED FILE READ ERROR.*) 
          INDEX  /ERR/EC25,(=C* DSP - QFT FULL.*) 
          INDEX  /ERR/EC26,(=C* DSP - THIS ROUTING NOT ALLOWED.*) 
          INDEX  /ERR/EC27,(=C* DSP - DEVICE FULL.*)
          INDEX  /ERR/EC30,(=C* DSP - MASS STORAGE ERROR.*) 
          INDEX  /ERR/EC31,(=C* DSP - I/O SEQUENCE ERROR.*) 
          INDEX  /ERR/EC32,FEMA  JOB COMMAND ERROR
          INDEX  /ERR/EC33,(=C* DSP - TOO MANY DEFERRED BATCH JOBS.*) 
          INDEX  /ERR/EC34,(=C* DSP - INCORRECT USER COMMAND.*) 
          INDEX  /ERR/EC35,(=C* DSP - DEVICE INACCESSIBLE.*)
          INDEX  /ERR/EC36,(=C* DSP - INCORRECT FILE MODE.*)
          INDEX  /ERR/EC37,(=C* DSP - INCORRECT EXTERNAL CHARACTERISTICS
,.*)
          INDEX  /ERR/EC40,(=C* DSP - INCORRECT ORIGIN TYPE.*)
          INDEX  /ERR/EC41,(=C* DSP - INCORRECT SPACING CODE.*) 
          INDEX  /ERR/EC42,(=C* DSP - INCORRECT JOB ABORT CODE.*) 
          INDEX  /ERR/EC45,(=C* DSP - INCORRECT SERVICE CLASS.*)
          INDEX  /ERR/EC46,(=C* DSP - ALTERNATE FAMILY NOT ALLOWED.*) 
          INDEX  /ERR/EC47,(=C* DSP - USER SECURITY COUNT EXHAUSTED.*)
          INDEX  /ERR/EC50,(=C* DSP - JSN ALREADY IN SYSTEM.*)
          INDEX  /ERR/EC51,(=C* DSP - ALTERNATE USER NOT ALLOWED.*) 
          INDEX  /ERR/ECMX
 IDM      SPACE  4,10 
**        IDM - ISSUE DAYFILE MESSAGES. 
* 
*         ENTRY  (A) = FWA OF MESSAGE.
* 
*         EXIT   MESSAGE ISSUED.
* 
*         USES   ER.
* 
*         CALLS  DFM, GFA, SEM. 
  
  
 IDM      SUBR               ENTRY/EXIT 
          STM    IDMA 
          RJM    GFA         SET FILE NAME IN MESSAGE 
          CRM    IDMB,ON
          LDC    IDMB 
          RJM    SEM         SET END OF MESSAGE 
          LDC    MSGA        * ERROR IN ROUTE FUNCTION, LFN = XXXXXXX.* 
          RJM    DFM
          LDC    **          ISSUE DAYFILE MESSAGE
 IDMA     EQU    *-1         (FWA OF MESSAGE) 
          ZJN    IDMX        IF NO ADDRESS
          ADC    CPON 
          RJM    DFM
          UJN    IDMX        RETURN 
  
  
 MSGA     DATA   H* ERROR IN ROUTE FUNCTION, LFN =* 
 IDMB     VFD    60/0 
  
 MSGB     DATA   H*SIUN,* 
 IDMC     EQU    *
 PUE      SPACE  4,13 
**        PUE - PROCESS USER NAME ERROR.
* 
*         ENTRY  (UN - UN+4) = USER NAME. 
* 
*         EXIT   TO *DPP*, IF NOT A SUBSYSTEM CALL. 
* 
*         USES   CM+1.
* 
*         CALLS  DFM, IDM, SEM. 
* 
*         MACROS MONITOR. 
  
  
 PUE      SUBR               ENTRY/EXIT 
          LDD    ST 
          LPN    SSFL 
          ZJN    PUEX        IF SUBSYSTEM CALL
          LDM    TDFM,ER     ISSUE ERROR MESSAGE
          RJM    IDM
          LDD    ER 
          LMN    /ERR/EC47
          ZJN    PUE1        IF *SECURITY COUNT EXHAUSTED* ERROR
          LDD    MA          SET USER NAME IN ACCOUNT FILE MESSAGE
          CWD    UN 
          CRM    IDMC,ON
          LDC    IDMC 
          RJM    SEM         SET END OF MESSAGE 
          LDC    MSGB+ACFN   * SIUN, USERNAM.*
          RJM    DFM
 PUE1     LDN    SVET        SET SECURITY CONFLICT ERROR FLAG 
          STD    CM+1 
          MONITOR CEFM
          LJM    DPP         DROP PPU 
 SEM      SPACE  4,10 
**        SEM - SET END OF MESSAGE. 
* 
*         ENTRY  (A) = ADDRESS OF MESSAGE INSERT. 
* 
*         EXIT   PERIOD SET AT END OF MESSAGE.
* 
*         USES   T1, T2.
  
  
 SEM      SUBR               ENTRY/EXIT 
          STD    T1 
          ADN    3
          STD    T2 
 SEM1     LDI    T1 
          ZJN    SEM2        IF END OF FILE NAME
          LPN    77 
          ZJN    SEM3        IF END OF FILE NAME
          AOD    T1 
          LMD    T2 
          NJN    SEM1        IF NOT 7TH CHARACTER 
          LDI    T1          CHECK 7TH CHARACTER
          SCN    77 
          NJN    SEM3        IF NOT END OF FILE NAME
 SEM2     LDC    1R.*100
          UJN    SEM4 
  
 SEM3     LDI    T1 
          SCN    77 
          LMN    1R.
 SEM4     STI    T1          SET PERIOD 
          LDN    0           SET END OF MESSAGE 
          STM    1,T1 
          UJN    SEMX        RETURN 
 FEMA     SPACE  4,10 
*         ERROR MESSAGE FORMATTING BUFFER.
  
 FEMA     DATA   H* JOB COMMAND ERROR.  (*
 FEMB     EQU    *
 FEMC     EQU    FEMB+10D 
 SQE      SPACE  4,15 
**        SQE - SET QFT ERROR.
* 
*         *SQE* CHANGES THE QUEUE TYPE OF THE QFT ENTRY TO
*         *ERQF* AND RETURNS THE LOCAL COPY OF THE FILE.
* 
*         ENTRY  (FA) = NFL OFFSET OF FILE. 
* 
*         EXIT   FILE RETURNED. 
*                QFT UPDATED BEFORE RELEASED. 
* 
*         USES   T7, CM - CM+4, CN - CN+4, FN - FN+4, FS - FS+4,
*                UN - UN+4. 
* 
*         MACROS MONITOR, NFA, SFA. 
  
  
 SQE      SUBR               ENTRY/EXIT 
          LDN    QFTP        SET LIMIT FOR QFT SEARCH 
          CRD    UN 
          LDN    0           INITIALIZE ORDINAL POINTER 
          STD    T7 
          NFA    FA,R        RETRIEVE NFL FNT/FST ENTRY 
          CRD    FN 
          ADN    FSTL 
          CRD    FS 
  
*         FIND MATCHING QFT ENTRY.
  
 SQE1     AOD    T7          ADVANCE ORDINAL
          LMD    UN+2 
          ZJN    SQE3        IF QFT NOT FOUND 
 SQE2     SFA    QFT,T7      READ TRACK AND EQUIPMENT OF QFT ENTRY
          ADK    ENTQ 
          CRD    CN 
          SBN    ENTQ 
          STD    CM+4 
          SHN    -14
          STD    CM+3 
  
*         COMPARE TRACK AND EQUIPMENT IN FST FOR MATCH. 
  
          LDD    CN+1        CHECK FIRST TRACK
          LMD    FS+1 
          NJN    SQE1        IF NO MATCH
          LDD    CN          CHECK EQUIPMENT
          LMD    FS 
          NJN    SQE1        IF NO MATCH
          LDN    2           SET NUMBER OF REQUESTS FOR *UTEM*
          STD    CM+1 
          LDD    MA          WRITE *UTEM* PARAMETER WORDS 
          CWM    SQEA,CM+1
          LDN    0
          STD    CM+2 
          MONITOR  UTEM      UPDATE QFT ENTRY 
          LDD    CM+1        CHECK STATUS OF UPDATE 
          NJN    SQE2        IF UPDATE FAILED 
          UJN    SQE4        RETURN LOCAL FILE ENTRY
  
 SQE3     LDN    0           SET NO ERROR FLAG
          STD    CM+2 
          LDC    *           SET ADDRESS WHERE ERROR DETECTED 
          STD    CM+1 
          MONITOR  CHGM      CONDITIONALLY HANG PP
  
*         RETURN LOCAL FILE ENTRY.
  
 SQE4     LDD    FA          SET NFL OFFSET FOR *PLFM*
          STD    CM+4 
          LDN    0
          STD    CM+2 
          STD    CM+3 
          LDN    DLFS        SET DELETE LOCAL FILE OPTION 
          STD    CM+1 
          MONITOR  PLFM      RETURN LOCAL FILE
          LJM    SQEX        RETURN 
  
 SQEA     VFD    1/0,5/JSNQ,6/6,6/6,42/ERQF 
          VFD    1/0,5/JSNQ,6/5,6/1,42/0
          SPACE  4,10 
**        DEFINE UNQUALIFIED ENTRY POINTS.
  
          QUAL
 ERP      EQU    /3DE/ERP 
          QUAL   *
          SPACE  4,10 
          OVERFLOW  OVL3,BFMS 
          SPACE  4
          TTL    DSP - DISPOSE FILE TO I/O QUEUE. 
          USE    OVERFLOW 
          ERRNG  OVL0-5-*    OVERFLOW INTO *0DQ*
          ERRNG  OVL2-5-*    OVERFLOW INTO *0DF*
          SPACE  4
          TTL    DSP - DISPOSE FILE TO I/O QUEUE. 
          END 
