*DECK GENSRT
USETEXT COMCBEG 
USETEXT COMCCAE 
USETEXT COMQCAF 
USETEXT COMQDEF 
USETEXT COMQDSP 
USETEXT COMQFIL 
USETEXT COMQQAC 
USETEXT COMQRTP 
    PROC GENSRT;
      BEGIN  # GENSRT # 
# 
**    GENSRT     GENERATE SYSTEM ROUTING TEXT.
* 
*     ENTRY      QACB = ACQUIRED FILE ENTRIES.
* 
*     EXIT       FILESRT = FWA OF TEXT BUFFER.
*                FILEOTY = OUTPUT DEVICE CODE FOR RFT.
* 
*     PROCESS    CREATE NEW ROUTING TEXT. 
# 
  
# 
****  XREF
# 
      XREF
        BEGIN 
        FUNC GETPIN     C(10);     # GET PRINT-IMAGE NAME # 
        PROC MESSAGE;              # ISSUE DAYFILE MESSAGE #
        PROC NAME;                 # DEBUG CODE # 
        PROC RTPUTC;               # PUT CHARACTERS # 
        PROC RTPUTD;               # PUT DECIMAL NUMBER # 
        PROC RTPUTO;               # PUT OCTAL NUMBER # 
        PROC TXTPUTI;              # INITIALIZE TEXT BUFFER # 
        PROC TXTPUTL;              # STORE LENGTH IN TEXT BUFFER #
        END 
  
