*DECK INITQ                        11SEP81
USETEXT COMCBEG 
USETEXT COMCAPR 
USETEXT COMQCPM 
USETEXT COMCCAE 
USETEXT COMQDEF 
USETEXT COMQFIL 
USETEXT COMQKDS 
USETEXT COMQNET 
    PROC INITQ; 
      BEGIN # INITQ # 
# 
**    INITQ      INITIALIZE QTFI OR QTFS. 
* 
*     THIS PROCEDURE INITIALIZES LOCAL AND SYSTEM VARIABLES 
*     FOR QTFI (INITIATOR) AND QTFS (SERVICER). 
* 
*     PROC INITQ
* 
*     ENTRY      APNAME = "QTFS" OR "QTF".
*                QRCV = TRUE (QTFS) OR FALSE (QTFI).
* 
*     EXIT       (NORMAL, RETURN) 
*                  HID = HOST IDENTIFIER (LOCAL PID). 
*                  INCLFILE = INCLUDE-FILE NAME, IF SPECIFED, 
*                             ELSE BLANKS.
*                  NETWORK MESSAGE CONSTANTS INITIALIZED. 
*                (ERROR, NO RETURN) 
*                  ABORTQ(FATAL REJECT CODE, 4-8).
*                  STOP  (NON-FATAL REJECT CODE, 1-3).
* 
*     PROCESS    IF INCORRECT ORIGIN: 
*                  ABORT JOB. 
*                CALL GETHD TO GET HOST IDENTIFIER. 
*                SET VARIABLES
*                PROCESS CONTROL STATEMENT ARGUMENTS
*                SET NETWORK MESSAGE HEADER WORDS 
*                CALL TXTINI TO INITIALIZE TEXT BUFFER SPACE. 
*                CALL NETON 
*                IF NAM AND SUBSYSTEM UNAVAILABLE:  
*                  DELAY AND RETRY FOR AWHILE.
*                IF NETON REJECTED: 
*                  SEND DAYFILE MESSAGES. 
*                  IF FATAL REJECT CODE (4-8):  
*                    ABORT PROGRAM
*                  ELSE:  
*                    STOP PROGRAM.
*                INITIALIZE K/L DISPLAY.
# 
  
# 
****  XREF
# 
      XREF
        BEGIN 
        PROC ABORT; 
        PROC FTUDBG;
        PROC FTUON; 
        PROC FTUSETF; 
        FUNC GETHD      C(10);     # GET HOST ID #
        PROC MESSAGE;              # ISSUE DAYFILE MESSAGE #
        PROC MSGLOG;
        PROC NAME;                 # DEBUG CODE # 
        FUNC NFETCH;
        PROC NSTORE;
        PROC ROLLOUT;              # ROLLOUT JOB #
        PROC SETKDSP;              # SET K DISPLAY #
        PROC TXTINI;
        FUNC YCDZ       C(10);
        PROC ZBYTE;                # ADD ZERO BYTE TO END OF MESSAGE #
        ITEM SSJ1;
        END 
