Retro1.org codex

*DECK     NVFAIAP 
USETEXT TXOUTAA 
USETEXT TXTAPSS 
USETEXT TEXTSS
USETEXT TEXTNVF 
USETEXT TXTANVF 
USETEXT TXSMNVF 
USETEXT TXTSUSS 
PROC NVFAIAP; 
# TITLE NVFAIAP - A-A ACTION CR/IAP/R SMS (OUTCALL REQUESTS) #
      BEGIN 
 
# 
**    NVFAIAP - A-A ACTION CR/IAP/R SMS (OUTCALL REQUESTS). 
* 
*     C. BRION          82/09/18. 83/05/06.  83/07/18. 83/08/02.
*                       83/11/16. 83/12/12. 
*     P. MURRAY         84/02/28. 
* 
*     THIS PROCEDURE PROCESSES THE CR/IAP/R AND FAI/APP/N SMS FROM THE
*     OUTCALL QUEUE (OUTSMQ) AND THE COMPLETED LID/PID FUNCTION 
*     REQUESTS FROM THE LPIDFXQ.
*     THE MAIN FUNCTION OF THIS PROCEDURE IS TO VALIDATE AND
*     LIMIT CHECK THE CALLING APPLICATION'S OUTCALL REQUEST TO EITHER 
*     ANOTHER HOST'S APPLICATION OR AN APPLICATION IN THE SAME HOST.
* 
*     PROC NVFAIAP
* 
*     ENTRY:  
*       OUTSMQ - AT LEAST 1 CR/IAP/R OR FAI/APP/N SM RESIDES IN OUTSMQ. 
*       LPIDFXQ - A COMPLETED LID/PID FUNCTION REQUEST RESIDES IN Q.
* 
*     EXIT: 
*       ALL ENTRIES IN THE LPIDFXQ ARE PROCESSED. 
*       ALL ENTRIES IN THE OUTSMQ ARE PROCESSED.
*       A CR/IAP/N OR CR/IAP/A SM IS SENT TO NIP. 
* 
*     NOTES:  
*       THE CR/IAP/R SM MAY BE REPEATED FOR THE SAME OUTCALL REQUEST. 
*       A REPEAT WILL INDICATE THAT A PREVIOUSLY ATTEMPTED OUTCALL VIA
*       A CR/IAP/N SM WAS NOT SUCCESSFUL. 
* 
*       THERE MAY OR MAY NOT BE OUTCALL BLOCKS DEFINED. IF NO OUTCALL 
*       BLOCKS ARE DEFINED IN THE LCF OR IN THE CR/IAP/R SM, THEN A 
*       SINGLE HOST TREATMENT OF THE OUTCALL REQUEST IS PERFORMED ONLY
*       IF THE INCOMING CR/IAP/R SM CONTAINS A ZERO VALUE REMOTE HOST ID
*       FIELD.
* 
*       IF A FAI/APP/N SM IS FOUND IN THE OUTCALL QUEUE, *NVFAFAI* WILL 
*       BE CALLED TO DELETE THE APPROPRIATE PAAC ENTRIES. 
* 
*     METHOD: 
* 
*       NVFAIAP IS STRUCTURED SUCH THAT THERE IS A FINITE SET OF ACTIONS
*       THAT MAY BE PERFORMED. THESE ACTIONS ARE FUNCTIONALLY GROUPED.
*       THE EXEC FUNCTION SIMPLY PERFORMS A SWITCH TO THE NEXT DESIRED
*       ACTION FUNCTION.
*       EACH ACTION FUNCTION THEN SETS THE APPROPRIATE NEXT ACTION TO BE
*       SWITCHED TO BY THE EXEC FUNCTION. 
* 
*       THE FOLLOWING ACTION GROUPS ARE DEFINED:  
* 
*         EXEC     EXECUTIVE SWITCHER FUNCTION. 
*         ACLPID   ACTION LID/PID FUNCTION REQUESTS.
*         GETSM    GET CR/IAP/R OR FAI/APP/N SM.
*         INITIAP  PROCESS INITIAL CR/IAP/R SM. 
*         CHLPID   CHECK LID/PID REQUIREMENTS.
*         SECIAP   PROCESS SECONDARY CR/IAP/R SM. 
*         CHCLGAP  LIMIT CHECK CALLING APPLICATION. 
*         SETNAM2  SET NAME 2 FOR OUTCALL SEARCH. 
*         FINDPATH FIND PATH IN LLPID TABLE.
*         FINDOUT  FIND OUTCALL BLOCK.
*         CHSHOST  CHECK SINGLE HOST REQUIREMENTS.
*         SENDIAPN  SET UP CR/IAP/N SM AND SEND.
*         MOVEDTE  MOVE DTE INFORMATION INTO CR/IAP/N SM. 
*         MOVEFAC  MOVE FACILITY INFORMATION INTO CR/IAP/N SM.
*         MOVECUD  MOVE CALL USER DATA INTO CR/IAP/N SM.
*         SENDSWH  SET UP AND SEND CR/SWH/R SM. 
*         ERRCHEK  PERFORM ERROR PROCESSING.
*         END      END OF TASKS, EXIT.
* 
*       ALL ACTION FUNCTION GROUPS MUST SET THE NEXT ACTION (NXTACT)
*       PRIOR TO RETURN TO THE EXEC FUNCTION. 
* 
*       VARIOUS ACTION FUNCTION GROUPS WILL SET THE RETURN ERROR ACTION 
*       (ERRACT) SO AS TO CAUSE THE ERRCHEK FUNCTION TO SET THE NEXT
*       ACTION TO A REQUESTED RETURN ACTION GROUP.
* 
# 
 
# 
****  PROC NVFAIAP XREF LIST
# 
 
      XREF
        BEGIN 
        PROC SSTRQE;                     # SS-REMOVE QUEUE ENTRY #
        PROC MESSAGE; 
        PROC ABORT; 
        PROC NVFAIAM;                    # ISSUE ACCOUNT MSG #
        PROC NVFAFAI;                    # PROCESS FAI/APP/N SM # 
        PROC SSTAQE;                     # SS-ACCEPT QUEUE ENTRY #
        PROC SSBEBF;                     # SS-EXTRACT BIT FIELD # 
        PROC SSBSBF;                     # SS-STORE BIT FIELD # 
        PROC SSTATS;                     # SS-ALLOCATE TABLE SPACE #
        PROC SSTRTS;                     # SS-RELEASE TABLE SPACE # 
        FUNC SSDCDA;                     # SS-DISPLAY TO ASCII #
        PROC NVFCFCE;                    # FIND CONNECTION ENTRY #
        PROC NVFSCAD;                    # COMPLETE APPL DEPARTURE #
        PROC NVFUMQE;                    # MAKE QUEUE ENTRY # 
        PROC NVFUFVO;                    # RELEASE VCB ORDINAL #
        PROC NVFUAFV;                    # ASSIGN VCB ORDINAL # 
        PROC NVFACTC;                    # CLEANUP TERM CONNECTION #
        END 
 
# 
****
# 
 
# 
*     PROC NVFAIAP DEFINITIONS. 
# 
 
 
#     REASON CODE VALUES FOR CR/IAP/A SMS. #
 
      DEF OK$           # 99 #;           # NULL REASON CODE #
      DEF SEESM$        #127#;            # REASON CODE IN PAAC # 
      DEF PRIDWORD$     # 6 #;            # WORD ORDINAL OF PRID #
      DEF SHUDL$        # 24 #;           # SINGLE HOST USER DATA LEN # 
      DEF PRIDBORD$     # 0 #;            # BIT ORDINAL OF PRID # 
      DEF APWORD$       # 7 #;            # WORD ORDINAL OF AP NAME # 
      DEF APBORD$       # 12 #;           # BIT ORDINAL OF AP NAME #
      DEF BLK$LMT       # 7  #;           # ABL AND DBL LIMIT          #
      DEF UBLK$LMT      # 31 #;           # UBL LIMIT                  #
 
# 
**    ACTSTAT - ACTION STATUS LIST. 
* 
*     THIS SWITCH IS USED TO SELECT THE APPROPRIATE ACTION TO PERFORM.
# 
      STATUS ACTSTAT
        SEXEC,          # EXEC FUNCTION                                #
        SACLPID,        # ACTION LID/PID FUNCTION REQUEST              #
        SGETSM,         # GET CR/IAP/R SM FROM OUTSMQ                  #
        SINITIAP,       # PROCESS INITIAL CR/IAP/R SM                  #
        SCHLPID,        # CHECK LID/PID REQUIREMENTS                   #
        SSECIAP,        # PROCESS SECONDARY CR/IAP/R SM                #
        SCHCLGAP,       # CHECK CALLING APPLICATION                    #
        SSETNAM2,       # SET UP NAME2                                 #
        SFINDPATH,      # FIND PATH IN LLPID TABLE                     #
        SFINDOUT,       # FIND OUTCALL BLOCK                           #
        SCHSHOST,       # CHECK FOR SINGLE HOST QUALIFICATION          #
        SSENDIAPN,      # SET UP AND SEND CR/IAP/N SM                  #
        SMOVEDTE,       # MOVE DTE ADDRESSES INTO CR/IAP/N SM          #
        SMOVEFAC,       # MOVE FACILITY CODES INTO CR/IAP/R SM         #
        SMOVECUD,       # MOVE CALL USER DATA INTO CR/IAP/N SM         #
        SSENDSWH,       # SET UP AND SEND CR/SWH/R SM                  #
        SERRCHEK,       # PERFORM ERROR PROCESSING                     #
        SEXIT;          # EXIT NVFAIAP                                 #
 
# 
**      ACTSWT - ACTION SWITCH. 
* 
*     THIS SWITCH SELECTS WHICH FUNCTION GROUP IS TO BE CALLED IN 
*     ORDER TO PERFORM THE NEXT ACTION. 
# 
      SWITCH ACTSWT:ACTSTAT 
        EXEC:SEXEC,          # EXEC FUNCTION                           #
        ACLPID:SACLPID,      # ACTION LID/PID FUNCTION REQUEST         #
        GETSM:SGETSM,        # GET CR/IAP/R SM FROM OUTSMQ             #
        INITIAP:SINITIAP,    # PROCESS INITIAL CR/IAP/R SM             #
        CHLPID:SCHLPID,      # CHECK LID/PID REQUIREMENTS              #
        SECIAP:SSECIAP,      # PROCESS SECONDARY CR/IAP/R SM           #
        CHCLGAP:SCHCLGAP,    # CHECK CALLING APPLICATION               #
        SETNAM2:SSETNAM2,    # SET UP NAME2                            #
        FINDPATH:SFINDPATH,  # FIND PATH IN LLPID TABLE                #
        FINDOUT:SFINDOUT,    # FIND OUTCALL BLOCK                      #
        CHSHOST:SCHSHOST,    # CHECK FOR SINGLE HOST QUALIFICATION     #
        SENDIAPN:SSENDIAPN,  # SET UP AND SEND CR/IAP/N SM             #
        MOVEDTE:SMOVEDTE,    # MOVE DTE ADDRESSES INTO CR/IAP/N SM     #
        MOVEFAC:SMOVEFAC,    # MOVE FACILITY CODES INTO CR/IAP/R SM    #
        MOVECUD:SMOVECUD,    # MOVE CALL USER DATA INTO CR/IAP/N SM    #
        SENDSWH:SSENDSWH,    # SET UP AND SEND CR/SWH/R SM             #
        ERRCHEK:SERRCHEK,    # PERFORM ERROR PROCESSING                #
        EXIT:SEXIT;          # EXIT NVFAIAP                            #
 
