Retro1.org codex

          IDENT  ROUTE,ROU,ROUTE 
          ABS
          SST
          SYSCOM B1
          ENTRY  ROUTE
          ENTRY  NPC=
          ENTRY  RFL=
*COMMENT  ROUTE - ROUTE FILE TO I/O QUEUE.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
          TITLE  ROUTE COMMAND PROCESSOR.
          SPACE  4,10
***       ROUTE - PROCESS ROUTE COMMAND.
*         R.N. LAGERSTROM    76/01/30.
*
*         ROUTE IS USED TO PLACE FILES INTO THE INPUT AND
*         OUTPUT QUEUES.
          SPACE  4,20
***       CALL.
*
*         ROUTE(LFN,P1,P2,...,PN)
*
*         LFN - FILE NAME TO ROUTE.
*
*         THE REMAINING PARAMETERS ARE ORDER INDEPENDENT.
*
*         DC=AA - TWO-CHARACTER DISPOSITION CODE (ALPHA CODE).
*         DEF - INDICATES DEFERRED (END-OF-JOB) ROUTING.
*         DO=XXX - DEFAULT OUTPUT MAINFRAME LOGICAL ID.
*         EC=XX - EXTERNAL CHARACTERISTICS.
*         FC=XX - FORMS CODE (TWO-CHARACTER ALPHA-NUMERIC).
*         FID=XXXXXXX - FILE ID.  (NOS/BE COMPATIBILITY)
*         FM=XXXXXXX - FAMILY NAME.
*         FM - IMPLICIT REMOTE ROUTING.
*         IC=XX - INTERNAL CHARACTERISTICS.
*         ID=NN - SELECT LOCAL DEVICE (0-67 OCTAL DEFAULT).
*         ID - IMPLICIT CENTRAL SITE ROUTING.
*         JSN=XXX - FORCE A UNIQUE THREE CHARACTER JSN ON A JOB.
*         OT=XXXX - SET THE ORIGIN TYPE OF THE FILE.
*         PI=N - PRINT IMAGE ORDINAL ( 0 - 7 )
*         PI=XXXXXXX - PRINT IMAGE NAME ( 1 TO 7 CHARACTER NAME )
*         PRI=NNNN - FILE PRIORITY. IGNORED WITH MESSAGE.
*         REP=NN - REPEAT COUNT (0-63 DECIMAL DEFAULT).
*         SC=XX - SPACING CODE (FOR 580-PFC SUPPORT).
*         SCL=XX - SELECT SERVICE CLASS FOR OUTPUT FILES (TWO-CHARACTER
*                  ALPHA-NUMERIC).
*         ST=XXX - LOGICAL ID (LID) OF SYSTEM TO WHICH FILE IS TO
*                  BE ROUTED.
*         TID=XX - PROCESSED AS UN=XXXXXXX (FOR NOS/BE COMPATIBILITY).
*         TID=C - IMPLICIT CENTRAL SITE ROUTING.
*         TID - IMPLICIT REMOTE ROUTING.
*         UJN=XXXXXXX - USER JOB NAME.
*         UN=XXXXXXX - USER NAME.
*         UN - IMPLICIT REMOTE ROUTING.
*
*         NOTE-
*
*         1. CENTRAL SITE ROUTING WILL BE SELECTED BY DEFAULT FOR ALL
*         ORIGIN TYPES EXCEPT *RBOT* UNLESS TID (EXCEPT TID=C), FM,
*         OR UN IS INCLUDED.
*
*         2. FOR *RBOT* ORIGIN JOBS, ROUTING WILL BE TO THE TERMINAL
*         OF ORIGIN UNLESS TID, FM, OR UN ARE SPECIFIED WITH A
*         PARAMETER. *TID=C* OR *TID* WILL ROUTE TO CENTRAL SITE.
*
*         3. IMPLICIT REMOTE ROUTING MEANS THAT ROUTING WILL BE TO A
*         REMOTE TERMINAL IDENTIFIED BY THE FM-UN OF THE JOB MAKING
*         THE REQUEST.
*
*         4. IMPLICIT CENTRAL SITE ROUTING WILL SUPPLY THE DEFAULT
*         LOCAL DEVICE ID AND OVER-RIDE DEFAULT REMOTE ROUTING FOR
*         *RBOT* ORIGIN JOBS.
          SPACE  4,10
**        PROGRAMS CALLED.
*
*         DSP - ROUTE FILE.
          SPACE  4,10
**        COMMON DECKS CALLED.
*
*         COMCDXB
*         COMCMAC
*         COMCSYS
*         COMSBIO
*         COMSDSP
*         COMSJIO
*         COMSSCD
*         COMSSSJ
          SPACE  4,20
