*COMDECK  CCLPRS
          TITLE  CCLPRS  -  PRESET
**        CCLPRS  -  PRESET 
* 
*         THIS SUBROUTINE IS EXECUTED DURING INITIATION TO PRESET 
*         ANY NEEDED DATA.
*         SET VALUE OF REGISTERS
*         SET SENSE SWITCH VALUES 
*         SET ERROR FLAG VALUES 
*         SET TIME AND FIELD LENGTH 
*         SET SERVICE CLASS 
*         SET SYSTEM SECURITY MODE
*         SET MACHINE ID
* 
*         NOTE - CCLPRS IS OVERLAID BY SCATTER BUFFER *SCATBF2* AND 
*                THEREFORE MUST NOT CALL ANY ROUTINE WHICH USES IT. 
  
  
  
 CCLPRS   SUBR   =
 OSNOSBE  IFNE   HOST,SC2 
  
*         INDICATE 63/64 CHARACTER SET
  
 OSNBE    IFEQ   HOST,NOSBE 
          SA1    RA.CSM      64/63 CHARACTER SET WORD 
 OSNBE    ELSE
          SA1    CSMR        GET WORD CSMR FROM COMMUNICATION AREA
 OSNBE    ENDIF 
          NG     X1,PRS0     SYSTEM IN 64 CHARACTER SET MODE
  
          SX6    4072B       COLON
          SA6    TVXDPR 
          SX6    4045B       63 CHARACTER SET PERCENT 
          SA6    TVXDCL 
          SX6    63B         COLON IN 63 CHARACTER SET
          SA6    DISCOL 
          SX6    1R          PERCENT UNDEFINED IN 63 CHARACTER SET
          SA6    DISPER 
  
 PRS0     BSS    0
 OSNOSBE  ENDIF 
  
  
*         GET JOB CONTROL INFORMATION 
  
          MX6    0
          SA6    JCI         ENSURE COMPLETE BIT ZERO 
          GETJCI JCI
  
*         SET REGISTERS, ERROR MODE, SENSE SWITCH, ERROR FLAG 
  
          SA1    JCI+W.JCEFG
          BX7    X1 
          EX6    X1,JCEFG 
          LX7    59-S.JCR1G 
          SA6    SNVEFG      EFG
          AX7    60-N.JCR1G  EXTEND SIGN
          EX6    X1,JCDSC 
          SA7    SNVR1G      R1G
          SA3    SNVEM
          SA6    SNVDSC 
          MX0    -N.SNVVAL
          EX7    X1,JCPNL 
          EX6    X1,JCEM
          SA7    SNVPNL 
          BX3    X0*X3       CLEAR OLD EM VALUE 
          BX6    X3+X6       ADD EM 
          SA6    SNVEM       EM 
          LX1    59-S.JCSSW  SENSE SWITCHES AT 59-54
          MX6    N.JCSSW
          MX0    -1 
          BX1    X1*X6
          SA2    SNVSSW+5 
 PRS1     BSS 
          LX1    1
          BX6    -X0*X1 
          BX6    X2+X6
          SA2    A2-B1
          BX1    X1*X0
          SA6    A2+B1
          NZ     X1,PRS1     IF ANOTHER SS IS SET 
  
*         SET EF, R1,R2,R3
  
          SA1    JCI+W.JCEF 
          BX6    X1 
          BX7    X1 
          LX6    59-S.JCR1
          LX7    59-S.JCR2
          AX6    60-N.JCR1   EXTRACT AND EXTEND SIGN
          AX7    60-N.JCR2   EXTRACT AND EXTEND SIGN BIT
          SA6    SNVR1
          SA7    SNVR2
          BX6    X1 
          LX6    59-S.JCR3
          AX6    60-N.JCR3   EXTEND SIGN
          EX7    X1,JCEF
          SA6    SNVR3
          SA7    SNVEF
  
