*DECK GENIRT
USETEXT COMCBEG 
USETEXT COMCCAE 
USETEXT COMQDEF 
USETEXT COMQDSP 
USETEXT COMQFIL 
USETEXT COMQQAC 
USETEXT COMQRTP 
    PROC GENIRT;
      BEGIN  # GENIRT # 
# 
**    GENIRT     GENERATE IMPLICIT ROUTING TEXT.
* 
*     ENTRY      QACB = ACQUIRED FILE ENTRIES.
* 
*     EXIT       FILEIRT = FWA OF TEXT BUFFER OR ZERO, IF NONE. 
* 
*     PROCESS    IF FILE HAS IMPLICIT TEXT: 
*                  MOVE TEXT TO BUFFER
*                ELSE 
*                  CREATE NEW IMPLICIT TEXT.
# 
  
# 
****  XREF
# 
      XREF
        BEGIN 
        PROC MESSAGE;              # ISSUE DAYFILE MESSAGE #
        PROC NAME;                 # DEBUG CODE # 
        PROC RTPUTC;               # PUT CHARACTERS # 
        PROC RTPUTO;               # PUT OCTAL NUMBER # 
        PROC TXTPUT;               # STORE ROUTING TEXT # 
        PROC TXTPUTI;              # INITIALIZE TEXT BUFFER # 
        PROC TXTPUTL;              # STORE LENGTH IN TEXT BUFFER #
        END 
  
# 
****  XREF END
# 
  
      BASED ARRAY IRT S(24);
        BEGIN 
        ITEM IRTTEXT    C(00,00,240); 
        ITEM IRTRMH     C(00,00,03);  # HOST TYPE # 
        ITEM IRTPID     C(00,18,07);  # HOST PID #
        ITEM IRTVRB     C(01,00,07);  # *ROUTE,,* # 
        END 
  
      ITEM IRTBUF     U;           # POINTER TO BUFFER #
      ITEM IRTLENGTH  U;           # LENGTH OF TEXT # 
      ITEM IRTTXT     U;           # POINTER TO TEXT #
  
        $BEGIN
        NAME("GENIRT"); 
        $END
  
      IRTBUF = 0; 
  
    CONTROL IFEQ OS$NOS;
      IRTLENGTH = QACBILN;
      IRTTXT = LOC(QACBIRT);
    CONTROL ENDIF;
  
    CONTROL IFEQ OS$NOSBE;
      IRTLENGTH = 0;
      IF QACRTR                    # IF ROUTING TEXT PRESENT #
      THEN
        BEGIN 
        P<DSPXPB> = QACXPBP;
        IRTLENGTH = DSPXILC;
        IRTTXT = LOC(DSPXIRTFWA); 
        END 
  
    CONTROL ENDIF;
  
      IF IRTLENGTH NE 0            # IF TEXT PRESENT #
      THEN
        BEGIN 
        TXTPUT(IRTBUF, IRTTXT, IRTLENGTH);
        END 
  
      ELSE
        BEGIN 
        TXTPUTI(IRTBUF, IRTTXT);   # CREATE NEW TEXT #
        P<IRT> = IRTTXT;
        P<RTP> = P<IRT>;
        RTP$BYTE = 16;             # FIRST BYTE FOR PARAMETERS #
        IRTPID = HID; 
        IRTVRB = "ROUTE,";
  
      CONTROL IFEQ OS$NOS;
        IRTRMH = NS2; 
        RTPUTC(",FM=", QACBDFMC);  # DESTINATION FAMILY # 
        RTPUTC(",UN=", QACBDUNC);  # DESTINATION UN # 
        IF (QACBID NE O"00")
          AND (QACBID NE O"77") 
        THEN
          BEGIN 
          RTPUTO(",ID=", QACBID);  # BATCH ID # 
          END 
  
        RTPUTC(",CUN=", QACBCUNC); # CREATION UN #
        RTPUTC(",CFM=", QACBCFMC); # CREATION FM #
        RTPUTC(",OUN=", QACBOUNC); # OWNER UN # 
        RTPUTC(",OFM=", QACBOFMC); # OWNER FM # 
        RTPUTC(",SCL=", FILESCL);  # SERVICE CLASS #
        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) #
      CONTROL ENDIF;
  
      CONTROL IFEQ OS$NOSBE;
        IRTRMH = NBE; 
        RTPUTO(",PRI=", QACBPRI);  # QUEUE PRIORITY # 
        RTPUTC(",TID=", QACBTIDC); # TERMINAL ID #
      CONTROL ENDIF;
  
        C<RTP$BYTE,1>IRTTEXT = "."; 
        RTP$BYTE = RTP$BYTE + 1;
        TXTPUTL(IRTBUF, RTP$BYTE); # UPDATE TEXT LENGTH # 
        END 
  
      FILEIRT = IRTBUF; 
  
        $BEGIN
        P<IRT> = IRTTXT;
        MESSAGE(IRT, 0);
        $END
  
      END  # GENIRT # 
    TERM