***       MESSAGES ISSUED.
*
*         ROUTE COMMAND ERROR.
*         ROUTE COMPLETE.
*         ROUTE COMPLETE.  JSN IS XXXX.
*         ROUTE *DC* INCOMPATIBLE WITH *EC*.
*         ROUTE INCORRECT *DO* PARAMETER.
*         ROUTE INCORRECT *EC* PARAMETER.
*         ROUTE INCORRECT *FC* PARAMETER.
*         ROUTE INCORRECT *IC* PARAMETER.
*         ROUTE INCORRECT *JSN* PARAMETER.
*         ROUTE INCORRECT KEYWORD.
*         ROUTE INCORRECT *OT* PARAMETER.
*         ROUTE INCORRECT SPACING CODE.
*         ROUTE INCORRECT *ST* PARAMETER.
*         ROUTE *JSN* NOT ALLOWED.
*         ROUTE *OT* NOT ALLOWED.
*         ROUTE *PRI* IGNORED.
*         ROUTE *REP* .GT. 63. DEFAULT USED.
*         ROUTE *TID* AND *FM/UN* CONFLICT.
*         ROUTE *TID/FM/UN* AND *ID* CONFLICT.
*         ROUTE UNDEFINED SERVICE CLASS.
*         ROUTE UNKNOWN *PI* PARAMETER.
          SPACE  4,10
**        DEFINE.
*         EXTERNAL CHARACTERISTICS (EC), AND
*         INTERNAL CHARACTERISTICS (IC).
          SPACE  4,10
*         SPECIAL ENTRY POINT.
 
 NPC=     EQU    0           FORCE OPERATING SYSTEM PARAMETER FORMAT
 
 
          QUAL   BIO
*CALL     COMSBIO
          QUAL   *
*CALL     COMSDSP
*CALL     COMCMAC
*CALL     COMSSSJ
          LIST   X
 
*CALL     COMSJIO
 
          LIST   *
          TITLE  TABLE DEFINITIONS.
          ORG    103B
 ROU      BSS    0
 TDSP     SPACE  4,30
**        TDSP - DSP PARAMETER BLOCK.
*
*T  W0    42/ FILE NAME,6/ ,1/F,4/ ,6/ OT,1/C
*T, W1    12/ ,12/ FC,12/ DC,3/ EC,3/ IC,18/ FLAGS
*T, W2    18/ SLID,18/ DLID,24/ DA
*T, W3    42/ UJN,18/
*T, W4    2/ 0,1/ P,3/ PI,6/ SC,12/ SCL,12/ FA,6/ ,6/ RC,12/
*T, W5    60/
*T, W6    60/
*
*         F  - FORCE ORIGIN TYPE FLAG.
*         OT - DESIRED ORIGIN TYPE.
*         C  - COMPLETE BIT.
*         FC - FORMS CODE
*         DC - DISPOSITION CODE
*         EC - EXTERNAL CHARACTERISTICS
*         IC - INTERNAL CHARACTERISTICS
*         SLID - LOGICAL ID (LID) TO RECEIVE OUTPUT FROM INPUT FILES.
*         DLID - DESTINATION LOGICAL ID OF MAINFRAME TO RECEIVE FILES.
*         DA - TID OR POINTER TO FM/UN
*         P - PRINT IMAGE FLAG (INDICATES PRINT IMAGE CODE PRESENT).
*         PI - PRINT IMAGE CODE (0-7) IF PRINT IMAGE FLAG SET.
*         SC - SPACING CODE
*         SCL - SERVICE CLASS
*         FA - ABORT CODE
*         RC - REPEAT COUNT
*         UJN - USER JOB NAME
 
 
 TDSP     BSS    0
          CON    0
          VFD    42/0,18/FRFN
          VFD    36/0,24/-0
          CON    0
          CON    0
          CON    0
          CON    0
 TFUN     SPACE  4,10
**        TFUN - FAMILY NAME, USER NAME TABLE
*
*T  W0    42/ FAMILY NAME,18/
*T, W1    42/ USER NAME,18/
 
 
 TFUN     BSSZ   2           FAMILY NAME - USER NAME
 
          SPACE  4,10
*         INTERNAL FLAGS.
 
 PTID     CON    0           TID PROCESSED
 PFUN     CON    0           FM-UN PROCESSED
 PDID     CON    0           DEVICE ID PROCESSED
 PDEF     CON    0           DEF PROCESSED
 PJSN     CON    0           JSN PROCESSED
 PUJN     CON    0           UJN PROCESSED
 PDCT     CON    0           DISPOSITION TYPE - SEE *TDCC*
 PECT     CON    0           EXTERNAL CHARACTERISTICS TYPE - SEE *TECC*
 PJOT     CON    0           ORIGIN OF JOB
          LIST   X
*CALL     COMTDSP
          LIST   -X
 ROUTE    TITLE  MAIN PROGRAM
**        ROUTE - PROCESS COMMAND.
 
 
 ROUTE    BSS    0           ENTRY
          SB1    1
          SA1    ACTR
          R=     A0,ARGR     FIRST ARGUMENT ADDRESS
          SB6    X1          SET ARGUMENT COUNT
          MX0    -18
          SA1    A0
          ZR     B6,ABT      IF NOT AT LEAST ONE ARGUMENT
 
