*DECK     NVFARAP 
USETEXT TXINAA
USETEXT TEXTNVF 
USETEXT TEXTSS; 
USETEXT TXTANVF;
USETEXT TXSMNVF;
USETEXT TXTAPSS;
USETEXT TXTSUSS;
PROC NVFARAP; 
# TITLE NVFARAP - PROCESS A-A INCALL REQUESTS. #
      BEGIN #NVFARAP# 
  
# 
**    NVFARAP - PROCESS A-A INCALL REQUEST SMS. 
* 
*     C. BRION          82/10/01. 83/04/19. 83/05/12. 
* 
*     THE FUNCTION OF THIS PROCEDURE IS TO PROCESS THE INCALL REQUEST 
*     SM - CR/RAP/R. THIS PROC VALIDATES THE INCALL REQUEST AND WILL
*     GENERATE EITHER A VALIDATION REQUEST (IF VALID MULTI HOST REQUEST)
*     OR IT WILL GENERATE A CR/RAP/N RESPONSE AND A CR/SWH/R SM IF THE
*     DETERMINED MODE IS FOR SINGLE HOST A-A CONNECTION.
* 
*     PROC NVFARAP
* 
*     ENTRY:  
* 
*       THE CR/RAP/R SM RESIDES IN THE INSMQ. 
* 
*     EXIT: 
* 
*       A VALIDATION REQUEST MAY BE QUEUED TO THE CPM REQUEST QUEUE.
*       A CR/RAP/N OR ABNORMAL MAY BE ISSUED. 
*       A CR/SWH/R MAY BE ISSUED TO THE CTQ.
* 
*     NOTES:  
* 
*     WHEN A CR/RAP/R SM IS RECEIVED, THE CALLED APPLICATION MUST PASS
*     LIMIT CHECKS, THERE MUST BE A VCB ORDINAL AVAILABLE, AND THERE
*     MUST BE EITHER 1) A VALID INCALL BLOCK FOR THE REQUEST OR 2) THE
*     REQUEST MUST BE FOR A SINGLE HOST A-A CONNECTION. A SINGLE HOST 
*     TYPE OF CONNECTION IS DETERMINED BY THE FACT THAT THE SOURCE AND
*     DESTINATION NODES ARE BOTH ZERO.
* 
*     THERE ARE TWO INTERNAL PROCEDURES THAT ARE CALLED BY THE MAIN 
*     LINE. THEY ARE DISSECT, WHICH BREAKS APART THE INCOMING SM INTO 
*     ITS VARIOUS PARTS AND CHEKFAC, WHICH VERIFIES THAT THE REQUESTED
*     FACILITIES IN THE CR/RAP/R SM ARE IN FACT THE FACILITIES THAT ARE 
*     ALLOWED ON A SPECIFIC INCALL BLOCK. 
* 
# 
      CONTROL EJECT;
  
# 
****  PROC NVFARAP XREF LIST. 
# 
  
      XREF
        BEGIN 
        PROC SSTRQE;                     # SS-REMOVE QUEUE ENTRY #
        PROC SSTATS;                     # SS-ALLOCATE TABLE SPACE #
        PROC NVFUAFV;                    # ASSIGN VCB ORDINAL # 
        PROC NVFUMQE;                    # MAKE QUEUE ENTRY # 
        PROC NVFUFVO;                    # FREE UP VCB #
        PROC NVFAIAM;                    # ISSUE ACCOUNT MESSAGE #
        PROC SSBEBF;                     # SS-EXTRACT BIT FIELD # 
        PROC SSBSBF;                     # SS-STORE BIT FIELD # 
        FUNC SSDCAD;                     # SS-CONVERT ASCII-DISPLAY # 
        PROC SSTRTS;                     # SS-RELEASE TABLE SPACE # 
        PROC NVFUCRS;                    # CHECK REQUEST START #
        PROC SSCATR;                     # SS-ACCEPT TIMER REQUEST #
        PROC MESSAGE;                    # ISSUE DAYFILE MESSAGE #
        PROC ABORT;                      # ABORT PROGRAM         #
        PROC SSTAQE;                     # ACCEPT QUEUE ENTRY    #
        PROC NVFCFCE;                    # FIND CONNECTION ENTRY #
        END 
  
# 
****
# 
      CONTROL EJECT;
  
      DEF MAXFACN$      # 10 #;          # MAX ALLOWED FACILITIES#
      DEF MAXCUDL$      # 17 #;          # MAX LEN (WORDS) OF USER DATA#
      DEF MXCUDOCT$     # 124 #;         # MAX LEN (OCTETS) OF USR DATA#
      DEF ZSHOST$       # X"303030" #;   # ASCII ZERO SHOST # 
      DEF VARPARM$      # 32 #;          # LEN OF VARIABLE PARM # 
      DEF OK$           # 99 #;          # NULL ERROR CODE #
      DEF FACWORD$      # 20 #;          # WORD ORD FOR FACILITIES #
      DEF FACSBIT$      # 48 #;          # START BIT FOR FACILITIES # 
      ITEM ERRCODE      I;
      ITEM NORMBITS     I;
      ITEM MOVNUM       I;
      ITEM J,I,K        I;
      ITEM IDX          I;
      ITEM IDXA         I;
      ITEM PACDEF       B;
      ITEM ERRFLAG      B;
      ITEM VCBDEF       B;
      ITEM PAC          I;
      ITEM VCB          I;
      ITEM ASTNUM       I;
      ITEM AORD         I;
      ITEM FOUND        B;
      ITEM PORD         I;               # PRIMARY AST ENTRY ORDINAL   #
      ITEM XX           I;
      ITEM NUMFACS      I;
      ITEM FACREJ       B;
      ITEM RSTAT        I;
      ITEM CTYP         I;
      ITEM DTEA         U;               # CALLED DTE ADDR FROM CR/RAP #
      ITEM DTEBITS      I;               # LENGTH (BITS) OF DTEA ADDR  #
      ITEM DTEREJ       B;               # DTEA REJECTED FLAG          #
      ITEM EXBIT,EXORD  I;               # LOCAL EXTRACT VARIABLES     #
      ITEM PARMBIT      I;               # LENGTH (BITS) OF FAC PARAMS #
      ITEM SBIT,SORD    I;               # LOCAL STORE VARIABLES       #
      ITEM TEMP         I;               # TEMPORARY VARIABLE          #
      ITEM UDATBITS     I;               # NUM BITS IN CALL USER DATA  #
      ITEM UDATL        I;               # LEN OF CALL USR DATA(OCTETS)#
      ITEM ACNN         I;               # TEMPORARY FOR CONNECTION NO.#
      ITEM AE           I;               # INDEX TO ACN TABLE          #
      ITEM NEWACN       B;               # TRUE IF ACN NOT FOUND       #
# 
*     FINCALL - INCALL FACILITY TEMPLATE. 
# 
  
      BASED ARRAY FINCALL [00:00] S(1); 
        BEGIN 
        ITEM FIN$LEN    U(00,00,08);     # FACILITY OCTET LNGTH # 
        ITEM FIN$CODE   U(00,08,08);     # FACILITY CODE #
        ITEM FIN$WSIN   U(00,16,08);     # RECV WINDOW SIZE # 
        ITEM FIN$WSOUT  U(00,24,08);     # SEND WINDOW SIZE # 
        ITEM FIN$DPLIN  U(00,16,08);     # RECV PKT SIZE #
        ITEM FIN$DPLOUT U(00,24,08);     # SEND PKT SIZE #
        ITEM FIN$FAC    U(00,08,48);
        END 
# 
*     TMPFAC - TEMP ARRAY FOR FACILITIES. 
# 
  
      ARRAY TMPFAC [00:00] S(1);
        BEGIN 
        ITEM TMP$CODE   U(00,00,08);     # FACILITY CODE #
        ITEM TMP$WININ  U(00,08,08);     # RECV WIN SIZE #
        ITEM TMP$WINOUT U(00,16,08);     # SEND WIN SIZE #
        ITEM TMP$DPLIN  U(00,08,08);     # RECV PKT SIZE #
        ITEM TMP$DPLOUT U(00,16,08);     # SEND PKT SIZE #
        ITEM TMP$FAST   U(00,00,16);     # FAST SELECT FAC #
        ITEM TMP$COLL   U(00,00,16);     # REV CHARGE FAC # 
        ITEM TMP$TWINOUT U(00,08,08);    # TELENET SEND WIN SIZE #
        ITEM TMP$TDPLOUT U(00,08,08);    # TELENET SEND PKT SIZE #
        END 
  
  
# 
*     ASCANAME - ASCII APPL NAME. 
# 
      BASED ARRAY ASCANAME [00:00] S(1);
        BEGIN 
        ITEM ASCA$APPL  U(00,04,56);
        END 
  
# 
*     ASCSHOST - ASCII SOURCEHOST.
# 
      BASED ARRAY ASCSHOST [00:00] S(1);
        BEGIN 
        ITEM ASCS$HOST  U(00,36,24);
        END 
  
# 
*     CUD - ARRAY FOR HOLDING CALL USER DATA. 
# 
  
      ARRAY CUD [00:00] S(MAXCUDL$);
        BEGIN 
        ITEM CUD$WORD   U(00,00,60);     # FULL WORD REFERENCE #
        END 
  
# 
*     FACCODE - ARRAY FOR HOLING FACILITY CODE OCTET VALUES.
# 
  
      ARRAY FACCODE [00:MAXFACN$] S(1); 
        BEGIN 
        ITEM FACC$WORD  U(00,00,60);     # WORD REFERENCE # 
        ITEM FACC$BLEN  U(00,44,08);     # BIT LENGTH OF FACILITY # 
        ITEM FACC$CODE  U(00,52,08);     # FACILITY CODE #
        ITEM FACC$LEN   U(00,52,02);     # CODED LENGTH # 
        ITEM FACC$VLEN  U(00,52,08);
        END 
  