# 
****  XREF END
# 
  
      ITEM ARGCNT     I;           # ARGUMENT COUNT # 
      ITEM I          U;           # FOR LOOP VARIABLE #
      ITEM NSTAT      U;           # STATUS FROM NETON #
  
      DEF CST$KW$MAX #01#;         # CONTROL STATEMENT PARAMS # 
  
      STATUS CSTKW
           ERR                     # INVALID KEYWORD #
          ,IF                      # IF= #
          ; 
  
      SWITCH SW$KW:CSTKW
           SW$KW$ERR:ERR
          ,SW$KW$IF:IF
          ; 
  
      ARRAY [0:CST$KW$MAX] S(1);
        BEGIN 
        ITEM CST$KW     C(00,00,07);
        ITEM CST$KW1    C(00,00,02) = 
          ["IF" 
          ,"**" 
          ];
        ITEM CST$KW2    U(00,12,30) = [CST$KW$MAX(0), 0]; 
        ITEM CST$KW$TYP S:CSTKW(00,42,18) = 
          [S"IF"
          ,S"ERR" 
          ];
        END 
  
      BASED ARRAY KW [0:0] S(1);
        BEGIN 
        ITEM KW$ARG$VAL C(00,00,07);
        ITEM KW$ARG$WD  U(00,00,60);
        ITEM KW$ARG$COD U(00,42,18);
        END 
  
    CONTROL IFEQ OS$NOS;
      BASED ARRAY SSJ$UIDS [0:0] S(1);
        BEGIN 
        ITEM SSJ$UID    U(00,43,17);  # USER INDEX #
        END 
  
      ARRAY MSGWFNAM   S(3);
        BEGIN 
        ITEM $DWFNAM    C(00,00,22) = [" QTF, WAITING FOR NAM."]; 
        ITEM $DWFNAMZB  U(02,12,48) = [0];
        END 
  
    CONTROL ENDIF;
  
      DEF LMSGINI    #16#;
      ITEM MSGINI     C(LMSGINI) = " QTF, INITIATED.";
  
      DEF LEMSGJOE   #23#;
      ITEM EMSGJOE    C(LEMSGJOE) = " QTF, JOB ORIGIN ERROR.";
  
      DEF LEMSGNOR   #58#;
      ARRAY EMSGNOR    S(6);
        BEGIN 
        ITEM $DNOR      C(00,00,LEMSGNOR) = 
                 [" QTF, NETON REJECT, CODE XX - "];
        ITEM EMSGNORRC  C(02,30,02);
        ITEM EMSGNORTX  C(03,00,28);
        END 
  
      DEF MXREJECT   #08#;
      ARRAY [1:MXREJECT] S(3);
        BEGIN 
        ITEM NREJECT    C(00,00,28) = 
                 ["SUBSYSTEM UNAVAILABLE.", 
                  "SUBSYSTEM FULL.",
                  "APPLICATION DISABLED.",
                  "APPLICATION NAME UNKNOWN.",
                  "ILLEGAL NETON.", 
                  "INVALID ACN VALUE.", 
                  "ALREADY NETTED ON.", 
                  "(UNRECOGNIZED CODE)." ]; 
        ITEM NREJECTABT B(02,48,01) = [4(FALSE), 4(TRUE)];
        ITEM NREJECTCOD U(02,49,11) = [1, 2, 3, 4, 5, 6, 7, 0]; 
        END 
  
  
        $BEGIN
        NAME("INIT");                # DEBUG CODE # 
        $END
  
      P<RA$ZERO> = 0; 
  
    CONTROL IFEQ OS$NOS;
      P<SSJ$UIDS> = LOC(SSJ1);
      IF (SSJ$UID NE O"377777") 
        OR (RA$JOP NE 0)
      THEN
        BEGIN 
        ZBYTE(LOC(EMSGJOE),LEMSGJOE); 
        MESSAGE(EMSGJOE,3); 
        ABORT;                     # ABORT QTFI OR QTFS # 
        END 
  
      IF NAM
      THEN
        BEGIN 
        KL$TINAM = "NAM";          # *RHF* -> *NAM* # 
        MSGWFAAM = " (NAM)."; 
        END 
  
      ELSE
        BEGIN 
        MSGWFAAM = " (RHF)."; 
        END 
  
      KL$TBUF = LOC(KL$DT);        # LEFT SCREEN DISPLAY TITLE #
      KDISLSC = LOC(KL$FWA);       # LEFT SCREEN BODY # 
    CONTROL ENDIF;
  
      HID = GETHD;                 # GET HOST PID # 
      CONACRQ=NFETCH(0,$CONACRQ);  # INITIALIZE CONSTANTS # 
      CONCB  =NFETCH(0,$CONCB); 
      CONEND =NFETCH(0,$CONEND);
      CONREQ =NFETCH(0,$CONREQ);
  
    CONTROL IFEQ OS$NOSBE;
      CTRINF =NFETCH(0,$CTRINF);
    CONTROL ENDIF;
  
      FCACK  =NFETCH(0,$FCACK); 
      FCBRK  =NFETCH(0,$FCBRK); 
      FCINA  =NFETCH(0,$FCINA); 
      FCINIT =NFETCH(0,$FCINIT);
      FCNAK  =NFETCH(0,$FCNAK); 
      LSTOFF =NFETCH(0,$LSTOFF);
      LSTON  =NFETCH(0,$LSTON); 
      SHUTINS=NFETCH(0,$SHUTINS); 
      NSTORE(SUPHDR,$ABHABT,SUPMSG);  # TYPE = SUP. MESSAGE # 
      NSTORE(SUPHDR,$ABHACT,SUPCHAT);  # MSG CHAR TYPE #
      NSTORE(SUPHDR,$ABHTLC,1);      # NO. WORDS IN TEXT #
      NSTORE(MSGHDR,$ABHABT,APPQMSG); # Q-MSG BLOCK TYPE #
      NSTORE(MSGHDR,$ABHACT,ACTDEF);  # CHAR TYPE # 
      INCLFILE = " ";              # ASSUME NO INCLUDE FILE # 
      ARGCNT = RA$ACT;             # CONTROL CARD ARGUMENT COUNT #
      P<KW> = LOC(RA$ARG) - 1;     # FIRST CONTROL CARD ARGUMENT #
      ASLONGAS (ARGCNT GT 1)
      DO
        BEGIN 
        ARGCNT = ARGCNT - 1;
        P<KW> = P<KW> + 1;
        IF (KW$ARG$COD EQ O"54")   # IF *KW=* # 
          OR (KW$ARG$COD EQ 2)
        THEN
          BEGIN 
          KW$ARG$COD = 0; 
          CST$KW[CST$KW$MAX] = KW$ARG$VAL;
          I = 0;
          ASLONGAS CST$KW[I] NE KW$ARG$VAL
          DO
            BEGIN 
            I = I + 1;
            END 
  
          ARGCNT = ARGCNT - 1;
          P<KW> = P<KW> + 1;
          GOTO SW$KW[CST$KW$TYP[I]];
  
