*DECK DB$DRAR 
USETEXT CDCSCTX 
      PROC DB$DRAR ( ERRBLKA ); 
      BEGIN 
 #
* *   DB$DRAR - DOWN AND RETURN AREA             PAGE  1
* *   D E TRIGLIA/W P CEAGLIO                    DATE  02/06/81 
* 
* DC  PURPOSE 
* 
*     DOWN AN AREA AND RETURN ITS ASSOCIATED FILES. 
* 
* DC  ENTRY CONDITIONS
* 
* D   PARAMETERS
# 
      ITEM ERRBLKA I;        # LOCATION OF ERROR BLOCK FILLED WITH     #
                             # ERROR INFORMATION                       #
# 
* D   ASSUMPTIONS 
* 
*     P<OFT> IS SET FOR AREA. 
*     OFUFT[0] IS SET IF UFT EXISTS, OTHERWISE IS ZERO. 
* 
* DC  EXIT CONDITIONS 
* 
*     DB$AREH HAS BEEN CALLED TO PRINT THE ERROR MESSAGE. 
*     THE CONTENTS OF THE ERROR BLOCK ARE ZERO. 
*     THE AREA HAS BEEN CLOSED IF IT WAS OPENED.
*     THE UFT HAS BEEN DELINKED.
*     THE AREA STATUS HAS BEEN SET TO *ERRDOWN*.
*     IF CDCS IS EXECUTING IN SYSTEM RECOVERY MODE, THE AREA AND INDEX
*     FILES HAVE BEEN RETURNED AND THE OFT HAS BEEN CONVERTED TO A DUMMY
*     ENTRY.
* DC  CALLING ROUTINES
* 
*     DB$ACAI      DOWN DUE TO ATTACH ERRORS
*     DB$OCAR      DOWN DUE TO CRM OPEN ERROR OR DBP LOAD ERROR 
*     DB$QRFA      DOWN DUE TO ERRORS IN QRF APPLICATION
*     DB$RFOR      DOWN DUE TO ERRORS ON ROLL FORWARD 
* 
* DC  CALLED ROUTINES 
* 
# 
      XREF PROC CLOSEM;            # CRM CLOSE INTERFACE ROUTINE       #
      XREF PROC DB$AREH;           # AUTO RECOVERY ERROR HANDLER       #
      XREF PROC DB$FLOP;           # GENERATE A FLOW POINT             #
      XREF PROC DB$LNKD;           # DELINK UFT FROM CHAIN             #
      XREF PROC DB$POP;            # RESTORE VARIABLE FROM RCB STACK   #
      XREF PROC DB$PUSH;           # SAVE VARIABLE IN RCB STACK        #
      XREF PROC DB$RTN;            # RETURN DATA AND INDEX FILES       #
# 
* 
* DC  NON-LOCAL VARIABLES MODIFIED
* 
*     OFT (CDCSCOMMN) 
*        OFSTATUS 
*        OFDUMY 
*        OFCOMP 
*     AUTO RECOVERY ERROR BLOCK 
*        ENTIRE BLOCK SET TO ZEROES 
* 
* DC  DESCRIPTION 
* 
*     -  CALL DB$AREH TO PRINT AN ERROR MESSAGE.  ZERO OUT THE ERROR
*        BLOCK. 
* 
*     -  IF A UFT EXISTS, THEN IF THE AREA IS OPEN, CLOSE IT, AND THEN
*        DELINK THE UFT FROM THE UFT CHAIN. 
* 
*     -  SET THE OFT STATUS TO *ERRDOWN*. 
* 
*     -  IF CDCS IS EXECUTING IN SYSTEM RECOVERY MODE, RETURN THE DATA
*        FILE, RETURN THE INDEX FILE IF IT EXISTS, AND CONVERT THE OFT
*        TO A DUMMY OFT.
* 
 #
      CONTROL EJECT;
  
#     NON-LOCAL VARIABLES REFERENCED                                   #
  
      XREF ARRAY DB$RA0;;    # PARAMETER LIST TERMINATOR               #
  
#     LOCAL VARIABLES                                                  #
  
      ITEM INDEX I;          # FOR LOOP INDEX                          #
  
      BASED ARRAY FIT;;      # FIT FOR CRM CALL                        #
  
*CALL SRERRDCLS 
  
      CONTROL EJECT;
  
# S T A R T   O F   D B $ D R A R   E X E C U T A B L E   C O D E      #
  
      CONTROL IFGR DFFLOP,0;
        DB$FLOP("DRAR");               # GENERATE A FLOW POINT         #
      CONTROL ENDIF;
  
#     CALL DB$AREH TO PRINT ERROR MESSAGE.                             #
  
      DB$AREH(ERRBLKA); 
  
      P<SRERRBLK> = ERRBLKA;
  
      FOR INDEX = 0 STEP 1 UNTIL DFSRESIZE - 1
      DO
        BEGIN 
        SREWORD[INDEX] = 0;            # ZERO OUT ERROR BLOCK          #
        END 
  
#     IF A UFT EXISTS, DELINK IT FROM THE UFT CHAIN.                   #
  
      P<UFT> = LOC(OFUFT[0]); 
      FOR INDEX = INDEX WHILE OFUFT[0] NQ DFNPTR
      DO
        BEGIN 
        P<UFT> = UFNEXT[0]; 
        IF UFFITOC[0] EQ DFFITOCOPEN   # CLOSE FILE IF AND ONLY IF OPEN#
        THEN
          BEGIN 
          UFFITFNF[0] = FALSE;
          P<FIT> = LOC(UFFIT[0]); 
          DB$PUSH(P<UFT>);
          CLOSEM(FIT,DFFITCFDET,DB$RA0);
          DB$POP(P<UFT>);              # A CRM CALL TO DB$QRF MAY HAVE #
                                       # CAUSED SCHEDULER TO SET       #
                                       # P<UFT> INCORRECTLY            #
          END 
        IF LOC(UFT) NQ LOC(OFUFT[0])
        THEN
          BEGIN 
          DB$LNKD(P<UFT>);
          END 
        ELSE
          BEGIN 
          UFWORD[0] = DFNPTR; 
          END 
        P<UFT> = LOC(OFUFT[0]); 
        END 
      P<UFT> = DFNPTR;
  
#     SET THE AREA STATUS TO *ERRDOWN*.                                #
  
      OFSTATUS[0] = S"ERRDOWN"; 
  
#     RETURN DATA AND INDEX FILES IF CDCS IS EXECUTING IN SYSTEM       #
#     RECOVERY MODE.                                                   #
  
      IF SYSRECOVERY
      THEN
        BEGIN 
        DB$RTN(OFFITLFN[0]);           # RETURN DATA FILE              #
        IF OFFITXN[0] NQ 0               # IF INDEX FILE EXISTS        #
        THEN
          BEGIN 
          DB$RTN(OFFITXN[0]);            # RETURN INDEX FILE           #
          END 
  
#       CONVERT THE OFT TO A DUMMY ENTRY.  ALSO, RESET THE COMPLETION  #
#       FLAG TO *FALSE*.                                               #
  
        OFDUMY[0] = TRUE; 
        OFCOMP[0] = FALSE;
         END
  
      END 
      TERM; 