# 
*     FACPARM - ARRAY FOR HOLING PARAMETER FIELDS.
# 
  
      ARRAY FACPARM [00:MAXFACN$] S(1); 
        BEGIN 
        ITEM FACP$WORD  U(00,00,60);     # WORD REF # 
        ITEM FACP$PARM  U(00,00,40);     # PARAMETER FIELD REF #
        ITEM FACP$WININ U(00,00,08);     # RECV WINDOW SIZE # 
        ITEM FACP$WINOUT U(00,08,08);    # SEND WINDOW SIZE # 
        ITEM FACP$DPLIN U(00,00,08);     # RECV PKT SIZE #
        ITEM FACP$DPLOUT U(00,08,08);    # SEND PKT SIZE #
        ITEM FACP$FREQ  U(00,00,08);     # FAST SEL PARM #
        ITEM FACP$COLL  U(00,00,08);     # REV CHARGE PARM #
        ITEM FACP$FSCL  U(00,00,08);     # FAST SEL AND REV CHARGE     #
        ITEM FACP$TELN  U(00,00,08);     # TELENET FACS FOLLOW         #
        ITEM FACP$TWINOUT U(00,00,08);   # TELENET SEND WINDOW SIZE    #
        ITEM FACP$TDPLOUT U(00,00,08);   # TELENET SEND PACKET SIZE    #
        END 
  
# 
*     INCFACS - ARRAY FOR ACCESSING THE FACILITIES IN THE INCALL BLOCK. 
# 
  
      BASED ARRAY INCFACS [00:00] S(1); 
        BEGIN 
        ITEM INCF$WORD  U(00,00,60);     # FULL WORD REFERENCE #
        ITEM INCF$CODE  U(00,08,08);     # FACILITY CODE #
        ITEM INCF$LEN   U(00,08,02);     # CODED LENGTH # 
        ITEM INCF$VLEN  U(00,16,08);     # VARIABLE LENGTH #
        ITEM INCF$PARM  U(00,24,32);     # PARAMETER FIELD #
        END 
  
# 
*     BPAC - DUMMY ARRAY FOR CLEARING PAAC ENTRY. 
# 
  
      BASED ARRAY BPAC  [00:00] S(1); 
        BEGIN 
        ITEM BPA$WORD  U(00,00,60); 
        END 
  
  
  
# 
*     SHOSTDCD - DCD SOURCE HOST. 
# 
      BASED ARRAY SHOSTDCD [00:00] S(1);
        BEGIN 
        ITEM SHO$HID    C(00,00,03);
        END 
  
# 
*     ANAMEDCD - DCD APPLICATION NAME.
# 
      BASED ARRAY ANAMEDCD [00:00] S(1);
        BEGIN 
        ITEM ANA$ANAME  C(00,00,07);
        END 
  
# 
*     INCALL - FIXED PORTION OF INCALL BLOCK. 
# 
  
      BASED ARRAY INCALL [00:00] S(9);
        BEGIN 
        ITEM INC$WC     U(00,49,11);     # BLOCK WORD LENGTH #
        ITEM INC$RANAME U(01,00,56);     # ASCII CALLED APPL NAME # 
        ITEM INC$PRI    B(02,00,01);     # PRIORITY FLAG #
        ITEM INC$DBL    U(02,04,08);     # DL BLOCK LIMIT # 
        ITEM INC$DBZ    U(02,12,12);     # DL BLOCK SIZE #
        ITEM INC$ABL    U(02,24,08);     # APPL BLOCK LIMIT # 
        ITEM INC$UBL    U(02,36,08);     # UL BLOCK LIMIT # 
        ITEM INC$UBZ    U(02,44,08);     # UL BLOCK SIZE #
        ITEM INC$PORT   U(02,52,08);     # CALL ACCESS PORT ON NPU #
        ITEM INC$SNOD   U(03,00,08);     # CDC SOURCE NODE OF CALL #
        ITEM INC$DNOD   U(03,08,08);     # CDC DESTINATION NODE # 
        ITEM INC$WS     U(03,16,04);     # SEND WINDOW THRESHOLD #
        ITEM INC$DPLS   U(03,20,08);     # PACKET SIZE #
        ITEM INC$WR     U(03,28,04);     # RECV WINDOW SIZE # 
        ITEM INC$DPLR   U(03,32,08);     # RECV PKT SIZE #
        ITEM INC$COLL   B(03,40,01);     # REVERSE CHARGE # 
        ITEM INC$FAST   B(03,41,01);     # FAST SELECT #
        ITEM INC$DTEL   U(03,56,04);     # LEN OF DTEA (SEMI-OCTETS) #
        ITEM INC$SHOST  U(04,00,24);     # ASCII SOURCE HOST #
        ITEM INC$FAM    C(05,00,07);     # FAMILY NAME #
        ITEM INC$FWORD  U(05,00,60);
        ITEM INC$USER   C(06,00,07);     # USER NAME #
        ITEM INC$FACL   U(06,52,08);     # NUMBER OF FACILITIES # 
        ITEM INC$UWORD  U(06,00,60);
        ITEM INC$DTEA   U(07,00,60);     # DTE ADDRESS #
        ITEM INC$WRD2   U(02,00,60);
        ITEM INC$WRD3   U(03,00,60);
        END 
  
# 
*     SHINCALL - SINGLE HOST INCALL BLOCK.
* 
*     SINGLE HOST INCALL BLOCK DEFINITION FOR INCOMING CALLS THAT 
*     QUALIFY AS A INTRA HOST CALL. 
# 
  
      ARRAY SHINCALL [00:00] S(7);
        BEGIN 
        ITEM SHI$WC     U(00,49,11)=[7]; # WORD COUNT # 
        ITEM SHI$RANAME U(01,00,56)=[0]; # CALLED APPL-ASCII #
        ITEM SHI$PRI    U(02,00,01)=[0]; # PRIORITY FALSE # 
        ITEM SHI$DBL    U(02,04,08)=[INTRADBL$]; # DL BLK LIMIT # 
        ITEM SHI$DBZ    U(02,12,12)=[INTRADBZ$]; # DL BLK SIZE #
        ITEM SHI$ABL    U(02,24,08)=[INTRABL$];  # APPL BLK LIMIT # 
        ITEM SHI$UBL    U(02,36,08)=[INTRAUBL$]; # UL BLK LIMIT # 
        ITEM SHI$UBZ    U(02,44,08)=[INTRAUBZ$]; # UL BLK SIZE #
        ITEM SHI$PORT   U(02,52,08)=[0]; # ACCESS PORT #
        ITEM SHI$SNOD   U(03,00,08)=[0]; # ZERO SOURCE NODE # 
        ITEM SHI$DNOD   U(03,08,08)=[0]; # ZERO DEST NODE # 
        ITEM SHI$WS     U(03,16,04)=[0]; # ZERO WINDOW SIZE # 
        ITEM SHI$DPLS   U(03,20,08)=[0]; # ZERO DATA PKT LEN #
        ITEM SHI$WR     U(03,28,04)=[0]; # ZERO RECV WINDOW # 
        ITEM SHI$DPLR   U(03,32,08)=[0]; # ZERO RECV PKT SIZE # 
        ITEM SHI$COLL   B(03,40,01)=[FALSE]; # NO REV CHARGE #
        ITEM SHI$FAST   B(03,41,01)=[FALSE]; # NO FAST SELECT # 
        ITEM SHI$SHOST  U(04,00,24)=[ZSHOST$]; # ZERO SOURCE HOST # 
        ITEM SHI$FAM    U(05,00,42)=[0];         # NULL FAMILY #
        ITEM SHI$USER   U(06,00,42)=[0];         # NULL USER #
        END 
  
  
# 
**    TMBBUF - TIMER REQUEST BUFFER.
* 
*     BUFFER CONTAINING THE TIMER INFO. SET UP TO CONTAIN THE 
*     FC/INACT SM WHICH IS RETURNED TO THE TAINPQ WHEN THE TIMER EXPIRES. 
# 
      ARRAY TMBBUF[00:00] S(TMBSIZ$); 
        BEGIN 
        ITEM TMB$SMID   S:CTQSTAT(00,00,12) = [S"SINA"];
        ITEM TMB$WC     U(00,48,12) = [TMBSIZ$];
        ITEM TMB$ABT    U(01,00,06) = [APPCMD]; 
        ITEM TMB$CNUM   U(01,18,18);
        ITEM TMB$PFCSFC U(02,00,16) = [FCINA];
        ITEM TMB$ACN    U(02,24,12);
        ITEM TMB$DELAY  U(03,24,18) = [NETPTIME$];
        ITEM TMB$QNUM   U(03,42,18);
        END 
  
      $BEGIN
# 
**    TBLMSG - MISSING TABLE MESSAGE. 
# 
      ARRAY TBLMSG [00:00] S(5);
        BEGIN 
        ITEM TBL$MSG    C(00,00,30) = 
                                    ["NVFARAP: CANNOT FIND ENTRY IN "]; 
        ITEM TBL$NAME   C(03,00,10);
        ITEM TBL$ZERO   U(04,00,60) = [0];
        END 
  
      $END
  
  
      CONTROL EJECT;
PROC DISSECT; 
# TITLE DISSECT - DISSECT THE CR/RAP/R SM. #
      BEGIN #DISSECT# 
  
