*DECK DBP$SAC 
USETEXT TAREATB 
USETEXT TFIT
      PROC DBP$SAC(EXIT, TABLELOC, DIRECTIVE, DBP$ACTION, RC);
      BEGIN 
#                                                                      #
#         D B P $ S A C                                                #
#                                                                      #
#     THIS ROUTINE SEARCHES THE CURRENT AREA TABLE FOR THE SPECIFIED   #
#     EXIT. IF FOUND, THE DATABASE PROCEDURE FOR THAT EXIT IS CALLED.  #
#     THE INPUT PARAMETERS TO THIS ROUTINE ARE:                        #
#        -- THE CODE FOR WHAT ENTRY TYPE THIS IS.                      #
#        -- THE LOCATION OF THE AREATABLE FOR THIS AREA                #
#        -- THE DIRECTIVE CODE IDENTIFYING WHAT QU DIRECTIVE           #
#           BROUGHT US HERE.                                           #
#        -- THE DBP$ACTION INDICATES THE CRM FUNCTION TO BE REPLACED.  #
#     THE ONE OUTPUT PARAMETER IS THE RETURN CODE PASSED BACK BY       #
#     THE CALLED DATA BASE PROCEDURE.                                  #
#     THIS ROUTINE CALLS -DBP$CAL- TO CALL THE DATA BASE PROCEDURE.    #
#                                                                      #
#----------------------------------------------------------------------#
  
      ITEM EXIT I;                 # VALUE DETERMINES WHAT KIND OF EXIT#
                                   # WE ARE PROCESSING. REFER TO VALUES#
                                   # LISTED IN STATUS LIST -ON-.       #
  
      ITEM TABLELOC I;             # CONTAINS LOCATION OF THE CURRENT  #
                                   # AREATABLE.                        #
  
      ITEM DIRECTIVE I;            # DIRECTIVE CODE IDENTIFYING THE QU #
                                   # DIRECTIVE THAT LED TO THIS ROUTINE#
                                   # BEING CALLED. REFER TO VALUES IN  #
                                   # STATUS LIST -DCODE-.              #
  
  
      ITEM DBP$ACTION I;           # THIS  PARAMETER IS USED BY THE    #
                                   # OPEN, SEARCH, AND UPDATE EXITS.   #
                                   # ITS VALUE REPRESENTS THE CRM      #
                                   # FUNCTION TO BE PERFORMED BY A DBP #
                                   #                                   #
                                   # OPEN :    1 = OPEN FOR INPUT      #
                                   #           2 = OPEN FOR I-O        #
                                   # --------------------------------- #
                                   # SEARCH :  1 = REWIND              #
                                   #           2 = GET                 #
                                   #           3 = GETN                #
                                   # --------------------------------- #
                                   # UPDATE :  1 = PUT                 #
                                   #           2 = DELETE              #
                                   #           3 = REPLACE             #
      ITEM RC I;                   # RETURN CODE FROM THE DATABASE PRO-#
                                   # CEDURE IDENTIFYING WHAT ACTION QU #
                                   # SHOULD TAKE - EG. GO ON, TERMINATE#
                                   # THE DIRECTIVE, OR TERMINATE QU.   #
  
      XREF PROC DBP$CAL;           # THIS PROC CALLS THE DBP-S.        #
  
      XREF ITEM DBP$NAM C(7);      # NAME OF DBP WE CALL (TRAP INFO)   #
  
      XREF ITEM RA0;               # THIS ITEM HAS A LOCATION OF ZERO. #
                                   # USED FOR TERMINATING SELECTED     #
                                   # PARAMETER LISTS.                  #
  
# THE FOLLOWING ITEM SUPPORTS A KLUGE FOR THE ON"SEARCH" EXIT. A RETURN#
# CODE OF ZERO INDICATES THE RECORD HAS BEEN RETRIEVED. BUT, THE COMMON#
# INTERPRETATION OF RETURN CODE ZERO IS -EVERYTHING OK. PROCEED.-  A   #
# ZERO RETURN CODE IS ALSO PRODUCED FOR  -THERE WAS NO DBP FOR THAT    #
# EXIT TYPE-. THE ITEM DBP$DID IS A BOOLEAN WHICH IS TRUE IF THERE WAS #
# A PROCEDURE FOR THAT EXIT TYPE AND WE *DID* CALL IT.                 #
      XDEF ITEM DBP$DID B;         # TRUE IF WE *DID* CALL A DBP       #
  
      BASED ARRAY DBP$TBL;         # DESCRIBES DBP INFO IN AREATABLE   #
        BEGIN 
        ITEM DBP$TBLWORD  I(00,00,60); #  WHOLE WORD DEFINITION        #
  
        ITEM DBP$TBLNAME  C(00,00,10); # NAME OF THE ENTRY POINT       #
  
        ITEM DBP$TBLADDR  I(00,42,18); # ABSOLUTE ADDRESS OF THE EP    #
        END 
  
      ITEM EC I;                   # ENTRY-CODE. CORRESPONDS TO *EXIT* #
  
      ITEM DIRTEMP I;              # TEMP STORAGE OF *DIRECTIVE*       #
  
      BASED ARRAY KA;;             # USED AS PARAMETER TO POINT TO KEY #
  
      BASED ARRAY WSA;;            # USED AS PARAMETER TO POINT TO WSA #
CONTROL EJECT;
  
#----------------------------------------------------------------------#
# BEGINNING OF EXECUTEABLE CODE FOR DBP$SAC.                           #
  
  
      RC = 0;                      # RETURN CODE FOR -CONTINUE-        #
      DBP$DID = FALSE;             # ASSUME WE WON-T CALL A DBP        #
      IF TABLELOC EQ 0 THEN        # IF NO AREA TABLE                  #
        BEGIN 
        RETURN; 
        END 
  
      P<AREA$TABLE> = TABLELOC;    # POSITION THE AREA TABLE ARRAY     #
      IF AT$DBPROC NQ 0 THEN       # IF DBP EXITS EXIST FOR THIS AREA  #
        BEGIN 
        P<DBP$TBL> = P<AREA$TABLE> + AT$DBPROC;  # FIND DBP INFO TABLES#
        IF DBP$TBLADDR[EXIT] NQ 0 THEN  # IF THE REQUESTED EXIT EXISTS #
          BEGIN 
          DBP$NAM = DBP$TBLNAME[EXIT];  # SAVE NAME OF WHO WE CALL     #
          P<FIT> = LOC(AT$AFITPOS);  # POSITION TO ACCESS FIT FIELDS   #
          P<WSA> = FITWSA;         # POINT TO THE RECORD LOCATION      #
          P<KA>  = FITKA;          # POINT TO THE KEY LOCATION         #
          FITES = 0;               # PRESET FITES TO 0 FOR DBP         #
          EC = EXIT;               # ENTRY CODE IS EXIT TYPE           #
          DIRTEMP = DIRECTIVE;     # DIRECTIVE CODE IN A TEMPORARY     #
  
          DBP$CAL (DBP$TBLADDR[EXIT], EC, RC, DIRTEMP, FIT, WSA,
                      FITRL, KA, FITKP, FITKL, DBP$ACTION, RA0);
  
          DBP$NAM = " ";           # CLEAR THE DBP NAME                #
          DBP$DID = TRUE;          # WE DID CALL A DBP.                #
          END 
        END 
      RETURN; 
      END 
      TERM