# 
****  XREF END
# 
  
      BASED ARRAY SRT S(24);
        BEGIN 
        ITEM SRTTEXT    C(00,00,240); 
        ITEM SRTVRB     C(00,00,07);  # *CYB  ,,* # 
        END 
  
      ITEM FTYPE      C(1);        # FILE TYPE #
      ITEM I          I;           # LOOP VARIABLE #
      ITEM SRTBUF     U;           # POINTER TO BUFFER #
      ITEM SRTLENGTH  U;           # LENGTH OF TEXT # 
      ITEM SRTTXT     U;           # POINTER TO TEXT #
  
        $BEGIN
        NAME("GENSRT"); 
        $END
  
      DC$DC[MAXDCV] = FILEDCC;
      I = 0;
      ASLONGAS DC$DC[I] NE DC$DC[MAXDCV]
      DO
        BEGIN 
        I = I + 1;
        END 
  
      FTYPE = DC$TYPE[I]; 
      OD$TYPE[MAXODV] = FTYPE;
      OD$DEFEC[MAXODV] = QACBEC + O"33";
      I = 0;
      ASLONGAS (OD$TYPE[I] NE OD$TYPE[MAXODV])
            OR (    (OD$DEFEC[I] NE " ")
                AND (OD$DEFEC[I] NE EC$DSPEC[MAXODV]) ) 
      DO
        BEGIN 
        I = I + 1;
        END 
  
      FILEOTY = OD$OD[I]; 
      TXTPUTI(SRTBUF, SRTTXT);     # CREATE NEW TEXT #
      P<SRT> = SRTTXT;
      P<RTP> = P<SRT>;
      RTP$BYTE = 6;                # FIRST BYTE FOR PARAMETERS #
      SRTVRB = "CYB  ,";           # CYBER ROUTING TEXT # 
      RTPUTC(",DC=",  FILEDCC);    # DISPOSITION CODE # 
      RTPUTD(",REP=", QACBRC);     # REPEAT COUNT # 
      RTPUTC(",UJN=", FILEJBN);    # UJN #
      IF FTYPE NE "I"              # IF NOT INPUT FILE #
      THEN
        BEGIN 
        EC$DSPEC[MAXECV] = QACBEC + O"33";
        EC$TYPE[MAXECV] = FTYPE;
        I = 0;
        ASLONGAS (EC$DSPEC[I] NE EC$DSPEC[MAXECV])
              OR (EC$TYPE[I]  NE EC$TYPE[MAXECV]) 
        DO
          BEGIN 
          I = I + 1;
          END 
  
        RTPUTC(",EC=",  EC$EC[I]); # EXTERNAL CHARACTERISTICS # 
        IC$DSPIC[MAXICV] = FILEICS + O"33"; 
        I = 0;
        ASLONGAS IC$DSPIC[I] NE IC$DSPIC[MAXICV]
        DO
          BEGIN 
          I = I + 1;
          END 
  
        RTPUTC(",IC=",  IC$IC[I]); # INTERNAL CHARACTERISTICS # 
        RTPUTC(",FC=",  QACBFRM);  # FORMS CODE # 
        RTPUTO(",SC=",  QACBSC);   # SPACING CODE # 
        END 
  
    CONTROL IFEQ OS$NOS;
      IF (QACBID NE O"00")
        AND (QACBID NE O"77") 
      THEN
        BEGIN 
        RTPUTO(",ID=",  QACBID);   # BATCH ID # 
        END 
  
      IF (QACBRUN NE 0)            # IF REMOTE UN OR FAMILY # 
        OR (QACBRFM NE 0) 
      THEN
        BEGIN 
        RTPUTC(",FM=",  QACBRFMC); # REMOTE FAMILY #
        RTPUTC(",UN=",  QACBRUNC); # REMOTE UN #
        END 
  
      ELSE                         # ELSE USE DESTINATION UN/FM # 
        BEGIN 
        RTPUTC(",FM=",  QACBDFMC); # DESTINATION FAMILY # 
        RTPUTC(",UN=",  QACBDUNC); # DESTINATION UN # 
        END 
  
      RTPUTC(",CFM=", QACBCFMC);   # CREATION FM #
      RTPUTC(",CUN=", QACBCUNC);   # CREATION UN #
      RTPUTC(",OFM=", QACBOFMC);   # OWNER FM # 
      RTPUTC(",OUN=", QACBOUNC);   # OWNER UN # 
      RTPUTC(",SCL=", FILESCL);    # SERVICE CLASS #
      RTPUTD(",OT=",  FILEORG);    # ORIGIN TYPE #
      RTPUTD(",PW1=", FILEPW1);    # ENCRYPTED PASSWORD (FIRST PART) #
      RTPUTD(",PW2=", FILEPW2);    # ENCRYPTED PASSWORD (SECOND PART) # 
      RTPUTC(",CH1=", FILECHG1C);  # CHARGE NUMBER (1-7) #
      RTPUTC(",CH2=", FILECHG2C);  # CHARGE NUMBER (8-10) # 
      RTPUTC(",PJ1=", FILEPJ11C);  # PROJECT NUMBER (1-7) # 
      RTPUTC(",PJ2=", FILEPJ12C);  # PROJECT (8-10) # 
      RTPUTC(",PJ3=", FILEPJ21C);  # PROJECT (11-17) #
      RTPUTC(",PJ4=", FILEPJ22C);  # PROJECT (18-20) #
      IF FTYPE EQ "P" 
      THEN
        BEGIN 
        RTPUTD(",DAY=", QACBDRA);  # DAYFILE RANDOM ADDRESS # 
        RTPUTC(",PI=",  GETPIN(QACBPI));  # PRINT IMAGE NAME #
        END 
  
    CONTROL ENDIF;
  
    CONTROL IFEQ OS$NOSBE;
      IF QACRTR 
      THEN
        BEGIN 
        P<DSPXPB> = QACXPBP;
        RTPUTC(",FM=",  DSPXFNC);  # NOS FM # 
        RTPUTC(",ID=",  DSPXIDC);  # NOS ID # 
        IF (DSPXUN NE 0)           # IF NOS UN OR FM SPECIFIED #
          OR (DSPXFN NE 0)
        THEN
          BEGIN 
          RTPUTC(",UN=",  DSPXUNC);  # NOS UN # 
          END 
  
        ELSE                       # ELSE SEND TID AS NOS UN #
          BEGIN 
          RTPUTC(",UN=",  QACBTIDC); # TID (FOR NOS) #
          END 
  
        END 
  
      ELSE
        BEGIN 
        RTPUTC(",UN=",  QACBTIDC); # TID (FOR NOS) #
        END 
  
      RTPUTO(",PRI=", QACBPRI);    # QUEUE PRIORITY # 
      RTPUTC(",TID=", QACBTIDC);   # TERMINAL ID #
      IF (FTYPE EQ "P") 
        AND QACBDAYF
      THEN
        BEGIN 
        RTPUTC(",DAY=", "0");      # DAYFILE ATTACHED # 
        END 
  
    CONTROL ENDIF;
  
      C<RTP$BYTE,1>SRTTEXT = "."; 
      RTP$BYTE = RTP$BYTE + 1;
      TXTPUTL(SRTBUF, RTP$BYTE);   # UPDATE TEXT LENGTH # 
      FILESRT = SRTBUF; 
  
        $BEGIN
        P<SRT> = SRTTXT;
        MESSAGE(SRT, 0);
        $END
  
      END  # GENSRT # 
    TERM
