*DECK     DB$CLOU 
USETEXT CDCSCTX;
      FUNC DB$CLOU((ADDROFT)) B;
      BEGIN 
 #
* *   DB$CLOU - CLOSE OPEN UFT'S ON THIS AREA    PAGE  1
* *   BOB MCALLESTER                             DATE  10/30/84 
* 
* DC  PURPOSE 
* 
*     DETERMINE IF TQT USES A GIVEN AREA
*     AND CLOSE ANY INSTANCES OF OPEN.
* 
* DC  ENTRY CONDITIONS
* 
*     ASSUMPTIONS 
* 
*     SALX POINTS TO SCHEMA 
*     TQT POINTER IS SET TO RUN UNIT
* 
*     PARAMETERS
# 
      ITEM ADDROFT   I;            # INPUT PARAMETER - OFT ADDRESS     #
# 
* DC  EXIT CONDITIONS 
* 
*     THE FUNCTION VALUE IS TRUE IF AN OPEN UFT IS FOUND FOR THE AREA.
*     FALSE OTHERWISE.
* 
* DC  CALLING ROUTINES
* 
*     DB$DSCS - (DB$DS06) DOWN AN AREA
*     DB$TARE - TERMINATE RUN UNITS USING AREA
* 
* DC  CALLED ROUTINES 
# 
      XREF PROC DB$CLSA;           # CLOSE AREA                        #
      XREF PROC DB$FLOP;           # GENERATE FLOW POINT               #
      XREF PROC DB$SWPI;           # SWAP IN TABLES FOR TQT            #
# 
*     NON-LOCAL VARIABLES MODIFIED
* 
*     P<ASL>                       ASL POINTER FOR CURRENT
*                                  SUBSCHEMA
*     P<CSFIXED>                   POINTER TO FIXED CST FOR 
*                                  CURRENT SUBSCHEMA
*     P<RSARBLK>                   POINTER TO RSB AREA CONTROL BLOCK
*     P<RSB>                       RSB AREA CONTROL BLOCK POINTER FOR CU
* 
* DC  DESCRIPTION 
* 
*     IF USER'S TABLES ARE SWAPPED OUT, SWAP TABLES IN. 
*     SET RSB, ASL AND CST POINTERS.
*     SET POINTER TO AREA CONTROL BLOCK.
*     LOOP THROUGH THE AREA WORK BLOCK LOOKING FOR A POINTER TO THE 
*     SPECIFIED OFT.
*     IF THE RSARBLK POINTER TO THE UFT IS NON-ZERO, SET DB$CLOU TO 
*     TRUE AND CLOSE THE AREA.
 #
  
#     LOCAL VARIABLES                                                  #
  
      ITEM INDEX  I;               # INDUCTION VARIABLE                #
  
  
  
  
#     B E G I N   E X E C U T A B L E   C O D E   D B $ C L O U        #
  
      CONTROL IFGR DFFLOP,0;
        DB$FLOP("CLOU");
      CONTROL ENDIF;
  
      DB$CLOU = FALSE;
      IF TQSWPF[0] THEN            # IF TABLES SWAPPED OUT             #
        DB$SWPI;                   # SWAP THEM IN                      #
  
      P<RSB> = TQRSB[0];           # SET PTRS TO TABLES NEEDED TO READ #
                                   # AREA CONTROL BLOCK                #
      IF P<RSB> EQ 0
      THEN                         # RSB NOT ALLOCATED YET             #
        BEGIN 
        RETURN; 
  
        END 
  
      P<ASL> = TQASL[0];           # SET ACTIVE SUBSCHEMA LIST POINTER #
      P<CSFIXED> = ASCSTLOC[0]; 
  
      P<RSARBLK> = LOC(RSB) + DFRSBFIX; 
      FOR INDEX = 1 STEP 1 UNTIL CSFARENO[0]
      DO
        BEGIN 
        IF RSAROFIT[0] EQ ADDROFT  # IF SUBSCH POINTS TO THE OFT       #
        THEN
          BEGIN 
          IF RSARFPT[0] NQ 0       # IF THERE IS AN FPT                #
          THEN                     # THE AREA IS OPEN FOR THIS USER    #
            BEGIN 
            RSFCAORD[0] = INDEX;   # SET THE CURRENT AREA ORDINAL      #
                                   # SO THAT THE AREA CAN BE           #
                                   # IDENTIFIED IN THE ERROR MESSAGE   #
            P<FKL> = RSFFKLLOC[0];
            P<FPT> = LOC(FKL) + RSARFPT[0]; 
  
            IF P<RCB> GR 0
            THEN
              BEGIN 
              RCOFTLOC[0] = 0;
              END 
            DB$CLSA;               # CLOSE THE AREA                    #
            DB$CLOU = TRUE;        # FLAG THE AREA USED                #
            END 
          END 
        P<RSARBLK> = LOC(RSARBLK) + DFARECON; 
        END 
  
      RETURN; 
      END 
      TERM; 
