*DECK DUMPFL
USETEXT COMCBEG 
USETEXT COMRMEM 
USETEXT COMRFLS 
PROC DUMPFL(EXPKG,ABTFLAG,RAPLUS1); 
# TITLE DUMPFL - DUMP RHF FL DURING REPRIEVE PROCESSING. #
  
      BEGIN  # DUMPFL # 
  
# 
**    DUMPFL - DUMP RHF FL DURING REPRIEVE PROCESSING.
* 
*     DUMPS RHF FIELD LENGTH DURING REPRRIEVE PROCESSING. 
* 
*     PROC DUMPFL(EXPKG,ABTFLAG,RAPLUS1)
* 
*     ENTRY   - EXPKG IS THE ADDRESS OF THE EXCHANGE PACKAGE ARRAY. 
*               RAPLUS1 IS THE ADDRESS OF RHF FIELD LENGTH ARRAY. 
* 
*     EXIT    - RHF FIELD LENGTH DUMPED.
*               ABTFLAG LEFT AT ZERO FOR ABNORMAL JOB TERMINATION.
* 
*     PROCESS - SEND SHUT DOWN MESSAGE TO B-DISPLAY.
*               IF NOT KILL 
*               THEN
*                 TAKE FIELD LENGTH DUMP. 
*               RETURN. 
* 
# 
  
      ARRAY EXPKG [0:16] S(1);
        BEGIN 
        ITEM ERRORCODE  I(00,42,18);
        END 
      ITEM ABTFLAG    U;             # JOB TERMINATION FLAG # 
      ITEM RAPLUS1    U;             # FIELD LENGTH ADDRESS # 
  
# 
****  PROC DUMPFL - XREF LIST BEGIN.
# 
  
      XREF
        BEGIN 
        PROC CALLSYS;                # MAKE RA + 1 CALLS #
        PROC RHFMSG;                 # SEND DAYFILE MESSAGE # 
        END 
  
# 
****  PROC DUMPFL - XREF LIST END.
# 
  
  
      DEF OPKILL     #7#; 
  
      ITEM I I; 
  
      ARRAY [0:0] S(1); 
        BEGIN 
        ITEM DMPCALL    U(00,00,60) = [0];
        ITEM DMPNAME    C(00,00,03) = ["DMD"];
        ITEM DMPRCL     B(00,19,01) = [TRUE]; 
        CONTROL IFEQ OS$NOS;
        ITEM DMPFROM    U(00,24,18) = [0];
        ITEM DMPTO      U(00,42,18) = [O"377777"];
        END 
        CONTROL ENDIF;
        CONTROL IFEQ OS$NOSBE;
        ITEM DMPADDR    U(00,42,18);
        END 
  
      ARRAY [0:0] S(1); 
        BEGIN 
        ITEM DMPPARAM   U(00,00,60) = [O"0000 0000 0037 7777 0000"];
        ITEM DMPCPLT    B(00,59,01);
        END 
        CONTROL ENDIF;
  
  
CONTROL EJECT;
  
      SHUTDWN = TRUE; 
      RHFMSG(LOC(MSG$SHTDWN),MSG$SHTLGT); 
  
      IF ERRORCODE[0] NE OPKILL 
      THEN
        BEGIN 
  
      CONTROL IFEQ OS$NOSBE;
        DMPADDR = LOC(DMPPARAM);
        DMPCPLT = FALSE;
      CONTROL ENDIF;
  
        CALLSYS(DMPCALL); 
        END 
  
      RETURN; 
  
      END  # DUMPFL # 
  
      TERM