# 
*     PROC NVFAIAP ITEM LIST
# 
      ITEM OLDACT       S:ACTSTAT;       # OLD ACTION # 
      ITEM CURACT       S:ACTSTAT;       # CURRENT ACTION # 
      ITEM NXTACT       S:ACTSTAT;       # NEXT ACTION #
      ITEM ERRACT       S:ACTSTAT;       # ERROR RETURN ACTION #
      ITEM RETACT       S:ACTSTAT;       # RETURN CALLER ACTION # 
      ITEM CONTACT      S:ACTSTAT;       # CONTROLLING ACTION   # 
      ITEM FOUND        B;               # LOCAL ENTRY FOUND FLAG # 
      ITEM APO          I;               # APOUTCL INDEX VARIABLE # 
      ITEM AX           I;               # ACPID INDEX VARIABLE # 
      ITEM I,J,K,L      I;               # LOOP VARIABLES # 
      ITEM LPORD        I;               # ACPID ENTRY ORDINAL #
      ITEM LPVCB        I;               # A-A CONNECTION VCB # 
      ITEM WORKB        B;               # TMP BOOLEAN #
      ITEM XJ,XZ,AZ     I;               # LOOP VARIABLES # 
      ITEM APODEF       B;               # APOUTCL ENTRY EXISTS FLAG #
      ITEM APOENTSZ     I;               # SIZE OF APOUTCL ENTRY #
      ITEM PATHFOUND    B;               # LLPID PATH FOUND FLAG #
      ITEM PIDSLEFT     B;               # PID REMAINING FLAG # 
      ITEM NOOUTBLK     B;               # NO OUTCALL MATCH FLAG #
      ITEM VCB          I;               # LOCAL VCB ORDINAL #
      ITEM ERRFLG       B;               # ERROR FLAG # 
      ITEM ERRCODE      I;               # LOCAL IAP ABNORMAL ERROR # 
      ITEM ERRCODE2     I;               # SECONDARY ERROR CODE # 
      ITEM PAC          I;               # LOCAL PAAC ORDINAL # 
      ITEM NACN         I;               # ACN OF CR/IAP/R SM # 
      ITEM NUMENT       I;               # NUMBER OF PAAC ENTRIES # 
      ITEM PACDEF       B;               # PAAC ENTRY EXISTS FLAG # 
      ITEM ASTNUM       I;               # NUMBER AST ENTRIES # 
      ITEM AORD         I;               # CALLING APPL AST ORDINAL # 
      ITEM PORD         I;               # PRIMARY APPL AST ORDINAL # 
      ITEM ZCHAR        I;               # LOCAL CHARACTER TEMP CELL #
      ITEM STORD,STBIT  I;               # LOCAL STORE VARIABLES #
      ITEM EXORD,EXBIT  I;               # LOCAL EXTRACT VARIABLES #
      ITEM AORD2        I;               # CALLED APPL AST ORDINAL #
      ITEM DTEBITS      I;               # DTE NUMBER OF BITS # 
      ITEM FACLORD      I;               # FACILITY LENGTH LOCATION # 
      ITEM FACLBIT      I;               # FACILITY LENGTH BIT LOC #
      ITEM FACBITS      I;               # FACILITY PAIRS BIT LENGTH #
      ITEM NUMBITS      I;               # SM BIT LENGTH #
      ITEM UDATBITS     I;               # USER DATA BIT LENGTH # 
      ITEM LENIAPN      I;               # IAP/N SM LENGTH #
      ITEM VCBDEF       B;               # VCB ASSIGNED FLAG #
      ITEM TEMP         I;               # LOCAL TRANSLATION CELL # 
      ITEM MTYP         I;               # ACCOUNT MSG TYPE # 
      ITEM CUDL         I;               # LOCAL CALL USER DATA LEN # 
      ITEM ACNN         I;               # TEMPORARY CONNECTION NUMBER #
      ITEM AE           I;               # INDEX TO ACN TABLE # 
      ITEM NEWACN       B;               # TRUE IF ACN DOES NOT EXIST # 
 
# 
*     OUTCALL - OUTCALL BLOCK FIXED (BASE) PORTION. 
* 
*     DEFINITION OF THE FIXED PORTION OF EACH OUTCALL BLOCK CONTAINED IN
*     THE OUTCALL RECORD. 
# 
 
      BASED ARRAY OUTCALL [00:00] S(7); 
        BEGIN 
        ITEM OUT$WRD2   U(02,00,60);     # WORD 2 REF # 
        ITEM OUT$WRD3   U(03,00,60);
        ITEM OUT$WRD4   U(04,00,60);
        ITEM OUT$WC     U(00,52,08);     # BLOCK WORD COUNT # 
        ITEM OUT$NM1    C(01,00,07);     # NAME 1 (CALLED APPL NAME) #
        ITEM OUT$NM2    C(01,42,03);     # NAME 2 (CALLED RHID ) #
        ITEM OUT$PRI    B(02,00,01);     # PRIORITY FLAG #
        ITEM OUT$DBL    U(02,04,08);     # DOWNLINE BLOCK LIMIT # 
        ITEM OUT$DBZ    U(02,12,12);     # DOWNLINW BLOCK SIZE #
        ITEM OUT$ABL    U(02,24,08);     # APPL BLOCK LIMIT # 
        ITEM OUT$UBL    U(02,36,08);     # UPLINE BLOCK LIMIT # 
        ITEM OUT$UBZ    U(02,44,08);     # UPLINE BLOCK SIZE #
        ITEM OUT$PORT   U(02,52,08);     # NPU CALL ACCESS PORT # 
        ITEM OUT$SNOD   U(03,00,08);     # SOURCE NODE OF CALL #
        ITEM OUT$DNOD   U(03,08,08);     # DEST NODE OF CALL #
        ITEM OUT$WS     U(03,16,04);     # SEND WINDOW #
        ITEM OUT$DPLS   U(03,20,08);     # SEND PACKET SIZE # 
        ITEM OUT$FACNUM U(03,28,08);     # NUMBER OF FACILITY CODES # 
        ITEM OUT$UDL    U(03,36,08);     # LENGTH OF CALL USER DATA # 
        ITEM OUT$SL     U(03,56,04);     # BLOCK SECURITY LEVEL # 
        ITEM OUT$DTEL   U(04,00,08);     # CALLED DTE ADDR LENGTH # 
        ITEM OUT$WRD6   U(06,00,60);
        END 
# 
**    ACENT - ACTIVE PID ENTRY TEMPLATE.
* 
*     TEMPLATE FOR THE PID ENTRY WORD OF THE ACPID ENTRY. 
# 
      BASED ARRAY ACENT [00:00] S(1); 
        BEGIN 
        ITEM ACE$PID       C(00,00,03);  # PID #
        ITEM ACE$SF        B(00,18,01);  # STORE/FORWARD FLAG # 
        ITEM ACE$NAMAC     B(00,59,01);  # NAM ACCESS FLAG #
        END 
 
# 
*     BPAAC - WORKING BASED ARRAY.
# 
 
      BASED ARRAY BPAAC[00:00] S(1);
        BEGIN 
        ITEM BPA$WORD   U(00,00,60);
        END 
 
# 
*     SHOSTOUT - OUTCALL BLOCK FOR SINGLE HOST. 
* 
*     THIS ARRAY DEFINES THE OUTCALL BLOCK TO BE USED WHEN THE REQUEST
*     RESULTS IN THE SAME HOST. 
# 
 
      ARRAY SHOSTOUT [00:00] S(10); 
        BEGIN 
        ITEM SH$WC      U(00,52,08);     # BLOCK WORD SIZE #
        ITEM SH$NM1     C(01,00,07);     # NAME 1 CALLED APPL NAME #
        ITEM SH$NM2     C(01,42,03);     # NAME 2 REMOTE HOST ID #
        ITEM SH$PRI     U(02,00,01) = [1]; # PRIORITY FLAG OFF #
        ITEM SH$DBL     U(02,04,08) = [INTRADBL$]; # DL BLOCK LIMIT # 
        ITEM SH$DBZ     U(02,12,12) = [INTRADBZ$]; # DL BLOCK SIZE #
        ITEM SH$ABL     U(02,24,08) = [INTRABL$]; # APPL BLOCK LIM #
        ITEM SH$UBL     U(02,36,08) = [INTRAUBL$]; # UL BLOCK LIMIT # 
        ITEM SH$UBZ     U(02,44,08) = [INTRAUBZ$]; #UL BLOCK SIZE # 
        ITEM SH$PORT    U(02,52,08) = [0]; # ACCESS NPU PORT #
        ITEM SH$UDL     U(03,36,08);       # CALL USER DATA LEN # 
        ITEM SH$WRD3    U(03,00,60) = [0];
        ITEM SH$WRD4    U(04,00,60) = [0]; # WORD 4 = 0      #
        ITEM SH$WRD5    U(05,00,60) = [0]; # WORD 5 = 0 # 
        ITEM SH$WRD6    U(06,00,60) = [0]; # WORD 6 = 0 # 
        ITEM SH$WRD7    U(07,00,60) = [0]; # WORD 7 = 0 # 
        ITEM SH$WRD8    U(08,00,60);
        ITEM SH$WRD9    U(09,00,60);
        END 
 
# 
*     OCFAC - FACILITY WORD DEFINITION IN OUTCALL BLOCK.
* 
*     WORD OVERLAY DEF FOR EXTRACTING LENGTH AND FACILITY CODE PAIRS
*     FROM THE OUTCALL BLOCK. 
# 
 
      BASED ARRAY OCFAC [00:00] S(1); 
        BEGIN 
        ITEM OCF$LEN    U(00,00,08);     # FACILITY SEMI-OCTET LENGTH # 
        ITEM OCF$WORD   U(00,00,60);
        END 
 
 
 
# 
*     OCUDATA - CALL USER DATA TEMPLATE.
* 
*     CALL USER DATA DEFINITION.
# 
 
      BASED ARRAY OCUDATA [00:00] S(1); 
        BEGIN 
        ITEM OCU$WORD   U(00,00,60);
        ITEM OCU$CUDL   U(00,24,08);     # CALL USER DATA LENGTH #
        END 
 
# 
*     PATH - TEMPLATE FOR A PATH DEFINITION IN LLPID TABLE. 
# 
 
      BASED ARRAY PATH [00:00] S(2);
        BEGIN 
        ITEM PATH$DN    U(00,00,08);     # DESTINATION NODE OF PATH    #
        ITEM PATH$SN    U(00,08,08);     # SOURCE NODE OF PATH         #
        ITEM PATH$PORT  U(00,16,08);     # NPU CALL ACCESS PORT        #
        ITEM PATH$DTEL  U(00,24,08);     # CALLED DTE ADDRESS LENGTH   #
        ITEM PATH$DTEA  U(01,00,60);     # DTE ADDR, 0 - 15 SEMI OCTETS#
        END 
 
# 
*     PID - TEMPLATE FOR PID DEFINITION IN LLPID TABLE. 
# 
 
      BASED ARRAY PID [00:00] S(1); 
        BEGIN 
        ITEM PID$PNAME  C(00,00,03);     # PID NAME                    #
        ITEM PID$PSTAT  B(00,48,01);     # PID ACCESSABLE FLAG         #
        ITEM PID$LLCNT  U(00,49,11);     # LOG LINKS DEFINED FOR PID   #
        END 
 
# 
*     FCL - FACILITY CODE LENGTH DEFINTION. 
* 
*     DEFINITION USED TO ACCUMULATE THE FACILITY CODE PAIRS LENGTH. 
# 
 
      ARRAY FCL [00:00] S(1); 
        BEGIN 
        ITEM FCL$LEN    U(00,00,08);
        ITEM FCL$WORD   U(00,00,60);
        END 
 
# 
**    LPIDCELL - LID PID CELL FOR PARAMETER HOLDING.
# 
      ARRAY LPIDCELL [00:00] S(3);
        BEGIN 
        ITEM LPC$LID    C(00,42,03);     # LID                         #
        ITEM LPC$PID     C(01,42,03);    # PID                         #
        ITEM LPC$TEMP    C(02,42,03);    # HOLDING CELL FOR LID-PID    #
        END 
 
 
      $BEGIN
# 
**    TBLMSG - MISSING TABLE MESSAGE. 
# 
      ARRAY TBLMSG [00:00] S(5);
        BEGIN 
        ITEM TBL$MSG    C(00,00,30) = 
                                    ["NVFAIAP: CANNOT FIND ENTRY IN "]; 
        ITEM TBL$NAME   C(03,00,10);
        ITEM TBL$ZERO   U(04,00,60) = [0];
        END 
 
      $END
 
      CONTROL EJECT;
 
# 
*     $$$$ MAIN PROCEDURE STARTS HERE $$$$
# 
# 
*     SET THE INITIAL ACTION CODES. 
# 
 
      OLDACT = S"SEXEC";
      CURACT = S"SEXEC";
      NXTACT = S"SACLPID";
      ERRACT = S"SEXEC";
      RETACT = S"SEXEC";
      CONTACT = S"SEXEC"; 
# 
 ........................................................................ 
# 
 
EXEC: # EXEC FUNCTION # 
 
      OLDACT = CURACT;
      CURACT = NXTACT;
      GOTO ACTSWT[NXTACT];
# 
 ...................................................................... 
# 
      CONTROL EJECT;
 
ACLPID: # ACTION COMPLETED LID/PID FUNCTION REQUESTS #
 
