*DECK DB$DRT
USETEXT CDCSCTX 
  PROC DB$DRT;
  BEGIN 
 #
* *   DB$DRT                                     PAGE  1
* *   DETERMINE RECORD TYPE 
* *   W P CEAGLIO                                DATE  3/20/76
* 
* DC  PURPOSE 
* 
*     DETERMINE THE RECORD TYPE (ORDINAL) OF THE LAST RECORD READ FOR 
*     A RUN-UNIT
* 
* DC  ENTRY CONDITIONS
* 
*     CDCS COMMON 
* 
*       P<RSARBLK> IS SET.
* 
* DC  EXIT CONDITIONS 
* 
*     NORMAL -- RSFCRORD SET TO NON-ZERO RECORD ORDINAL 
* 
*     ABNORMAL -- AN ERROR MESSAGE IS ISSUED AND THE REQUEST TERMINATED 
* 
* DC  CALLING ROUTINES
* 
*     DB$RD$     READ SEQUENTIAL CONTROL SYMBIONT 
*     DB$RLS$    READ RELATION SEQUENTIAL CONTROL SYMBIONT
*     DB$REW$    REWRITE CONTROL SYMBIONT 
*     DB$WR2$    WRITE CONTROL SYMBIONT 
* 
* DC  CALLED ROUTINES 
* 
*     DB$DPIF    DATA BASE PROCEDURE INTERFACE
*     DB$ERR     ERROR MESSAGE GENERATOR
*     DB$FLOP    GENERATE FLOW POINT
* 
* DC  NON-LOCAL VARIABLES 
* 
*     CDCS COMMON 
* 
*           RSB         FIXED PART OF RSB 
*           CSFIXED     FIXED PART OF CST 
*           RSARBLK     AREA CONTROL BLOCK IN RSB 
*     OTHER 
* 
*           CSAREBLK    AREA WORK BLOCK IN CST
* 
* DC  DESCRIPTION 
* 
*     1.  POINT TO THE AREA WORK BLOCK IN THE CST BY USING THE AREA 
*         ORDINAL IN THE RSB TO GET TO THE PROPER RSB AREA CONTROL
*         BLOCK, WHICH HAS A POINTER TO THE CORRESPONDING CST ENTRY.
*     2.  CHECK THE RECORD CODE FLAG IN THE WORK BLOCK HEADER.  IF
*         THERE IS NO RECORD CODE TABLE, THEN THE REQUIRED RECORD 
*         ORDINAL IS EXTRACTED FROM THE CODE TABLE POINTER FIELD IN 
*         RECORD CODE HEADER. THEN AN IMMEDIATE EXIT IS TAKEN.
*     3.  OTHERWISE, THE RECORD CODE TABLE IS EXAMINED.  IF THE RECORD
*         TYPE IS TO BE DETERMINED BY A DATA BASE PROCEDURE (INDICATED
*         BY A FLAG IN THE HEADER WORD OF THE TABLE), "DB$DPIF" IS
*         CALLED TO SETUP THE PARAMETERS AND EXECUTE THE PROCEDURE. 
*         IF NO ERROR OCCURED, THE CURRENT RECORD ORDINAL ENTRY IN THE
*         RSB WILL HAVE BEEN SET.  OTHERWISE, AN ERROR MESSAGE WILL 
*         HAVE BEEN ISSUED BY "DB$DPIF" AND THE REQUEST TERMINATED. 
*     4. IF THE ARGUMENT FOR THE SEARCH IS THE KEY FIELD IN THE CURRENT 
*         RECORD (POINTED TO BY THE ENTRY IN THE RSB), THEN THE KEY 
*         FIELD IS LOCATED IN THE RECORD BY USING THE ITEM ATTRIBUTES 
*         CONTAINED IN THE RECORD CODE HEADER.  THE CONTENTS OF THIS
*         FIELD ARE MATCHED AGAINST THE LITERAL VALUES IN THE CODE
*         TABLE. IF THERE IS A MATCH, AND THE RECORD TYPE FOR THAT
*         LITERAL IS IN THE SUBSCHEMA, THE RECORD ORDINAL CORRESPONDING 
*         TO THE LITERAL IS EXTRACTED AND STORED AS THE CURRENT RECORD
*         ORDINAL IN THE RSB.  OTHERWISE, "DB$ERR" IS CALLED TO ISSUE 
*         AN ERROR MESSAGE AND THE REQUEST IS TERMINATED. 
* 
 #
      CONTROL NOLIST;                   # CDCSCOMMN,RSBARDCLS,CSTARDCLS#
*CALL CSTARDCLS 
      CONTROL LIST; 
      CONTROL EJECT;
  
