*DECK DAYFMSG 
USETEXT COMCBEG 
USETEXT COMADEF 
USETEXT COMACBF 
USETEXT COMACBX 
USETEXT COMADFM 
USETEXT COMAMCB 
USETEXT COMAFET 
PROC DAYFMSG(MSGORD); 
# TITLE DAYFMSG - DAYFILE A MESSAGE.  # 
  
      BEGIN  # DAYFMSG #
  
# 
**    DAYFMSG - DAYFILE A MESSAGE.
* 
*     DAYFMSG WRITES A DAYFILE MESSAGE AND ABORTS THE CONTROL POINT IF
*     ABORT FLAG IS NET.
* 
*     PROC DAYFMSG(MSGORD)
* 
*     ENTRY      MSGORD - ORDINAL OF A DAYFILE MESSAGE TO WRITE.
* 
*     EXIT       NONE.
* 
*     MESSAGES   FOR A LIST OF THE MESSAGES, SEE COMADFM. 
* 
*     PROCESS    IF DEBUG-XFR-MESSAGE FLAG IS ON
*                  OR RHF I/O ERROR MESSAGE 
*                  OR FATAL ERROR MESSAGE 
*                  OR 2-LINE MESSAGE
*                THEN 
*                  CALL SYSTEM (MSG) TO LOG DAYFILE MESSAGE.
*                IF FATAL ERROR:  
*                  CALL SYSTEM (ABT) TO ABORT JOB.
* 
# 
  
      ITEM MSGORD     I;             # MESSAGE ORDINAL #
  
# 
****  PROC DAYFMSG - XREF LIST BEGIN. 
# 
  
      XREF
        BEGIN 
        PROC CALLSYS;                # MAKES RA+1 CALLS # 
        FUNC OCTCHF     C(10);       # OCTAL DISPLAY CODE # 
        END 
  
# 
****  PROC DAYFMSG XREF LIST END. 
# 
  
      ITEM I I;                      # LOOP COUNTER # 
  
      ARRAY ABTCALL [0:0] S(1); 
        BEGIN 
        ITEM ABT$NAME   C(0,00,03) = ["ABT"]; 
        END 
  
      BASED ARRAY INPUTWORD [0:0] S(1);  # INPUT WORD # 
        BEGIN 
        ITEM INP$LH     U(0,00,30);  # LEFT HALF OF INPUT WORD #
        ITEM INP$RH     U(0,30,30);  # RIGHT HALF OF INPUT WORD # 
        END 
  
      BASED ARRAY DESTINBUFF [0:0] S(2);  # DESTINATION BUFFER AREA # 
        BEGIN 
        ITEM DES$WORD0  U(0,00,60); 
        ITEM DES$WORD1  U(1,00,60); 
        END 
CONTROL EJECT;
  
      IF DBUGXFR
        OR (MSGORD GE FIRSTRIOEO AND MSGORD LE LASTRIOEOR)
        OR (MSGORD GE FIRSTFMSGO AND MSGORD LE LASTFMSGOR)
        OR BUFF$MSGEN NE 0
      THEN
        BEGIN 
        MSG$STATWD = LOC(MSG$BUFADR);  # SET MSG PARAMETER ADDR # 
        MSG$BUFADR = LOC(BUFFORMSG);
        IF MSGORD GE FIRSTIMSGO 
          AND MSGORD LE LASTIMSGOR
        THEN
          BEGIN 
          BUFF$MSG[0] = IDFM$MSG[MSGORD]; 
          END 
  
        ELSE
          BEGIN 
          IF MSGORD GE FIRSTRIOEO 
            AND MSGORD LE LASTRIOEOR
          THEN
            BEGIN 
            BUFF$MSG2 = RIOE$MSG[MSGORD];  # DETAIL, 2D LINE #
            MSGORD    = NDRIOERR;          # RESET MESSAGE INDEX #
            BUFF$MSG  = IDFM$MSG[MSGORD];  # "RHF I/O ERROR" #
            END 
  
          ELSE
            BEGIN 
            BUFF$MSG = FDFM$MSG1[MSGORD];  # 1ST LINE # 
            BUFF$MSG2 = FDFM$MSG2[MSGORD];  # 2D LINE # 
            END 
  
          END 
  
      CONTROL IFEQ OS$NOSBE;
        IF BUFF$MSGEN NE 0         # IF LONG MESSAGE #
        THEN
          BEGIN 
          BUFF$FIPN[0] = FIPNAMC;  # RESET MESSAGE PREFIX # 
          END 
      CONTROL ENDIF;
  
        MSG$STATUS[0] = 0;
        CALLSYS(MSGCALL); 
        BUFF$MSGEN = 0;            # RESET END OF 1ST LINE #
  
      CONTROL IFEQ OS$NOSBE;
        BUFF$FIPN[0] = FIPNAME;    # RESTORE PREFIX # 
      CONTROL ENDIF;
  
        END 
  
      IF DBUGXFR
        AND MSGORD EQ NDRIOERR
      THEN
        BEGIN 
        BUFF$WD3 = 0;              # TERMINATE SHORT MESSAGES # 
        P<INPUTWORD> = P<RFET>;    # SOURCE ADDR #
        P<DESTINBUFF> = LOC(BUFF$MSG);  # DESTINATION ADDR #
        FOR I = 0 STEP 1 WHILE I LE 7 DO
          BEGIN 
          DES$WORD0 = OCTCHF(INP$LH,10);
          DES$WORD1 = OCTCHF(INP$RH,10);
          P<INPUTWORD> = P<INPUTWORD> + 1;  # NEXT SOURCE WORD #
          MSG$STATUS[0] = 0;
          CALLSYS(MSGCALL); 
          END 
  
        END 
  
  
      IF MSGORD GE FIRSTFMSGO 
      THEN
        BEGIN 
        CALLSYS (ABTCALL);           # ABORT THE CONTROL POINT #
        END 
  
      END    # DAYFMSG #
  
      TERM