# 
*     DISSECT - BREAK APART THE CR/RAP/R/ SM. 
* 
*     C. BRION          82/09/30. 
* 
*     THE FUNCTION OF THIS PROCEDURE IS TO EXTRACT THE DYNAMIC FIELDS 
*     OF THE CR/RAP/R SM AND ENTER THEM IN A KNOWN FORMAT FOR THE 
*     PROCESSING BY THE PROC NVFARAP. 
* 
*     PROC DISSECT
* 
*     ENTRY:  
* 
*       THE CR/RAP/R SM HAS BEEN REMOVED INTO LOCAL MSGBUF. 
* 
*     EXIT: 
* 
*       THE CALLED DTE ADDRESS IN DTEA. 
*       THE FACILITY LENGTH EXTRACTED INTO FACL.
*       NUMBER OF FACILITY PAIRS IN NUMFAC. 
*       FACILITY PAIR LENGTHS IN THE FACCODE ARRAY. 
*       FACILITY PAIR PARAMETERS IN THE FACPARM ARRAY.
*       THE CALL USER DATA LENGTH IN UDATL. 
*       THE ASCII SOURCE HOST NAME IN ASCSHOST ARRAY. 
*       THE ASCII CALLED APPLICATION NAME IN ASCANAME ARRAY.
*       THE ERRCODE SETTING IF ERRORS OCCUR.
*       THE DISPLAY CALLED APPLICATION NAME IN DCDSHOST.
*       THE CALL USER DATA IN THE CUD ARRAY.
# 
      CONTROL EJECT;
  
# 
*     ****  ITEM LIST ****
# 
  
  
      ITEM LEN          I;
      ITEM LEN2         I;
      ITEM FACL         I;
      ITEM FACBITS      I;
      ITEM TABSIZ       I;
      ITEM LOOPNUM      I;
      ITEM REM          I;
      ITEM W,X          I;
      ITEM BITNUM       I;
      ITEM FACTMP       I;
      ITEM DONE         B;
      ITEM FINBITS      I;
      ITEM CUDEXBIT     I;
      ITEM CUDEXORD     I;
      ITEM EXFORD,EXFBIT I; 
      ITEM STFORD,STFBIT I; 
      ITEM Z            I;
      ITEM TEMP         U;
      ITEM CHAR         U;
      ITEM SRCHOST      U;
      ITEM DSTHOST      U;
      ITEM ASANAME      U;
      ITEM DCDSHOST     U;
      ITEM DCDANAME     U;
      ITEM TEMP2        U;
      ITEM PARMLEN      U;
  
      CONTROL EJECT;
  
# 
*     **** PROC DISSECT ENTRY ****
# 
  
  
# 
      INITIALIZE THE ERROR CODE FOR EXIT. 
# 
      ERRCODE = OK$;
  
# 
      INITIALIZE THE STARTING WORD AND BIT ORDINALS FOR THE CALLED DTE
      ADDRESS.  EXTRACT THE CALLED DTE ADDR FROM THE CR/RAP SM. 
# 
  
      EXORD = 2;
      EXBIT = 40; 
      DTEBITS = (((CRRAL2[0] + 1)/2)*2)*4;
      SSBEBF(APSM[0],EXORD,EXBIT,DTEBITS,DTEA); 
  
# 
      DETERMINE THE STARTING WORD ORDINAL AND BIT ORDINAL FROM THE
      WORD 2 OF THE SM AREA WHERE THE FACILITY LENGTH WOULD START.
# 
      LEN = 40 + ((((CRRAL1[0]+CRRAL2[0])+1)/2)*2)*4; 
      LEN2 = LEN / 60;
      EXBIT = LEN - (LEN2 * 60);
      EXORD = 2 + LEN2; 
  
# 
      EXTRACT THE FACILITY LENGTH OCTET.
# 
  
      SSBEBF(APSM[0],EXORD,EXBIT,8,FACL); 
      FACBITS = FACL * 8; 
      NORMBITS = LEN + FACBITS + 8; 
      NUMFACS = 0;
# 
      IF FACILITIES ARE REQUESTED IN THE SM THEN DETERMINE THE SIZE OF
      THE FACTAB MANAGED TABLE AND EXTRACT THE FACL LENGTH NUMBER OF
      BITS INTO THE TABLE.
# 
  
      IF FACL NQ 0
      THEN
        BEGIN 
        IF FACL LS 8
        THEN
          TABSIZ = 1; 
        ELSE
          TABSIZ = 1 + (FACBITS/60);
  
        SSTATS(P<FACTAB>,TABSIZ); 
  
  
# 
      THE FACILITY FIELDS MUST BE EXTRACTED FROM THE SM AREA AND STORED 
      INTO THE FACTAB MANAGED TABLE.
  
      DETERMINE THE VALUES NEEDED TO MOVE THE BITS INTO FACTAB FROM 
      THE SM AREA.
  
# 
  
        LOOPNUM = FACBITS / 60; 
        IF FACBITS LS 60
        THEN
          REM = FACBITS;
        ELSE
          REM = FACBITS - (LOOPNUM * 60); 
  
        IF REM NQ 0 
        THEN
          LOOPNUM = LOOPNUM + 1;
  
        SORD = 0; 
        SBIT = 0; 
  
# 
      EXTRACT AND STORE THE FACILITY BITS.
# 
  
        FOR W = 1 STEP 1 UNTIL LOOPNUM
        DO
          BEGIN 
  
          IF W EQ LOOPNUM 
          THEN
            BITNUM = REM; 
          ELSE
            BITNUM = 60;
  
          SSBEBF(APSM[0],EXORD,EXBIT,BITNUM,FACTMP);
          SSBSBF(FACTAB[0],SORD,SBIT,BITNUM,FACTMP);
          END 
  
# 
      THE ENTIRE FACILITY PAIR GROUPS HAVE BEEN MOVED INTO FACTAB.
      NOW, MUST SEPARATE EACH PAIR INTO THE FACCODE AND FACPARM ARRAYS. 
      EACH FACILITY PAIR CONSISTS OF A CODED LENGTH OCTET. THERE ARE
      4 POSSIBLE VALUES - 
  
        00XXXXXX = 1 OCTET PARAMETER LENGTH.
        01XXXXXX = 2 OCTET PARAMETER LENGTH.
        10XXXXXX = 3 OCTET PARAMETER LENGTH.
        11XXXXXX = VARIABLE NUMBER OCTET PARAMETER LENGTH.
                   FOLLOWING OCTET CONTAINS THE NUMBER OF OCTETS IN THE 
                   PARAMETER FIELD. 
                   **** MAX IS 4 OCTETS FOR CDC CURRENTLY ****
  
# 
  
        DONE = FALSE; 
        FINBITS = 0;
        EXFORD = 0; 
        EXFBIT = 0; 
  
        FOR X = 0 STEP 1 WHILE
         ((NOT DONE) AND
          (X LS MAXFACN$))
        DO
          BEGIN 
          TEMP = 0; 
          TEMP2 = 0;
  
# 
      GET THE FACILITY LENGTH CODE OCTET. 
# 
  
          SSBEBF(FACTAB[0],EXFORD,EXFBIT,8,TEMP); 
          STFORD = 0; 
          STFBIT = 52;
          FACC$WORD[X] = 0; 
  
# 
      STORE THE LENGTH CODE INTO THE CODE ARRAY.
# 
  
          SSBSBF(FACCODE[X],STFORD,STFBIT,8,TEMP);
          PARMBIT = ((FACC$LEN[X] + 1) * 8);
# 
      IF A VARIABLE LENGTH PARAMETER FIELD, MUST DETERMINE THE LENGTH 
      FROM THE NEXT SUBSEQUENT OCTET. 
# 
  
          IF PARMBIT EQ VARPARM$
          THEN
            BEGIN 
            TEMP = 0; 
            SSBEBF(FACTAB[0],EXFORD,EXFBIT,8,TEMP); 
            STFORD = 0; 
            STFBIT = 52;
            SSBSBF(FACCODE[X],STFORD,STFBIT,8,TEMP);
            PARMBIT = FACC$VLEN[X] * 8; 
  
# 
      MAX SIZE FOR ANY PARAMETER FIELD IS 4 OCTETS (32 BITS). 
      IF LARGER ENCOUNTERED, SET CONDITIONS SO THAT THE SCAN ENDS AND 
      THE ERRCODE IS SET TO TERMINATE THE PROCESSING AND RETURN AN
      CR/RAP/A RESPONSE, RC=INVALID REQUEST.
# 
            IF PARMBIT GR 32
            THEN
              BEGIN 
              ERRCODE = RCRA"XFP";
              PARMLEN = PARMBIT;
              PARMBIT = 32; 
              FINBITS = FACBITS;         # FORCES END TO LOOP # 
              END 
            ELSE
              FINBITS = FINBITS + PARMBIT + 16; 
            END 
          ELSE
            FINBITS = FINBITS + PARMBIT + 8;
  
          FACC$BLEN[X] = PARMBIT; 
  
# 
      READY TO EXTRACT THE FACILITY PARAMETER FIELD.
# 
  
          TEMP = 0; 
          SSBEBF(FACTAB[0],EXFORD,EXFBIT,PARMBIT,TEMP); 
  
# 
      STORE THE PARAMETER FIELD INTO THE FACPARM ARRAY. 
# 
          TEMP2 = 0;
          STFORD = 0; 
          STFBIT = 0; 
          SSBSBF(TEMP2,STFORD,STFBIT,PARMBIT,TEMP); 
          B<0,PARMBIT>FACP$PARM[X] = B<0,PARMBIT>TEMP2; 
  
# 
      IF NUMBER OF BITS MOVED EQUALS NUMBER OF BITS IN SM, THEN DONE. 
# 
  
          IF FINBITS EQ FACBITS 
          THEN
            DONE = TRUE;
  
          END 
  
        NUMFACS = X;
  
  
# 
      RELEASE THE FACTAB SPACE
# 
  
        SSTRTS(P<FACTAB>,0,TABSIZ); 
  
        END # IF FACL NQ 0 #
  
# 
      SAVE THE CURRENT WORD AND BIT POSITION IN THE CR/RAP SM.  THIS IS 
      WHERE THE CALL USER DATA STARTS.
# 
  
      CUDEXBIT = EXBIT; 
      CUDEXORD = EXORD; 
  