*         GET FILE NAME.
 
          BX6    -X0*X1
          AX6    1
          NZ     X6,ABT      IF FILE NAME NOT FIRST PARAMETER
          BX7    X0*X1
          SA7    TDSP        STORE FILE NAME
 
*         PROCESS NEXT PARAMETER.
 
 EPRX     BSS    0           END-OF-PROCESSING PARAMETER EXIT
          SB6    B6-B1       REDUCE REMAINING PARAMETER COUNT
          SA0    A0+B1
          LE     B6,B0,DSP   IF END OF PARAMETERS
          SA2    A0          GET NEXT ARGUMENT
          MX3    0           ZERO PARAMETER
          SX7    X2-1R=
          ZR     X7,ROU1     IF *=* SEPARATOR
          SX7    X2-2
          NZ     X7,ROU3     IF NOT *=* SEPARATOR (NOS/BE FORMAT)
 
*         PROCESS EQUIVALENCED PARAMETER, IF PRESENT.
 
 ROU1     SA0    A0+B1
          SB6    B6-B1
          SA3    A0          GET NEXT PARAMETER
          SB2    X3
          LE     B2,B1,ROU2  IF 0 OR 1 TERMINATOR
          SB2    B2-17B
          ZR     B2,ROU2     IF 17B TERMINATOR
          EQ     ABT         ABORT
 
 ROU2     MX0    42          CHECK FOR NULL PARAMETER
          BX3    X0*X3
          NZ     X3,ROU3     IF NOT NULL PARAMETER
          SX3    -1          SET NULL PARAMETER FLAG
 
*         SEARCH FOR KEYWORD.
 
 ROU3     SA1    TKEY-1
          MX0    36
 ROU4     SA1    A1+B1
          BX7    X1-X2       COMPARE KEYWORD
          BX7    X0*X7
          SB2    X1          SET PROCESSOR ADDRESS
          ZR     X1,ROU6     IF KEYWORD NOT FOUND IN TABLE
          NZ     X7,ROU4     IF NOT THIS KEYWORD
          SX7    -B1         DELETE KEYWORD FROM TABLE
          SA7    A1
          MX0    42
          BX7    X3-X7
          ZR     X7,EPRX     IF NULL PARAMETER, IGNORE
          BX3    X0*X3
          LX1    59-18
          NG     X1,ROU5     IF NONEQUIVALENCED PARAMETER ALLOWED
          ZR     X3,ABT      IF NONEQUIVALENCED PARAMETER
 ROU5     JP     B2          EXECUTE KEYWORD PROCESSOR
 
 ROU6     MESSAGE (=C* ROUTE INCORRECT KEYWORD.*),0,RECALL
          EQ     ABT1        ABORT
 
 ABT      MESSAGE (=C* ROUTE COMMAND ERROR.*),0,RECALL
 ABT1     ABORT
 