# 
*     THIS FUNCTION PROCESSES ALL ENTRIES IN THE LPIDFXQ. 
*     WHEN ALL ENTRIES PROCESSED, THE NEXT ACTION SET TO
*     CONTINUE WITH GETSM ACTION. 
* 
*     THE ERROR ACTION IS SET TO RETURN CONTROL TO THIS FUNCTION
*     UPON COMPLETION OF ANY ERROR PROCESSING. THIS IS DUE TO 
*     THE FACT THAT THIS FUNCTION MUST CONTINUE PROCESSING UNTIL
*     THE LPIDFXQ IS EMPTY. 
*     THE RETURN ACTION IS SET TO RETURN TO THIS FUNCTION ALSO. 
*     THE CONTROL ACTION IS SET TO S"SACLPID" OR S"SGETSM" DEPENDENT
*     ON WHETHER THE LPIDFXQ IS EMPTY.
# 
 
# 
*     INITIALIZE THE ERRCODE VALUES.
*     IF LPIDFXQ EMPTY, NO NEED TO PROCESS. RETURN. 
# 
      ERRCODE = OK$;
      ERRCODE2 = OK$; 
 
      IF LPIDFXQL EQ 0
      THEN
        BEGIN 
        NXTACT = S"SGETSM"; 
        CONTACT = S"SGETSM";
        GOTO EXACLPID;
        END 
# 
*     ENTRIES EXIST IN LPIDFXQ. 
*     SET ERROR ACTION SO AS TO RETURN TO THIS FUNCTION.
*     SET CONTROLLING ACTION TO S"SACLPID" SO AS TO CAUSE PROCESSING
*     OF ALL ENTRIES IN THE LPIDFXQ.
*     REMOVE QUEUE ENTRY AND PROCESS. 
# 
 
      RETACT = S"SACLPID";
      ERRACT = S"SACLPID";
      CONTACT = S"SACLPID"; 
# 
*     ZERO OUT THE MSGBUF AREA. 
# 
      FOR J = 0 STEP 1 UNTIL NMSGBUF$ 
      DO
        BEGIN 
        MSG$WORD[J] = 0;
        END 
 
# 
*     REMOVE COMPLETED LID/PID FUNCTION REQUEST FROM LPIDFXQ. 
# 
      P<LPIDBUF> = LOC(MSGBUF); 
      SSTRQE(P<LPIDFXQ>,WCBUF,ABHBUF,MSGBUF); 
# 
*     SET LOCAL VCB ORDINAL VALUE.
*     LOCATE OWNING PAAC ENTRY. 
# 
      VCB = LPI$VCB[0]; 
      FOR PAC = 0 STEP 1 WHILE
        (VCB NQ PA$VCB[PAC]) AND
        (PAC LS (PACLNGTH/PAACSIZ$))
      DO
        BEGIN 
        END 
 
      $BEGIN
# 
*     DEBUG - IF NO PAAC THEN SERIOUS PROBLEM.
# 
        IF PAC EQ (PACLNGTH/PAACSIZ$) 
        THEN
          BEGIN 
          $BEGIN
          TBL$NAME[0] = "PAAC"; 
          MESSAGE(TBLMSG,0);
          ABORT;
          $END
          END 
      $END
# 
*     SET PAC AND VCB DEFINED FLAGS.
*     LOCATE THE ACPID TABLE ENTRY FOR THIS PAAC ENTRY. 
# 
      VCBDEF = TRUE;
      PACDEF = TRUE;
      FOUND = FALSE;
 
      FOR I = 0 STEP ACP$ESIZ[I] WHILE
        (I LS ACPIDL) AND NOT FOUND 
      DO
        BEGIN 
        IF ACP$VCB[I] EQ VCB
        THEN
          BEGIN 
          AX = I; 
          LPORD = I;
          FOUND = TRUE; 
          END 
        END 
 
      $BEGIN
# 
*     IF NO ACPID TABLE ENTRY, DEBUG ABORT NVF. 
# 
      IF NOT FOUND
      THEN
        BEGIN 
        TBL$NAME[0] = "ACPID";
        MESSAGE(TBLMSG,0);
        ABORT;
        END 
 
      $END
# 
*     IF THE APPLICATION HAD SPECIFIED OUTCALL PARAMETERS, THEN LOCATE
*     THE APOUTCL ENTRY.
# 
      APODEF = FALSE; 
      IF PA$OUTSPEC[PAC]
      THEN
        BEGIN 
        FOR APO = 0 STEP APO$WC[APO]
          WHILE ((PA$VCB[PAC] NQ APO$VCB[APO]) AND
           (APO LS APOUTCLL)) 
        DO
          BEGIN 
          END 
 
      $BEGIN
# 
*     IF NO APOUTCL ENTRY, ABORT NVF (IN DEBUG MODE). 
# 
        IF APO EQ APOUTCLL
        THEN
          BEGIN 
          TBL$NAME[0] = "APOUTCL";
          MESSAGE(TBLMSG,0);
          ABORT;
          END 
 
      $END
 
        APODEF = TRUE;
        END 
 
      PA$ACPIDL[PAC] = ACP$ESIZ[AX];
# 
*     IF GETLIDC FUNCTION AND RETURN CODE INDICATES BAD LID 
*     SET ERRCODE AND EXIT. 
# 
      IF LPI$FC[0] EQ GLIDCFC$ AND
         ACP$RC[AX] EQ LPIDBADLP$ 
      THEN
        BEGIN 
        ERRCODE = RCIA"ILP";
        NXTACT = S"SERRCHEK"; 
        GOTO EXACLPID;
        END 
# 
*     IF GETPIDA FUNCTION AND RETURN CODE INDICATES BAD PID 
*     SET STATUS AS IF NAME2 IS ACCESSIBLE MEANING THAT THIS
*     PID IS NOT VALID TO NOS SO ATTEMPT OUTCALL AS NAME2 ONLY. 
# 
      IF LPI$FC[0] EQ GPIDAFC$
      THEN
        BEGIN 
        IF ACP$RC[AX] EQ LPIDBADLP$ 
        THEN
          BEGIN 
          ACP$RC[AX] = 0; 
          ACP$GPAST[AX] = PIDOPST$; 
 
          END 
        ELSE
          BEGIN 
# 
*     VALID PID STATUS RETURNED.
*     IF NOT ACCESSIBLE, SET ERROR CODE AND EXIT. 
# 
          IF ACP$GPAST[AX] NQ PIDOPST$
          THEN
            BEGIN 
            ERRCODE = RCIA"PNS";
            NXTACT = S"SERRCHEK"; 
            GOTO EXACLPID;
            END 
          END 
        END 
# 
*     SET THE CURRENT PID POINTER OF THE PAAC ENTRY TO THE LAST 
*     PID ENTRY OF THE ACPID TABLE ENTRY FOR THIS PAAC ENTRY. 
*     SET ENTRY BIAS WHERE PID DEFINITIONS START DEPENDENT ON 
*     EACH FUNCTION TYPE. 
# 
      IF LPI$FC[0] EQ GPIDAFC$
      THEN
        BEGIN 
        PA$CUACPID[PAC] = 1;
        PA$PIDBIAS[PAC] = GPIDABIAS$; 
        END 
      ELSE
        BEGIN 
        PA$CUACPID[PAC] = ACP$GLCNP[AX];
        PA$PIDBIAS[PAC] = GLIDCBIAS$; 
        END 
# 
*     PROCEED TO CHECK CALLING APPLICATION FUNCTION.
# 
      NXTACT = S"SCHCLGAP"; 
 
EXACLPID: # EXIT SUBFUNCTION OF FUNCTION ACLPID # 
 
# 
*     THE NEXT ACTION, RETURN ACTION AND ERRCODES ARE SET.
*     SIMPLY RETURN TO THE EXECUTIVE. 
# 
      GOTO EXEC;
# 
 .............................................................. 
# 
      CONTROL EJECT;
 
GETSM: # GETSM FUNCTION # 
 
# 
*     ALL ENTRIES RESIDENT IN THE OUTSMQ ARE PROCESSED. 
*     THE ERROR RETURN ACTION MUST BE SET TO RETURN TO GETSM
*     SO THAT AFTER A CR/IAP/R SM HAS BEEN ABNORMALLY RESPONDED 
*     TO, CONTROL IS RETURNED TO GETSM TO PROCESS NEXT CR/IAP/R 
*     SM IN OUTSMQ. THE RETURN ACTION IS SET TO GETSM ALSO. 
*     THE CONTROLLING FUNCTION WAS SET TO S"SGETSM" BY ACLPID ACTION. 
*     SET CONTROLLING ACTION TO GETSM.
# 
      CONTACT = S"SGETSM";
# 
*     CHECK IF NO CR/IAP/R SMS AVAILABLE. 
*     IF NOT, FINISHED, EXIT NVFAIAP PROCEDURE. 
# 
 
      IF OUTSMQL EQ 0 
      THEN
        BEGIN 
        NXTACT = S"SEXIT";
        GOTO EXGETSM; 
        END 
# 
*     ENTRY RESIDENT IN OUTSMQ. 
*     INITIALIZE THE SM AREA, WORD COUNT AND ABH WORDS. 
# 
      ERRACT = S"SGETSM"; 
      FOR J = 0 STEP 1 UNTIL NMSGBUF$ 
      DO
        BEGIN 
        MSG$WORD[J]= 0; 
        END 
 
      WCB$WORD[0]= 0; 
      WCB$WORD[1]= 0; 
      ABH$WORD[0] = 0;
      ABH$WORD[1] = 0;
# 
*     GET AN INCOMING CR/IAP/R OR FAI/APP/N SM FROM THE OUTSMQ QUEUE. 
# 
      SSTRQE(P<OUTSMQ>,WCBUF,ABHBUF,MSGBUF);
# 
*     IF FAI/APP/N SM, CALL NVFAFAI TO PROCESS IT.
# 
      IF WCB$SMID[0] EQ CTQSTAT"SFAI" 
      THEN
        BEGIN 
        NVFAFAI;
        NXTACT = S"SGETSM"; 
        GOTO EXGETSM; 
        END 
# 
*     INITIALIZE LOCAL FLAGS AND ERROR CODE VALUES. 
# 
      PACDEF = FALSE; 
      VCBDEF = FALSE; 
      APODEF = FALSE; 
      ERRCODE = OK$;
      ERRCODE2 = OK$; 
      ASTNUM = ASTLNGTH / ASTSIZ$;
      AORD = ASTNUM;
# 
*     CHECK IF THE HOST IS IN IDLE OR DISABLE STATE IN WHICH
*     CASE THE CONNECTION REQUEST CAN NOT BE MADE.
*     SAVE THE ACN FOR LATER INSERTION INTO THE CR/IAP/A SM.
*     SET ERROR CODE , ERRCHEK ACTION AND EXIT. 
# 
      IF NVFSTATE 
      THEN
        BEGIN 
        NACN = CRNACN[0]; 
        ERRCODE = RCIA"IDH";
        NXTACT = S"SERRCHEK"; 
        GOTO EXGETSM; 
        END 
# 
*     CHECK IF SM IS A REPEAT SM BY CHECKING THE VALUE OF 
*     THE IAN FIELD.
*     IF NON-ZERO, THEN SM IS AN INITIAL SM.
*     SET NEXT ACTION TO INITIAL CR/IAP/R SM. 
*     OTHERWISE, MUST BE A REPEAT SM. SET NEXT ACTION TO
*     SECONDARY CR/IAP/R SM.
# 
      IF CRIAN[0] NQ 0
      THEN
        NXTACT = S"SINITIAP"; 
      ELSE
        NXTACT = S"SSECIAP";
 
EXGETSM:  
 
      GOTO EXEC;
 
# 
 .................................................................. 
# 
      CONTROL EJECT;
 
INITIAP: # PROCESS INITIAL CR/IAP/R SM #
 
 
# 
*     THIS FUNCTION PERFORMS THE FUNCTIONS FOR AN INITIAL 
*     CR/IAP/R SM.
* 
*     GET A VCB ORDINAL ASSIGNED. 
*     IF NO VCBS AVAILABLE, SET ERRCODE AND NEXT ACTION TO
*     TO ERRCHEK AND EXIT.
*     OTHERWISE, GET A PAAC ENTRY ASSIGNED. 
# 
 
      NVFUAFV(VCB,ERRFLG);
      IF ERRFLG 
      THEN
        BEGIN 
        ERRCODE = RCIA"NVO";
        NXTACT = S"SERRCHEK"; 
        GOTO EXINITIAP; 
        END 
 