# 
      EXTRACT THE CALL USER DATA LENGTH, ASCII SOURCE HOST, ASCII 
      DESTINATION HOST AND THE ASCII CALLED APPLICATION NAME. 
  
      ADVANCE THE EXTRACTION VECTORS PAST THE PRID FIELD. 
# 
  
      UDATL = 0;
      TEMP = 0; 
      SSBEBF(APSM[0],EXORD,EXBIT,24,TEMP);
      SSBEBF(APSM[0],EXORD,EXBIT,8,UDATL);
      SSBEBF(APSM[0],EXORD,EXBIT,24,SRCHOST); 
      SSBEBF(APSM[0],EXORD,EXBIT,16,DSTHOST); 
      SSBEBF(APSM[0],EXORD,EXBIT,56,ASANAME); 
      P<ASCANAME> = LOC(ASANAME); 
      P<ASCSHOST> = LOC(SRCHOST); 
      P<ANAMEDCD> = LOC(DCDANAME);
      P<SHOSTDCD> = LOC(DCDSHOST);
  
# 
      CONVERT THE RHID TO DCD.
# 
  
      SORD = 0; 
      SBIT = 0; 
      EXFORD = 0; 
      EXFBIT = 36;
  
  
      FOR Z = 1 STEP 1 UNTIL 3
      DO
        BEGIN 
        SSBEBF(SRCHOST,EXFORD,EXFBIT,8,CHAR); 
        CHAR = SSDCAD(CHAR);
        SSBSBF(DCDSHOST,SORD,SBIT,6,CHAR);
        END 
# 
      CONVERT THE CALLED APPLICATION NAME TO DCD. 
# 
  
      SORD = 0; 
      SBIT = 0; 
      EXFORD = 0; 
      EXFBIT = 4; 
  
  
      FOR J = 1 STEP 1 UNTIL 7
      DO
        BEGIN 
        SSBEBF(ASANAME,EXFORD,EXFBIT,8,CHAR); 
        CHAR = SSDCAD(CHAR);
        SSBSBF(DCDANAME,SORD,SBIT,6,CHAR);
        END 
  
# 
      IF CALL USER DATA EXISTS, EXTRACT IT FROM THE CR/RAP/R SM AND 
      STORE IT IN THE CUD.
# 
  
      IF UDATL NQ 0 
      THEN
        BEGIN 
  
# 
        THE MAX SIZE FOR THE CALL USER DATA IS 124 OCTETS.  SET THE 
        ERROR CODE IF THIS SIZE IS EXCEEDED.
# 
  
        IF UDATL GR MXCUDOCT$ 
        THEN
          BEGIN 
          ERRCODE = RCRA"XUD";
          END 
        ELSE
          BEGIN 
  
# 
          INITIALIZE THE WORD AND BIT LOCATIONS FOR STORING THE DATA. 
          CALCULATE THE NUMBER OF BITS TO STORE.
# 
  
          SORD = 0; 
          SBIT = 0; 
          UDATBITS = UDATL * 8; 
          J = UDATBITS; 
          TEMP = 0; 
  
          FOR I = 0 WHILE J GR 0
          DO
            BEGIN 
            IF J GR 60
            THEN
              BEGIN 
              K = 60; 
              J = J - 60; 
              END 
            ELSE
              BEGIN 
              K = J;
              J = 0;
              END 
            SSBEBF(APSM[0],CUDEXORD,CUDEXBIT,K,TEMP); 
            SSBSBF(CUD[0],SORD,SBIT,K,TEMP);
            TEMP = 0; 
            END 
          END 
        END 
  
      END #DISSECT# 
      CONTROL EJECT;
PROC CHEKFAC(PC); 
# TITLE CHEKFAC - CHECK FACILITIES #
      BEGIN 
  
# 
*     CHEKFAC - GENERATE FACILITIES.
* 
*     C. BRION      83/03/25. 
* 
*     THE FUNCTION OF THIS INTERNAL PROCEDURE IS TO QUALIFY THE 
*     RECEIVED OPTIONAL USER FACILITIES OF THE CR/RAP/R SM. 
*     THIS ROUTINE WILL ALSO SET THE RETURN USER FACILITIES IN THE
*     CR/RAP/N SM AREA OF THE PAAC ENTRY IF NEGOTIATION OF THE USER 
*     FACILITY IS WARRANTED. THIS ROUTINE WILL NOT ALLOW CERTAIN
*     FACILITITES TO BE USED IF NOT SPECIFIED IN THE INCALL BLOCK 
*     THAT IS CURRENTLY BEING SCANNED FOR QUALIFICATION.
* 
*     PROC CHEKFAC(PC)
* 
*     ENTRY:  
* 
*      PC      = THE CURRENT INDEX OF THE PAAC ENTRY FOR THIS CON-
*                NECTION REQUEST. 
* 
*     EXIT: 
* 
*      THE GLOBAL FACREJ WILL BE SET ACCORDINGLY: 
* 
*        IF THE FACILITY IS NOT ALLOWED, FACREJ IS SET TO TRUE. 
*        OTHERWISE, THE FACILITIES ARE ALLOWED AND/OR NEGOTIATED. 
* 
*        THE CR/RAP/SM RESPONSE FOR FACILITY NEGOTIATED PARAMETERS WILL 
*        BE SET UP IN THE PAAC ENTRY. 
# 
  
  
# 
*     A CHECK OF THE TYPE OF FACILITY IN THE CR/RAP/R IS MADE.  IF
*     REVERSE CHARGING OR FAST SELECT USER FACILITY IS REQUESTED AND NOT
*     DEFINED IN THE INCALL BLOCK, THE QUALIFICATION OF THIS INCALL 
*     BLOCK HAS FAILED. 
* 
*     IF THE REQUESTED FACILITY IS EITHER WINDOW SIZE OR PACKET SIZE THEN 
*     FOR THE FACILITIES DEFINED IN THE INCALL BLOCK, THE SMALLER VALUE 
*     OF THE REQUESTED IN, REQUESTED OUT AND DEFINED VALUE IS USED AS 
*     THE VALUE TO BE NEGOTIATED. IF THE NEGOTIATED VALUE IS LESS THAN THE
*     REQUESTED VALUE, FACILITY NEGOTIATION ON THE RESPONSE (CALL CONNECTED 
*     PACKET - CR/RAP/N SM) MUST BE PERFORMED.
* 
*     IF THE FACILITY IS NOT REVERSE CHARGING, FAST SELECT, WINDOW SIZE,
*     OR PACKET SIZE, THEN THE INCALL BLOCK IS SEARCHED FOR A MATCHING
*     FACILITY.  IF A MATCH IS FOUND, THE FACILITY PARAMETERS MUST
*     MATCH.  IF A MATCH IS NOT FOUND OR IF THE FACILITY PARAMETERS DO
*     NOT MATCH, THEN QUALIFICATION OF THIS INCALL BLOCK HAS FAILED.
# 
      CONTROL EJECT;
# 
*     DEFINITIONS AND ITEM DECLARATIONS 
# 
      DEF COLLECT$      # 01 #;          # REV CHARGE CODE #
      DEF COLLREQ$      # 01 #;          # COLLECT REQ PARM # 
      DEF DEFPKTSIZ$    # 07 #;          # DEFAULT PACKET SIZE (128) #
      DEF DEFWSIZE$     # 02 #;          # DEFAULT WINDOW SIZE #
      DEF FASCOL1$      # X"81" #;       # COLLECT AND FASTSEL COMBINED#
      DEF FASCOL2$      # X"C1" #;       # COLLECT AND FASTSEL COMBINED#
      DEF FAST$         # 01 #;          # FAST SELECT CODE # 
      DEF FSEL1$        # X"80" #;       # FAST SEL REQ 1 # 
      DEF FSEL2$        # X"C0" #;       # FAST SEL REQ 2 # 
      DEF PKTSIZ$       # X"42" #;       # PKT SIZE CODE #
      DEF PKTSIZL$      # 3 #;           # OCTET LEN OF PKT SIZE FAC #
      DEF TELCODE$      # X"00" #;       # TELENET FACILITY CODE #
      DEF TELPARM$      # X"21" #;       # TELENET FACILITY PARAM # 
      DEF TPKTSIZ$      # X"06" #;       # TELENET PACKET SIZE CODE # 
      DEF TPKTSIZL$     # 2 #;           # OCTET LEN TELENET PKTSIZ FAC#
      DEF TWSIZE$       # X"05" #;       # TELENET WINDOW SIZE CODE # 
      DEF TWSIZEL$      # 2 #;           # OCTET LEN OF TELNET WSIZ FAC#
      DEF WSIZE$        # X"43" #;       # WIN SIZE CODE #
      DEF WSIZEL$       # 3 #;           # OCTET LEN OF WSIZE FAC # 
      ITEM FACEC        I;               # FACILITY ERROR CODE #
      ITEM FACERR       B;               # ERROR CODE # 
      ITEM FCBIT        I;               # BIT ORDINAL LOC #
      ITEM FCORD        I;               # WORD ORDINAL LOC # 
      ITEM MATCHFOUND   B;               # TRUE IF MATCH ON INCALL FAC #
      ITEM NUMINFACS    I;               # NUM OF FACS IN INCALL BLOCK #
      ITEM PC           I;               # PAAC ENTRY ORDINAL # 
      ITEM PIDX         I;               # FACILITY ARRAY INDEX # 
      ITEM PKTCODE      B;               # PACKET SIZE FAC SEEN # 
      ITEM PKTIN        I;               # LOCAL RECV PKT SIZE #
      ITEM PKTOUT       I;               # LOCAL SEND PKT SIZE #
      ITEM TELENET      B;               # TRUE IF TELENET FACILITY    #
      ITEM TEMP1        U;               # TEMP VARIABLE #
      ITEM TEMP2        U;               # TEMP VARIABLE #
      ITEM TEMP3        U;               # TEMP VARIABLE #
      ITEM WINCODE      B;               # WINDOW SIZE FAC SEEN # 
      ITEM WININ        I;               # LOCAL RECV WINDOW #
      ITEM WINOUT       I;               # LOCAL SEND WINDOW #
      ITEM PARMPOS      I;  # STARTING BIT POSITION OF PARAMETER FIELD #
  
      CONTROL EJECT;
  
      WINCODE = FALSE;
      PKTCODE = FALSE;
  
