*DECK DB$MKY
USETEXT RELCMTX 
USETEXT CDCSCTX 
      PROC DB$MKY;
      BEGIN 
 #
  *   DB$MKY                                     PAGE 1 
  *   M L MOORE                                  DATE 10/14/75
  *   M D SAXE  (REVISION FOR 2.0)               DATE 09/24/76
  DC  PURPOSE 
      PROCESS A RELATION READ WITH RETRIEVAL BY MAJOR PRIMARY KEY OR
      MAJOR ALTERNATE KEY.  THE RECORD RETURNED ( IF ANY ) MUST 
      SATISFY BOTH THE JOIN AND THE 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
      JOIN BUFFER FOR THIS RANK CONTAINS THE VALUE TO WHICH THE 
         TARGET DBI MUST BE EQUAL 
      MFPRETCD = 0
      IN THE USER FPT ARRAY, THE RKP, RKW, KA, KP FIELDS HAVE BEEN SET. 
  
  DC  EXIT CONDITIONS 
      MFPRETCD = 0 (RCOKAY) IF A QUALIFIED RECORD IS BEING RETURNED 
               = 1 (RCNULL) IF AN INVALID KEY ERROR OCCURRED
               = 2 (RCIOERR) IF AN I/O, CONVERSION, OR
                     INTERNAL ERROR OCCURRED
               = 777 (RCNEWRK) IF THE NEXT LOWER RANK MUST
                      BE PROCESSED, BECAUSE 
                     NO QUALIFIED RECORD CAN BE FOUND AT THIS RANK
                     OR BECAUSE END-OF-INFORMATION WAS DETECTED 
  
  DC  CALLING ROUTINE 
  
  DC  CALLED ROUTINES 
      DB$JCPR - COMPARE JOIN DBI VALUE TO MAJOR KEY 
      CHECKEND  - SET MFPRETCD TO RCNEWRK IF AT END-OF-INFORMATION
                  (CALLED THROUGH FIT DX FIELD) 
      CHECKES  - SET MFPRETCD IF CRM ERROR STATUS 
                 (CALLED THRU FIT EX FIELD )
      DB$MPGT   - READ A RECORD BY KEY
      DB$MPGN   - READ NEXT RECORD
      DB$QTST - CHECK IF RECORD QUALIFIES BY CALLING DB$QUAL
      DC$XFER - MOVE CURRENT KEY VALUE TO KEYREAD BUFFER
  
  DC  NON-LOCAL VARIABLES 
      ALL VARIABLES REQUIRED BY THE DB$CMPR CALL WILL BE MODIFIED 
  
  DC  DESCRIPTION 
      THE FIT FIELD FOR MAJOR KEY LENGTH IS SET FROM THE JOIN ITEM
      SIZE.  IF RETRIEVAL IS FOR A FILE WHICH HAS ALTERNATE KEYS, 
      THE KEY TABLE FOR THIS AREA IS SEARCHED FOR A KEY WITH THE
      SAME BEGINNING WORD POSITION - BEGINNING BIT POSITION AS
      THIS KEY.  THE KL FIELD IN THE FIT IS SET USING THE LENGTH
      FOR THIS KEY. 
           A FOR LOOP IS THEN INITIATED TO READ RECORDS FROM THE FILE.
        - A CRM GET REQUEST IS MADE IF THE RSNFSTRK FLAG IS 
      SET, INDICATING THAT THIS IS THE FIRST CHILD RECORD TO
      BE RETRIEVED.  THE KEY USED FOR THE GET IS THE VALUE SAVED
      IN BUFFER -KEYREAD-.
        - OTHERWISE A CRM GETN REQUEST IS MADE.  FOR THE GETN, THE
*     KEY IS SAVED IN THE JOIN BUFFER. IF 
      THE KEY VALUE CHANGES FOR THE RECORD RETURNED, THE NEW KEY
*     VALUE WILL BE STORED IN THE KEYREAD BUFFER BY CRM.
        - THE VALUE OF MFPRETCD MAY BE SET TO ONE OF THE FOLLOWING. 
          - 1 (RCNULL - SET BY CHECKES) IF AN INVALID KEY 
      ERROR OCCURRED ON THE GET.
          - 2 (RCIOERR - SET BY CHECKES) IF AN ERROR WAS
      DETECTED DURING THE CRM REQUEST.