*         MAKE *DSP* CALL.
 
 DSP      SA1    TDSP+1
          MX0    -12         EXTRACT DISPOSITION CODE
          BX2    X1
          AX1    24
          BX7    -X0*X1
          SB3    B0          INITIALIZE POINTER
          AX1    12
          BX1    -X0*X1
          SX3    X7-2RSC
          NZ     X3,DSP0     IF NOT *DC=SC*
          SA0    B1          SET * ROUTE COMPLETE.* MESSAGE
          EQ     DSP1        CONTINUE
 
 DSP0     SA3    DSPB+B3     GET INPUT MNEMONIC
          ZR     X3,DSP0.2   IF END OF TABLE
          IX3    X7-X3
          ZR     X3,DSP0.1   IF MATCH
          SB3    B3+B1       GET NEXT MNEMONIC
          EQ     DSP0        CONTINUE
 
 DSP0.1   NZ     X1,ABT      IF *FC=XX* ON INPUT DISPOSITION
          SA1    PDEF        CHECK FOR *DEF* PARAMETER
          NZ     X1,ABT      IF DEFERRED INPUT FILE
 DSP0.2   SA0    0           SET *ROUTE COMPLETE. JSN IS XXXX.*
 DSP1     SA1    PFUN
          SA3    PTID
          SX4    FRTI
          BX6    X3+X1
          BX7    X4+X2
          ZR     X6,DSP2     IF NOT REMOTE ROUTING
          SA7    TDSP+1      SET *TID* FLAG BIT
          SA1    TFUN
          SA2    A1+B1
          BX2    X2+X1
          ZR     X2,DSP2     IF IMPLICIT REMOTE ROUTING
          SA2    TDSP+2
          SX3    A1          SET ADDRESS OF FAMILY/USERNUMBER BLOCK
          MX0    36
          BX3    -X3
          BX6    -X0*X3
          BX2    X0*X2
          BX6    X2+X6
          SA6    TDSP+2
 DSP2     MX0    -3
          SA1    PDCT
          LX0    3
          SA2    PECT
          BX1    -X0*X1      GET *DC* TYPE
          BX2    -X0*X2      GET *EC* TYPE
          ZR     X1,DSP3     IF NO *DC* TYPE
          ZR     X2,DSP3     IF NO *EC* TYPE
          BX1    X1-X2
          ZR     X1,DSP3     IF TYPES COMPARE
          MESSAGE (=C/ ROUTE *DC* INCOMPATIBLE WITH *EC*./),3,RECALL
          EQ     ABT1        ABORT
 
 DSP3     ROUTE  TDSP,RECALL
          SX1    A0
          SA2    TDSP
          MX0    -1
          SA3    A2+B1       GET FLAGS FIELD
          BX3    -X0*X3
          NZ     X3,DSP5     IF THIS WAS A DEFERRED ROUTE
          NZ     X1,DSP5     IF JSN NOT TO BE RETURNED
          SA3    DSPA+2      POSITION JSN
          MX0    24
          BX6    X0*X2
          ZR     X6,DSP5     IF NO JSN RETURNED
          LX0    30
          BX3    -X0*X3
          LX6    30
          BX6    X3+X6
          SA6    DSPA+2      STORE JSN IN MESSAGE
          MESSAGE DSPA,3,RECALL
 DSP4     ENDRUN
 
 DSP5     MESSAGE (=C* ROUTE COMPLETE.*),3,RECALL
          EQ     DSP4
 
 DSPA     DATA   H/ ROUTE COMPLETE.  JSN IS XXXX./
 DSPB     DATA   2RIN        *DC=IN*
          DATA   2RNO        *DC=NO*
          DATA   2RTO        *DC=TO*
          DATA   0
          TITLE  KEYWORD PROCESSORS.
**        ALL OF THE FOLLOWING ROUTINES HAVE COMMON ENTRY AND EXIT
*         CONDITIONS-
*
*         ENTRY  X3 = PARAMETER WHEN  *KW=PP* IS THE FORMAT.
*                X3 = ZERO IF NO PARAMETER WITH KEYWORD.
*
*         EXIT   CORRECT ENTRIES MADE IN *TDSP*.
*                RETURN IN ALL NORMAL CASES TO *EPRX*
*
*         USES   ALL REGISTERS EXCEPT A0, B6.
 
 
 KDC      SPACE  4,10
**        KDC - PROCESS DC=XX.  DISPOSITION CODE.
*
*         EXIT   *DC* FIELD SET IN *TDSP+1*
*                *FLAGS* ENTERED WITH *FRDC* IN *TDSP+1*.
 
 
 KDC      BSS    0           ENTRY
          SA1    TDCC-1
          MX0    12
 
*         FIND CODE IN TABLE.
 
 KDC1     SA1    A1+1
          BX7    X1-X3       COMPARE CODES
          BX7    X0*X7
          ZR     X1,KDC2     IF END OF TABLE
          NZ     X7,KDC1     IF NO MATCH
 KDC2     BX7    X1
          SA7    PDCT        SET TYPE PROCESSED
          LX3    -24         POSITION PARAMETER
          SA1    TDSP+1
          SX7    FRDC
          LX0    -24         POSITION MASK
          BX3    X0*X3
          BX1    -X0*X1
          BX3    X1+X3       ENTER *DC* PARAMETER
          BX7    X3+X7       ENTER FLAG BIT
          SA7    A1
          EQ     EPRX        RETURN
 KDE      SPACE  4,10
**        KDE - PROCESS *DEF*. DEFERRED ROUTE
*
*         EXIT   *FLAGS* IN *TDSP+1* ENTERED WITH *FRDR*.
 
 
 KDE      BSS    0           ENTRY
          NZ     X3,ABT      IF EQUIVALENCED PARAMETER
          SA1    TDSP+1
          SX7    FRDR
          SA7    PDEF        SET *DEF* PARAMETER ENTERED FLAG
          BX7    X1+X7       ENTER FLAG
          SA7    A1
          EQ     EPRX        RETURN
 KDO      SPACE  4,10