# 
*     VCB ASSIGNED, GET PAAC ENTRY. 
# 
 
      PAC = PACLNGTH / PAACSIZ$;
      VCBDEF = TRUE;
      SSTATS(P<PAAC>,PAACSIZ$); 
      PACDEF = TRUE;
 
# 
*     CLEAR PAAC ENTRY
# 
      P<BPAAC> = LOC(PAAC[PAC]);
      FOR J = 0 STEP 1 UNTIL (PAACSIZ$ - 1) 
      DO
        BEGIN 
        BPA$WORD[J] = 0;
        END 
 
# 
*     INITIALIZE THE PAAC ENTRY FROM THE CR/IAP/R SM. 
# 
 
      PA$RAPNM[PAC] = CRRANM[0];
      PA$URHID[PAC] = CRRHID[0];
      PA$NACN[PAC] = CRNACN[0]; 
      PA$VCB[PAC] = VCB;
      PA$IAPAN[PAC] = CRIAN[0]; 
      PA$SMAN[PAC] = CRIAN[0];
      PA$OUTCUR[PAC] = 0; 
      PA$STATE[PAC] = PAACST"PAIAP";
      PA$OUTNXT[PAC] = 0; 
      PA$ULID[PAC] = CRULID[0]; 
      PA$UPID[PAC] = CRUPID[0]; 
      PA$PIDCUR[PAC] = 0; 
      PA$PATHNXT[PAC] = 0;
# 
*     CALCULATE NUMBER OF AST ENTRIES.
# 
      ASTNUM = ASTLNGTH / ASTSIZ$;
# 
*     LOCATE CALLING AST ENTRY. 
# 
      FOR AORD = 0 STEP 1 WHILE 
       ((AST$AN[AORD] NQ PA$IAPAN[PAC]) AND 
        (AORD LS ASTNUM)) 
      DO
        BEGIN 
        END 
# 
*     IF THIS IS A SECONDARY APPL, LOCATE THE PRIMARY APPL AST ENTRY. 
# 
      PORD = AORD;
      IF AST$PANAM[AORD] NQ AST$SANAM[AORD] 
      THEN
        BEGIN 
        FOR PORD = 0 STEP 1 WHILE 
          ((PORD LS ASTNUM) AND 
           (AST$SANAM[AORD] NQ AST$PANAM[PORD]))
        DO
          BEGIN 
          END 
        IF PORD EQ ASTNUM 
        THEN
          BEGIN 
          PORD = AORD;
          END 
        END 
     IF AST$PPF[AORD]              # IF PRIVILEGED APPLICATION         #
     THEN 
       BEGIN
       PA$OUTSPEC[PAC] = (WCB$WC[0] GR (LCRIAP + 2)); 
       END
     ELSE 
       BEGIN                       # IGNORE EXCESS WORDS FOR REGUALR   #
       PA$OUTSPEC[PAC] = FALSE;    # APPLICATION                       #
       END
# 
*     IF THE APPLICATION SUPPLIED OUTCALL PARAMETERS IN THE CR/IAP, COPY
*     THE SM WORDS INTO ANOTHER BUFFER TO SAVE THEM FOR LATER ACCESS. 
*     DO NOT COPY THE FIRST AND THIRD WORDS OF THE SM AS THEY ARE NOT 
*     NEEDED. 
# 
      IF PA$OUTSPEC[PAC]
      THEN
        BEGIN 
        APO = APOUTCLL; 
        APOENTSZ = WCB$WC[0] - 2; 
        SSTATS(P<APOUTCL>,APOENTSZ);
        APO$VCB[APO] = PA$VCB[PAC]; 
        APO$WC[APO] = APOENTSZ; 
        P<BPAAC> = LOC(APOUTCL[APO]); 
        BPA$WORD[1] = MSG$WORD[1];
        K = 3;
        FOR J = 2 STEP 1 UNTIL (APOENTSZ - 1) 
        DO
          BEGIN 
          BPA$WORD[J] = MSG$WORD[K];
          K = K + 1;
          END 
        APODEF = TRUE;
        END 
# 
*     NORMAL STATUS TO HERE. SET NEXT ACTION TO CHECK LID/PID 
*     REQUIREMENTS OF THE CALL. 
# 
 
      NXTACT = S"SCHLPID";
 
EXINITIAP:  
 
      GOTO EXEC;
# 
 ................................................................ 
# 
      CONTROL EJECT;
 
CHLPID: # CHECK LID/PID REQUIREMENTS #
 
# 
*     THIS FUNCTION PERFORMS THE FUNCTIONS TO DETERMINE THE 
*     LID/PID REQUIREMENTS OF THE CURRENT CR/IAP/R SM.
*     IF A LID IS SPECIFIED IN THE CR/IAP/R, THEN A GETLIDC 
*     FUNCTION REQUEST IS SENT TO THE CPMRQ FOR ACTION. 
*     IF ONLY A PID IS SPECIFIED, THEN A GETPIDA FUNCTION 
*     IS SENT TO THE CPMRQ FOR ACTION.
* 
*     THIS FUNCTION WILL COMPLETE PHASE 1 PROCESSING OF THE 
*     CR/IAP/R SM ONLY IF A LID WAS SPECIFIED ALONE, A LID AND
*     A PID SPECIFIED OR A PID ALONE SPECIFIED. IN THIS CASE, 
*     THE NEXT ACTION IS SET TO GETSM.
# 
 
# 
*     INITIALIZE LOCAL VARIABLES AND PAAC 
# 
      LPORD = 0;
      LPVCB = PA$VCB[PAC];
      PA$ACPIDL[PAC] = 0; 
      PA$CUACPID[PAC] = 0;
 
# 
*     IF NO LID OR PID SPECIFIED, THE NEXT ACTION IS SET TO CHECK 
*     CALLING APPLICATION SINCE THERE IS NO NEED TO VERIFY THE LID
*     OR PID WITH NOS.
# 
 
      IF PA$ULID[PAC] EQ 0 AND PA$UPID[PAC] EQ 0
      THEN
        BEGIN 
        NXTACT = S"SCHCLGAP"; 
        GOTO EXCHLPID;
        END 
 
# 
*     A LID OR A PID SPECIFIED THEREFORE A NEED TO ISSUE
*     A LID/PID FUNCTION REQUEST. 
# 
 
# 
*     SET UP THE FUNCTION REQUEST INDEPENDENT VALUES. 
# 
      P<LPIDBUF> = LOC(MSGBUF); 
      LPI$WORD0[0] = 0; 
      LPI$WORD1[0] = 0; 
      LPI$VCB[0] = PA$VCB[PAC]; 
      LPI$QNUM[0] = LOC(P<AALPID>); 
# 
*     IF LID SPECIFIED, ISSUE GETLIDC FUNCTION. 
# 
      IF PA$ULID[PAC] NQ 0
      THEN
        BEGIN 
        LPI$FC[0] = GLIDCFC$; 
        LPI$LID[0] = PA$LID[PAC]; 
        LPI$SIZE[0] = GLIDBUFS$;
        END 
      ELSE
# 
*     LID NOT SPECIFIED, MUST BE PID. 
*     SET UP GETPIDA FUNCTION REQUEST.
# 
        BEGIN 
        LPI$FC[0] = GPIDAFC$; 
        LPI$PID[0] = PA$PID[PAC]; 
        LPI$SIZE[0] = GPIDBUFS$;
        END 
# 
*     ISSUE REQUEST TO CPMRQ. 
# 
      NVFUMQE(P<CPMRQ>,LPIDBUF[0],APPTTX$,0,LPIDLEN$);
# 
*     PHASE 1 PROCESSING DONE. MUST WAIT FOR COMPLETED LID/PID
*     FUNCTION TO RETURN THROUGH THE LPIDFXQ TO THE ACLPID
*     FUNCTION. SET NEXT ACTION TO PROCEED ONTO NEXT CR/IAP/R SM. 
# 
      NXTACT = S"SGETSM"; 
 
EXCHLPID: 
      GOTO EXEC;
# 
 ................................................................ 
# 
      CONTROL EJECT;
 
SECIAP: # PROCESS SECONDARY CR/IAP/R SM # 
 
# 
*     THIS FUNCTION PERFORMS THE PROCESSING OF THE SECONDARY
*     CR/IAP/R SMS. IN THE EVENT THAT A CR/IAP/N SM ISSUED
*     BY NVF DID NOT SUCCEED, A REPEATED ATTEMPT (I.E. A SEC- 
*     ONDARY SM) IS ISSUED BY NIP TO NVF. 
*     A SECONDARY SM ALREADY HAS A PAAC ENTRY AND VCB ASSIGNED. 
*     IF LID/PID REQUIRED BY THE INITIAL SM THEN THE INFORMA- 
*     TION IS STILL INTACT FOR THE REPEATED SM. 
# 
 
# 
*     SET ERROR CODE IN ORDER TO USE THE ERROR CODE OF THE RE-
*     PEATED SM IN ALL ABNORMAL CR/IAP/R SM THAT MAY BE SENT. 
*     (ONLY IF CALLING APPLICATION FAILS DOES THE ERROR CODE GET
*     OVERRIDDEN).
# 
      ERRCODE2 = SEESM$;
# 
*     CALCULATE NUMBER OF PAAC ENTRIES. 
# 
      NUMENT = (PACLNGTH/PAACSIZ$); 
# 
*     LOCATE PAAC ENTRY FOR THIS REPEATED SM. 
# 
      FOR PAC = 0 STEP 1 WHILE
        ((PA$NACN[PAC] NQ CRNACN[0]) AND
         (PAC LS NUMENT)) 
      DO
        BEGIN 
        END 
# 
*     IF NO PAAC ENTRY, THERE SHOULD BE.
*     SET THE NEXT ACTION TO ERRCHEK WITH ERROR ACTION
*     SET TO THE CONTROLLINH FUNCTION.
# 
      IF PAC EQ NUMENT
      THEN
        BEGIN 
        PACDEF = FALSE; 
        NXTACT = S"SERRCHEK"; 
        ERRACT = CONTACT; 
        GOTO EXSECIAP;
        END 
# 
*     PAAC ENTRY EXISTS. SET STATE TO SECONDARY IAP AND SAVE REASON 
*     CODE FOR REPEATED SM .
# 
      PACDEF = TRUE;
      VCBDEF = TRUE;
      PA$IAPRC[PAC] = CRRIAP[0];
# 
*     IF THE APPLICATION HAD SPECIFIED OUTCALL PARAMETERS, THEN LOCATE
*     THE APOUTCL ENTRY.
# 
      IF PA$OUTSPEC[PAC]
      THEN
        BEGIN 
        FOR APO = 0 STEP APO$WC[APO]
          WHILE ((PA$VCB[PAC] NQ APO$VCB[APO]) AND
                 (APO LS APOUTCLL)) 
        DO
          BEGIN 
          END 
 
      $BEGIN
# 
*     IF NO APOUTCL ENTRY, ABORT NVF (IN DEBUG MODE). 
# 
        IF APO EQ APOUTCLL
        THEN
          BEGIN 
          TBL$NAME[0] = "APOUTCL";
          MESSAGE(TBLMSG,0);
          ABORT;
          END 
 
       $END 
 
        APODEF = TRUE;
        END 
# 
*     SINCE REPEAT SM, DECREMENT NUMBER A-A CONNECTIONS FOR APPL. 
*     LOCATE THE CALLING APPL AST ENTRY.
# 
      PA$SMAN[PAC] = CRIAN[0];
      FOR AORD = 0 STEP 1 WHILE 
        ((AORD LS ASTNUM) AND 
         (PA$IAPNM[PAC] NQ AST$PANAM[AORD]))
      DO
        BEGIN 
        END 
# 
*     CHECK IF THIS APPL IS A SECONDARY APPL AND THEN DETERMINE THE 
*     PRIMARY AST ORDINAL.
# 
      PORD = AORD;
      IF AST$PANAM[AORD] NQ AST$SANAM[AORD] 
      THEN
        BEGIN 
        FOR PORD = 0 STEP 1 WHILE 
          ((PORD LS ASTNUM) AND 
           (AST$SANAM[AORD] NQ AST$PANAM[PORD]))
        DO
          BEGIN 
          END 
        IF PORD EQ ASTNUM 
        THEN
          BEGIN 
          PORD = AORD;
          END 
        END 