*         SET JOB AND SYSTEM PAGE PARAMETERS
  
          GETPAGE SPP 
  
          SA1    SPP+W.PGJPD
          EX3    X1,PGJPD 
          SA2    SNVJPP 
          BX6    X2+X3
          SA6    A2          STORE PRINT DENSITY
          EX3    X1,PGJPS 
          SA2    A2+B1
          BX6    X2+X3
          SA6    A2          STORE PAGE SIZE
          SA2    A2+B1
          BX6    X2+X3
          SA6    A2          STORE PAGE LENGTH (SIZE) 
          EX3    X1,PGJPW 
          SA2    A2+B1
          BX6    X2+X3
          SA6    A2          STORE PRINT WIDTH
  
          SA1    SPP+W.PGSPD
          EX3    X1,PGSPD 
          SA2    SNVSPP 
          BX6    X2+X3
          SA6    A2          STORE PRINT DENSITY
          EX3    X1,PGSPS 
          SA2    A2+B1
          BX6    X2+X3
          SA6    A2 
          SA2    A2+B1
          BX6    X2+X3
          SA6    A2          STORE PAGE LENGTH (SIZE) 
          EX3    X1,PGSPW 
          SA2    A2+B1
          BX6    X2+X3
          SA6    A2 
  
          CLOCK  PRSWRD 
  
          SA2    PRSWRD      WALL CLOCK TIME  HH.MM.SS
          MX0    12 
          LX2    6
          BX6    X0*X2       EXTRACT HOURS     HH 
          LX2    6
          LX0    48 
          BX7    X0*X2       EXTRACT MINUTES   MM 
          BX1    X6+X7       HHMM 
          RJ     =XSTREVN    EVALUATE NUMERIC 
  
          SA6    SNVTIME     SNVTIME - HHMM 
          SA1    W.RAJOT
          SA4    SNVOT
          MX7    -N.RAJOT 
          AX1    S.RAJOT-N.RAJOT+1
          BX7    -X7*X1      EXTRACT JOB ORIGIN TYPE
          BX7    X4+X7
          SA7    A4          SNVOT  -  ORIGIN CODE
          MX6    0
          SA6    PRSWRD      SET REQUEST FOR CURRENT FL 
          MEMORY  SCM,PRSWRD,RECALL 
  
          SA1    PRSWRD 
          MX0    30 
          LX1    30 
          BX6    -X0*X1 
          SA6    SNVFL       SNVFL - CURRENT SCM FIELD LENGTH 
  
          MX6    29 
          SA6    PRSWRD      SET FOR MAX. MEMORY REQUEST
          MEMORY  SCM,PRSWRD,RECALL 
  
          SA1    PRSWRD      FIELD LENGTH RETURNED IN UPPER 30 BITS 
          MX0    30 
          LX1    30 
          BX6    -X0*X1 
          MX7    29 
          SA6    SNVMFL 
          SA7    PRSWRD      SET FOR FLL REQUEST
          MEMORY  LCM,PRSWRD,RECALL 
  
          SA1    PRSWRD      FIELD LENGTH RETURNED IN UPPER 30 BITS 
          MX0    30 
          LX1    30 
          BX6    -X0*X1 
          SA6    SNVMFLL
 OSNOS    IFEQ   HOST,NOS 
  
*         SET SERVICE CLASS SYMBOL *SC* TO CURRENT SERVICE CLASS. 
  
          SA1    SNVSC
          BX7    X1          RETAIN SERVICE CLASS SYMBOL
          GETJOSC  SNVSC
          SA1    SNVSC       EXTRACT CURRENT SERVICE CLASS
          LX1    -6 
          MX0    -6 
          BX1    -X0*X1 
          BX7    X7+X1       COMBINE SYMBOL AND VALUE 
          SA7    A1+         SAVE CURRENT SERVICE CLASS 
  
  
  
*         SET NOMINAL FIELD LENGTH VALUES (KCL COMPATIBILITY) 
  
          GETFLC FLCM,FLECS 
  
          SA1    FLCM        12/MFL,12/RFL,12/JMFL,12/RIFL,12/FLIR
          LX1    12+12       POSITION TO RFL FIELD
          MX2    -12
          BX6    -X2*X1 
          SA6    SNVCMN      NOMINAL CM FIELD LENGTH
  
          SA1    FLECS       PICK UP WORD 
          LX1    12+12
          MX2    -12
          BX6    -X2*X1 
          SA6    SNVECN      NOMINAL ECS FIELD LENGTH 
  
