*DECK HLGLERR 
USETEXT NIPDEF
USETEXT ACB 
USETEXT AHEADER 
USETEXT APPSTAT 
USETEXT AT
USETEXT AWLNTRY 
USETEXT DRHDR 
USETEXT NWLNTRY 
USETEXT PARAMS
USETEXT PT
USETEXT SUPMSG
      PRGM HLGLERR;          # FORM LOGICAL ERROR MESSAGE              #
  
STARTIMS;                                                                NAMA378
 #
*1DC  HLGLERR                                                            NAMA378
*                                                                        NAMA378
*     1. PROC NAME           AUTHOR              DATE                    NAMA378
*        HLGLERR             Y. HSIEH            78/02/15 
*                                                                        NAMA378
*     2. FUNCTIONAL DESCRIPTION.                                         NAMA378
*        THIS ROUTINE IS RESPONSIBLE FOR FORMATTING A LOGICAL ERROR      NAMA378
*        MESSAGE AND SENDING IT TO THE APPROPRIATE APPLICATION.          NAMA378
*                                                                        NAMA378
*     3. METHOD USED.                                                    NAMA378
*        FORM A LOGICAL ERROR MESSAGE WITH ERROR CODE TO THE
*        APPLICATION BY LINKING TO THE PROPER ACB.
*                                                                        NAMA378
*     4. ENTRY PARAMETERS.                                               NAMA378
*          PARAMS1           REASON CODE FOR THE ERROR
*                                                                        NAMA378
*     5. EXIT PARAMETERS. 
*          BUFADDR           LOCATION OF LOGICAL ERROR MESSAGE
*                                                                        NAMA378
*     6. COMDECKS CALLED AND SYMPL TEXTS USED.
*        ACB     AHEADER     APPSTAT
*        DRHDR     NIPDEF     NWLNTRY 
*        OSSIZE     PARAMS     SUPMSG 
*                                                                        NAMA378
*     7. ROUTINES CALLED.                                                NAMA378
*          BLINK             LINK DATA BLOCK INTO DATA RING 
*          MGETS             ALLOCATE EMPTY BUFFER
*          XTRACE            RECORD CALL                                 NAMA378
*                                                                        NAMA378
*     8. DAYFILE MESSAGES.                                               NAMA378
*          NONE                                                          NAMA378
* 
*        THIS PROGRAM IS A SECONDARY OVERLAY LOADED BY 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 SECONDARY 
*CALL OSSIZE
* 
*        THIS OVERLAY IS CALLED BY MANY ROUTINE WHICH DETECTED
*        AN APPLICATION-S LOGICAL ERRORS. 
*                                                                        NAMA378
 #                                                                       NAMA378
STOPIMS;                                                                 NAMA378
# INPUT PARAMETERS                                                     # NAMA378
                                                                         NAMA378
# OUTPUT PARAMETERS  NONE                                              # NAMA378
#                                                                        NAMA378
                    EXTERNAL VARIABLES                                   NAMA378
#                                                                        NAMA378
   XREF PROC BLINK;          # LINK DATA BLOCK INTO DATA RING          #
   XREF PROC MGETS;          # ALLOCATE EMPTY BUFFER                   #
   XREF PROC XTRACE;         # RECORD CALL                             # NAMA378
   XREF LABEL RJMAIN;        # RETURN ADDRESS IN OVLCALL               #
                                                                         NAMA378
#                                                                        NAMA378
                    LOCAL VARIABLES                                      NAMA378
#                                                                        NAMA378
  
   ITEM BUFADDR;             # ADDR OF LOGICAL ERROR BUFFER            #
   ITEM LENGTH;              # LENGTH OF BUFFER FOR LOGICAL ERROR MSG  #
   ITEM REASON;              # REASON FOR LOGICAL ERROR                #
                                                                         NAMA378
#**********************************************************************# NAMA378
                                                                         NAMA378
      BEGIN                                                              NAMA378
      CONTROL IFEQ DEBUG,1;                                              NAMA378
        XTRACE("HLGLE") ; 
      CONTROL FI;                                                        NAMA378
                                                                         NAMA378
#             SET APPLICATION ACB POINTER                              #
  
        REASON = PARAMS1;               # REASON CODE OF LOGICAL ERROR #
        P<ACB> = ACBADDR;               # APPL ACB ADDRESS             #
  
#            CHECK WHETHER LOGICAL ERROR LIMIT IS REACHED OR NOT       #
  
      IF ACBERCNT[0] LQ MAXLGERR        # NOT REACH LOGICAL ERR LIMIT  #
      THEN
        BEGIN 
        IF ACBERCNT[0] EQ MAXLGERR      # LOGICAL ERR LIMIT REACHED    #
        THEN
            REASON = RLG"IAL";
  
        ACBERCNT[0] = ACBERCNT[0] + 1;  # INCRE LOGICAL ERR COUNT      #
  
  
# 
      STEP 1  GET EMPTY BUFFER FOR LOGICAL ERROR MESSAGE
# 
  
      P<NWLENTRY> = WLADDR; 
      LENGTH      = BLKHSIZE + ABHSIZE + LERR;
      IF NWLTLC[0] EQ 0 
      THEN
        LENGTH     = LENGTH - 1;
      MGETS(LENGTH, BUFADDR, TRUE); 
# 
        STEP 2  FILL IN FIELDS IN LOGICAL ERROR MESSAGE 
# 
  
        P<AHEADER> = BUFADDR + BLKHSIZE;
        P<SUPMSG> = BUFADDR + BLKHSIZE + ABHSIZE; 
  
        ABHABT[0] = APPCMD; 
        ABHACT[0] = CT60TRANS;
        ABHTLC[0] = LENGTH - BLKHSIZE - ABHSIZE;
  
        PFCSFC[0] = ERRLGL;             # FUNCTION CODE FOR LGL/ERR MSG#
        ERRRLG[0] = REASON;             # REASON CODE                  #
  
        ERRABH[0] = NWLEABH[0];   # COPY ABH OF THE NWLENTRY IN ERROR  #
        IF NWLTLC[0] NQ 0 
        THEN
          BEGIN                   # COPY ONE WORD OF MSG FROM NWLENTRY #
          P<DRHDRWD> = 0; 
          ERRMSG[0]  = CMWORD[WLADDR + AIPHSIZE + ABHSIZE]; 
          END 
# 
        LINK LOGICAL ERROR MESSAGE INTO PCB DATA RING 
# 
        BLINK(BUFADDR,ACBADDR); 
        END 
      GOTO RJMAIN;                      # RETURN TO CALLING ROUTINE    #
      END                                                                NAMA378
TERM                                                                     NAMA378
