*DECK DB$PKY
USETEXT CDGDFTX 
USETEXT RELCMTX 
      PROC DB$PKY;
      BEGIN 
 #
  *   DB$PKY                                     PAGE 1 
  *   M L MOORE                                  DATE 10/15/75
  *   M D SAXE  (REVISION FOR 2.0)               DATE 09/24/76
  DC  PURPOSE 
      PROCESS A RELATION READ WITH RETRIEVAL BY PRIMARY KEY.  THE 
      RECORD RETURNED MUST ALSO SATISFY RESTRICT CONDITIONS.
  
  DC  LANGUAGE
      SYMPL 
  
  DC  ENTRY CONDITIONS
      CST AND RSB SEARCH TABLE POINTERS ARE SET FOR THE CURRENT RANK
      USER FPT IS SET FOR THE CURRENT RANK. 
      MFPRETCD = 0
*     IN FPT ARRAY, RKP, RKW, KL, KA, KP FIELDS ARE SET.  KA POINTS 
        TO THE KEYREAD BUFFER, WHICH CONTAINS THE KEY.
  
  DC  EXIT CONDITIONS 
      MFPRETCD = 0  IF A QUALIFIED RECORD IS RETURNED 
                 1  IF AN INVALID KEY ERROR OCCURRED
                 2   IF A CRM I/O ERROR, CONVERSION ERROR, OR MPF 
                     INTERNAL ERROR OCCURRED
      EOKFLAG = TRUE. 
  
  DC  CALLING ROUTINES
      DB$MFP
  
  DC  CALLED ROUTINES 
      CHECKES  - SET MFPRETCD IF CRM ERRORS 
                 (CALLED THRU FIT EX FIELD )
      DB$MPGT  - READ A RECORD BY KEY 
      DB$QTST  -  CHECK RECORD QUALIFICATION
  
  DC  DESCRIPTION 
           THE KEY LENGTH FIELD IN THE FIT IS SET FROM THE VALUE
*     STORED IN THE RSNSTAB AS THE JOIN ITEM SIZE. A CRM GET
      REQUEST IS MADE TO READ IN A RECORD.  IF THERE WERE 
      NO ERRORS, THE DB$MFP PROC QUALTEST IS CALLED TO CHECK
      RECORD QUALIFICATION.  IF THE RECORD DOES NOT QUALIFY,
      MFPRETCD IS SET TO 1 TO INDICATE A NULL OCCURRENCE.  AN 
      EXIT IS MADE, WITH THE VALUE OF MFPRETCD REFLECTING A 
      NULL OCCURRENCE (1), AN INVALID KEY (1 - SET BY CHECKES), 
      A CRM ERROR (2 - SET BY CHECKES), A CONVERSION OR INTERNAL ERROR
      (2 - SET BY QUALTEST), OR A QUALIFIED RECORD (0). 
           EOKFLAG IS ALWAYS SET TO TRUE SO THAT THE NEXT LOWER 
      RANK WILL BE READ TO RETRIEVE A NEW PRIMARY KEY FOR THIS RANK.
 #
  
                             # CALLS TO COMMON DECKS MFPDFDCLS,        #
                             # MFPCMDCLS, RELCMDCLS                    #
      CONTROL NOLIST; 
*CALL MFPDFDCLS 
*CALL MFPCMDCLS 
      CONTROL LIST; 
  
      XREF
        BEGIN 
        ARRAY DB$RA0;;
        PROC DB$FLOP;        # GENERATE FLOW POINT                     #
        PROC DB$MPGT; 
        PROC DB$QTST; 
        END 
  
#    *****   BEGINNING OF DB$PKY EXECUTABLE CODE   *****   #
  
      CONTROL IFGR DFFLOP,0;
        DB$FLOP("PKY    "); 
      CONTROL ENDIF;
  
      DB$MPGT;
      IF MFPRETCD EQ 0
        THEN
        BEGIN                # PROCESS IF NO CRM ERRORS  #
        XCALL DB$QTST;
        IF NOT RCQUAL        # IF RECORD IS NOT QUALIFIED # 
          THEN MFPRETCD = RCNULL;   # SET NULL OCCURRENCE RETURN CODE # 
        END 
      EOKFLAG = TRUE; 
      RETURN; 
  
      END 
      TERM