*         GET SUBSYSTEM 
  
          GETSS  SUBS 
  
 OSNOS    ENDIF 
  
  
 OSNOSBE  IFNE   HOST,SC2 
 OSNOS    IFEQ   HOST,NOS 
  
          MACHID SNVHID            GET MACHINE (HOST) ID
  
 OSNOS    ELSE
  
          GETHID SNVHID 
  
 OSNOS    ENDIF 
  
          SA1    SNVHID 
          SX2    3RHID
          LX2    S.SNVNAM-S.SNVOFF
          BX6    X1+X2             48/0LHID,12/HID
          SA6    A1 
  
 OSNOSBE  ENDIF 
 OSNOS    IFEQ   HOST,NOS 
  
*         GET SCREEN OR LINE
  
 SDOVL    IFNE   IP.SDO,0 
          MX7    0
          SA7    SDMODL 
          SA7    SDMODE 
          SA1    GSLARG      A1 = ADDRESS OF ARGUMENT LIST
          SB1    1
          RJ     =XVDTGSL    DETERMINE SCREEN OR LINE 
          SB1    1
          SA1    SDMODE 
          BX7    X1 
          SA7    SNVSL
 SDOVL    ENDIF 
  
  
*         RETRIEVE NOS VERSION
  
          MX7    0
          SA7    SNVVER 
          VERSION PRSVER     GET NOS SYSTEM VERSION LEVEL 
  
          SA1    SNVVER 
          BX7    X1 
          AX7    6
          SA7    SNVVER 
  
*         GET RELEASE LEVEL.
  
          GETLVL TLVL 
  
 OSNOS    ENDIF 
  
          SA1    SNVSYS      GET HOST SYSTEM INDEX
          SX6    X1 
          SA1    TLVL        GET HOST RELEASE LEVEL 
          BX7    X1 
          SA7    TLVL+X6     SET HOST ENTRY IN RELEASE LEVEL TABLE
  
 OSSC2    IFNE   HOST,SC2 
  
  
*         GET DATE AND COMPUTE DAY OF WEEK
  
          DATE   PRSWRD 
  
 OSNBE    IFEQ   HOST,NOSBE 
  
 DE1      MICRO  1,1, "IP.YMD"
 DE2      MICRO  2,1, "IP.YMD"
 DE3      MICRO  3,1, "IP.YMD"
  
 DE1      MICRO  1,, "DE1""DE1" 
 DE2      MICRO  1,, "DE2""DE2" 
 DE3      MICRO  1,, "DE3""DE3" 
  
 "DE1"    EQU    0
 "DE2"    EQU    1
 "DE3"    EQU    2
  
          SA1    PRSWRD      FETCH NOS/BE DATE
          MX0    12 
          BX7    X1 
          LX0    -6          DESTINATION FOR YEAR 
          LX7    YY*18
          BX6    X0*X7       YEAR 
          BX7    X1 
          LX0    -18         DESTINATION FOR MONTH
          LX7    MM*18-18 
          BX7    X0*X7       MONTH
          BX6    X6+X7       YEAR, MONTH
          SA4    PRSDSKL     DATE SKELETON
          LX0    -18         DESTINATION FOR DAY
          LX1    DD*18-36 
          BX1    X0*X1
          BX6    X6+X4       YEAR, MONTH IN SKELETON
          BX6    X6+X1       FULL DATE IN NOS FORMAT
          SA6    A1 
          BX1    X6 
 OSNBE    ELSE
          SA1    PRSWRD 
 OSNBE    ENDIF 
          MX0    12 
          LX1    42 
          BX1    X0*X1       EXTRACT DAY
          RJ     =XSTREVN    CONVERT TO BINARY
  
          SA1    PRSWRD 
          SA6    SNVDAY 
          MX0    12 
          LX1    24 
          BX1    X0*X1       EXTRACT MONTH
          RJ     =XSTREVN    CONVERT TO BINARY
  
          SA1    PRSWRD 
          SA6    SNVMON 
          MX0    12 
          LX1    6
          BX1    X0*X1       EXTRACT YEAR 
          RJ     =XSTREVN    CONVERT TO BINARY
  
          SA1    SNVMON 
          SA2    SNVDAY 
          SA6    SNVYEAR
          SX3    100
          IX4    X3*X6       YEAR*100 
          SA5    X1+PRSHATH-1      DAYS BEFORE MONTH
          IX4    X1+X4       YYMM 
          IX4    X3*X4       YYMM-- 
          IX7    X2+X4       YYMMDD 
          SA7    SNVDATE
          SX7    X6+1900D 
          SX4    X6-77
          PL     X4,PRS1.0   IF YEAR .LT. 2000
          SX7    X6+2000D 
 PRS1.0   SA7    SNVYEAR4    4-DIGIT YEAR 
          IX4    X3*X7       YYYY-- 
          IX4    X1+X4       YYYYMM 
          IX4    X3*X4       YYYYMM-- 
          IX7    X2+X4       YYYYMMDD 
          SA7    SNVDATE4 
          SX3    365
          SX4    X6-77       YEAR - 1977
          PL     X4,PRS1.1   IF YEAR .LT. 2000
          SX4    X6+23       ADJUST YEARS 2000 AND BEYOND 
 PRS1.1   IX3    X3*X4       DAYS IN FULL YEARS 
          AX4    2           LEAP YEAR DAYS 
          IX2    X2+X3
          IX2    X2+X4
          IX2    X2+X5
          SX5    B1 
          SX7    3
          BX6    X7*X6       LEAP YEAR FLAG 
          IX1    X1-X7
          NZ     X6,PRS2     IF NOT IN LEAP YEAR
  
          NG     X1,PRS2     IF NOT PAST FEBRUARY 
  
          IX2    X2+X5
 PRS2     BSS    0
          IX7    X2-X5       DAYS SINCE JAN 1 1977
          SA7    SNVDAYS     CONVERT TO DAY OF WEEK 
          SX7    X7-1        SUN=0,MON=1...,SAT=6 
          SX1    7
          PX0    X1 
          PX4    X7 
          NX2    X0 
          FX5    X4/X2
          UX0    B2,X5
          LX2    B2,X0
          IX4    X2*X1
          IX7    X7-X4
          NZ     X7,PRS3     IF NOT SUNDAY
  
          SX7    7           SET SUNDAY=7 
 PRS3     BSS    0
          SA7    SNVDOW      STORE DAY OF WEEK
  
 OSSC2    ENDIF 
 OSNOS    IFEQ   HOST,NOS 
  
  
