Retro1.org codex

*DECK HDCTRU
USETEXT ACB 
USETEXT ACNB
USETEXT ACNT
USETEXT AT
USETEXT NIPDEF
USETEXT APPSTAT 
USETEXT NWLNTRY 
USETEXT OVERLAY 
USETEXT PARAMS
USETEXT PT
USETEXT SUPMSG
      PRGM HDCTRU;           # PROCESS DC/TRU/R FROM APP               #
 
*IF DEF,IMS 
 STARTIMS;
 #
*1DC  HDCTRU
* 
*     1. PROC NAME           AUTHOR              DATE 
*        HDCTRU              S. WATANABE         79/04/04 
* 
*     2. FUNCTIONAL DESCRIPTION.
*          PROCESS DC/TRU/R SUPERVISORY MESSAGE FROM APPLICATION. 
* 
*     3. METHOD USED. 
*          VALIDATE DC/TRU/R SUPERVISORY MESSAGE. 
*          IF ACN IS NON-ZERO AND ACNB IS FOUND,
*            DATA TRUNCATION FLAG IS SET IN THE  ACNB.
*          IF ACN IS ZERO,
*            DATA TRUNCATION FLAG IS SET IN THE  ACB
*            AND IN ALL ITS ACTIVE  ACNB-S. 
* 
*     4. ENTRY PARAMETERS.
*          DCACN             APPLICATION CONNECTION NUMBER
*          ACBADDR           ACB ADDRESS
*          WLADDR            WORKLIST ENTRY ADDRESS 
* 
*     5. EXIT PARAMETERS. 
*          NONE 
* 
*     6. COMDECKS CALLED AND SYMPL TEXTS USED.
*        ACB   ACNB   APPSTAT   AT        NIPDEF
*        ACNT     OVERLAY     PARAMS     SUPMSG     PT
* 
*     7. ROUTINES AND OVERLAYS CALLED.
*          HLGLERR   OVL     FORM LOGICAL ERROR MESSAGE 
*          OVLCALL           LOAD AND EXECUTE OVERLAY 
*          XTRACE            RECORD PROCESSOR CALLS 
* 
*     8. DAYFILE MESSAGES AND OTHER IMPORTANT INFORMATION.
*          NONE 
* 
*        THIS PROGRAM IS A PRIMARY OVERLAY LOADED BY SUBROUTINE OVLCALL.
*        WHEN EXECUTION HAS COMPLETED, A JUMP IS MADE TO LOCATION RJMAIN
*        TO RETURN TO THE CALLING PROGRAM.
* 
*        W A R N I N G - THIS PROGRAM CANNOT EXCEED THE PRIMARY 
*CALL OPSIZE
* 
*        THIS OVERLAY IS CALLED BY HPPUT. 
* 
 #
 STOPIMS; 
*ENDIF
# 
      EXTERNAL VARIABLES
# 
      XREF
        BEGIN 
        PROC OVLCALL;        # LOAD OVERLAY                            #
        PROC XTRACE;         # TRACE CALLS                             #
        LABEL RJMAIN;        # RETURN ADDRESS IN OVLCALL               #
        END 
# 
      INTERNAL VARIABLES
# 
      ITEM FOUND U;          # HOSTSIDE ACNB ADDRESS                   #
      ITEM INDX;             # LOOP VARIABLE                           #
#**********************************************************************#
      BEGIN 
      CONTROL IFEQ DEBUG,1; 
        XTRACE("HDCTR") ; 
      CONTROL FI; 
 
      P<SUPMSG>  = WLADDR + AIPHSIZE + ABHSIZE;  # TEXT ADDRESS        #
      P<ACB> = ACBADDR; 
      P<ACNT> = ACBACNT[0]; 
 
      IF DCACN[0] NQ 0       # ACN IS GIVEN                            #
      THEN                   # LOCATE THE ACNB                         #
        BEGIN 
        FOUND = 0;       # ZERO FOUND ITEM                             #
        IF DCACN[0] LQ ACNTHCN[0] AND DCACN[0] GQ ACNTMINACN[0] 
        THEN
          BEGIN 
          P<ACNB> = ACNTACNB[DCACN[0] + ACNTHSIZE - ACNTMINACN[0]]; 
          FOUND = P<ACNB>;
          END 
        IF FOUND EQ 0        # NO ACNB WITH THIS ACN                   #
        THEN
          BEGIN 
          PARAMS1 = RLG"ACN"; 
          OVLNAME = HLGLERRP;  # SEND LOGICAL ERROR MSG                #
          OVLCALL;
          END 
        ELSE                 # ACNB FOUND                              #
          BEGIN 
          ACNBD[0] = TRUE ; 
          END 
        END 
      ELSE                   # NO ACN SPECIFIED                        #
        BEGIN 
        ATT[ACBAN[0]] = TRUE; 
        FOR INDX = ACNTHSIZE STEP 1 UNTIL ACNTHCN[0] - ACNTMINACN[0]
                   + ACNTHSIZE
        DO
          BEGIN 
          P<ACNB> = ACNTACNB[INDX]; 
          IF P<ACNB> NQ 0 THEN
            BEGIN 
            ACNBD[0] = TRUE;
            END 
          END 
        END 
      GOTO RJMAIN;
      END 
TERM