# 
*     IF NO FACILITIES REQUESTED IN THE CR/RAP/R SM, THEN NO NEED TO
*     CHECK. SET THE WINDOW SIZE AND PACKET SIZE FROM THE INCALL BLOCK. 
# 
      IF NUMFACS NQ 0 
      THEN
        BEGIN 
  
# 
*     FACILITIES REQUESTED. MUST CHECK EACH FACILITY REQUESTED TO THE 
*     CURRENT INCALL BLOCK BEING QUALIFIED. 
# 
      FACERR = FALSE; 
      FACEC = 0;
      FACREJ = FALSE; 
      PA$FACWRD[PC] = FACWORD$; 
      PA$FACSBIT[PC] = FACSBIT$;
      TELENET = FALSE;
  
      FOR PIDX = 0 STEP 1 WHILE 
        PIDX LS NUMFACS AND NOT FACERR
      DO
        BEGIN 
  
# 
*     FOR EACH REQUESTED FACILITY CODE/PARAMETER GROUP, A CHECK IS
*     MADE AGAINST THE CURRENT INCALL BLOCK.
# 
  
# 
*     IF FACILITY IS FAST SELECT REQUESTED AND FAST SELECT IS NOT 
*     ALLOWED FOR THIS INCALL BLOCK, QUALIFICATION HAS FAILED.
*     COLLECT HAS THE SAME FACILITY CODE AS THE FAST SELECT.
*     HERE, IF COLLECT PARAM 01 SPECIFIED AND COLLECT NOT 
*     SPECIFIED, THEN QUALIFICATION FAILS TOO.
# 
  
        IF FACC$CODE[PIDX] EQ FAST$ 
        THEN
          BEGIN 
          IF (FACP$FREQ[PIDX] EQ FSEL1$ OR
               FACP$FREQ[PIDX] EQ FSEL2$) 
          THEN
            BEGIN 
            IF NOT INC$FAST[0]
            THEN
              BEGIN 
              FACERR = TRUE;
              FACEC = RCRA"MMF";
              GOTO ENDCHECK;
              END 
            END 
          IF (FACP$COLL[PIDX] EQ COLLREQ$)
          THEN
            BEGIN 
            IF NOT INC$COLL[0]
            THEN
              BEGIN 
              FACERR = TRUE;
              FACEC = RCRA"MMF";
              GOTO ENDCHECK;
              END 
            END 
          IF (FACP$FSCL[PIDX] EQ FASCOL1$)
             OR (FACP$FSCL[PIDX] EQ FASCOL2$) 
          THEN
            BEGIN 
            IF NOT INC$COLL[0] OR NOT INC$FAST[0] 
            THEN
              BEGIN 
              FACERR = TRUE;
              FACEC = RCRA"MMF";
              GOTO ENDCHECK;
              END 
            END 
          END 
  
# 
*     IF WINDOW SIZE FACILITY NEGOTIATION REQUESTED THEN RETURN NEGO- 
*     TIATION IS NEEDED ONLY IF THE REQUESTED SIZE IS GREATER THAN THE
*     INCALL BLOCK SPECIFIED SIZE OR IF THE RECEIVE AND SENDING SIZES ARE 
*     DIFFERENT.
* 
*     IF RETURN NEGOTIATION NEEDED, THEN THE SMALLEST VALUE OF THE REQUESTED
*     RECEIVE AND SEND AND THE SPECIFIED INCALL VALUES IS USED AS THE RETURN
*     NEGOTIATED VALUE. 
# 
        ELSE IF (FACC$CODE[PIDX] EQ WSIZE$) OR
                (TELENET AND (FACC$CODE[PIDX] EQ TWSIZE$))
        THEN
          BEGIN 
          WINCODE = TRUE; 
          WININ = INC$WR[0];
          WINOUT = INC$WS[0]; 
# 
*     IF INC$WR IS ZERO, USE INC$WS FOR BOTH VALUES.
# 
          IF INC$WR[0] EQ 0 
          THEN
            WININ = INC$WS[0];
# 
*     IF THIS IS A TELENET FACILITY, ONLY THE OUTGOING WINDOW SIZE VALUE
*     IS SPECIFIED.  USE THE DEFAULT WINDOW SIZE VALUE FOR THE INCOMING 
*     WINDOW SIZE VALUE.
# 
          IF TELENET
          THEN
            BEGIN 
            FACP$WINOUT[PIDX] = FACP$TWINOUT[PIDX]; 
            FACP$WININ[PIDX] = DEFWSIZE$; 
            END 
  
          IF FACP$WININ[PIDX] GR WININ OR 
             FACP$WINOUT[PIDX] GR WINOUT OR 
             FACP$WININ[PIDX] NQ FACP$WINOUT[PIDX]
          THEN
            BEGIN 
  
# 
*     NEGOTIATION NEEDED. INCREMENT FACILITY CODE LENGTH OCTET. 
*     SET FACILITY CODE IN TEMP ARRAY TO WINDOW SIZE. 
*     OBTAIN SMALLEST VALUE. SET WINDOW SIZE IN SM AREA OF PAAC.
*     MOVE FACILITY CODE/PARAMETER INTO PAAC SM AREA. 
# 
            IF FACP$WININ[PIDX] LS WININ
            THEN
              PA$WININ[PC] = FACP$WININ[PIDX];
            ELSE
              PA$WININ[PC] = WININ; 
            IF FACP$WINOUT[PIDX] LS WINOUT
            THEN
              PA$WINOUT[PC] = FACP$WINOUT[PIDX];
            ELSE
              PA$WINOUT[PC] = WINOUT; 
  
            FCORD = PA$FACWRD[PC];
            FCBIT = PA$FACSBIT[PC]; 
            IF NOT TELENET
            THEN
              BEGIN 
              PA$FCL[PC] = PA$FCL[PC] + WSIZEL$;
              TMP$CODE[0] = WSIZE$; 
              IF PA$WININ[PC] LS PA$WINOUT[PC]
              THEN
                BEGIN 
                TMP$WINOUT[0] = PA$WININ[PC]; 
                TMP$WININ[0] = PA$WININ[PC];
                END 
              ELSE
                BEGIN 
                TMP$WINOUT[0] = PA$WINOUT[PC];
                TMP$WININ[0] = PA$WINOUT[PC]; 
                END 
              PA$WSIZ[PC] = TMP$WININ[0]; 
              SSBSBF(PAAC[PC],FCORD,FCBIT,WSIZEL$,TMPFAC[0]); 
              END 
            ELSE
              BEGIN 
              PA$FCL[PC] = PA$FCL[PC] + TWSIZEL$; 
              TMP$CODE[0] = TWSIZE$;
              IF PA$WININ[PC] LS PA$WINOUT[PC]
              THEN
                BEGIN 
                TMP$TWINOUT[0] = PA$WININ[0]; 
                END 
              ELSE
                BEGIN 
                TMP$TWINOUT[0] = PA$WINOUT[0];
                END 
              PA$WSIZ[PC] = TMP$TWINOUT[0]; 
              SSBSBF(PAAC[PC],FCORD,FCBIT,TWSIZEL$,TMPFAC[0]);
              END 
            PA$FACWRD[PC] = FCORD;
            PA$FACSBIT[PC] = FCBIT; 
            END 
          ELSE # NO NEGOTIATION NEEDED #
            PA$WSIZ[PC] = FACP$WINOUT[PIDX];
          END 
# 
*     IF FACILITY IS PACKET SIZE, FOLLOW SAME LOGIC AS FOR WINDOW SIZE
*     FACILITY NEGOTIATION. 
# 
  
        ELSE IF FACC$CODE[PIDX] EQ PKTSIZ$
        THEN
          BEGIN 
          PKTCODE = TRUE; 
          PKTIN = INC$DPLR[0];
          PKTOUT = INC$DPLS[0]; 
# 
*     IF INC$DPLR IS ZERO, USE THE INC$DPLS VALUE FOR BOTH. 
# 
  
          IF INC$DPLR[0] EQ 0 
          THEN
            PKTIN = INC$DPLS[0];
  
          IF FACP$DPLIN[PIDX] GR PKTIN OR 
             FACP$DPLOUT[PIDX] GR PKTOUT OR 
             FACP$DPLIN[PIDX] NQ FACP$DPLOUT[PIDX]
          THEN
            BEGIN 
            PA$FCL[PC] = PA$FCL[PC] + 3;
            TMP$CODE[0] = PKTSIZ$;
            IF FACP$DPLIN[PIDX] LS PKTIN
            THEN
              PA$DPLIN[PC] = FACP$DPLIN[PIDX];
            ELSE
              PA$DPLIN[PC] = PKTIN; 
            TMP$DPLIN[0] = PA$DPLIN[PC];
            IF FACP$DPLOUT[PIDX] LS PKTOUT
            THEN
              PA$DPLOUT[PC] = FACP$DPLOUT[PIDX];
            ELSE
              PA$DPLOUT[PC] = PKTOUT; 
            TMP$DPLOUT[0] = PA$DPLOUT[PC];
            IF TMP$DPLIN[0] LS TMP$DPLOUT[0]
            THEN
              TMP$DPLOUT[0] = TMP$DPLIN[0]; 
            ELSE
              TMP$DPLIN[0] = TMP$DPLOUT[0]; 
            PA$PSIZ[PC] = TMP$DPLIN[0]; 
            FCORD = PA$FACWRD[PC];
            FCBIT = PA$FACSBIT[PC]; 
            SSBSBF(PAAC[PC],FCORD,FCBIT,PKTSIZL$,TMPFAC[0]);
            PA$FACWRD[PC] = FCORD;
            PA$FACSBIT[PC] = FCBIT; 
            END 
          ELSE # NEGOTIATION NOT NEEDED # 
            PA$PSIZ[PC] = FACP$DPLIN[PIDX]; 
          END 