*         SET SYSTEM SECURED MODE SYMBOL *SSM*. 
  
          SA1    SNVSSM 
          BX7    X1          RETAIN SYSTEM SECURITY MODE SYMBOL 
          GETSSM SNVSSM      GET SYSTEM SECURE MODE VALUE 
          SA1    SNVSSM 
          EX0    X1,SNVVAL   REPLACE VALUE IN SYMBOL FIELD
          OX6    X7,X1,SNVVAL 
          SA6    A1 
  
*         GET *FAMILY*, *PACK*, *USER*, *PFDT*, *UI*, 
*         *JSN*, AND *UJN* SYMBOL VALUES. 
  
          GETPFP SNVFNM      GET NOS PERMANENT FILE PARAMETERS
          SA1    SNVUSR      GET USER INDEX 
          MX0    -18
          BX6    -X0*X1 
          SA6    SNVUIX 
          SA1    SNVPAK      GET PF DEVICE TYPE 
          BX6    -X0*X1 
          LX6    42 
          SA6    SNVDTY 
          GETJN  SNVJSN      GET JSN
          SA1    SNVJSN 
          SA2    PRSQACB+2
          MX0    24 
          BX1    X0*X1
          BX2    -X0*X2 
          BX6    X1+X2
          SA6    A2          PLACE JSN IN QAC REQUEST BLOCK 
          SA1    SNVUIX      USER INDEX 
          BX6    X1 
          ZR     X6,PRS3.1   IF UI ZERO (QAC WILL ABORT IF UI IS ZERO)
          SYSTEM QAC,R,PRSQAC  CALL QAC TO OBTAIN UJN 
          SA1    PRSQACP+1
          MX0    42 
          BX6    X0*X1       ISOLATE UJN
 PRS3.1   SA6    SNVUJN 
  
*         JUSTIFY *FAMILY*, *PACK*, *USER*, *PFDT*, *JSN* AND *UJN* 
*         SYMBOL VALUES.
  
          SB6    SNVDTY-SNVFNM
 PRS4     BSS    0
          SA1    SNVFNM+B6   GET NAME TO BE JUSTIFIED 
          EX7    X1,SNVNAM   EXTRACT NAME 
          ZR     X7,PRS6     IF NO NAME PRESENT 
  
          LX7    6
          MX0    -6 
 PRS5     BSS    0
          LX7    -6 
          BX1    -X0*X7 
          ZR     X1,PRS5     IF JUSTIFICATION NOT COMPLETE
  
 PRS6     BSS    0
          SA7    A1 
          SB6    B6-B1
          GE     B6,B0,PRS4  IF MORE NAMES TO JUSTIFY 
  
  