SW$KW$IF:                          # IF=INCLUDE-FILE-NAME # 
            INCLFILE = KW$ARG$VAL;
            GOTO SW$KW$END; 
  
SW$KW$ERR:  
SW$KW$END:  
          END 
  
        END 
  
      TXTINI;                      # INITIALIZE TEXT BUFFER SPACE # 
      KS$MAXPAGE[KDIS"TRANSFE"] = 
          (LACNMAX + KS$ITPERPG[KDIS"TRANSFE"] - 1) 
              / KS$ITPERPG[KDIS"TRANSFE"];
  
      FTUON(APNAME,NSUP,NSTAT,1,LACNMAX); # ATTEMPT TO NETON #
  
    CONTROL IFEQ OS$NOS;
      ASLONGAS NAM
        AND (NOT QRCV)
        AND (NSTAT EQ 1)
      DO
        BEGIN 
        MESSAGE(MSGWFNAM, 1);      # *WAITING FOR NAM* #
        ROLLOUT (O"0000 0000 0000 7700 0012");  # 10 SECOND ROLLOUT # 
        FTUON(APNAME,NSUP,NSTAT,1,LACNMAX); # ATTEMPT TO NETON #
        END 
  
    CONTROL ENDIF;
  
      IF NSTAT NE 0                # IF NETON NOT SUCCESSFUL #
      THEN
        BEGIN 
        EMSGNORRC = YCDZ(NSTAT,2);
        NREJECTCOD[MXREJECT] = NSTAT; 
        NSTAT = 1;
        ASLONGAS NREJECTCOD[NSTAT] NE NREJECTCOD[MXREJECT]
        DO
          BEGIN 
          NSTAT = NSTAT + 1;
          END 
  
        EMSGNORTX = NREJECT[NSTAT]; 
        MSGLOG(LOC(EMSGNOR),LEMSGNOR);
        IF NREJECTABT[NSTAT]
        THEN
          BEGIN 
          ABORT;                   # ABORT PROGRAM #
          END 
  
        ELSE
          BEGIN 
          STOP;                    # STOP PROGRAM # 
          END 
  
        END 
  
      FTUDBG(0,0,NSTAT,0);         # ENABLE AIP/FIP TRACE IF SO BUILT # 
      FTUSETF(1,NSTAT);            # ENSURE TRACE FILE FLUSH #
      RA$CFO = TRUE;               # ACCEPT CFO INPUT # 
      SETKDSP;                     # SET K DISPLAY #
      MSGLOG(LOC(MSGINI),LMSGINI);
  
      END      # INITQ #
    TERM
