*DECK FACCHK
USETEXT COMCBEG 
    PROC FACCHK (TIN,TIL,NAM,PTF,TOT,TOL,QUAL,TXFR,ERR);
      BEGIN 
# 
**    FACCHK - CHECK FACILITIES ATTRIBUTE.
* 
*     PROC       FACCHK (TIN,TIL,NAM,PTF,TOT,TOL,QUAL,TXFR,ERR) 
* 
*     ENTRY      TIN  = INPUT TEXT
*                TIL  = INPUT TEXT LENGTH 
*                NAM  = NETWORK TYPE (NAM IF TRUE, LCN IF FALSE)
*                PTF  = APPLICATION (PTF IF TRUE, QTF IF FALSE) 
* 
*     EXIT       TOT  = OUTPUT TEXT ADDRESS 
*                TOL  = OUTPUT TEXT LENGTH
*                QUAL = "S" OR "M" (QUALIFIER). 
*                TXFR = NETXFR FACILITIES TEXT
*                ERR  = 0  ALL REQUIRED ATTRIBUTES PRESENT AND NO 
*                            INVALID ATTRIBUTES.
*                     > 0  REQUIRED ATTRIBUTES ADDED AND/OR 
*                            INVALID ATTRIBUTES REMOVED.
*                     < 0  NON-ALPHANUMERIC CHARACTERS PRESENT. 
* 
*     PROCESS 
* 
*     SET APPLICATION AND NETWORK INDEXES.
*     IF TIL .LT. 0 
*       INSTR = DEFAULT BITSTRING (REQUIRED AND VALID). 
*     ELSE
*       CALL FACDTB TO CONVERT TEXT TO BITSTRING
*     OUTSTR = INSTR .AND. DEFAULT BITS 
*     IF OUTSTR MISSING REQUIRED FACILITY OR
*        INSTR CONTAINS INVALID FACILITY
*       SET QUAL = M(ODIFY) 
*       ADD REQUIRED FACILITY BIT(S) TO OUTSTR
*       SET ERR = INVALID FACILITY BITS 
*     ELSE: 
*       SET QUAL = S(ELECT) 
*     CALL FACBTD TO CONVERT OUTSTR TO PROTOCOL TEXT (TOT)
*     OUTSTR = OUTSTR .AND. DEFAULT NETXFR BITS 
*     CALL FACBTD TO CONVERT OUTSTR TO NETXFR TEXT (TXFR) 
# 
  
      ITEM TIN        U;
      ITEM TIL        I;
      ITEM NAM        B;
      ITEM PTF        B;
      ITEM TOT        U;
      ITEM TOL        U;
      ITEM QUAL       C(1); 
      ITEM TXFR       U;
      ITEM ERR        U;
  
# 
****  XREF BEGIN
# 
      XREF
        BEGIN 
        PROC FACBTD;
        FUNC FACDTB     U;
        END 
# 
****  XREF END
# 
  
# 
*     THE FOLLOWING ARRAY DEFINES THE REQUIRED AND VALID FACILITIES 
*     USED IN APPLICATION PROTOCOL (I. E., PARAMETER 03 OF RFT AND
*     RPOS COMMANDS) BY QTF AND PTF ON THE LCN AND NAM NETWORKS.
*                 FACILITY CODES -  C (COLLECT TEXT)
*                                   M (CHECK MARK)
*                                   R (RESTART REQUEST) 
*                                   S (SEND DATA ACK) 
# 
  
      ARRAY [0:1,0:1] S(2);  # APPLIC =  ---QTF---     ---PTF---   #
        BEGIN               # NETWORK =  LCN   NAM     LCN   NAM   #
          # REQUIRED FACILITIES # 
        ITEM FACREQ     U(00,00,60) = [[    0,    0] [    0,    0]];
        ITEM FACREQ$S   B(00,19,01) = [[FALSE, TRUE] [FALSE, TRUE]]; #S#
          # VALID FACILITIES #
        ITEM FACVAL     U(01,00,60) = [[    0,    0] [    0,    0]];
        ITEM FACVAL$C   B(01,03,01) = [[FALSE,FALSE] [ TRUE, TRUE]]; #C#
        ITEM FACVAL$M   B(01,13,01) = [[FALSE, TRUE] [FALSE, TRUE]]; #M#
        ITEM FACVAL$R   B(01,18,01) = [[FALSE, TRUE] [FALSE, TRUE]]; #R#
        ITEM FACVAL$S   B(01,19,01) = [[FALSE, TRUE] [FALSE, TRUE]]; #S#
          # MAXIMUM CHARACTERS #
        ITEM FACVALTXTM I(01,48,12) = [[    0,    3] [    1,    4]];
        END 
  