# 
*     DECREMENT THE NUMBER OF A-A CONNECTIONS TO THE APPL.  IF THIS 
*     IS A SECONDARY APPL, THEN DECREMENT THE NUMBER OF A-A CONNECTIONS 
*     TO THE PRIMARY APPL ALSO. 
# 
      AST$AACN[AORD] = AST$AACN[AORD] - 1;
      IF AORD NQ PORD 
      THEN
        BEGIN 
        AST$AACN[PORD] = AST$AACN[PORD] - 1;
        END 
# 
*     SINCE SECONDARY CR/IAP/R SM, MUST DETERMINE IF ACPID TABLE
*     ENTRY EXISTS FOR THIS CONNECTION. SEARCH THE ACPID TABLE FOR
*     A ENTRY WITH MATCHING VCB ORDINAL.
# 
      IF PA$ACPIDL[PAC] NQ 0
      THEN
        BEGIN 
# 
*     ACPID TABLE ENTRY EXISTS FOR THIS CONNECTION. 
*     DETERMINE THE RELETIVE WORD ORDINAL OF THE ENTRY. 
# 
        VCB = PA$VCB[PAC];
        WORKB = FALSE;
        FOR XJ = 0 STEP ACP$ESIZ[XJ] WHILE
         XJ LS ACPIDL AND NOT WORKB 
        DO
          BEGIN 
          IF VCB EQ ACP$VCB[XJ] 
          THEN
            BEGIN 
            WORKB = TRUE; 
            LPORD = XJ; 
            END 
          END 
        END 
# 
*     SET NEXT ACTION TO CHECK CALLING APPLICATION S"SCHCLGAP"
# 
      NXTACT = S"SCHCLGAP"; 
 
EXSECIAP: 
 
      GOTO EXEC;
# 
 .......................................................... 
# 
      CONTROL EJECT;
 
CHCLGAP: # CHECK CALLING APPLICATION #
 
# 
*     THIS FUNCTION LIMIT CHECKS THE CALLING APPLICATION. 
*     IF A LIMIT CHECK FAILS, THE NEXT ACTION IS SET TO 
*     ERRCHEK AND THE ERROR ACTION IS SET TO RETURN TO ACTION 
*     SPECIFIED BY THE CONTROLLING ACTION (CONTACT).
* 
*     IF ALL GOES WELL, THE NEXT ACTION IS SET TO SETNAM2 IN
*     IN ORDER TO PREPARE FOR THE OUTCALL SEARCH. 
# 
 
# 
*     INITIALIZE THE ERROR ACTION TO THE CONTROLLING ACTION.
# 
      ERRACT = CONTACT; 
# 
*     CALCULATE NUMBER OF AST ENTRIES.
# 
      ASTNUM = ASTLNGTH / ASTSIZ$;
 
# 
*     LOCATE CALLING AST ENTRY. 
# 
      FOR AORD = 0 STEP 1 WHILE 
       ((AST$AN[AORD] NQ PA$IAPAN[PAC]) AND 
        (AORD LS ASTNUM)) 
      DO
        BEGIN 
        END 
 
# 
*     IF NO AST ENTRY, SET ERRCODE, NEXT ACTION TO ERRCHEK. 
# 
      IF AORD EQ ASTNUM 
      THEN
        BEGIN 
        ERRCODE = RCIA"APF";
        NXTACT = S"SERRCHEK"; 
        GOTO EXCHCLGAP; 
        END 
# 
*     IF THIS IS A SECONDARY APPL, LOCATE THE PRIMARY APPL AST ENTRY. 
# 
      PORD = AORD;
      IF AST$PANAM[AORD] NQ AST$SANAM[AORD] 
      THEN
        BEGIN 
        FOR PORD = 0 STEP 1 WHILE 
          ((PORD LS ASTNUM) AND 
           (AST$SANAM[AORD] NQ AST$PANAM[PORD]))
        DO
          BEGIN 
          END 
        IF PORD EQ ASTNUM 
        THEN
          BEGIN 
          PORD = AORD;
          END 
        END 
# 
*     CALLING APPL AST EXISTS.
*     INSURE APPL UP AND OK.
*     IF APPLICATION DOWN OR DISABLED OR NOT ACTIVE, SET THE
*     NEXT ACTION TO ERRCHEK AND EXIT.
# 
      IF AST$DNF[AORD] OR 
         AST$DIF[AORD] OR 
         AST$JSN[AORD] EQ " " 
      THEN
        BEGIN 
        ERRCODE = RCIA"APF";
        NXTACT = S"SERRCHEK"; 
        GOTO EXCHCLGAP; 
        END 
# 
*     CALLING APPL OK SO FAR, START LIMIT CHECKS. 
*     CHECK NUMBER OF CONNECTIONS.
*     IF CHECK FAILS, SET ERROR CODE, NEXT ACTION TO ERROR
*     ACTION AND EXIT.
# 
      IF AST$MCN[AORD] LQ (AST$TACN[AORD] + AST$AACN[AORD]
                                          + AST$RACN[AORD]) 
      THEN
        BEGIN 
        ERRCODE = RCIA"CAM";
        NXTACT = S"SERRCHEK"; 
        GOTO EXCHCLGAP; 
        END 
# 
*     LIMIT CHECK NUMBER OF RETRY ATTEMPTS FOR CALLING APPLICATION
*     IF CHECK FAILS, SET ERROR CODE, NEXT ACTION TO ERROR ACTION 
*     AND EXIT. 
# 
      IF AST$RETRY[AORD] EQ AL
      THEN
        BEGIN 
        ERRCODE = RCIA"RLR";
        NXTACT = S"SERRCHEK"; 
        GOTO EXCHCLGAP; 
        END 
# 
*     CALLING APPLICATION OK. SET THE PAAC ENTRY. 
*     SET CALLING APPL NAME, NUMBER AND SWITCHED APPL NAME
*     AND NUMBER. SET NEXT ACTION TO SETNAM2 AND EXIT.
# 
 
      PA$IAPNM[PAC] = AST$ANAM[AORD]; 
      PA$IAPAN[PAC] = AST$AN[AORD]; 
      PA$SWAP[PAC] = AST$ANAM[AORD];
      PA$SWAPAN[PAC] = AST$AN[AORD];
      NXTACT = S"SSETNAM2"; 
 
EXCHCLGAP:  
 
      GOTO EXEC;
 
# 
 ................................................................ 
# 
      CONTROL EJECT;
 
SETNAM2: # SET UP NAME 2 FOR OUTCALL SEARCH # 
 
# 
*     THIS FUNCTION PERFORMS THE ACTIONS NEEDED TO SET UP THE NAME 2
*     PARAMETER USED IN THE OUTCALL SEARCH. 
# 
 
# 
*     SET UP THE NAME2 (PID) VARIABLE SO THAT A VALID PID OR THE
*     RECEIVED NAME2 PARAMETER IS SET IN THE PAAC ENTRY.
# 
      LPC$TEMP[0] = PA$RHID[PAC]; 
      WORKB = FALSE;
      IF (PA$UPID[PAC] NQ 0) OR 
         ((PA$UPID[PAC] EQ 0) AND (PA$ULID[PAC] NQ 0))
      THEN
        BEGIN 
# 
*     AN ACPID TABLE ENTRY MUST EXIST.
*     SET UP TO EXTRACT THE NEXT PID FROM THE ENTRY.
# 
        FOR XZ = 0 WHILE
          (NOT WORKB AND PA$CUACPID[PAC] NQ 0)
        DO
          BEGIN 
          P<ACENT> = (P<ACPID> + PA$PIDBIAS[PAC] +
                       LPORD + PA$CUACPID[PAC]);
          IF PA$UPID[PAC] NQ 0
          THEN
            BEGIN 
# 
*     PID SPECIFIED.
*     PID IN CR/IAP/R SM MUST MATCH A PID OF THE ENTRY AND THE
*     PID MUST BE NAM ACCESSIBLE. 
# 
            IF ((ACE$PID[0] EQ PA$PID[PAC]) AND 
                ACE$NAMAC[0]) 
            THEN
              WORKB = TRUE; 
            END 
          ELSE
            BEGIN 
# 
*     PID NOT SPECIFIED.
*     CHECK IF NEXT PID IN ACPID ENTRY IS NAM ACCESSIBLE AND DOES NOT 
*     HAVE A LID STORE AND FORWARD ATTRIBUTE. 
# 
            IF (ACE$NAMAC[0] AND
               (NOT ACE$SF[0])) 
            THEN
              WORKB = TRUE; 
            END 
          IF NOT WORKB
          THEN
            PA$CUACPID[PAC] = PA$CUACPID[PAC] - 1;
          END 
        END 
# 
*     RESTORE THE REMOTE HOST ID FROM WORK. EITHER BE A 
*     NEW PID FROM THE ACPID ENTRY OR THE PREVIOUS RHID VALUE 
*     OF THE CR/IAP/R SM. 
# 
      IF WORKB
      THEN
        LPC$TEMP[0] = ACE$PID[0]; 
 
      PA$RHID[PAC] = LPC$TEMP[0]; 
# 
*     IF OUTCALL PARAMETERS WERE SPECIFIED IN THE CR/IAP/R SM, THERE IS 
*     NO NEED TO PERFORM AN OUTCALL BLOCK SEARCH.  SET THE NEXT ACTION
*     TO FIND A PATH.  OTHERWISE, SET THE NEXT ACTION TO FIND OUTCALL 
*     BLOCK.
# 
      IF PA$OUTSPEC[PAC]
      THEN
        BEGIN 
        NXTACT = S"SFINDPATH";
        END 
      ELSE
        BEGIN 
        NXTACT = S"SFINDOUT"; 
        END 
 
EXSETNAM2:  
 
        GOTO EXEC;
# 
 .................................................................
# 
      CONTROL EJECT;
 
FINDPATH: # FIND APPROPRIATE PATH IN LLPID TABLE #
 
# 
*     THIS FUNCTION LOCATES AN APPROPRIATE PATH IN THE LLPID TABLE.  IT 
*     STORES THE PATH INFORMATION IN THE OUTCALL BLOCK THAT WAS SUPPLIED
*     BY THE CALLING APPLICATION IN THE CR/IAP/R. 
# 
 
      PIDSLEFT = (PA$CUACPID[PAC] GR 0);
      PATHFOUND = FALSE;
 
# 
*     LOOP THRU THE ACPID AND LLPID TABLES UNTIL EITHER A PATH IS FOUND,
*     OR ALL THE PIDS IN THE ACPID TABLE HAVE BEEN EXHAUSTED. 
# 
 
      FOR XZ = 0 WHILE
        (NOT PATHFOUND) AND PIDSLEFT
      DO
        BEGIN 
# 
*       LOOP THRU THE LLPID TABLE TO FIND A PID THAT MATCHES THE CURRENT
*       PID.
# 
        FOR XZ = 0 WHILE
          ((NOT PATHFOUND) AND
          (PA$PIDCUR[PAC] LS LLPIDL)) 
        DO
          BEGIN 
# 
*         LOCATE THE CURRENT LLPID ENTRY.  IF THIS PID MATCHES THE
*         CURRENT PID, THEN CHECK FOR AN AVAILABLE PATH.
# 
          P<PID> = P<LLPID> + PA$PIDCUR[PAC]; 
          IF PID$PNAME[0] EQ PA$RHID[PAC] 
          THEN
            BEGIN 
# 
*           IF THE PID IS ACCESSABLE AND IF THE NEXT PATH EXISTS FOR
*           THIS PID, COPY THE PATH INFORMATION FROM THE LLPID ENTRY
*           INTO THE OUTCALL PORTION OF THE CR/IAP/R SM.
# 
 
            IF PA$PATHNXT[PAC] LS PID$LLCNT[0]
            THEN
              BEGIN 
              PATHFOUND = TRUE; 
              P<PATH> = P<PID> + ((PA$PATHNXT[PAC] * PIDLLSIZ$) + 1); 
              PA$PATHNXT[PAC] = PA$PATHNXT[PAC] + 1;
              P<OUTCALL> = P<APOUTCL> + APO;
              OUT$SNOD[0] = PATH$SN[0]; 
              OUT$DNOD[0] = PATH$DN[0]; 
              OUT$PORT[0] = PATH$PORT[0]; 
              OUT$DTEL[0] = PATH$DTEL[0]; 