# 
*     IF FACILITY IS TELENET PACKET SIZE, FOLLOW THE SAME LOGIC AS
*     FOR WINDOW SIZE FACILITY NEGOTIATION. 
# 
        ELSE IF TELENET AND 
                FACC$CODE[PIDX] EQ TPKTSIZ$ 
        THEN
          BEGIN 
  
          PKTCODE = TRUE; 
          PKTIN = INC$DPLR[0];
          PKTOUT = INC$DPLS[0]; 
# 
*     IF INC$DPLR IS ZERO, USE THE INC$DPLS VALUE FOR BOTH. 
# 
  
          IF INC$DPLR[0] EQ 0 
          THEN
            PKTIN = INC$DPLS[0];
# 
*     SINCE THIS IS A TELENET FACILITY, ONLY THE OUTGOING PACKET SIZE 
*     IS SPECIFIED.  USE THE DEFAULT PACKET SIZE VALUE FOR THE INCOMING 
*     PACKET SIZE VALUE.
* 
*     THE TELENET FACILITY PARAMTER VALUE FOR PACKET SIZE IS COMPUTED 
*     DIFFERENTLY FROM THE WAY THE INCALL VALUE FOR PACKET SIZE IS
*     COMPUTED. 
# 
          FACP$DPLOUT[PIDX] = FACP$TDPLOUT[PIDX]; 
          FACP$DPLIN[PIDX] = DEFPKTSIZ$;
  
          TEMP1 = FACP$DPLOUT[PIDX] * 16; 
          TEMP2 = 2 ** PKTOUT;
          TEMP3 = 2 ** FACP$DPLIN[PIDX];
  
          IF FACP$DPLIN[PIDX] GR PKTIN OR 
             TEMP1 GR TEMP2 OR
             TEMP1 NQ TEMP3 
          THEN
            BEGIN 
# 
*     NEGOTIATION NEEDED.  INCREMENT FACILITY CODE LENGTH OCTET.  SET 
*     FACILITY CODE IN TEMP ARRAY TO TELENET PACKET SIZE. 
# 
            PA$FCL[PC] = PA$FCL[PC] + TPKTSIZL$;
            TMP$CODE[0] = TPKTSIZ$; 
# 
*     OBTAIN SMALLEST PACKET SIZE VALUE.  SET PACKET SIZE IN SM AREA
*     OF PAAC.  MOVE FACILITY CODE/PARAMETER INTO PAAC SM AREA. 
# 
            IF FACP$DPLIN[PIDX] LS PKTIN
            THEN
              BEGIN 
              PA$DPLIN[PC] = FACP$DPLIN[PIDX];
              END 
            ELSE
              BEGIN 
              PA$DPLIN[PC] = PKTIN; 
              END 
  
            IF TEMP1 LS TEMP2 
            THEN
              BEGIN 
              PA$DPLOUT[PC] = FACP$DPLOUT[PIDX];
              END 
            ELSE
              BEGIN 
              PA$DPLOUT[PC] = PKTOUT; 
              END 
  
            IF PA$DPLIN[PC] LS PA$DPLOUT[PC]
            THEN
              BEGIN 
              TMP$TDPLOUT[0] = PA$DPLOUT[PC]; 
              END 
            ELSE
              BEGIN 
              TMP$TDPLOUT[0] = PA$DPLOUT[PC]; 
              END 
  
            PA$PSIZ[PC] = TMP$TDPLOUT[0]; 
            FCORD = PA$FACWRD[PC];
            FCBIT = PA$FACSBIT[PC]; 
            SSBSBF(PAAC[PC],FCORD,FCBIT,TPKTSIZL$,TMPFAC[0]); 
            PA$FACWRD[PC] = FCORD;
            PA$FACSBIT[PC] = FCBIT; 
            END 
          ELSE
            BEGIN 
            PA$PSIZ[PC] = FACP$DPLIN[PIDX]; 
            END 
          END 
# 
*     IF THE COMBINATION OF FACILITY CODE AND FACILITY PARAMETER
*     INDICATES THAT TELENET FACILITIES FOLLOW, SET THE TELENET FLAG. 
# 
        ELSE IF (FACC$CODE[PIDX] EQ TELCODE$) AND 
                (FACP$TELN[PIDX] EQ TELPARM$) 
        THEN
          BEGIN 
          TELENET = TRUE; 
          END 
# 
*       UNSUPPORTED FACILITY CODE.  TRY TO FIND A MATCH FOR IT IN THE 
*       INCALL BLOCK.  IF NO MATCH IS FOUND, SET ERROR FLAG.
# 
  
        ELSE
          BEGIN 
          P<INCFACS> = P<INCALL> + 8; 
          NUMINFACS = INC$FACL[0];
          MATCHFOUND = FALSE; 
  
# 
*         LOOP THROUGH THE FACILITIES IN THE INCALL BLOCK LOOKING FOR 
*         A MATCH.
# 
  
          FOR I = 0 STEP 1 WHILE
            (NOT MATCHFOUND) AND
            (I LS NUMINFACS)
          DO
             BEGIN
             IF FACC$CODE[PIDX] EQ INCF$CODE[I] 
             THEN 
  
# 
*            A MATCHING FACILITY CODE HAS BEEN FOUND.  NOW CHECK IF THE 
*            FACILITY PARAMETERS MATCH. 
# 
               BEGIN
               MATCHFOUND = TRUE; 
# 
*              FIRST FIGURE OUT THE NUMBER OF BITS IN THE PARAMETER 
*              FIELD, AND THE BIT POSITION WHERE THE FIELD STARTS.
*              THESE DEPEND ON WHETHER THE FIELD HAS FIXED OR VARIABLE
*              LENGTH.
# 
               IF INCF$LEN[I] LS 3
               THEN                     # FIXED LENTGH PARAM  FIELD # 
                 BEGIN
                 PARMBIT = ((INCF$LEN[I] + 1) * 8);  # NO. OF BITS  # 
                 PARMPOS = 16;              # STARTING BIT POSITION # 
                 END
               ELSE                # VARIABLE LENTGH PARAMETER FIELD# 
                 BEGIN
                 PARMBIT = INCF$VLEN[I] * 8;         # NO. OF BITS  # 
                 PARMPOS = 24;              # STARTING BIT POSITION # 
                 END
  
# 
*              THE LENGTH OF THE PARAMETERS ARE NOT THE SAME.  SET THE
*              ERROR FLAG.
# 
  
               IF PARMBIT NQ FACC$BLEN[PIDX]
               THEN 
                 BEGIN
                 FACERR = TRUE; 
                 FACEC = RCRA"MMF"; 
                 GOTO ENDCHECK; 
                 END
  
# 
*              THE FACILITY PARAMETER VALUES DO NOT MATCH.  SET THE 
*              ERROR FLAG.
# 
  
               IF B<0,PARMBIT>FACP$WORD[PIDX] NQ
                  B<PARMPOS,PARMBIT>INCF$WORD[I]
               THEN 
                 BEGIN
                 FACERR = TRUE; 
                 FACEC = RCRA"MMF"; 
                 GOTO ENDCHECK; 
                 END
               END
             END
  
# 
*         NO MATCHING FACILITY CODE WAS FOUND.  SET THE ERROR FLAG. 
# 
  
          IF NOT MATCHFOUND 
          THEN
            BEGIN 
            FACERR = TRUE;
            FACEC = RCRA"NMF";
            GOTO ENDCHECK;
            END 
  
          END 
        END # FOR LOOP #
      END # IF NUMFACS NQ 0 # 
  
# 
*     IF NO FACS DEFINED OR WINDOW SIZE FAC NOT SEEN, MUST
*     SET THE WINDOW SIZE FROM THE INCALL BLOCK.
# 
  
      IF NUMFACS EQ 0 OR
        NOT WINCODE 
      THEN
        BEGIN 
        WININ = INC$WR[0];
        WINOUT = INC$WS[0]; 
        IF INC$WR[0] EQ 0 
        THEN
          WININ = INC$WS[0];
        IF WININ LQ WINOUT
        THEN
          PA$WSIZ[PC] = WININ;
        ELSE
          PA$WSIZ[PC] = WINOUT; 
        END 
  
# 
*     IF NO FACILITIES OR PACKET SIZE FAC NOT SEEN, MUST SET
*     PACKET SIZE FROM INCALL BLOCK.
# 
      IF NUMFACS EQ 0 OR
        NOT PKTCODE 
      THEN
        BEGIN 
        PKTIN = INC$DPLR[0];
        PKTOUT = INC$DPLS[0]; 
        IF INC$DPLR[0] EQ 0 
        THEN
          PKTIN = INC$DPLS[0];
        IF PKTIN LQ PKTOUT
        THEN
          PA$PSIZ[PC] = PKTIN;
        ELSE
          PA$PSIZ[PC] = PKTOUT; 
        END 
  
ENDCHECK: 
      IF FACERR 
      THEN
        BEGIN 
# 
*     ERROR OCCURRED. SET GLOBAL ERRCODE TO LOCAL FACILITY ERROR
*     CODE FACEC. 
# 
        FACREJ = TRUE;
        ERRCODE = FACEC;
        END 
      ELSE
        ERRCODE = OK$;
  
      END # CHEKFAC # 
  
   CONTROL EJECT; 
  
# 
*     **** PROC NVFARAP ENTRY START ****
# 
  
