Retro1.org codex

*DECK IPISPCA 
USETEXT TEXTIPL 
      PROC IPISPCA; 
*CALL COPYRITE          CDCNET - COPYRIGHT CONTROL DATA. 1992.
# TITLE IPISPCA - PROCESS CON/ACRQ/A SUPERVISORY MESSAGE               #
 
      BEGIN                            # IPISPCA                       #
# 
****  IPISPCA  PROCESS CON/ACRQ/A SUPERVISORY MESSAGE 
* 
*     THIS PROCEDURE PROCESSES A CON/ACRQ/A SUPERVISORY MESSAGE.
* 
*     PROC IPISPCA
* 
*     ENTRY    P<ABH>  = PTR TO INPUT APPLICATION BLOCK HEADER (*IABH*).
*              ABHABN  = C/N TYPE WHICH IS USED AS INDEX INTO ACN 
*              P<APSM> = PTR TO INPUT SUPERVISORY MESSAGE (*INPBUF*). 
*              CURACN  = FILE SERVER CONNECTION NUMBER. 
* 
*     EXIT     ISS$STATUS = APPROPRIATE STATUS OF SOCKET
* 
*     METHOD   ISSUE A DAYFILE MESSAGE TO FLAG THE PROBLEM.  SET THE
*              ABORT STATUS IN THE INITIATING SOCKET STATUS WORD. 
*              THE APPLICATION IS ABORTED IF A CONNECTION IS NOT IN 
*              THE PROCESS OF BEING ESTABLISHED.
# 
 
      DEF FATALERR       # 02 #;
# 
****  PROC IPISPCA - XREF LIST
# 
 
      XREF
        BEGIN 
        PROC IPIAIPA;    # ABORT IP APPLICATION                        #
        PROC MESSAGE;    # ISSUE DAYFILE MESSAGE                       #
        FUNC XCDD  C(10);# CONVERT INTEGER TO DECIMAL DISPLAY          #
        END 
 
      ARRAY RCMSG[00:00] S(5);         # MSG FOR CON/ACRQ/A REASON CODE#
        BEGIN 
        ITEM RCMSG$TEXT C(00,00,36)=
                                ["CONNECTION FAILED, CON/ACRQ/A, RC ="];
        ITEM RCMSG$RC   C(03,36,04);
        ITEM RCMSG$END  U(04,00,60) = [0];
        END 
 
 
      ITEM TEMPCHAR    C(10); 
# 
**
# 
      CONTROL EJECT;
# 
****  START MAIN PROCEDURE
# 
 
# 
****  DAYFILE THIS EVENT. 
# 
      TEMPCHAR = XCDD (CONRAC [0]);    # CONVERT RC TO DISPLAY CODE    #
      RCMSG$RC = C<06,04>TEMPCHAR;
      MESSAGE (RCMSG, 0);              # DAYFILE IT.                   #
 
 
      IF   (CONAABN [0] NQ CONNECTABN$) 
        OR (ISS$STATUS [0] NQ SOCKSTAT"WAIT") 
      THEN
        BEGIN                          # TREAT AS NAM PROTOCOL ERROR   #
        IPIAIPA (NCONACRQA$); 
        RETURN; 
        END 
 
      IF CONRAC2 LQ FATALERR
      THEN
        BEGIN                          # PROBABLY A CONFIGURATION ERROR#
        ISS$STATUS [0] = SOCKSTAT"CONFIGERR"; 
        END 
      ELSE
        BEGIN                          # GATEWAY PROBABLY UNAVAILABLE  #
        ISS$STATUS [0] = SOCKSTAT"UNAVGATE";
        END 
 
      RETURN;                          # RETURN TO CALLER              #
 
      END                              # IPISPCA                       #
 
      TERM