**        KDO - PROCESS *DO=XXX*.  DEFAULT OUTPUT MAINFRAME.
*
*         EXIT   SOURCE LOGICAL ID IS PLACED IN *TDSP+2*.
*
*         ERROR  IF INCORRECT *DO* PARAMETER OR *LID* IS
*                GREATER THAN THREE CHARACTERS.
 
 
 KDO      BSS    0           ENTRY
          MX0    18
          BX2    -X0*X3
          AX2    18
          NZ     X2,KDO2     IF *LID* GREATER THAN THREE CHARACTERS
          BX6    X0*X3       EXTRACT OUTPUT MAINFRAME *LID*
          SA5    =1L*        CHECK FOR ASTERISK
          R=     X4,LCPD     SET SLID TO PID
          LX6    18
          IX3    X4-X6
          PL     X3,KDO2     IF .LE. SPECIAL SLID VALUES
          LX5    18
          BX5    X5-X6
          NZ     X5,KDO1     IF NOT ASTERISK
          BX6    X4          SET SLID=PID
 KDO1     SA2    TDSP+2      SET SLID IN TDSP
          BX2    -X0*X2
          LX6    42
          BX6    X2+X6
          SA6    A2
          SX6    FRLD
          SA1    A2-B1       SET SLID/DLID FLAG
          BX6    X1+X6
          SA6    A1+         STORE FLAG
          EQ     EPRX        RETURN
 
 KDO2     MESSAGE  (=C+ ROUTE INCORRECT *DO* PARAMETER.+),3,RECALL
          EQ     ABT1        ABORT
 KEC      SPACE  4,10
**        KEC - PROCESS *EC=XX*. EXTERNAL CHARACTERISTICS.
*
*         EXIT   *EC* FIELD SET IN *TDSP+1*.
*                *FLAGS* FIELD IN *TDSP+1* ENTERED WITH *FREC*.
 
 
 KEC      BSS    0           ENTRY
          SA1    TECC-1
          MX0    36
          SA2    TDSP+1
          MX7    -3
 
 KEC1     SA1    A1+B1
          ZR     X1,KEC2     IF *EC* NOT FOUND
          BX6    X3-X1
          BX6    X0*X6
          NZ     X6,KEC1     IF NOT CORRECT *EC*
          BX6    X1
          SA6    PECT        SET TYPE PROCESSED
          LX7    23-2        POSITION MASK
          LX1    23-2        POSITION ENTRY FROM *EC* TABLE
          SX6    FREC
          BX2    X7*X2
          BX1    -X7*X1
          BX6    X2+X6       ENTER FLAG BIT
          BX6    X1+X6       ENTER *EC* CODE
          SA6    A2+
          EQ     EPRX        RETURN
 
 KEC2     MESSAGE (=C+ ROUTE INCORRECT *EC* PARAMETER.+),3,RECALL
          EQ     ABT1        ABORT
 KFC      SPACE  4,10
**        KFC - PROCESS *FC=XX. FORMS CODE.
*
*         EXIT   *FC* FIELD SET IN *TDSP+1*.
*                *FLAGS* FIELD IN *TDSP+1* ENTERED WITH *FRFC*.
*
*         ERROR  TO *ABT1*.
*
*         MACROS MESSAGE.
 
 
 KFC      BSS    0           ENTRY
          SA1    TDSP+1
          MX0    -48
          SX6    FRFC
          BX2    -X0*X3
          LX3    -12
          NZ     X2,KFC1     IF FORMS CODE GREATER THAN TWO CHARACTERS
          LX0    -12
          BX1    X1+X6       ENTER FLAG BIT
          BX3    X0*X3
          BX6    X1+X3       ENTER FORMS CODE
          SA6    A1
          EQ     EPRX        RETURN
 
 KFC1     MESSAGE (=C+ ROUTE INCORRECT *FC* PARAMETER.+),0,RECALL
          EQ     ABT1        ABORT
 KFM      SPACE  4,10
**        KFM - PROCESS *FM=XXXXXXX* PARAMETER.
*
*         EXIT   FAMILY NAME ENTERED IN *TFUN*.
*                FLAG SET IN *PFUN* IF *PTID* AND *PDID* ARE ZERO.
 
 
 KFM      BSS    0           ENTRY
          SA1    PDID
          NZ     X1,KFM2     IF *FM* AND *ID* CONFLICT
          SA1    PTID
          SX7    FRTI
          NZ     X1,KFM1     IF *TID* PROCESSED
          SA7    PFUN        SET *FM-UN* FLAG
          ZR     X3,EPRX     IF IMPLICIT REMOTE ROUTING
          MX0    42
          BX7    X0*X3
          SA7    TFUN        STORE FAMILY NAME IN *TFUN*
          EQ     EPRX        RETURN
 
 KFM1     MESSAGE (=C+ ROUTE *TID* AND *FM/UN* CONFLICT.+),3,RECALL
          EQ     ABT1        ABORT
 
 KFM2     MESSAGE (=C+ ROUTE *TID/FM/UN* AND *ID* CONFLICT.+),3,RECALL
          EQ     ABT1        ABORT
 KIC      SPACE  4,10