*         SET SYMBOLS REQUIRING USE OF TSTATUS MACRO. 
  
          TSTATUS  PRSTST,3 
  
*         SET CONNECTION STATUS SYMBOL *CS*.
  
          SA1    SNVCS       CONNECTION STATUS SYMBOL 
          SA2    PRSTST+W.TSTCS 
          EX3    X2,TSTCS 
          BX7    X1+X3
          SA7    A1 
  
*         SET TERMINAL CHARACTER SET SYMBOL *CSET*. 
  
          SA1    SNVTC       CHARACTER SET SYMBOL 
          SA2    PRSTST+W.TSTTC 
          EX3    X2,TSTTC 
          BX7    X1+X3
          SA7    A1 
  
*         SET NETWORK CONNECTED SYMBOL *NWK*. 
  
          SA1    SNVNWK      NETWORK SYMBOL 
          SA2    PRSTST+W.TSTNT 
          EX3    X2,TSTNT    NETWORK TYPE 
          BX7    X1+X3
          SA7    A1 
  
*         SET NETWORK TERMINAL NAME SYMBOL *TN*.
  
          SA1    PRSTST+W.TSTTN 
          EX6    X1,TSTTN 
          MX0    -6          CHECK FOR AND REMOVE TRAILING SPACES 
          LX6    6
 PRS7     AX6    6
          ZR     X6,PRS8     IF NO CHARACTERS LEFT
          BX7    -X0*X6 
          SX7    X7-1R
          ZR     X7,PRS7     IF TRAILING SPACE
 PRS8     SA6    SNVNTN 
 OSNOS    ENDIF 
          JP     CCLPRS      EXIT 
  
  
*         DATA WORD FOR CLOCK AND MEMORY
  
 FLCM     BSSZ   1           CM  FIELD LENGTH WORD
 FLECS    BSSZ   1           ECS FIELD LENGTH WORD
 PRSWRD   BSSZ   1
 OSSC2    IFNE   HOST,SC2 
 PRSHATH  DATA   0,31,59,90,120,151,181,212,243,273,304,334 
 OSNOS    IFEQ   HOST,NOS 
 PRSVER   VFD    12/2,12/2,12/3,6/0,18/SNVVER 
 PRSTST   BSSZ   3           STATUS BLOCK FOR TSTATUS MACRO 
  
*         *QAC* PARAMETER BLOCK.
  
 PRSQAC   VFD    50/0,9/PKFC,1/0   REQUEST PREFIX PORTION 
          VFD    36/0,6/11,18/PRSQACP 
          VFD    42/0,18/PRSQACP
          VFD    42/0,18/PRSQACP
          VFD    42/0,18/PRSQACP+3
 PRSQACB  VFD    60/0              SELECTION CRITERIA PORTION 
          VFD    60/0 
          VFD    24/0LJSNX,36/JSSF
          VFD    12/EXQQ,48/0 
          VFD    60/0 
          VFD    60/0 
          VFD    60/0 
          VFD    60/-0             PEEK FUNCTION PORTION
          VFD    12/-0,48/0 
          VFD    48/0,12/UJPB+JSPB JSN AND USER JOBNAME 
          VFD    60/0 
  
*         *QAC*/*PEEK* BUFFER.
  
 PRSQACP  BSSZ   3
 OSNOS    ENDIF 
 OSNBE    IFEQ   HOST,NOSBE 
 PRSDSKL  VFD    6/1L ,12/0,6/1L/,12/0,6/1L/,12/0,6/1L. 
 OSNBE    ENDIF 
 OSSC2    ENDIF 
 PRSLEN   EQU    *-CCLPRS 
  
 SCATBF2  EQU    CCLPRS 
          IFMI   PRSLEN-V.SBSIZ-1,1 
          BSS    1+V.SBSIZ-PRSLEN  ALLOW ROOM FOR SCATTER BUFFER
