*DECK DB$GET
USETEXT CDCSCTX 
      PROC DB$GET;
      BEGIN 
 #
* *   DB$GET -- CRM RANDOM GET PROCESSOR         PAGE  1
* *   C O GIMBER                                 11/29/76 
* 
* DC  PURPOSE 
* 
*     DO A CRM RANDOM GET ON AN AREA AND LOCK THE RECORD READ.
* 
* DC  ENTRY CONDITIONS
* 
*     ALL APPROPRIATE FIT FIELDS ARE SET. 
*     P<RSARBLK> IS SET.
* 
* DC  EXIT CONDITIONS 
* 
*     P<RSARBLK> IS SET 
*     NORMAL EXIT 
*       CRM GET PERFORMED 
*       IF AREA IS OPENED FOR I/O THEN THE RECORD IS LOCKED.
*     ABNORMAL EXIT 
*       EXIT THRU ERROR ROUTINE SPECIFIED IN FIT. 
* 
* DC  CALLED ROUTINES 
# 
      XREF PROC DB$FLOP;     #GENERATE FLOW POINT                      #
      XREF PROC DB$FSAV;     #SAVE ACCESS KEYS TO PERMIT REPOSITIONING #
      XREF PROC DB$LOK;      #RECORD LOCK PROCESSOR#
      XREF PROC DB$LOKD;     #LOCK DELETE PROCESSOR#
      XREF PROC DB$POP;      #POP FROM STACK# 
      XREF PROC DB$PUSH;     #PUSH INTO STACK#
      XREF PROC DB$SEK;      #SEEK PROCESSOR# 
      XREF PROC GET;         #CRM GET ROUTINE#
# 
* DC  NON-LOCAL VARIABLES 
# 
      XREF ARRAY DB$RA0;;    #USED TO TERMINATE PARAMETER LISTS#
# 
*     CDCS COMMON 
 #
# 
*     LOCAL VARIABLES 
# 
      BASED ARRAY FIT;;      #USED FOR CRM CALLS# 
      ITEM INDEX;            #SCRATCH ITEM# 
      ITEM MKL;              #SAVED MKL FIELD FROM FIT# 
      BASED ARRAY WSA;       #USED FOR CRM CALLS# 
        ITEM WSAWORD;        #USED FOR KEY LOCKING# 
  
  
  
  
  
#     B E G I N   D B $ G E T   E X E C U T A B L E   C O D E .        #
  
      CONTROL IFGR DFFLOP,0;
        DB$FLOP ("GET");
      CONTROL ENDIF;
  
 #
* 
* DC  DESCRIPTION 
* 
*     PUSH ENTRY POINT
 #
      DB$PUSH(DB$GET);
 #
*     LOOP UNTIL RECORD READ AND LOCKED WITHOUT QUEUEING. 
 #
      LOKSTATUS = FALSE;
      FOR INDEX=INDEX WHILE NOT LOKSTATUS DO
        BEGIN 
 #
*       DO CRM SEEK.
*         DB$SEK CALLS DB$FSET TO SELECT AND SET A FIT. 
 #
        DB$SEK; 
 #
*       GET THE RECORD. 
*         SAVE AND RESTORE MKL ACCROSS GET. 
*       IF CRM ERROR THEN 
*         EXIT. 
*       LOCK THE RECORD.
 #
        P<FIT> = LOC(UFFIT[0]); 
        MKL = UFFITMKL[0];
        GET(FIT,DB$RA0);
        UFFITMKL[0] = MKL;
        IF UFFITES[0] NQ 0 THEN 
          BEGIN 
          DB$LOKD(FALSE);               # RETURN RECORD LOCK           #
  
          CONTROL IFGR DFFLOP,0;
            DB$FLOP ("GET-1");          #GENERATE A FLOW POINT.        #
          CONTROL ENDIF;
  
          GOTO EXIT;
          END 
        P<OFT> = RSAROFIT[0]; 
        P<WSA> = UFFITWSA[0]; 
        DB$LOK(LOC(WSA)+OFPRIRKW[0],OFPRIRKP[0],TRUE);
        END  #LOOP WHILE NOT LOCKSTATUS#
EXIT: 
 #
*     SAVE THE PRIMARY KEY (AND ALTERNATE KEY IF USED) SO THAT FILE 
*     POSITION CAN BE RE-ESTABLISHED IN THE EVENT THAT THIS UFT IS
*     USED IN ANOTHER SEQUENCE. 
 #
      DB$FSAV;
 #
*     POP ENTRY POINT.
*     RETURN. 
 #
      DB$POP(DB$GET); 
  
#     SAVE VALUES FROM THE UFT BEFORE IT CAN BE RE-ASSIGNED.           #
  
      FPFITFP[0] = UFFITFP[0];
      RETURN; 
      END  #DB$GET# 
      TERM; 
