Retro1.org codex

*DECK HCACRQA 
USETEXT NIPDEF
USETEXT ACB 
USETEXT ACNB
USETEXT AHEADER 
USETEXT AT
USETEXT PT
USETEXT PARAMS
USETEXT SUPMSG
PRGM HCACRQA ;     # SEND CON/ACRQ/A TO APPLICATION                    #
STARTIMS; 
 #
*1DC  HCACRQA 
* 
*     1. PROC NAME           AUTHOR              DATE 
*        HCACRQA             A. BEN-ARTZI        82/05/06 
* 
*     2. FUNCTIONAL DESCRIPTION 
*        SEND CON/ACRQ/A TO APPLICATION 
* 
*     3. METHOD USED
*        ALLOCATE A BUFFER FOR MESSAGE
*        FORMAT APPLICATION BLOCK HEADER
*        FORMAT THE MESSAGE USING VALUES STORED IN THE ACNB 
*        QUEUE MESSAGE TO APPLICATION-S ACB 
* 
*     4. ENTRY PARAMETERS 
*        PARAMS1 - REASON CODE FOR CON/ACRQ/A 
*        PARAMS2 - ADDRESS OF ACNB
* 
*     5. EXIT PARAMETERS
*        NONE 
* 
*     6. COMDECKS CALLED AND SYMPL TEXTS USED 
*        NIPDEF     ACNB     AHEADER     AT     PT
*        PARAMS     SUPMSG     OSSIZE 
*       ACB 
* 
*     7. ROUTINES AND OVERLAYS CALLED 
*        MGETS - ALLOCATE A BUFFER
*        BLINK - QUEUE MESSAGE ON APPLICATION-S ACB 
*        OSCHAPP - SCHEDULE APPLICATION 
*        XTRACE - TRACE PROCEDURE CALL
* 
*     8. DAYFILE MESSAGES AND OTHER IMPORTANT INFORMATION 
*        THIS IS A SECONDARY OVERLAY CALLED BY HCSTTP.
* 
*        W A R N I N G - THIS PROGRAM CANNOT EXCEED THE SECONDARY 
*CALL OSSIZE
* 
 #
STOPIMS;
# 
      EXTERNAL VARIABLES
# 
 XREF 
   BEGIN
   PROC BLINK ;           # LINK MESSAGE ON APPLICATION"S ACB          #
   PROC MGETS ;           # ALLOCATE A BUFFER                          #
   PROC OSCHAPP;          # SCHEDULE APPLICATION                       #
   PROC XTRACE;           # DEBUG TRACE CALL                           #
   LABEL RJMAIN;
   END
# 
      INTERNAL VARIABLES
# 
      DEF X25RC  # 214 #; # REASON CODE X"D6" FOR X25 TROUBLE          #
      ITEM  BUFADDR  ;    # HOLD SM BUFFER ADDRESS                     #
#**********************************************************************#
      BEGIN 
      CONTROL IFEQ DEBUG,1 ;
        XTRACE("ACRQA")    ;
      CONTROL FI           ;
# 
      ALLOCATE BUFFER 
# 
      MGETS( LCONACA + BLKHSIZE + ABHSIZE,BUFADDR,TRUE) ; 
# 
      SET APPLICATION BLOCK HEADER
# 
      P<AHEADER>  =  BUFADDR + BLKHSIZE ; 
      ABHABT[0]  = APPCMD ; 
      ABHACT[0]  = CT60TRANS; 
      ABHTLC[0]  = LCONACA  ; 
# 
      SET THE MESSAGE 
# 
      P<SUPMSG>  =  BUFADDR + BLKHSIZE + ABHSIZE ;
      PFCSFC[0] = CONACRA  ;
      IF PARAMS1 EQ RCCB"LLF"    # IF REASON CODE OBTAINED FROM CRCB   #
      THEN
        BEGIN 
        CONRAC[0] = RCIA"NLL";   # MAP TO REASON CODE H"23"            #
        END 
      ELSE
        BEGIN 
        IF PARAMS1 EQ RCCB"I"    # IF REASON CODE IS 9 FROM TCNTA      #
        THEN                     # WHICH IS THEN COPYIED TO CRCB       #
          BEGIN 
          CONRAC[0] = X25RC;     # MAP TO 214 AS X.25 PROBLEM          #
          END 
        ELSE
          BEGIN 
          CONRAC[0] = PARAMS1  ;   #   REASON CODE FOR ABNORMAL        #
          END 
        END 
      P<ACNB>   = PARAMS2  ;     # BASE ACNB                           #
      CONANM[0] = ACNBANM[0]  ;  # NAME OF APPLICATION FROM CON/ACRQ/R #
      CONHID[0] = ACNBHID[0]  ;  # HOST DESTINATION                    #
      CONAABN[0] = ACNBABN[0];  # APPLICATION BLOCK NUMBER             #
# 
      AND QUEUE IT TO THE APPLICATION"S ACB 
# 
      P<ACB> = ATACBA[ACNBIAN];  # ADDRESS OF ACB                      #
      BLINK(BUFADDR,P<ACB>);     # QUEUE SUP MSG TO ACB                #
      OSCHAPP(P<ACB>);           # SWAPIN APPLICATION                  #
      ACBERCNT[0] = ACBERCNT[0] + 1;   # INCRE CNT OF CON/ACRQ/A QUEUED#
      GOTO RJMAIN ; 
      END 
TERM