# 
*             MOVE THE DTE ADDRESS INTO THE OUTCALL BLOCK.
# 
              DTEBITS = OUT$DTEL[0] * 4;
              EXORD = 1;
              EXBIT = 0;
              STORD = 4;
              STBIT = 8;
              TEMP = 0; 
              SSBEBF(PATH[0],EXORD,EXBIT,DTEBITS,TEMP); 
              SSBSBF(OUTCALL[0],STORD,STBIT,DTEBITS,TEMP);
              IF (OUT$ABL[0] LQ 0 OR OUT$ABL[0] GR BLK$LMT) 
                OR (OUT$DBL[0] LQ 0 OR OUT$DBL[0] GR BLK$LMT) 
                OR (OUT$UBL[0] LQ 0 OR OUT$UBL[0] GR UBLK$LMT)
              THEN
                BEGIN 
                ERRCODE = RCIA"NPL";  # BAD NETWORK BLOCK VALUES       #
                NXTACT = S"SERRCHEK"; 
                ERRACT = CONTACT; 
                GOTO EXFINDPATH;
                END 
              END 
            ELSE
# 
*           A MATCHING PID EXISTS BUT IS EITHER INACCESSABLE, OR HAS NO 
*           MORE PATHS LEFT TO TRY.  FORCE AN EXIT FROM THIS LOOP.
# 
              BEGIN 
              PA$PIDCUR[PAC] = LLPIDL;
              END 
            END 
 
          ELSE
# 
*         THE LLPID PID DOES NOT MATCH THE CURRENT PID.  MOVE TO THE
*         NEXT LLPID ENTRY AND TRY AGAIN. 
# 
            BEGIN 
            PA$PIDCUR[PAC] = PA$PIDCUR[PAC] + 
                              ((PID$LLCNT[0] * PIDLLSIZ$) + 1); 
            END 
          END 
# 
*       IF A PATH WAS NOT FOUND FOR THE CURRENT PID, GET THE NEXT 
*       AVAILABLE PID IN THE ACPID TABLE. 
# 
        IF NOT PATHFOUND
        THEN
          BEGIN 
          FOUND = FALSE;
          FOR AZ = 0 WHILE
            PIDSLEFT AND (NOT FOUND)
          DO
            BEGIN 
            PA$CUACPID[PAC] = PA$CUACPID[PAC] - 1;
            IF PA$CUACPID[PAC] GR 0 
            THEN
              BEGIN 
              P<ACENT> = P<ACPID> + PA$PIDBIAS[PAC] + 
                           LPORD + PA$CUACPID[PAC]; 
# 
*             IF A PID WAS SPECIFIED IN THE CR/IAP/R SM, THEN THE PID 
*             IN THE ACPID ENTRY MUST MATCH THE SM PID AND MUST BE NAM
*             ACCESSABLE. 
# 
              IF PA$UPID[PAC] NQ 0
              THEN
                BEGIN 
                IF (ACE$PID[0] EQ PA$PID[PAC]) AND
                  ACE$NAMAC[0]
                THEN
                  BEGIN 
                  FOUND = TRUE; 
                  END 
                END 
              ELSE
# 
*             A PID WAS NOT SPECIFIED IN THE CR/IAP/R SM, SO THE ACPID
*             NEED ONLY BE NAM ACCESSABLE AND MUST NOT HAVE A LID STORE 
*             AND FORWARD ATTRIBUTE.
# 
                BEGIN 
                IF (ACE$NAMAC[0] AND
                   (NOT ACE$SF[0])) 
                THEN
                  BEGIN 
                  FOUND = TRUE; 
                  END 
                END 
              END 
            ELSE
# 
*           ALL OF THE PIDS IN THE ACPID TABLE HAVE BEEN EXHAUSTED. 
# 
              BEGIN 
              PIDSLEFT = FALSE; 
              END 
            END 
# 
*         IF A MATCHING PID WAS FOUND IN THE ACPID TABLE, STORE THE 
*         NEWLY FOUND PID IN THE PAAC.  INITIALIZE THE PATH AND PID 
*         COUNTERS. 
# 
          IF FOUND
          THEN
            BEGIN 
            PA$RHID[PAC] = ACE$PID[0];
            PA$PIDCUR[PAC] = 0; 
            PA$PATHNXT[PAC] = 0;
            END 
          END 
        END 
# 
*     IF A MATCHING PID WAS NOT FOUND IN THE ACPID TABLE, SET THE ERROR 
*     CODE, SET THE NEXT ACTION TO ERRCHEK, AND EXIT. 
# 
      IF NOT PIDSLEFT 
      THEN
        BEGIN 
        ERRCODE = RCIA"NPL";
        NXTACT = S"SERRCHEK"; 
        ERRACT = CONTACT; 
        GOTO EXFINDPATH;
        END 
 
      NXTACT = S"SSENDIAPN";
 
EXFINDPATH: 
 
      GOTO EXEC;
# 
 .......................................................................
# 
      CONTROL EJECT;
 
FINDOUT: # FIND APPROPRIATE OUTCALL BLOCK # 
 
# 
*     THIS FUNCTION IS RESPONSIBLE FOR LOCATING THE APPROPRIATE 
*     OUTCALL BLOCK FOR THE CALL REQUEST. 
*     IF NO OUTCALL BLOCK FOUND THEN THE ERROR ACTION IS SET. 
# 
 
# 
*     PERFORM OUTCALL BLOCK SEARCH USING THE CURRENT PID VALUE IN 
*     PAAC ENTRY RHID UNTIL EITHER ALL OUTCALL BLOCKS ARE SCANNED 
*     WITHOUT A MATCH. IF NO MATCH OCCURS, ADVANCE TO THE NEXT PID
*     VALUE FROM THE ACPID ENTRY. NOTE THAT ON THE FIRST ITERATION, 
*     THAT THE PID POINTING ALGORITHM WILL RESIDE ON THE FIRST PID
*     ENTRY OF THE ACPID TABLE ENTRY. 
# 
 
      PIDSLEFT = TRUE;
      NOOUTBLK = TRUE;
      IF (OUTRECL GR 0 AND
          PA$URHID[PAC] NQ 0) 
      THEN
        BEGIN 
 
# 
*     OUTCALL SEARCH ONLY PERFORMED AT THIS STAGE IF OUTCALL
*     BLOCKS EXIST AND THE NAME2 (PID) PARAMETER IS NON-ZERO. 
# 
        FOR XZ= 0 WHILE 
          NOOUTBLK AND PIDSLEFT 
        DO
          BEGIN 
 
# 
*     CHECK IF OUTCALL BLOCKS EXHAUSTED FOR CURRENT PID.
# 
          IF PA$OUTNXT[PAC] GQ OUTRECL
          THEN
            BEGIN 
# 
*     OUTCALL BLOCKS EXHAUSTED FOR CURRENT PID. ADVANCE TO NEXT PID 
*     AND START NEXT OUTCALL SEARCH.
# 
            PA$OUTNXT[PAC] = 0; 
 
# 
*     REPEAT LOOP AS LONG AS OUTCALL BLOCK NOT FOUND AND PIDS 
*     ARE AVAILABLE.
# 
            IF PA$CUACPID[PAC] EQ 0 
            THEN
              PIDSLEFT = FALSE; 
            ELSE
              BEGIN 
# 
*     PIDS STILL AVAILABLE. 
*     ADVANCE THE POINTERS TO THE NEXT ACTIVE PID ENTRY.
*     PID ENTRY ONLY VALID IF-
*        1) NAM ACCESSIBLE AND REQUESTED PID ZERO AND NOT 
*           STORE/FORWARD LID TYPE. 
*                  ** OR ** 
*        2) PID SPECIFIED AND EQUAL TO ACPID ENTRY PID AND
*           ACPID ENTRY PID NAM ACCESSIBLE. 
* 
*     IF NO PIDS LEFT, LEAVE THE LOOP.
# 
              WORKB = TRUE; 
              FOR AZ = 0 WHILE
                WORKB AND PA$CUACPID[PAC] GR 0
              DO
                BEGIN 
                P<ACENT> = (P<ACPID> + PA$PIDBIAS[PAC]
                               + LPORD + PA$CUACPID[PAC]);
 
                IF (ACE$NAMAC[0] AND
                    (PA$UPID[PAC] EQ 0) AND 
                    (NOT ACE$SF[0]))
                THEN
                  BEGIN 
                  WORKB = FALSE;
                  END 
                IF (ACE$NAMAC[0] AND
                    (PA$UPID[PAC] NQ 0) AND 
                    (PA$PID[PAC] EQ ACE$PID[0]))
                THEN
                  BEGIN 
                  WORKB = FALSE;
                  END 
                PA$CUACPID[PAC] = PA$CUACPID[PAC] - 1;
                END 
 
# 
*     IF PIDS EXHAUSTED, SET LOOP VARIABLES TO EXIT LOOP. 
*     OUTCALL SEARCH DONE, NO OUTCALL BLOCKS FOUND. 
# 
              IF WORKB
              THEN
                PIDSLEFT = FALSE; 
              END 
 
            IF ((NOT PIDSLEFT) AND
                ((PA$UPID[PAC] NQ 0) OR (PA$ULID[PAC] NQ 0))) 
            THEN
              BEGIN 
              ERRCODE = RCIA"NOM";
              NXTACT = S"SERRCHEK"; 
              ERRACT = CONTACT; 
              GOTO EXFINDOUT; 
              END 
# 
*     TO HERE, MUST HAVE FOUND AN OUTCALL BLOCK OR THE RHID IS 0. 
*     RESTORE THE RHID OF THE PAAC ENTRY. 
# 
            IF WORKB
            THEN
              PA$RHID[PAC] = ACE$PID[0];
            ELSE
              PA$URHID[PAC] = PA$UPID[PAC]; 
            END 
# 
*     VALID PID SETTING ACCOMPLISHED. SCAN THE OUTCALL BLOCKS 
*     FOR A MATCH ON THE REQUESTED APPLICATION NAME, THE RHID AND THE 
*     SECURITY LEVEL. 
# 
          FOR J = 0 WHILE 
            (NOOUTBLK AND (PA$OUTNXT[PAC] LS OUTRECL))
          DO
            BEGIN 
 
# 
*     SET THE CURRENT OUTCALL BLOCK RELETIVE WORD LOCATION
*     TO THE NEXT VALUE. POINT THE LOCAL OUTCALL BLOCK TEMPLATE 
*     TO THE BEGINNING OF THE OUTCALL RECORD PLUS THE CURRENT 
*     DISPLACEMENT VALUE. 
*     SET THE NEXT DISPLACEMENT VALUE TO THE CURRENT VALUE PLUS 
*     THE WORD COUNT OF THE CURRENT ENTRY SO AS TO BE POINTED TO THE
*     NEXT OUTCALL BLOCK OF THE RECORD. 
# 
            PA$OUTCUR[PAC] = PA$OUTNXT[PAC];
            P<OUTCALL> = (P<OUTREC> + PA$OUTCUR[PAC]);
            PA$OUTNXT[PAC] = PA$OUTNXT[PAC] + OUT$WC[0];
 
            IF ((OUT$NM1[0] EQ PA$RAPNM[PAC]) AND 
                (OUT$NM2[0] EQ PA$RHID[PAC]) AND
                (OUT$SL[0] LQ AST$AAL[AORD])) 
            THEN
              BEGIN 
              NOOUTBLK = FALSE; 
              PA$NUMOUT[PAC] = PA$NUMOUT[PAC] + 1;
              END 
            END 
          END 
        END 
# 
*     OUTCALL SEARCH COMPLETE. SET NEXT ACTION TO CHSHOST.
# 
      NXTACT = S"SCHSHOST"; 
 
EXFINDOUT:  
 
 
      GOTO EXEC;
 
# 
 .................................................................
# 
      CONTROL EJECT;
 
CHSHOST: # CHECK FOR SINGLE HOST OUTCALL REQUEST #
 
# 
*     THIS FUNCTION IS RESPONSIBLE FOR CHECKING IF A REQUEST DOES 
*     QUALIFY FOR A SINGLE HOST CALL IF NO OUTCALL WAS FOUND. 
*     IN THE EVENT THAT NO OUTCALL BLOCK FOUND AND THE CALL REQUEST 
*     QUALIFIES FOR SINGLE HOST, THEN THE HARDCODED SINGLE HOST 
*     OUTCALL BLOCK IS SET AND USED FOR THE CALL. 
* 
*     IF THE CALL DOES NOT QUALIFY FOR SINGLE HOST AND THERE ARE
*     NO OUTCALL BLOCKS THAT QUALIFY, THEN THE ERROR CODE IS SET
*     AND THE NEXT ACTION IS SET ERRCHEK, THE ERROR ACTION IS SET 
*     TO THE CONTROLLING ACTION (CONTACT) AND AN EXIT IS MADE.
* 
# 
      ERRCODE = OK$;
      IF NOOUTBLK 
      THEN
        BEGIN 
 
