*COMDECK  CALLOWN 
#----------------------------------------------------------------------#
#                                                                      #
#     C A L L O W N                                                    #
#                                                                      #
# THIS PROC SETS UP PARAMETERS AND CALLS TO USER DATA BASE PROCEDURES  #
# AND PROCESSES EXCEPTION (ERROR) RETURNS FROM THE USER.               #
# ACTIONS TAKEN BY THIS ROUTINE ARE GIVEN BELOW.  TO DETERMINE THE     #
# ACTION TAKEN, USE *DBPRC* AND THE RETURN CODE FROM THE DATA BASE     #
# PROCEDURE (0 TO 3) TO INDEX INTO THE ARRAY *RCACTION*.               #
#        0 - PROCEED                                                   #
#        1 - CLOSE AREA, GET NEXT DIRECTIVE                            #
#        2 - GET NEXT DIRECTIVE                                        #
#        3 - CLOSE AREA, EXIT QU                                       #
#        4 - EXIT QU                                                   #
#----------------------------------------------------------------------#
  
      PROC CALLOWN(EXITYPE, DBPRC); 
      BEGIN 
      ITEM DBPRC I;                # DATABASE PROCEDURE RETURN CODE    #
                                   # SEARCH AND CALL APPROPRIATE DBP   #
      ITEM EXITYPE I;              # STATUS LIST VALUE FOR THIS TYPE OF#
                                   # DBP EXIT. REFER TO STATUS LIST-ON-#
      ITEM SAVEFITKA I;            # SAVE FITKA                        #
      ITEM SAVEFITWSA I;           # SAVE FITWSA                       #
      ARRAY ECRCTOAC [1:8]; 
        BEGIN 
        ITEM RCACTION I(0,0,60);
        ITEM RC0 I(0,00,6) = [ 0, 0, 0, 0, 0, 0, 0, 0]; 
        ITEM RC1 I(0,06,6) = [ 1, 0, 0, 0, 0, 0, 4, 0]; 
        ITEM RC2 I(0,12,6) = [ 3, 2, 2, 2, 2, 2, 4, 2]; 
        ITEM RC3 I(0,18,6) = [ 3, 1, 1, 1, 1, 1, 4, 1]; 
        END 
  
      SWITCH ACTION 
        PROCEED,                   # 0 = PROCEED                       #
        CAGND,                     # 1 = CLOSE AREA, GET NEXT DIRECTIVE#
        GETNEXTDIR,                # 2 = GET NEXT DIRECTIVE            #
        CAEXITQU,                  # 3 = CLOSE AREA, EXIT QU           #
        EXITQU;                    # 4 = EXIT QU                       #
  
  
  
      DBPRC = 0;                   # INITIALIZE RETURN CODE            #
      P<AREA$TABLE> = ATPTR;       # POSITION AREA$TABLE               #
      IF DBP$FWA EQ 0              # IF NO DBPS AT ALL                 #
      THEN
        BEGIN 
        RETURN; 
        END 
      P<FIT> = LOC(AT$AFITPOS); 
      SAVEFITKA = FITKA;           # SAVE FITKA                        #
      SAVEFITWSA = FITWSA;         # SAVE FITWSA                       #
      IF EXITYPE EQ ON"CLOSE"      # IF ON CLOSE DBP                   #
      THEN
        BEGIN 
        IF AT$DBPCLOSE             # IF TERMINATING QU SESSION IN      #
                                   # RESPONSE TO PREVIOUS CALL TO      #
                                   # CLOSE DBP                         #
        THEN
          BEGIN 
          RETURN;                  # DO NOT CALL ON CLOSE DBP AGAIN    #
          END 
        ELSE
          BEGIN 
          AT$DBPCLOSE = TRUE;      # CLOSE DBP IS EXECUTING            #
          END 
        END 
      DBP$SAC(EXITYPE, P<AREA$TABLE>, IDIRCODE, DBP$ACTION, DBPRC); 
      FITWSA = SAVEFITWSA;         # RESTORE FITWSA IN CASE DBP USED   #
                                   # A DIFFERENT WSA                   #
      FITKA = SAVEFITKA;           # RESTORE FITKA                     #
      IF DBPRC LS 0 
        OR DBPRC GR 3 
      THEN
        BEGIN 
        DIAG(917);                 # DBP RETURN CODE OUT OF RANGE      #
        GOTO GETNEXTDIR;
        END 
      I = B<DBPRC * 6, 6> RCACTION[EXITYPE];  # INDEX INTO THE ACTION  #
                                              # ARRAY BY EXIT TYPE AND #
                                              # DBP SUPPLIED RC        #
      IF EXITYPE EQ ON"CLOSE"      # IF CLOSE DBP                      #
        AND I LS 3                 # IF NOT (EXIT QU)                  #
      THEN
        BEGIN 
        AT$DBPCLOSE = FALSE;       # CLOSE DBP IS FINISHED             #
        END 
      IF I NQ 0                         # IF ERROR OCCURRED            #
      THEN
        BEGIN 
        IF (ACCESSES + HITS + IOS NQ 0)  # IF ACCESS/HIT/IO MSG HAS NOT#
                                         # BEEN DISPLAYED YET          #
        THEN
          BEGIN 
          DIAG (1006, ACCESSES, HITS, IOS);  # DISPLAY THE MESSAGE     #
                                             # REINITIALIZE PARAMETERS #
          ACCESSES = 0; 
          HITS = 0; 
          IOS = 0;
          END 
        IF (OWNFORCD + OWNREJ NQ 0)  # IF ANY RECORD(S) WERE FORCED OR #
                                     # REJECTED BY A DBP               #
        THEN
          BEGIN 
          DIAG (1003, OWNFORCD, OWNREJ);  # DISPLAY FORCED/REJECTED MSG#
                                          # REINITIALIZE PARAMETERS    #
          OWNFORCD = 0; 
          OWNREJ = 0; 
          END 
        END 
      GOTO ACTION[I]; 
      BEGIN                        # START OF RC ACTION PROCESSING     #
CAGND:  
      DIAG(919);                   # AREA CLOSED MESSAGE               #
      DIAG(918);                   # CURRENT DIRECTIVE TERMINATED      #
      CLEANUP;
      INDEX = 0;                   # CALL *UNUSE* IN OVERLAY (5,0)     #
      PRIMARY = 5;
      SECONDARY = 0;
      LOADX0;                      # THERE IS NO RETURN FROM THIS CALL #
  
GETNEXTDIR: 
      DIAG(918);                   # CURRENT DIRECTIVE TERMINATED      #
      CLEANUP;
      EXITCTL;                     # THERE IS NO RETURN FROM THIS CALL #
  
CAEXITQU: 
      DIAG(924);                   # SESSION TERMINATED MESSAGE        #
      CLEANUP;
      STOPEXEC;                    # THERE IS NO RETURN FROM THIS CALL #
  
EXITQU: 
      DIAG(919);                   # AREA CLOSED MESSAGE               #
      DIAG(924);                   # SESSION TERMINATED MESSAGE        #
      CLEANUP;
      STOPEXEC;                    # THERE IS NO RETURN FROM THIS CALL #
  
PROCEED:  
      RETURN; 
      END 
      END 