# 
      MAIN LOOP REMOVES A CR/RAP/R SM FROM THE INSMQ AND PROCESSES IT.
# 
      FOR I = 0 WHILE INSMQL NQ 0 
      DO
        BEGIN 
# 
      CLEAR THE SM AREAS. 
# 
  
      FOR IDXA = 0 STEP 1 UNTIL NMSGBUF$
      DO
        BEGIN 
        MSG$WORD[IDXA] = 0; 
        END 
  
      WCB$WORD[0] = 0;
      WCB$WORD[1] = 0;
      ABHWORD[0] = 0; 
      ABHWORD[1] = 0; 
  
  
      SSTRQE(P<INSMQ>,WCBUF,ABHBUF,MSGBUF); 
  
# 
      INIT FLAGS FOR ERREXIT CONDITIONS.
# 
  
      PACDEF = FALSE; 
      ERRCODE = OK$;
      VCBDEF = FALSE; 
  
# 
*     CHECK IF HOST IN IDLE OR DISABLED STATE. IF SO, NO
*     FURTHER CONNECTIONS ALLOWWED. SET UP ABNORMAL REASON CODE 
*     FOR SHUT HOST.
# 
  
      IF NVFSTATE 
      THEN
        BEGIN 
        ERRCODE = RCRA"IDH";
        GOTO ERREXIT; 
        END 
  
# 
      CHECK FOR AVAILABLE VCB ORDINAL 
# 
  
      NVFUAFV(VCB,ERRFLAG); 
      IF ERRFLAG
      THEN
        BEGIN 
        ERRCODE = RCRA"NVO";
        GOTO ERREXIT; 
        END 
  
  
# 
      VCB AVAILABLE, BUILD PAAC AND CLEAR IT. 
# 
  
      VCBDEF = TRUE;
      PAC = PACLNGTH / PAACSIZ$;
      SSTATS(P<PAAC>,PAACSIZ$); 
      PACDEF = TRUE;
  
      P<BPAC> = LOC(PAAC[PAC]); 
      FOR IDXA = 0 STEP 1 UNTIL (PAACSIZ$ - 1)
      DO
        BEGIN 
        BPA$WORD[IDXA] = 0; 
        END 
# 
      CALL DISSECT TO BREAK APART THE CR/RAP/R. 
# 
  
      DISSECT;
      IF ERRCODE NQ OK$ 
      THEN
        GOTO ERREXIT; 
  
# 
      INIT THE PAAC ENTRY FROM THE CR/RAP/R SM. 
# 
      PA$RHID[PAC] = SHO$HID[0];
      PA$RAPNM[PAC] = ANA$ANAME[0]; 
      PA$NACN[PAC] = CRNACN[0]; 
      PA$VCB[PAC] = VCB;
      PA$INCUR[PAC] = 0;
      PA$INNXT[PAC] = 0;
      PA$SNODE[PAC] = CRASNOD[0]; 
      PA$DNOD[PAC] = CRADNOD[0];
      PA$PORT[PAC] = CRRPORT[0];
      PA$ICMCN[PAC] = TRUE;           # THIS IS AN INCOMING CONN #
  
# 
      LOCATE THE CALLED APPLICATION IN THE AST. 
# 
  
      ASTNUM = ASTLNGTH / ASTSIZ$;
      FOR AORD = 0 STEP 1 WHILE 
        ((AORD LS ASTNUM) AND 
         (AST$ANAM[AORD] NQ ANA$ANAME[0]))
      DO
        BEGIN 
        END 
  
# 
      APPLICATION MAY NOT BE FOUND. IF SO, SET ERROR AND EXIT.
# 
  
      IF AORD EQ ASTNUM 
      THEN
        BEGIN 
        ERRCODE = RCRA"AND";
        GOTO ERREXIT; 
        END 
  
# 
*     CHECK IF THIS IS A SECONDARY APPLICATION AND IF SO, 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 
  
# 
*     CHECK IF NON REQUEST STARTABLE APPLICATION OR APPL THAT ALLOWS
*     ONLY ONE COPY ACTIVE, IS DOWN OR NOT NETTED ON.  IF SO, SET ERROR 
*     CODE AND ERREXIT. 
# 
      IF ((NOT AST$RS[AORD]) AND (AST$MXCOP[AORD] EQ 1)) AND
         (AST$DNF[AORD] OR
         (AST$JSN[AORD] EQ " "))
      THEN
        BEGIN 
        ERRCODE = RCRA"ANA";
        GOTO ERREXIT; 
        END 
# 
*     CHECK IF CALLED APPLICATION IS DISABLED 
# 
      IF AST$DIF[AORD]
      THEN                   # CALLED APPLICATION IS DISABLED          #
        BEGIN 
        ERRCODE = RCRA"ADI";
        GOTO ERREXIT; 
        END 
  
# 
*     CHECK IF REQUESTED APPL IS NS OR CS.
*     IF SO, SET NO RECEIVER ERROR STATUS AND ERROR EXIT. 
# 
      IF AST$PANAM[AORD] EQ "NS" OR 
         AST$PANAM[AORD] EQ "CS"
      THEN
        BEGIN 
        ERRCODE = RCRA"RCS";
        GOTO ERREXIT; 
        END 
  
# 
*     APPL OK SO FAR, CONTINUE LIMIT CHECK WITH MAX CONNECTION .
*     IF NON REQUEST STARTABLE APPLICATION OR APPLICATION THAT ALLOWS 
*     ONLY ONE ACTIVE COPY IS AT CONNECTION LIMIT, SET ERROR EXIT CODE
*     AND ERROR EXIT. 
# 
  
      IF ((NOT AST$RS[AORD]) AND (AST$MXCOP[AORD] EQ 1)) AND
          (AST$MCN[AORD] LQ 
           (AST$TACN[AORD] + AST$AACN[AORD] + AST$RACN[AORD]))
      THEN
        BEGIN 
        ERRCODE = RCRA"NMC";
        GOTO ERREXIT; 
        END 
  
# 
*     START THE INCALL BLOCK SEARCH.
# 
  
      FOUND = FALSE;
  
      IF INRECL GR 0
      THEN
        BEGIN 
  
# 
      INCALL BLOCKS ARE DEFINED.
      COMPARE THE REQUEST INFO WITH THE INCALL BLOCKS DEFINED LOOKING 
      FOR AN INCALL BLOCK THAT SATISFIES THE REQUEST. 
# 
        FOR XX = 0 WHILE
         ((NOT FOUND) AND 
          (PA$INNXT[PAC] LS INRECL))
        DO
          BEGIN 
          PA$INCUR[PAC] = PA$INNXT[PAC];
          P<INCALL> = (P<INREC> + PA$INCUR[PAC]); 
          PA$INNXT[PAC] = PA$INNXT[PAC] + INC$WC[0];
  
# 
      THE CALLED APPLICATION NAME, SOURCE HOST ID, SOURCE NODE, 
      DESTINATION NODE AND PORT MUST MATCH BETWEEN THE SM AND THE 
      INCALL BLOCK. 
      IF EITHER OF THE PARAMETERS IS ZERO IN THE INCALL BLOCK,
      THEN THAT PARAMETER CHECK IS BYPASSED AND NOT USED TO 
      QUALIFY THE MATCH.
# 
  
          IF INC$RANAME[0] EQ ASCA$APPL[0]
          THEN
            BEGIN 
  
            IF ((INC$SHOST[0] NQ ZSHOST$ AND
             INC$SHOST[0] EQ ASCS$HOST[0]) OR 
             INC$SHOST[0] EQ ZSHOST$) 
            THEN
              BEGIN 
              IF ((INC$SNOD[0] NQ 0 AND 
                 INC$SNOD[0] EQ PA$SNODE[PAC]) OR 
                 INC$SNOD[0] EQ 0)
              THEN
                BEGIN 
                IF ((INC$DNOD[0] NQ 0 AND 
                   INC$DNOD[0] EQ PA$DNOD[PAC]) OR
                   INC$DNOD[0] EQ 0)
                THEN
                  BEGIN 
                  IF ((INC$PORT[0] NQ 0 AND 
                     INC$PORT[0] EQ PA$PORT[PAC]) OR
                     INC$PORT[0] EQ 0)
                  THEN
                    BEGIN 
# 
*               INCALL BLOCK MATCH SO FAR. NOW CHECK IF THE CALLED
*               DTE ADDRESS IN THE CR/RAP MATCHES THE DTE ADDRESS IN
*               THE INCALL BLOCK.  ALSO CHECK IF THE FACILITIES MATCH.
# 
  
                    DTEREJ = TRUE;
                    IF (INC$DTEL[0] EQ 0) OR
                       ((CRRAL2[0] EQ INC$DTEL[0]) AND
                       (DTEA EQ B<0,DTEBITS>INC$DTEA[0])) 
                    THEN
                      BEGIN 
                      DTEREJ = FALSE; 
                      END 
  
                    CHEKFAC(PAC); 
                    IF NOT FACREJ AND NOT DTEREJ
                    THEN
                      BEGIN 
                      FOUND = TRUE; 
                      PA$STATE[PAC] = PAACST"PAAWTVAL"; 
                      END 
                    END 
                  END 
                END 
              END 
            END 
          END 
  
        END 
  
# 
*     AT THIS POINT, EITHER A MATCHING INCALL BLOCK FOUND OR NO INCALL
*     BLOCK FOUND OR INCALL BLOCKS NOT DEFINED. IF NO INCALL BLOCKS ARE 
*     DEFINED, THEN CHECK FOR SINGLE HOST INCALL REQUEST QUALIFICATION. 
*     A CALL IS QUALIFIED FOR SINGLE (OR INTRA ) HOST CALLING ATTEMPT 
*     IF THE SOURCE AND DESTINATION NODES ARE ZERO. 
# 
  
      IF NOT FOUND
      THEN
        BEGIN 
        IF PA$SNODE[PAC] EQ 0 AND PA$DNOD[PAC] EQ 0 
        THEN
  