# 
*     CHECK IF AT LEAST 1 OUTCALL MATCH OCCURRED. IF SO THEN
*     IT MEANS THAT AT LEAST 1 OUTCALL ATTEMPT FAILED. SET ERROR
*     CODE, NEXT ACTION TO ERRCHEK, ERROR ACTION TO SGETSM. 
# 
        IF PA$NUMOUT[PAC] NQ 0
        THEN
          BEGIN 
          ERRCODE = RCIA"ANA";
          END 
        ELSE
# 
*     NEVER MATCHED ON AN OUTCALL BLOCK.
# 
          BEGIN 
          IF PA$SMAN[PAC] EQ 0
          THEN
# 
*     SECONDARY CR/IAP/R SM. A SINGLE HOST OUTCALL HAS ALREADY
*     FAILED ONCE TO CONNECT. SET ERROR CODE, ACTIONS, ETC. 
# 
            ERRCODE = RCIA"DRJ";
          ELSE
# 
*     FIRST TIME OCCURRENCE FOR CR/IAP/R SM.
*     CHECK IF RHID IS ZERO FOR SINGLE HOST REQUEST.
# 
            BEGIN 
            IF PA$UPID[PAC] EQ 0 AND PA$ULID[PAC] EQ 0
            THEN
# 
*     CALL REQUEST IS SINGLE HOST. SET OUTCALL BLOCK TO THE 
*     SINGLE HOST OUTCALL BLOCK AND SET PAAC OUTCALL VALUES.
# 
              BEGIN 
              P<OUTCALL> = LOC(SHOSTOUT); 
              PA$OUTNXT[PAC] = OUTRECL; 
              PA$NUMOUT[PAC] = 1; 
 
# 
*     THE SINGLE HOST OUTCALL BLOCK IS TO BE USED SINCE 
*     THERE HAS NEVER BEEN AN OUTCALL BLOCK MATCH AND THE 
*     REQUEST IS FOR A HOST RESIDENT APPLICATION. 
* 
*     INITIALIZE THE CALL USER DATA FIELD OF THE SINGLE 
*     HOST OUTCALL BLOCK WITH THE ASCII EQUIVALENT OF THE 
*     ZERO PRID AND THE SOURCE NODE, DESTINATION NODE AND 
*     REQUESTED APPLICATION NAME FIELDS OF THE CR/IAP/R SM. 
# 
 
              SH$UDL[0] = SHUDL$; 
              ZCHAR = O"33";
              ZCHAR = SSDCDA(ZCHAR);
              STORD = PRIDWORD$;
              STBIT = PRIDBORD$;
# 
*      STORE NINE ASCII ZERO CHARS FOR PRID (4),
*      DESTINATION HOST (2), SOURCE NODE (3). 
# 
              FOR J = 1 STEP 1 UNTIL 9
              DO
                BEGIN 
                SSBSBF(SHOSTOUT[0],STORD,STBIT,8,ZCHAR);
                END 
# 
*     CONVERT REQUESTED APPLICATION NAME AND STORE INTO THE 
*     SINGLE HOST OUTCALL BLOCK.
# 
              EXORD = 0;
              EXBIT = 0;
              STORD = APWORD$;
              STBIT = APBORD$;
# 
*     CONVERT AND STORE ASCII APPLICATION NAME INTO SHOST OUTCALL 
*     BLOCK.
# 
              L = PA$WORD3[PAC];
              FOR J = 1 STEP 1 UNTIL 7
              DO
                BEGIN 
                SSBEBF(L,EXORD,EXBIT,6,ZCHAR);
                ZCHAR = SSDCDA(ZCHAR);
                SSBSBF(SHOSTOUT[0],STORD,STBIT,8,ZCHAR);
                END 
              END 
            ELSE
# 
*     CALL REQUEST DOES NOT QUALIFY FOR SINGLE HOST.
*     SET ERROR CODE. 
# 
              ERRCODE = RCIA"NOM";
            END 
          END 
        END 
# 
*     CHECK ERRCODE. IF NOT OK, SET NEXT ACTION FOR ERRCHEK, SET
*     ERROR ACTION TO CONTROLLING ACTION AND EXIT.
# 
      IF ERRCODE NQ OK$ 
      THEN
        BEGIN 
        NXTACT = S"SERRCHEK"; 
        ERRACT = CONTACT; 
        END 
      ELSE
# 
*     EVERYTHING OK TO HERE. SET NEXT ACTION TO SEND CR/IAP/N SM. 
# 
        NXTACT = S"SSENDIAPN";
 
      GOTO EXEC;
 
# 
 .......................................................... 
# 
      CONTROL EJECT;
 
SENDIAPN: # FORMAT AND SEND THE CR/AIP/N SM # 
 
# 
*     THIS FUNCTION FORMATS THE CR/IAP/N SM.
*     THIS FUNCTION INVOKES THE MOVEDTE, MOVEFAC AND MOVECUD
*     FUNCTIONS. ORIGIN OF CALLER INTO THIS FUNCTION IS DETERMINED
*     FROM THE OLD ACTION (OLDACT SET BY THE EXEC). 
# 
      IF OLDACT NQ S"SMOVEDTE" AND
         OLDACT NQ S"SMOVEFAC" AND
         OLDACT NQ S"SMOVECUD"
      THEN
        BEGIN 
# 
*     INITIALIZE THE MSGBUF STORAGE AREA. 
# 
        FOR J = 0 STEP 1 UNTIL NMSGBUF$ 
        DO
          BEGIN 
          MSG$WORD[J] = 0;
          END 
 
# 
*     INITIAL ENTRY INTO THIS FUNCTION. 
*     SET FIELDS OF THE CR/AIP/N SM FROM THE OUTCALL BLOCK AND
*     PAAC ENTRY. 
# 
        PFCSFC[1] = CRIAPN; 
        CRALN[1] = 1; 
        CRACN[1] = PA$NACN[PAC];
        CRICT[1] = CT6DISPLAY;
        CRVCB[1] = PA$VCB[PAC]; 
        SPMSG1[1] = OUT$WRD2[0];
        CRADBZ[1] = OUT$DBZ[0]; 
        CRAABL[1] = OUT$ABL[0]; 
        CRASNOD[1] = OUT$SNOD[0]; 
        CRADNOD[1] = OUT$DNOD[0]; 
        CRIWS[1] = OUT$WS[0]; 
        CRIDPLS[1] = OUT$DPLS[0]; 
# 
*     MUST MOVE THE DTE ADDRESSES INTO THE SM AREA. 
*     SET NEXT ACTION TO S"SMOVEDTE" AND EXIT.
# 
        NXTACT = S"SMOVEDTE"; 
        RETACT = S"SSENDIAPN";
        GOTO EXSENDIAPN;
        END 
# 
*     CHECK IF RETURN FROM MOVEDTE. 
*     IF SO, THEN NEXT ACTION IS TO MOVE FACILITIES INTO SM AREA. 
*     SET NEXT ACTION TO S"SMOVEFAC", RETURN ACTION TO S"SSENDIAPN",
*     AND EXIT. 
# 
      IF OLDACT EQ S"SMOVEDTE"
      THEN
        BEGIN 
        NXTACT = S"SMOVEFAC"; 
        RETACT = S"SSENDIAPN";
        GOTO EXSENDIAPN;
        END 
# 
*     CHECK IF RETURN FROM MOVEFAC. 
*     IF SO, NEXT ACTION IS TO MOVE CALL USER DATA INTO THE SM AREA.
# 
      IF OLDACT EQ S"SMOVEFAC"
      THEN
        BEGIN 
        NXTACT = S"SMOVECUD"; 
        RETACT = S"SSENDIAPN";
        GOTO EXSENDIAPN;
        END 
# 
*     CHECK IF RETURN FROM MOVECUD. 
*     IF SO, THEN CR/IAP/N IS READY TO SEND TO CONNECTION TRAFFIC 
*     QUEUE (CTQ).
# 
      IF OLDACT EQ S"SMOVECUD"
      THEN
        BEGIN 
# 
*     DETERMINE THE TOTAL NUMBER OF OCTETS FOR THE WHOLE CR/IAP/N.
*     THE FIXED LENGTH PART OF THE SM CONSISTS OF THE FIRST TWO 
*     WORDS THE FIRST 32 BITS OF THE 3RD WORD, A TOTAL OF 152 BITS. 
*     THE VARIABLE LENGTH PORTION OF THE SM IS THE SUM OF DTEBITS,
*     FACBITS, AND UDATBITS. 7 BITS ARE ADDED TO THE TOTAL BEFORE 
*     IT IS DEVIDED BY 8 JUST FOR ROUNDING PURPOSE. 
# 
        CRIOCTN[1] = (152 + DTEBITS + FACBITS + UDATBITS + 7) / 8;
 
# 
*     DETERMINE TOTAL LENGTH OF CR/IAP/R SM.
# 
 
        NUMBITS = (DTEBITS + FACBITS + UDATBITS -28 + 59);
        LENIAPN = ((NUMBITS / 60) + 3); 
 
# 
*     SEND THE CR/IAP/N SM TO THE OTQ, BYPASSING THE CTQ. 
# 
 
        WCB$WORD[0] = 0;
        WCB$WC[0] = LENIAPN + 2;
 
        ABHWORD[0] =0;
        ABHABT[0] = APPCMD; 
        ABHADR[0] = 0;
        ABHTLC[0] = LENIAPN;
        ABHACT[0] = 1;
 
        SSTAQE (P<OTQ>, WCBUF, ABHBUF, APSM[1]);
 
# 
*     CHANGE ACN STATE FROM CREATE TO ACTIVE. 
# 
      ACNN = PA$NACN[PAC];
      NVFCFCE (ACNN,AE,NEWACN); 
      IF NEWACN    # COULD NOT FIND ACN ENTRY, SERIOUS PROBLEM #
      THEN
        BEGIN 
        $BEGIN
        TBL$NAME[0] = "ACN";
        MESSAGE(TBLMSG,0);
        ABORT;
        $END
        END 
      ELSE   # ACN ENTRY EXIST, UPDATE ITS STATE #
        ACN$STATE[AE] = ACNST"ACTIVE";
 
# 
*     POST INFO TO THE PAAC ENTRY.
# 
        PA$FAM[PAC] = "       ";
        PA$USER[PAC] = "       "; 
        PA$SNODE[PAC] = OUT$SNOD[0];
        PA$DNOD[PAC] = OUT$DNOD[0]; 
# 
*     FUNCTION COMPLETE. SET NEXT ACTION TO SEND CR/SWH/R SM. 
# 
        NXTACT = S"SSENDSWH"; 
        END 
 
EXSENDIAPN: 
 
      GOTO EXEC;
# 
 .............................................................
# 
      CONTROL EJECT;
 
MOVEDTE: # MOVE DTE ADDRESS INFO INTO CR/IAP/N SM # 
 
# 
*     THIS FUNCTION MOVES THE DTE ADDRESS INFO INTO THE CR/IAP/N SM.
# 
 
# 
*     INITIALIZE THE WORD AND BIT LOCATIONS FOR STORING.
# 
      EXORD = 4;
      EXBIT = 0;
# 
*     CALCULATE NUMBER OF BITS IN CALLED DTE ADDRESS FIELD. 
*     NOTE THAT THE LENGTH IS THE NUMBER OF SEMI-OCTETS (4 BIT
*     QUANITIES). 
# 
 
      DTEBITS = 8 + (((OUT$DTEL[0] + 1)/2)*2)*4;
      STORD = DTEASW$;
      STBIT = DTEASB$;
 
# 
*     MOVE CALLED DTE ADDRESS LENGTH AND ADDRESS INTO SM
# 
 
      J = DTEBITS;
      TEMP = 0; 
      FOR I = 0 WHILE J GR 0
      DO
        BEGIN 
        IF J GR 60
        THEN
          BEGIN 
          J = J - 60; 
          K = 60; 
          END 
        ELSE
          BEGIN 
          K = J;
          J = 0;
          END 
        SSBEBF(OUTCALL[0],EXORD,EXBIT,K,TEMP);
        SSBSBF(APSM[1],STORD,STBIT,K,TEMP); 
        TEMP = 0; 
        END 
# 
*     RETURN VIA THE RETURN ACTION DICTATED.
# 
      NXTACT = RETACT;
      GOTO EXEC;