**        KIC - PROCESS *IC=XX* (INTERNAL CHARACTERISTICS)
*
*         EXIT   *IC* FIELD SET IN *TDSP+1*.
*                *FLAGS* FIELD IN *TDSP+1* ENTERED WITH *FRIC*.
 
 
 KIC      BSS    0           ENTRY
          SA1    TDSP+1
          SA2    TICC-1
          SX6    FRIC
          MX7    -2
          MX0    36
          LX7    19-1        POSITION MASK
          BX6    X1+X6       ENTER FLAG BIT
 
 KIC1     SA2    A2+B1
          ZR     X2,KIC2     IF UNKNOWN *IC* CODE
          BX1    X3-X2
          BX1    X0*X1
          NZ     X1,KIC1     IF NOT FOUND
          LX2    19-1
          BX6    X7*X6
          BX2    -X7*X2
          BX6    X6+X2       ENTER IC CODE
          SA6    A1
          EQ     EPRX        RETURN
 
 KIC2     MESSAGE (=C+ ROUTE INCORRECT *IC* PARAMETER.+),3,RECALL
          EQ     ABT1        ABORT
 KID      SPACE  4,10
**        KID - PROCESS *ID=NN* (LOCAL DEVICE ID).
*
*         EXIT   DEVICE ID STORED IN *TDSP+2* (TID FIELD).
*                *FLAGS* FIELD IN *TDSP+1* ENTERED WITH *FRTI*.
*                *PDID* SET IF *PTID* AND *PFUN* ARE ZERO.
 
 
 KID      BSS    0           ENTRY
          SA1    PTID
          SA2    PFUN
          SX7    B1
          BX1    X1+X2
          NZ     X1,KFM2     IF *ID* - *TID*/*FM*/*UN* CONFLICT
          SA7    PDID
          ZR     X3,KID1     IF NONEQUIVALENCED PARAMETER
          SB7    B0          SET OCTAL CONVERSION DEFAULT
          BX5    X3
          RJ     =XDXB
          NZ     X4,ABT      IF CONVERSION ERROR
          SA1    TDSP+2
          MX0    36
          SX2    X6-IDLM
          BX7    X0*X1
          PL     X2,ABT      IF ID .GE. IDLM
          BX7    X7+X6
          SA7    A1
          SX3    FRTI
 
 KID1     SA2    TDSP+1
          SX6    FRCS
          BX6    X2+X6       SET CENTRAL SITE ROUTING FLAG
          BX6    X3+X6       OPTIONALLY SET *TID* FLAG
          SA6    A2+
          EQ     EPRX        RETURN
 KJS      SPACE  4,10
**        KJS - PROCESS *JSN=XXX* (UNIQUE JSN).
*
*         EXIT   FORCED JSN FIELD SET IN *TDSP+6*.
*                *FLAGS* FIELD IN *TDSP+1* ENTERED WITH *FRFJ*.
 
 
 KJS      BSS    0           ENTRY
          ZR     X3,ABT      IF NULL PARAMETER
          SX6    B1+
          SA6    PJSN
          SA1    JOPR        CHECK JOB ORIGIN TYPE
          MX0    -12
          LX1    0-24
          BX1    -X0*X1
          MX0    42
          IFNE   SYOT,0,1
          SX1    X1-SYOT
          ZR     X1,KJS1     IF SYSTEM ORIGIN JOB
          MESSAGE  (=C+ ROUTE *JSN* NOT ALLOWED.+),3
          EQ     ABT1        ABORT
 
 KJS1     LX3    18
          BX1    X0*X3
          NZ     X1,KJS2     IF JSN TOO LONG
          MX7    -6
          BX1    -X7*X3
          ZR     X1,KJS2     IF JSN TOO SHORT
          SA1    TDSP+6
          SA2    TDSP+1
          BX6    X0*X1
          BX6    X6+X3       SET JSN IN FORCED JSN FIELD
          SX7    FRFJ
          BX7    X2+X7       SET FORCED JSN FLAG
          SA6    A1
          SA7    A2+
          EQ     EPRX        RETURN
 
 KJS2     MESSAGE  (=C+ ROUTE INCORRECT *JSN* PARAMETER.+),3
          EQ     ABT1        ABORT
 KOT      SPACE  4,10
**        KOT - PROCESS *OT=XXXX* (ORIGIN TYPE).
*
*         EXIT   *F* AND *OT* FIELDS SET IN *TDSP*.
 
 
 KOT      BSS    0           ENTRY
          SA1    JOPR        CHECK JOB ORIGIN TYPE
          MX0    -12
          LX1    11-35
          BX1    -X0*X1
          MX0    30
          SA2    TLOT-1
          SX1    X1-SYOT
          ZR     X1,KOT1     IF *SYOT* JOB ORIGIN
          MESSAGE (=C/ ROUTE *OT* NOT ALLOWED./),3,RECALL
          EQ     ABT1        ABORT
 
 KOT1     SA2    A2+1
          BX6    X3-X2
          BX6    X0*X6
          ZR     X2,KOT2     IF END OF TABLE
          NZ     X6,KOT1     IF NOT A MATCH
          MX0    -7
          SA1    TDSP
          BX2    -X0*X2      EXTRACT ORIGIN VALUE
          SX2    X2+4000B    SET FLAG BIT
          BX1    X0*X1
          BX7    X1+X2       ENTER ORIGIN VALUE
          SA7    TDSP
          EQ     EPRX        RETURN
 
 KOT2     MESSAGE (=C+ ROUTE INCORRECT *OT* PARAMETER.+),3,RECALL
          EQ     ABT1        ABORT
 KPI      SPACE  4,10
