Retro1.org codex

*DECK HBSMABH 
USETEXT NIPDEF
USETEXT ACB 
USETEXT APPSTAT 
USETEXT DUMPFLG 
USETEXT MSGIDX
USETEXT NWLNTRY 
USETEXT OVERLAY 
USETEXT PARAMS
 PROC HBSMABH(NEXTLEN);      # BUILD NEW SUP MSG APPLICATION BLK HDR   #
 
 STARTIMS;
 #
*1DC  HBSMABH 
* 
*     1. PROC NAME           AUTHOR              DATE 
*        HBSMABH             E. GEE              77/08/03 
* 
*     2. FUNCTIONAL DESCRIPTION.
*          COMPUTE LENGTH IN WORDS OF SUP MSG 
* 
*     3. METHOD USED. 
*          COMPUTE LENGTH BASED ON CHAR TYPE OF MSG 
* 
*     4.ENTRY PARAMETERS. 
*          ACBADDR           ADDR OF ACB CONTAINING SUP MSG IN DATA RING
* 
*     5. EXIT PARAMETERS. 
*          NEXTLEN           LENGTH OF SUP MSG
* 
*     6. COMDECKS CALLED AND SYMPL TEXTS USED.
*        APPSTAT   DUMPFLG   MSGIDX 
*        NIPDEF    NWLNTRY   OVERLAY   PARAMS 
*        ACB
* 
*     7. ROUTINES AND OVERLAYS CALLED.
*          OVLCALL           LOAD AND EXECUTE OVERLAY 
*          XERRMSG    OVL    ISSUE ERROR DAYFILE MESSAGE
*          XTRACE            RECORD PROCEDURE CALLS 
* 
*     8. DAYFILE MESSAGES AND OTHER IMPORTANT INFORMATION.
*          NIP FATAL ERROR PROC=HBSM. THIS MESSAGE IS ISSUED IF THE 
*        CHARACTER TYPE IS NOT 8 BIT ASCII OR 60 BIT TRANSPARENT. 
*        THIS PROCEDURE IS CALLED BY HPGETSM. 
* 
 #
 STOPIMS; 
# 
                    EXTERNAL VARIABLES
# 
 XREF 
   BEGIN
   PROC XTRACE; 
   PROC OVLCALL;
   END
# 
                    INTERNAL VARIABLES
# 
 ITEM TEMP; 
 
# OUTPUT PARAMETERS                                                    #
    ITEM NEXTLEN; 
    ITEM PNAME C(10) = "HBSM";
 
 
#**********************************************************************#
 
      BEGIN 
 
      CONTROL IFEQ DEBUG,1; 
        XTRACE("HBSMA") ; 
      CONTROL FI; 
 
      P<ACB> = ACBADDR; 
      P<NWLENTRY> = ACBDRFP[0]; 
      TEMP = NWLACT[0]; 
      IF TEMP EQ CT8ASCII 
      THEN                       # 8 BIT ASCII - 7 1/2 CHARS PER WORD  #
        BEGIN 
        NEXTLEN = (2 * NWLTLC[0] + 14) / 15;
        END 
      ELSE
        BEGIN 
          IF TEMP EQ CT60TRANS
          THEN                # 60 BIT TRANSPARENT - 1 CHAR PER WORD   #
            NEXTLEN = NWLTLC[0];
          ELSE
            BEGIN 
            DMPFLG = DHBSMAB1; # STORE REASON CODE FOR DUMPING FL      #
            PARAMS1 = DFMSG01;        # *NIP FATAL ERROR PROC=XXXX.*   #
            PARAMS6 = PNAME;          # PROC NAME = HBSM               #
            OVLNAME = XERRMSGP; 
            OVLCALL;
            END 
        END 
      NEXTLEN = NEXTLEN + ABHSIZE ; 
      RETURN; 
      END 
TERM