# 
 .................................................................. 
# 
      CONTROL EJECT;
 
MOVEFAC: # MOVE FACILITY CODE/PARAMETER GROUPS INTO SM. # 
 
# 
*     THIS FUNCTION IS RESPONSIBLE FOR MOVING THE FACILITY CODES
*     FROM THE OUTCALL BLOCK INTO THE SM. 
# 
 
# 
*     SAVE THE WORD AND BIT LOCATIONS 
*     WHERE THE YET TO BE DETERMINED FACILITY LENGTH WILL BE
*     INSERTED INTO THE CALL REQUEST PACKET PORTION OF THE SM.
# 
      FACLORD = STORD;
      FACLBIT = STBIT;
      FCL$LEN[0] = 0; 
# 
*     ADVANCE THE STORE WORD AND BIT LOCATIONS BEYOND THE FACILITY
*     LENGTH LOCATION TO WHERE THE ACTUAL FACILITY CODE PAIRS ARE 
*     TO BE INSERTED. 
# 
      SSBSBF(APSM[1],STORD,STBIT,8,TEMP); 
# 
*     ONLY IF FACILITIES DEFINED, 
*     MOVE FACILITY CODE PAIRS SERIALLY INTO THE SM FROM THE
*     OUTCALL BLOCK. ACCUMULATE THE FACILITY OCTET LENGTH.
# 
 
      P<OCFAC> = (P<OUTCALL> + 6);
      P<OCUDATA> = (P<OUTCALL> + 6);
      FACBITS = 0;
      IF OUT$FACNUM[0] NQ 0 
      THEN
        BEGIN 
# 
*     AT LEAST 1 FACILITY CODE DEFINED FOR OUTCALL. 
# 
        FOR J = 0 STEP 1 UNTIL (OUT$FACNUM[0] - 1)
        DO
          BEGIN 
          EXORD = 0;
          EXBIT = 8;
          K = (P<OCFAC> + J); 
          P<OCFAC> = K; 
          FCL$LEN[0] = FCL$LEN[0] + OCF$LEN[0]; 
          NUMBITS = (OCF$LEN[0] *4);
          FACBITS = FACBITS + NUMBITS;
          SSBEBF(OCFAC[0],EXORD,EXBIT,NUMBITS,TEMP);
          SSBSBF(APSM[1],STORD,STBIT,NUMBITS,TEMP); 
          END 
 
# 
*     FACILITY CODE PAIRS ARE STORED IN SM AREA. NOW STORE THE
*     FACILITY LENGTH (OCTET LENGTH) AFTER CALCULATING SINCE THE
*     LENGTH TO NOW IS A SEMI-OCTET LENGTH. 
# 
 
        P<OCUDATA> = (P<OCFAC> + 1);
        END 
 
      TEMP = (FCL$LEN[0] / 2);
      SSBSBF(APSM[1],FACLORD,FACLBIT,8,TEMP); 
      FACBITS = FACBITS + 8;
# 
*     FACILITY CODES MOVED. RETURN VIA THE RETURN ACTION. 
# 
      NXTACT = RETACT;
      GOTO EXEC;
# 
 ...............................................................
# 
      CONTROL EJECT;
 
MOVECUD: # MOVE CALL USER DATA INTO SM FROM OUTCALL BLOCK # 
 
# 
*     THIS FUNCTION MOVES THE CALL USER DATA FROM THE OUTCALL BLOCK 
*     INTO THE CR/IAP/N SM. 
# 
 
# 
*     MOVE CALL USER DATA WITH PRID FIELD INTO SM AREA. THE STORE 
*     WORD AND BIT LOCATIONS ARE STILL INTACT.
*     CALCULATE NUMBER OF BITS TO STORE FOR CALL USER DATA. 
*     USE CALL USER DATA LENGTH (SEMI-OCTETS) TIMES 4 PLUS THE
*     PRID LENGTH (32 BITS).
# 
      UDATBITS = ((OUT$UDL[0] *4) + 32);
# 
*     CALCULATE THE OCTET LENGTH OF CALL USER DATA. 
# 
 
      CUDL = (OUT$UDL[0] / 2) + 4;
# 
*     MOVE CALL USER DATA PREFIXED BY THE PRID FIELD. 
# 
      J = UDATBITS; 
      TEMP = 0; 
      FOR I = 0 STEP 1 WHILE J GR 0 
      DO
        BEGIN 
        K = 60; 
        IF J GR 60
        THEN
          J = J - 60; 
        ELSE
          J = 0;
# 
*         STORE OCTET LENGTH OF CALL USER DATA INTO LAST OCTET OF 
*         THE PRID FIELD OF THE CALL USER DATA. 
# 
 
        IF I EQ 0 
        THEN
          OCU$CUDL[I] = CUDL; 
 
        TEMP = OCU$WORD[I]; 
        SSBSBF(APSM[1],STORD,STBIT,K,TEMP); 
        TEMP = 0; 
        END 
# 
*     RETURN VIA THE RETURN ACTION. 
# 
      NXTACT = RETACT;
      GOTO EXEC;
# 
 .......................................................... 
# 
      CONTROL EJECT;
 
SENDSWH: # SEND THE CR/SWH/R SM # 
 
# 
*     THIS FUNCTION FORMATS AND SENDS THE CR/SWH/R SM TO THE CTQ. 
# 
 
# 
*    SET UP THE CR/SWH/R SM.
# 
     FOR J = MSBFNVL STEP 1 UNTIL NMSGBUF$
     DO 
       BEGIN
       MSG$WORD[J] = 0; 
       END
# 
*    SET UP THE HOST TYPE TO CALLING HOST FOR WHEN THE CR/ACC RETURNS.
*    SET THE SWITCH SM VALUES.
# 
 
     PFCSFC[1] = CRSWH; 
     CRSNAME[1] = PA$RAPNM;        # CALLED APPLICATION NAME           #
     CRNACN[1] = PA$NACN[PAC];
     CRABL[1] = OUT$ABL[0]; 
# 
*    SET THE DEVICE TYPE DEPENDING ON IF THE REMOTE HOST ID IS
*    ZERO (SAME HOST) OR NON-ZERO.
# 
     IF (PA$SNODE[PAC] EQ 0 AND PA$DNOD[PAC] EQ 0)
     THEN 
       BEGIN
       CRDT[1] = DT$INTA; 
       END
     ELSE 
       BEGIN
       CRDT[1] = DT$INTE; 
       END
# 
*     FINISH SETTING UP THE CR/SWH/R SM.
# 
      CRSWSL[1] = OUT$SL[0];
      CRSWHID[1] = PA$URHID[PAC]; 
      CRSWDBZ[1] = OUT$DBZ[0];
      CRSWUBZ[1] = OUT$UBZ[0];
      CRSWAN[1] = PA$IAPAN[PAC];
# 
*     MOVE CALL USER DATA AND CALL USER DATA LENGTH FROM THE OUTCALL
*     BLOCK INTO THE SM AREA.  INITIALIZE THE WORD AND BIT LOCATIONS
*     FOR STORING THE DATA.  INITIALIZE THE NUMBER OF BITS TO MOVE. 
# 
      CRSWUDL[1] = OCU$CUDL[0]; 
      STORD = 4;
      STBIT = 0;
      K = 60; 
      J = UDATBITS; 
      TEMP = 0; 
      FOR I = 0 STEP 1 WHILE J GR 0 
      DO
        BEGIN 
        IF J GR 60
        THEN
          BEGIN 
          J = J - 60; 
          END 
        ELSE
          BEGIN 
          J = 0;
          END 
        TEMP = OCU$WORD[I]; 
        SSBSBF(APSM[1],STORD,STBIT,K,TEMP); 
        TEMP = 0; 
        END 
# 
*    SEND THE SWITCH SM TO THE CTQ. 
# 
 
      NVFUMQE(P<CTQ>,APSM[1],APPPR$,0,LCRSWH);
 
# 
*     SAVE THE CONNECT TIME IN THE PAAC ENTRY.
# 
      PA$CNTIME[PAC] = CTM$PDT[0];
# 
*     INCREMENT NUMBER OF CONNECTIONS TO CALLING APPLICATION.  IF THIS
*     APPL IS A SECONDARY APPL, INCREMENT NUMBER OF CONNECTIONS TO THE
*     PRIMARY APPL.  CLEAR RETRY COUNT SINCE SUCCESSFUL CONNECTION. 
# 
      AST$AACN[AORD] = AST$AACN[AORD] + 1;
      IF AORD NQ PORD 
      THEN
        BEGIN 
        AST$AACN[PORD] = AST$AACN[PORD] + 1;
        END 
      AST$RETRY[AORD] = 0;
# 
*     SET NEXT ACTION TO THE CONTROLLING ACTION.
# 
      NXTACT = CONTACT; 
      GOTO EXEC;
 
# 
 .................................................................
# 
      CONTROL EJECT;
 
ERRCHEK: # PERFORM ERROR CHECKS # 
 
# 
*     THIS FUNCTION IS RESPONSIBLE FOR CHECKING IF ERRORS OCCURRED
*     AND TO ISSUE THE APPROPRIATE ACCOUNTING MESSAGE AND CR/IAP/A
*     SM RESPONSE IF NEEDED.
# 
 
# 
*    IF AN ERROR HAS OCCURRED, ISSUE A CR/IAP/A SM, ISSUE AN ACCOUNT
*    MESSAGE IF NEEDED, CLEAR THE ASSIGNED VCB AND PAAC ENTRY IF THEY 
*    EXIST. 
# 
     IF ERRCODE NQ OK$
     THEN 
       BEGIN
 
# 
*     IF THE SECONDARY ERROR CODE IS NOT OK, THEN THE REASON CODE 
*     FROM THE PAAC ENTRY IS TO BE USED.
# 
      IF ((ERRCODE2 EQ SEESM$) AND (ERRCODE NQ RCIA"APF"))
      THEN
        ERRCODE = PA$IAPRC[PAC];
# 
*      IF AN INVALID REQUEST ERROR, THEN ISSUE THE ABEA ACCOUNT MESSAGE 
*      AND CHARGE THE CALLING APPLICATION WITH AN ATTEMPT (RETRY).
# 
       IF (ERRCODE EQ RCIA"ANP" OR
           ERRCODE EQ RCIA"NPL" OR
           ERRCODE EQ RCIA"NOM" OR
           ERRCODE EQ RCIA"AND") AND
           PACDEF 
       THEN 
         BEGIN
         MTYP = ABEA$;
         NVFAIAM(PAC,MTYP); 
         AST$RETRY[AORD] = AST$RETRY[AORD] + 1; 
         END
# 
*      IF THE RETRY LIMIT REACHED ERROR OCCURRED, THEN ISSUE THE ABRE 
*      ACCOUNT MESSAGE. 
# 
       IF ERRCODE EQ RCIA"RLR" AND PACDEF 
       THEN 
         BEGIN
         MTYP = ABRE$;
         NVFAIAM(PAC,MTYP); 
         END
# 
*      ISSUE THE CR/IAP/A SM. 
# 
       SPMSG0[0] = 0; 
       PFCSFC[0] = CRIAP; 
       IF PACDEF
       THEN 
         BEGIN
         CRNACN[0] = PA$NACN[PAC];
         END
       ELSE 
         BEGIN
         CRNACN[0] = NACN;
         END
       EB[0] = TRUE;
       CRRIAP[0] = ERRCODE; 
       NVFUMQE(P<CTQ>,APSM[0],APPPR$,0,LCRIAPA);
# 
*      IF AN AST ENTRY EXISTS, CALL NVFSCAD TO COMPLETE APPLICATION 
*      DEPARTURE, IF NECESSARY. 
# 
       IF AORD NQ ASTNUM
       THEN 
         BEGIN
         NVFSCAD(AORD); 
         END
# 
*      IF PAC ENTRY EXISTS, CALL NVFACTC TO RELEASE PAAC ENTRY, 
*      ACPID ENTRY TABLE SPACE, APOUTCL ENTRY, AND VCB IF DEFINED.
# 
       IF PACDEF
       THEN 
         NVFACTC(PAC,VCBDEF); 
       END
 
 
# 
*     RETURN VIA THE ERROR ACTION.
# 
      NXTACT = ERRACT;
      GOTO EXEC;
# 
 .............................................................
# 
      CONTROL EJECT;
 
EXIT: # EXIT THE NVFAIAP PROCEDURE #
 
      RETURN; 
 
      END # NVFAIAP # 
 TERM