**        KPI - PROCESS *PI=NNNNNNN* (PRINT IMAGE).
*
*         EXIT-  *P* FLAG AND *PI* FIELD SET IN *TDSP+4*
*
 
 
 KPI      BSS    0           ENTRY
          ZR     X3,EPRX     IF NULL PARAMETER
          SA1    TPIN-1
          MX0    1
 
*         CHECK FOR VALID PRINT IMAGE NAME.
 
 KPI1     SA1    A1+B1       CHECK NEXT ENTRY
          ZR     X1,KPI2     IF END OF TABLE
          SX6    X1          ISOLATE MASK SIZE
          BX7    X1-X3
          AX6    6
          SB4    X6
          AX6    X0,B4       FORM MASK
          BX2    X6*X7
          NZ     X2,KPI1     IF NO MATCH
          SA2    TDSP+4B
          MX0    -6          ISOLATE PRINT IMAGE ORDINAL
          LX2    6
          BX6    -X0*X1
          BX7    X0*X2
          SX6    X6+10B      SET PRINT IMAGE FLAG
          BX7    X6+X7       SET PRINT IMAGE CODE INTO PARAMETER BLOCK
          LX7    -6
          SA7    A2
          EQ     EPRX        RETURN
 
 KPI2     MESSAGE (=C/ ROUTE UNKNOWN *PI* PARAMETER./),3,R
          EQ     ABT1        ABORT
 KPR      SPACE  4,10
**        KPR - PROCESS *PRI=NNNN* (PRIORITY)
*
*         EXIT   MESSAGE ISSUED, PARAMETER IGNORED.
 
 
 KPR      BSS    0           ENTRY
          MESSAGE (=C/ ROUTE *PRI* IGNORED./),3,RECALL
          EQ     EPRX        RETURN
 KRE      SPACE  4,10
**        KRE - PROCESS *REP=NN* (REPEAT COUNT)
*
*         EXIT   REPEAT COUNT SET IN *TDSP+4* - *RC* FIELD.
*                *FLAGS* IN *TDSP+1* ENTERED WITH *FRRC*.
 
 
 KRE      BSS    0           ENTRY
          SB7    B1          SET DECIMAL CONVERSION
          BX5    X3
          RJ     =XDXB       CONVERT VALUE
          NZ     X4,ABT      IF CONVERSION ERROR
          SA1    TDSP+1
          MX0    -6
          BX2    X0*X6
          NZ     X2,KRE1     IF VALUE .GT. 63D (77B)
          SA2    TDSP+4
          SX7    FRRC
          LX0    12          POSITION MASK
          LX6    12          POSITION VALUE
          BX2    X0*X2
          BX7    X1+X7       SET FLAG BIT
          SA7    A1
          BX6    X6+X2       ENTER REPEAT COUNT
          SA6    A2+
          EQ     EPRX        RETURN
 
 KRE1     MESSAGE (=C/ ROUTE *REP* GT 63. DEFAULT USED./),3,RECALL
          EQ     EPRX        RETURN
 KSC      SPACE  4,10
**        KSC - PROCESS *SC=XX* (SPACING CODE).
*
*         EXIT   SPACING CODE ENTERED IN *TDSP+4*.
 
 
 KSC      BSS    0           ENTRY
          SB7    B0          SET OCTAL CONVERSION
          BX5    X3
          RJ     =XDXB       CONVERT VALUE
          NZ     X4,ABT      IF CONVERSION ERROR
          MX0    -6          ENTER SPACING CODE
          BX3    -X0*X6
          BX1    X0*X6
          ZR     X1,KSC1     IF SC .LE. 77B
          MESSAGE  (=C* ROUTE INCORRECT SPACING CODE.*),3,R
          EQ     ABT1        ABORT
 
 KSC1     SA1    TDSP+4
          LX0    48
          BX1    X0*X1
          LX3    48
          BX6    X1+X3
          SA6    A1+
          SA1    TDSP+1      SET SPACING CODE FLAG
          SX6    FRSC
          BX6    X6+X1
          SA6    A1
          EQ     EPRX        RETURN
 KST      SPACE  4,10
