*DECK PRSTXFR 
USETEXT COMCBEG 
USETEXT COMCAPR 
USETEXT COMCCAE 
USETEXT COMQDEF 
USETEXT COMQFIL 
USETEXT COMQNET 
    PROC PRSTXFR; 
      BEGIN    # PRSTXFR #
# 
**    PRSTXFR    PROCESS STATE OF TRANSFER ATTRIBUTE. 
* 
*     PRSTXFR IS CALLED BY THE VARIOUS LEVEL 7 COMMAND
*     PROCESSORS (RCMXX) TO ANALYZE THE STATE OF TRANSFER 
*     ATTRIBUTE SENT FROM THE REMOTE APPLICATION. 
* 
*     ENTRY      ACN = AFT INDEX. 
*                ATEXTWD = STATE OF TRANSFER ATTRIBUTE. 
* 
*     EXIT       AFT UPDATED. 
*                CONERR, RCMERR, USRDSC, USRERR CALLED IF APPROPRIATE.
* 
*     PROCESS    LOOK UP PARAMETER IN TABLE.
# 
  
# 
****  XREF
# 
      XREF
        BEGIN 
        PROC CONLOG;               # LOG MESSAGE FOR CONNECTION # 
        PROC NAME;                 # DEBUG CODE # 
        PROC RCMERR;               # PROCESS PROTOCOL ERROR # 
        PROC USRDSC;               # DECREMENT SECURITY COUNT # 
        PROC USRERR;               # PROCESS USER ERROR # 
        END 
  
# 
****  XREF END
# 
  
  
      DEF MAXSTXFR   #26#;
  
      STATUS SOT                   # STATE-OF-TRANSFER ACTION # 
        OK,                        #   NO ERROR   # 
        RETRY,                     #   RETRY      # 
        ABORT,                     #   NO RETRY (EVICT FILE) #
        UNKNOWN;                   #   UNKNOWN SOT #
  
      ARRAY [0:MAXSTXFR] S(1);
        BEGIN 
        ITEM STX$CODE   C(00,00,06) = 
          ["XXXXXX",
           "000000", "000001", "011000", "011001",
           "011002", "011010", "011011", "011012",
           "011013", "011014", "011015", "011016",
           "011017", "011018", "011019", "011020",
           "011021", "022000", "022001", "033000",
           "033001", "033002", "033003", "033004",
           "033005", "033006" 
          ];
        ITEM STX$STORD  U(00,36,03) = 
          [0, 2(0), 15(1), 2(2), 7(3)]; 
        ITEM STX$SECURE B(00,39,01) = 
          [11(FALSE), 4(TRUE), 12(FALSE)];
        ITEM STX$MSGORD U(00,40,05) = 
          [1, 2(0), 8, 0, 10, 5(1), 5(7), 6, 9, 3(0), 2(5), 
           2(4), 3, 2]; 
        ITEM STX$CLASS  S:SOT(00,45,03) = 
          [S"UNKNOWN",
           S"OK",    S"OK",    S"ABORT", S"ABORT",
           S"ABORT", S"ABORT", S"ABORT", S"ABORT",
           S"ABORT", S"ABORT", S"ABORT", S"ABORT",
           S"ABORT", S"ABORT", S"ABORT", S"ABORT",
           S"ABORT", S"OK",    S"ABORT", S"OK", 
           S"RETRY", S"ABORT", S"RETRY", S"ABORT",
           S"RETRY", S"ABORT"]; 
        END 
  
      SWITCH STX$CLSW:SOT 
        STX$OK:OK,
        STX$RETRY:RETRY,
        STX$ABORT:ABORT,
        STX$UNKNOWN:UNKNOWN;
  
      ARRAY [0:10] S(3);
        BEGIN 
        ITEM STX$MSGTXT C(00,00,28) = 
          [".                           ",  # 00 #
           " - (CONTACT SITE ANALYST).  ",  # 01 #
           " - PROTOCOL ERROR.          ",  # 02 #
           " - TIME-OUT MATURED.        ",  # 03 #
           " - SENDER PROBLEMS.         ",  # 04 #
           " - RECEIVER PROBLEMS.       ",  # 05 #
           " - FILE SIZE TOO BIG.       ",  # 06 #
           " - INVALID USERNAME/ACCOUNT.",  # 07 #
           " - UNSPECIFIC TRANSFER.     ",  # 08 #
           " - QUEUE TYPE UNAVAILABLE.  ",  # 09 #
           " - UNACCEPTABLE ATTRIBUTES. "]; # 10 #
        END 
  
      ARRAY [1:3] S(1); 
        BEGIN 
        ITEM STX$STTXT  C(00,00,10) = 
          ["REJECTED  ",
           "TERMINATED",
           "ABORTED   "]; 
        END 
  
      DEF LEMSGUS    #46#;
      ITEM EMSGUS     C(LEMSGUS) =
          "UNKNOWN STATE-OF-TRANSFER SENT BY REMOTE HOST."; 
  
      DEF LEMSGST    #35#;
      ARRAY EMSGST     S(4);
        BEGIN 
        ITEM $DST       C(00,00,LEMSGST) =
          ["TRANSFER XXXXXXXXXX BY REMOTE HOST."];
        ITEM EMSGSTST   C(00,54,10);
        END 
  
      DEF LEMSGRC    #49#;
      ARRAY EMSGRC     S(5);
        BEGIN 
        ITEM $DRC       C(00,00,14) = ["REASON CODE = "]; 
        ITEM EMSGRCRC   C(01,24,06);
        ITEM EMSGRCTXT  C(02,00,28);
        END 
  
      ITEM I          I;
      ITEM NO$RNEG    B;           # NO-RNEG-PROCESSED FLAG # 
      ITEM STX        C(6); 
  
        $BEGIN
        NAME("PRSTXFR");
        $END
  
      NO$RNEG = FILE2 EQ 0; 
      STX = ATEXTWD[0]; 
      STX$CODE[0] = STX;
      I = MAXSTXFR; 
      ASLONGAS STX NE STX$CODE[I] 
      DO
        BEGIN 
        I = I - 1;
        END 
  
      IF STX$SECURE[I]
      THEN
        BEGIN 
        USRDSC;                    # DECREMENT USER SECURITY COUNT #
        END 
  
      IF NO$RNEG AND (STX$STORD[I] NE 0)
      THEN
        BEGIN 
        EMSGSTST = STX$STTXT[STX$STORD[I]]; 
        CONLOG(LOC(EMSGST),LEMSGST);
        END 
  
      EMSGRCRC = STX; 
      EMSGRCTXT = STX$MSGTXT[STX$MSGORD[I]];
      GOTO STX$CLSW[STX$CLASS[I]];
  
STX$OK: 
        GOTO STX$END; 
  
STX$RETRY:  
        IF NO$RNEG                 # IF RNEG NOT SENT NOR RECEIVED #
        THEN
          BEGIN 
          RCMERR(LOC(EMSGRC),LEMSGRC);
          END 
  
        GOTO STX$END; 
  
STX$ABORT:  
        IF NO$RNEG                 # IF RNEG NOT SENT NOR RECEIVED #
        THEN
          BEGIN 
          USRERR(LOC(EMSGRC),LEMSGRC);
          END 
  
        GOTO STX$END; 
  
STX$UNKNOWN:  
        CONLOG(LOC(EMSGUS),LEMSGUS);
        RCMERR(LOC(EMSGRC),LEMSGRC);
        GOTO STX$END; 
  
STX$END:  
#  END OF SIMULATED CASE STATEMENT #
  
      END  # PRSTXFR #
    TERM