*     MFPRETCD MAY ALSO BE SET TO 2 BY THE DB$JCPR AND DB$CMPR PROCS. 
          - 777 (RCNEWRK) IF END-OF-INFO WAS RETURNED BY THE
      CRM REQUEST ( THROUGH THE DX EXIT TO CHECKEND ).
        IN ALL OF THESE CASES NO FURTHER PROCESSING WILL BE DONE. 
        - IF MFPRETCD IS ZERO AFTER THE CRM REQUEST, FURTHER
      PROCESSING IS DONE. 
          - IF THE CRM REQUEST WAS A GETN, THE RECORD RETRIEVED 
      MUST BE CHECKED TO SEE IF THE JOIN CONDITION IS STILL 
      SATISFIED.  THIS CHECK IS DONE BY COMPARING THE SOURCE
      DBI VALUE, SAVED IN THE JOIN BUFFER, TO THE KEY VALUE 
      RETURNED BY THE CRM REQUEST TO THE LOCAL BUFFER.
            - IF THE JOIN CONDITION IS NOT SATISFIED, MFPRETCD
      IS SET TO 777 (RCNEWRK) TO INDICATE THAT A RECORD MUST
      BE RETRIEVED FROM THE NEXT LOWER RANK, AND NO FURTHER 
      PROCESSING IS DONE. 
            - IF THE JOIN CONDITION IS SATISFIED, A CHECK MUST
      BE MADE ON THE QUALIFICATION CONDITION FOR THE RECORD.
        - AN EXIT IS MADE, IF A QUALIFED RECORD HAS BEEN RETRIEVED
      OR IF THE VALUE OF MFPRETCD IS
      NON-ZERO.  OTHERWISE THE RECORD READ LOOP CONTINUES.
 #
                             # CALL TO COMMON DECKS MFPDFDCLS,MFPCMDCLS#
                             # RELCMDCLS, RMCOMDCLS, CSTARDCLS         #
                             # CDCSCOMMN                               #
      CONTROL NOLIST; 
*CALL MFPDFDCLS 
*CALL MFPCMDCLS 
*CALL RMCOMDCLS 
      CONTROL LIST; 
  
  
      XREF
        BEGIN 
        ARRAY DB$RA0;;
        PROC DB$FLOP;        # GENERATE FLOW POINT                     #
        PROC DB$JCPR; 
        PROC DB$MPGT; 
        PROC DB$MPGN; 
        PROC DB$QTST; 
        PROC DC$XFER; 
        END 
  
#     LOCAL VARIABLES                                                  #
  
      ITEM J; 
      ITEM FLAG B;
  
#   ******   BEGINNING OF DB$MKY EXECUTABLE CODE   ******   # 
  
      CONTROL IFGR DFFLOP,0;
        DB$FLOP("MKY    "); 
      CONTROL ENDIF;
  
      XCALL DC$XFER(JNBUFA+RSNJNPTR[0],0,LOC(KEYREAD),0,6*RSNJNSZ[0]);
      FPFITKA[0] = LOC(KEYREAD);
      HILOEQ = 0;            # INITIALIZE FOR FRST TIME THRU #
      RCQUAL = FALSE; 
      FOR J = J WHILE NOT RCQUAL AND MFPRETCD EQ 0 DO 
        BEGIN                # RECORD READ LOOP   # 
        IF RSNFSTRK [0]         # FIRST TIME - GET BY KEY # 
          THEN
          BEGIN 
          FPFITMKL[0] = RSNJNSZ[0];    # SET MKL FIELD IN FPT          #
          P<CSAREBLK> = LOC(CSFIXED) + RSARCSTP[0]; 
          P<CSAKEYTB> = LOC(CSAREBLK) + CSAKEYPT[0];
          FLAG = TRUE;             #FIND KL#
          FOR J = J WHILE FLAG DO 
            BEGIN 
            FLAG = CSAKNEXT[0]; 
            IF CSAKBWP[0] EQ CSNSTBWP[0]     #SAME BCP, BWP#
              AND CSAKBCP[0] EQ CSNSTBCP[0] 
              THEN
              BEGIN 
              FLAG = FALSE; 
              FPFITKL[0] = CSAKLENC[0]; 
              END 
            P<CSAKEYTB> = P<CSAKEYTB> + DFAREKEY; 
            END 
          XCALL DB$MPGT;
          FPFITMKL[0] = 0;     # CLEAR MKL FIELD IN FPT                #
          END 
        ELSE                   # OTHERWISE, GET NEXT RECORD IN FILE # 
          BEGIN 
          XCALL DB$MPGN;
          END 
        IF MFPRETCD EQ 0
          THEN                 # DO OTHER PROCESSING *ONLY*  #
          BEGIN                # IF THERE ARE NO CRM ERRORS # 
          IF NOT RSNFSTRK [0]   # IF GETN WAS DONE, SET UP #
            THEN               # PARAMETERS FOR DB$CMPR CALL #
            BEGIN 
            COMPBWP = JNBUFA + RSNJNPTR [0];
            TGIBBP = 0; 
            TGIFWA = LOC(KEYREAD);
            XCALL DB$JCPR;
            IF HILOEQ NQ 0       # TARGET NOT EQUAL TO JOIN VALUE # 
              AND MFPRETCD EQ 0  # AND NO ERRORS . . .     #
              THEN               # HAVE GONE PAST THIS MAJOR KEY  # 
              BEGIN              # SO RETURN, WITH MFPRETCD = 777 # 
              MFPRETCD = RCNEWRK; 
              END 
            END 
  
# JOIN CONDITION SATISFIED, SEE IF RECORD QUALIFIES     # 
  
          IF HILOEQ EQ 0       # COMPARE OK OR FIRST TIME THRU #
            THEN XCALL DB$QTST;    # CHECK QUALIFICATION   #
          END 
        RSNFSTRK [0] = FALSE;  # FLAG TO SHOW GET WAS DONE #
        END                  # END OF RECORD READ LOOP #
  
      END                    # OF DB$MKY  # 
      TERM