# 
*     THE FOLLOWING ARRAY DEFINES THE DATA-TRANSFER (NETXFR) FACILITIES 
*     FOR LCN AND NAM NETWORKS.  (THIS IS A SUBSET OF THE PROTOCOL
*     FACILITIES.)
# 
  
      ARRAY [0:1] S(1);    # DATA-TRANSFER FACILITIES # 
        BEGIN              # NETWORK = LCN    NAM  #
        ITEM FACXFR     U(00,00,60) = [    0,    0];
        ITEM FACXFR$M   B(00,13,01) = [FALSE, TRUE];  # M # 
        ITEM FACXFR$R   B(00,18,01) = [FALSE, TRUE];  # R # 
        ITEM FACXFR$S   B(00,19,01) = [FALSE, TRUE];  # S # 
        ITEM FACXFRTXTM I(00,48,12) = [    0,    3];  # MAX CHARS # 
        END 
  
      ITEM APP        I;
      ITEM BADCHAR    U;
      ITEM EXTRA      U;
      ITEM INSTR      U;
      ITEM MISSING    U;
      ITEM NWT        I;
      ITEM OUTSTR     U;
      ITEM TC         I;
  
      APP = 0;                     # ASSUME QTF APPLICATION # 
      IF PTF
      THEN
        BEGIN 
        APP = 1;                   # RESET FOR PTF #
        END 
  
      NWT = 0;                     # ASSUME LCN NETWORK # 
      IF NAM
      THEN
        BEGIN 
        NWT = 1;                   # RESET FOR NAM #
        END 
  
      IF TIL LS 0                  # RETURN DEFAULT FACILITIES #
      THEN
        BEGIN 
        INSTR = FACVAL[NWT,APP] LAN O"37777777777740000000";
        BADCHAR = 0;
        MISSING = 0;
        END 
  
      ELSE                         # CHECK FACILITIES RECEIVED #
        BEGIN 
        INSTR = FACDTB(TIN,TIL);
        BADCHAR = INSTR LAN O"40000000000000000000";
        MISSING = FACREQ[NWT,APP] LAN (FACREQ[NWT,APP] LXR INSTR);
        END 
  
      OUTSTR  = FACVAL[NWT,APP] LAN O"37777777777740000000";
      EXTRA   = INSTR LAN (LNO OUTSTR); 
      OUTSTR = INSTR LAN OUTSTR;
      IF INSTR NQ OUTSTR
        OR MISSING NQ 0 
      THEN
        BEGIN 
        QUAL = "M"; 
        OUTSTR = OUTSTR LOR MISSING;
        MISSING = MISSING LOR EXTRA;
        END 
  
      ELSE
        BEGIN 
        QUAL = "S"; 
        END 
  
      TC = FACVALTXTM[NWT,APP]; 
      INSTR = OUTSTR LAN FACXFR[NWT]; 
      FACBTD (OUTSTR,TOT,TC);      # SET PROTOCOL FACILITIES #
      TOL = TC; 
      ERR = MISSING LOR OUTSTR LOR BADCHAR; 
  
      TC = FACXFRTXTM[NWT]; 
      FACBTD (INSTR,TXFR,TC);      # SET NETXFR FACILITIES #
      END  # FACCHK # 
  
    TERM; 
