ROUTE 
          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 