# LOCAL ITEMS AND ARRAYS                                               #
  
      ITEM BCP;                         # USED IN "BY VALUE" CHECK     #
      ITEM BWP;                         # USED IN "BY VALUE" CHECK     #
      ITEM I;                           # INDEX INTO RECORD CODE TABLE #
      ITEM J;                           # INDEX INTO RECORD CODE TABLE #
      ITEM SIZE;                        # USED IN "BY VALUE" CHECK     #
  
      BASED ARRAY RECORD;;              # DUMMY                        #
  
      BASED ARRAY RECCODE;              # DUMMY                        #
          ITEM RECKEY   C(0,0,240); 
  
# EXTERNAL REFERENCES                                                  #
  
      XREF PROC DB$DPIF;                # DATA BASE PROCEDURE INTERFACE#
      XREF PROC DB$ERR;                 # ERROR MESSAGE GENERATOR      #
      XREF PROC DB$FLOP;                # GENERATE FLOW POINT          #
      CONTROL EJECT;
  
# S T A R T  O F  D B $ D R T  E X E C U T A B L E  C O D E            #
  
  
      P<CSAREBLK> = P<CSFIXED> + RSARCSTP[0]; 
  
# IF NO RECORD CODE TABLE, RETURN ORDINAL IN RECORD CODE HEADER        #
  
      IF CSAONERC [0]  THEN 
          BEGIN 
          RSFCRORD [0] = CSARCORD [0];
  
          CONTROL IFGR DFFLOP,1;
            DB$FLOP("DRT-1"); 
          CONTROL ENDIF;
  
          RETURN; 
          END 
  
      CONTROL IFGR DFFLOP,0;
        DB$FLOP("DRT"); 
      CONTROL ENDIF;
  
# RECORD CODE TABLE PRESENT -- NEED TO SEARCH IT                       #
  
      P<CSACODTB> = P<CSAREBLK> + CSACODPT [0]; 
  
# DETERMINE METHOD BY WHICH RECORD CODE IS TO OBTAINED                 #
  
      IF CSACTYPE [0]  THEN 
  
# METHOD IS BY PROCEDURE                                               #
  
          BEGIN 
  
# EXECUTE THE DATA BASE PROCEDURE                                      #
  
      IF SADBPPTR[SALX] NQ 0
      THEN
        BEGIN 
        DB$DPIF(DFDPRECCODE); 
        END 
  
          CONTROL IFGR DFFLOP,0;
            DB$FLOP("DRT-2"); 
          CONTROL ENDIF;
  
          RETURN; 
          END 
  
      ELSE
  
# METHOD IS BY VALUE                                                   #
  
          BEGIN 
  
# PICKUP THE LOCATION AND SIZE OF THE RECORD CODE FIELD IN THE RECORD  #
# AND POINT TO THE KEY FIELD                                           #
  
          BWP = CSACBWP [0];
          BCP = CSACBCP [0];
          SIZE = CSACLENC [0];
          P<FKL> = RSFFKLLOC[0];
          IF RSARFPT[0] NQ 0
          THEN
            BEGIN 
            P<FPT> = LOC(FKL) + RSARFPT[0]; 
            END 
          P<RECORD> = FPFITWSA[0];
          P<RECCODE> = P<RECORD> + BWP; 
  
# SEARCH THRU "VALUE" LIST FOR A MATCH WITH THE RECORD CODE FIELD IN   #
# THE CURRENT RECORD                                                   #
  
          I = 1;
 LOOP2: 
          J = CSACLITP [I]; 
          IF C<BCP,SIZE>RECKEY [0] EQ C<0,CSACLITL[I]>CSACLITR[J] 
          THEN
  
# MATCH OCCURRED -- MAKE SURE RECORD IS IN SUBSCHEMA                   #
  
            BEGIN 
            IF CSACRORD[I] EQ 0 
            THEN           # ERROR -- RECORD NOT IN SUBSCHEMA          #
              BEGIN 
              DB$ERR(91); 
              END 
            ELSE           # SET RECORD ORDINAL                        #
              BEGIN 
              RSFCRORD [0] = CSACRORD [I];
              RSARRORD[0] = CSACRORD[I];
              RETURN; 
              END 
            END 
  
          IF CSACNEXT [I]  THEN         # IF ANOTHER ENTRY CHECK IT    #
              BEGIN 
              I = I + 1;
              GOTO LOOP2; 
              END 
  
# ERROR -- INVALID RECORD TYPE                                         #
  
          DB$ERR (25);                  # ISSUE ERROR MESSAGE          #
          END 
  END 
      TERM
