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