**        KST - PROCESS *ST=XXX*.  DESTINATION LID.
*
*         EXIT   THE LOGICAL ID IS PLACED IN *TDSP+2*.
*
*         ERROR  IF INCORRECT *ST* PARAMETER OR *LID* IS
*                GREATER THAN THREE CHARACTERS.
 
 
 KST      BSS    0           ENTRY
          MX0    18
          BX2    -X0*X3
          AX2    18
          NZ     X2,KST2     IF *LID* GREATER THAN THREE CHARACTERS
          BX6    X0*X3
          SA5    =1L*        CHECK FOR ASTERISK
          R=     X4,LCPD     SET DLID TO PID
          LX6    18
          IX3    X4-X6
          PL     X3,KST2     IF .LE. SPECIAL DLID VALUES
          LX5    18
          BX5    X5-X6
          NZ     X5,KST1     IF NOT ASTERISK
          BX6    X4          SET DLID=PID
 KST1     LX6    24
          SA2    TDSP+2      SET DLID IN TDSP
          LX0    -18
          BX2    -X0*X2
          BX6    X6+X2
          SX1    FRLD        SET SLID/DLID FLAG
          SA6    A2
          SA2    A2-B1
          BX6    X2+X1
          SA6    A2          STORE FLAG
          EQ     EPRX        RETURN
 
 KST2     MESSAGE  (=C+ ROUTE INCORRECT *ST* PARAMETER.+),3,RECALL
          EQ     ABT1        ABORT
 KSV      SPACE  4,10
**        KSV -  PROCESS *SCL=XX* (SERVICE CLASS).
*
*         EXIT   SERVICE CLASS ENTERED IN *TDSP+4*.
 
 
 KSV      BSS    0           ENTRY
          SA1    TSCT-1
 
*         CHECK FOR VALID SERVICE CLASS.
 
 KSV1     SA1    A1+B1
          ZR     X1,KSV2     IF END OF TABLE
          BX7    X1-X3
          NZ     X7,KSV1     IF NO MATCH
          SA1    TDSP+4
          MX0    12
          BX7    X0*X3       SET SERVICE CLASS INTO PARAMETER BLOCK
          LX7    -12
          BX7    X7+X1
          SA7    A1
          SA1    TDSP+1      SET FORCED SERVICE CLASS FLAG
          MX0    -1
          LX0    20
          BX7    -X0+X1
          SA7    A1+
          EQ     EPRX        RETURN
 
 KSV2     MESSAGE  (=C+ ROUTE UNDEFINED SERVICE CLASS.+),3,RECALL
          EQ     ABT1        ABORT
 KTD      SPACE  4,10
**        KTD - PROCESS *TID=XX* (TERMINAL ID).
*
*         EXIT   *PTID* SET NON-ZERO IF *PFUN* AND *PDID* EQUAL ZERO.
*                *TID=C* PROCESSED AS *ID*.
*                *TID=XX* PROCESSED AS *UN*.
 
 
 KTD      BSS    0           ENTRY
          SX6    1RC
          LX6    59-5
          BX6    X6-X3
          ZR     X6,KTD1     IF *TID=C* - ROUTE TO CENTRAL SITE
          SA1    PDID
          NZ     X1,KFM2     IF *TID* - *ID* CONFLICT
          SA1    PFUN
          NZ     X1,KFM1     IF TID - FM/UN CONFLICT
          PL     X3,KUN      IF *TID=XX*
          SX7    FRTI
          SA7    PTID
          EQ     EPRX        RETURN
 
 KTD1     SX3    0
          EQ     KID         PROCESS AS *ID*
 KUJ      SPACE  4,10
**        KUJ - PROCESS *UJN=XXXXXXX* (USER JOB NAME).
*
*         EXIT   *UJN* FIELD SET IN *TDSP+3*.
*                *FLAGS* IN *TDSP+1* ENTERED WITH *FRUJ*.
 
 
 KUJ      BSS    0           ENTRY
          SX6    B1+
          SA6    PUJN
          SA1    TDSP+1      ENTER FLAG BIT
          SX7    FRUJ
          BX7    X1+X7
          SA7    A1
          SA1    TDSP+3      ENTER *UJN* PARAMETER
          BX1    -X0*X1
          BX6    X1+X3
          SA6    A1
          EQ     EPRX        RETURN
 KUN      SPACE  4,10
**        KUN - PROCESS *UN=XXXXXXX* (USER NAME).
*
*         EXIT   USER NAME ENTERED IN *TFUN+1*.
*                FLAG SET IN *PFUN* IF *PTID* AND *PDID* ARE ZERO.
 
 
 KUN      BSS    0           ENTRY
          SA1    PDID
          NZ     X1,KFM2     IF *UN* - *ID* CONFLICT
          SA1    PTID
          SX7    FRTI
          NZ     X1,KFM1     IF FM/UN - TID CONFLICT
          SA7    PFUN
          ZR     X3,EPRX     IF IMPLICIT REMOTE ROUTING
          MX0    42
          BX6    X0*X3
          SA6    TFUN+1      STORE USER NAME
          EQ     EPRX        RETURN
          SPACE  4,10
          USE    LITERALS
 
**        COMMON DECKS.
 
*CALL     COMCDXB
*CALL     COMCSYS
 
          BSS    0
 RFL=     EQU    *+8
 
          END