# 
*     CALL QUALIFIES FOR SINGLE HOST. SET THE INCALL BLOCK POINTER
*     TO THE SINGLE HOST INCALL BLOCK, SET THE PAAC STATE SO IT IS
*     KNOWN A SINGLE HOST CALL IN EFFECT AND SET FOUND FLAG.
# 
  
          BEGIN 
          P<INCALL> = LOC(SHINCALL);
          PA$STATE[PAC] = PAACST"PARAP";
          FOUND = TRUE; 
          ERRCODE = OK$;
          FACREJ = FALSE; 
          END 
        END 
  
# 
*     IF NO INCALL BLOCK ASSIGNED AT THIS POINT, THEN AN UNAUTHORIZED 
*     ATTEMPT TO MAKE AN INCALL HAS OCCURRED. SET THE ERROR CODE AND
*     PROCEED TO ERROR EXIT PROCESSING. 
# 
  
      IF NOT FOUND
      THEN
        BEGIN 
        IF NOT FACREJ 
        THEN
# 
*     ERROR UNRELATED TO FACILITY TYPE OF ERROR OCCURRED. MUST BE AN
*     UNAUTHORIZED ATTEMPT. OTHERWISE ALREADY SET BY CHEKFAC PROCEDURE. 
# 
          ERRCODE = RCRA"NIM";
        GOTO ERREXIT; 
        END 
  
# 
*     MOVE THE APPROPRIATE FIELDS OF THE ASSIGNED INCALL BLOCK
*     TO THE PAAC ENTRY.
# 
  
      PA$ICWRD2[PAC] = INC$WRD2[0]; 
      PA$DBZ[PAC] = INC$DBZ[0]; 
      PA$ABL[PAC] = INC$ABL[0]; 
      PA$ICWRD3[PAC] = INC$WRD3[0]; 
      PA$FWORD[PAC] = INC$FWORD[0]; 
      PA$UWORD[PAC] = INC$UWORD[0]; 
  
# 
*     MOVE THE CALLED APPLICATION INFO INTO THE PAAC ENTRY. 
# 
  
      PA$RAPNM[PAC] = ANA$ANAME[0]; 
      PA$RAPAN[PAC] = AST$AN[AORD]; 
      PA$SWAP[PAC] = ANA$ANAME[0];
      PA$SWAPAN[PAC] = AST$AN[AORD];
  
  
# 
*     ENTER WORDS OF THE CR/RAP/N SM IN THE PAAC ENTRY. 
# 
  
      PA$RAPSM0[PAC] = SPMSG0[0]; 
      PA$RAPSM1[PAC] = PA$ICWRD2[PAC];
      IF (PA$SNODE[PAC] EQ 0 AND PA$DNOD[PAC] EQ 0) 
      THEN
        PA$DT[PAC] = DT$INTA; 
      ELSE
        PA$DT[PAC] = DT$INTE; 
# 
*     CHECK IF REQUESTED APPLICATION IS REQUEST STARTABLE OR CAN HAVE 
*     MULTIPLE COPIES.  IF SO, A CALL TO NVFUCRS IS MADE TO DETERMINE 
*     THE STATUS OF THE APPLICATION.  UPON RETURN, THE CONNECTION IS PUT
*     INTO A NETON PENDING STATE, IS CONSIDERED IN ERROR, OR IS ALLOWED 
*     THE CONNECTION. 
# 
      IF AST$RS[AORD] OR
        (AST$MXCOP[AORD] GR 1)
  
      THEN
        BEGIN 
        PORD = 0; 
        RSTAT = CONNOK$;
        CTYP = AACON$;
        NVFUCRS(AORD,PORD,RSTAT,CTYP);
        IF RSTAT EQ NETP$ 
        THEN
          BEGIN 
          PA$STATE[PAC] = PAACST"PANETP"; 
          TMB$ACN[0] = PA$NACN[PAC];
          TMB$QNUM[0] = LOC(P<AAINPQ>); 
          SSCATR(TMBBUF[0]);
          PA$SWAP[PAC] = AST$PANAM[AORD]; 
          PA$CNUM[PAC] = TMB$CNUM[0]; 
          GOTO ERREXIT; 
          END 
        IF RSTAT EQ NOCONN$ OR
           RSTAT EQ MCLIMIT$
        THEN
          BEGIN 
          ERRCODE = RCRA"ANA";
          GOTO ERREXIT; 
          END 
        IF RSTAT EQ CONNOK$ 
        THEN
          BEGIN 
          PA$RAPNM[PAC] = AST$PANAM[PORD];
          PA$RAPAN[PAC] = AST$AN[PORD]; 
          PA$SWAP[PAC] = AST$PANAM[PORD]; 
          PA$SWAPAN[PAC] = AST$AN[PORD];
          END 
  
        END 
  
      SPMSG0[1] = PA$RAPSM0[PAC]; 
      SPMSG1[1] = PA$RAPSM1[PAC]; 
      SPMSG2[1] = PA$RAPSM2[PAC]; 
      ABHWORD[1] = ABHWORD[0];
      RB[1] = TRUE; 
      CRALN[1] = 1; 
      CRVCB[1] = PA$VCB[PAC]; 
      CRICT[1] = CT8ASCII;
  
# 
*     SEND THE CR/IAP/N SM TO THE OTQ, BYPASSING THE CTQ. 
# 
  
        WCB$WORD[0] = 0;
        WCB$WC[0] = LCRRAPN + 2;
  
        ABHWORD[0] =0;
        ABHABT[0] = APPCMD; 
        ABHADR[0] = 0;
        ABHTLC[0] = LCRRAPN;
        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";
  
# 
*     CR/RAP/N SM SENT. CLEAR THE OUTGOING SM AREA AND SET UP THE 
*     CR/SWH/R SM.
# 
      IDX = (NMSGBUF$ + 1) / 2; 
      FOR J = IDX STEP 1 UNTIL NMSGBUF$ 
      DO
        BEGIN 
        MSG$WORD[J] = 0;
        END 
  
      PFCSFC[1] = CRSWH;
      CRNACN[1] = CRACN[0]; 
      CRSNAME[1] = "       "; 
      CRSWAN[1] = PA$RAPAN[PAC];
      CRSWSL[1] = AASECLEV$;
      CRDT[1] = PA$DT[PAC]; 
      CRSWDBZ[1] = PA$DBZ[PAC]; 
      CRABL[1] = PA$ABL[PAC]; 
      CRSWHID[1] = PA$URHID[PAC]; 
      CRSWUBZ[1] = PA$UBZ[PAC]; 
      CRSWUDL[1] = UDATL; 
  
# 
*     MOVE THE CALL USER DATA FROM THE CUD TO THE CR/SWH/R SM.
*     INITIALIZE THE WORD AND BIT POSITIONS FOR EXTRACTING AND STORING
*     THE DATA. 
# 
  
      IF UDATL GR 0 
      THEN
        BEGIN 
        SORD = 4; 
        SBIT = 0; 
        EXORD = 0;
        EXBIT = 0;
        TEMP = 0; 
        J = UDATBITS; 
  
        FOR I = 0 WHILE J GR 0
        DO
          BEGIN 
          IF J GR 0 
          THEN
            BEGIN 
            K = 60; 
            J = J - 60; 
            END 
          ELSE
            BEGIN 
            K = J;
            J = 0;
            END 
          SSBEBF(CUD[0],EXORD,EXBIT,K,TEMP);
          SSBSBF(APSM[1],SORD,SBIT,K,TEMP); 
          TEMP = 0; 
          END 
        END 
  
# 
*     SEND THE CR/SWH/R SM. 
# 
  
      NVFUMQE(P<CTQ>,APSM[1],APPPR$,0,LCRSWH);
  
# 
*     INCREMENT THE NUMBER OF A-A CONNECTIONS AND INCOMING CONNEC-
*     TION COUNT FOR THE CALLED APPLICATION.
# 
  
      AST$AACN[AORD] = AST$AACN[AORD] + 1;
      AST$ICCN[AORD] = AST$ICCN[AORD] + 1;  #INCR INCOMING CONN COUNT#
      IF AORD NQ PORD 
      THEN
        BEGIN 
        AST$AACN[PORD] = AST$AACN[PORD] + 1;
        AST$ICCN[PORD] = AST$ICCN[PORD] + 1;
        END 
  
  
ERREXIT:  
  
# 
*     CHECK IF AN ERROR HAS OCCURRED ALONG THE WAY. 
*     IF SO, A CR/RAP/A SM MUST BE ISSUED, AN ACCOUNT MSG IS ISSUED,
*     THE PAAC AND VCB ARE RELEASED IF WARRANTED. 
# 
  
      IF ERRCODE NQ OK$ 
      THEN
        BEGIN 
        SPMSG0[1] = 0;
        PFCSFC[1] = PFCSFC[0];
        EB[1] = TRUE; 
        CRNACN[1] = CRNACN[0];
        CRRRAP[1] = ERRCODE;
        NVFUMQE(P<CTQ>,APSM[1],APPPR$,0,LCRRAPA); 
  
# 
*     ISSUE ACCOUNT MESSAGE ONLY IF PAAC ENTRY EXISTS.
# 
  
        IF PACDEF 
        THEN
          BEGIN 
          MOVNUM = ABAR$; 
          NVFAIAM(PAC,MOVNUM);
  
# 
*     RELEASE THE PAAC ENTRY. 
# 
  
          PAC = PAC * PAACSIZ$; 
          SSTRTS(P<PAAC>,PAC,PAACSIZ$); 
          END 
  
# 
*     RELEASE THE VCB IF ASSIGNED.
# 
  
        IF VCBDEF 
        THEN
          NVFUFVO(VCB); 
        END 
  
  
      END 
  
      END # NVFARAP # 
TERM
