*DECK CDCSGET 
USETEXT TAREATB 
USETEXT TCOMMON 
USETEXT TCRMDEF 
USETEXT TEXPRES 
USETEXT TFIT
USETEXT TPSTACK 
USETEXT TRELTBL 
USETEXT TSBASIC 
      PROC CDCSGET (RC);
      BEGIN 
#----------------------------------------------------------------------#
#     S T A R T    O F    X R E F S                                    #
  
      XREF PROC BGFILL;            # PAD RECORD WITH BACKGROUND IMAGE  #
      XREF PROC BGIMAGE;           # COPY BACKGROUND IMAGE TO RECORD   #
      XREF PROC CLOSEM;            # CLOSE FILE                        #
      XREF PROC CMOVE;             # CHARACTER MOVE ROUTINE            #
      XREF PROC DB$RD1;            # CDCS SEQUENTIAL READ ON AREA      #
      XREF PROC DB$RD2;            # CDCS RANDOM READ ON AREA          #
      XREF PROC DB$REL;            # CDCS RANDOM READ ON RELATION      #
      XREF PROC DB$RELS;           # CDCS SEQUENTIAL READ ON RELATION  #
       XREF PROC DB$RWX;
      XREF PROC DIAG;              # ISSUE DIAGNOSTIC MESSAGE          #
      XREF PROC DIAG904;           # ISSUE DIAGNOSTIC 904              #
      XREF PROC EXPEVALUATE;       # EVALUATE PROGRAM STACK            #
      XREF PROC GETP;              # READ PARTIAL RECORD               #
      XREF PROC OPENM;             # OPEN FILE                         #
      XREF PROC READ;              # INPUT DATA FROM TERMINAL          #
      XREF PROC RETURNM;           # RETURN FILE                       #
  
      XREF ARRAY AKT$TBL [0:0] S(1);  # DESCRIPTION OF SINGLE ALTERNATE#
                                      # KEY USED FOR RECORD RETRIEVAL  #
        BEGIN 
        ITEM AKT$ITEMORD   U(00,00,15);  # ITEM ORDINAL IF CDCS, ELSE 0#
        ITEM AKT$TYPE      U(00,15,06);  # KEY TYPE:  0 = ALPHANUMERIC #
                                         #            1 = NUMERIC, COMP#
                                         #            2 = INTEGER      #
                                         #            3 = COMP-1       #
                                         #            4 = COMP-2       #
                                         #            5 = DOUBLE       #
                                         #            6 = COMPLEX      #
                                         #            7 = LOGICAL      #
        ITEM AKT$LENGTH    U(00,21,09);  # KEY LENGTH IN CHARACTERS    #
        ITEM AKT$CPOS      U(00,30,06);  # CHAR POSITION OF KEY IN WORD#
                                         # POINTED TO BY AKT$WPOS      #
        ITEM AKT$WPOS      I(00,42,18);  # WORD POSITN OF KEY IN RECORD#
        END 
      XREF BASED ARRAY DBSTAT;     # DATA BASE STATUS BLOCK            #
        BEGIN 
        ITEM DBSERRCODE   I(00,00,60);  # CRM OR CDCS ERROR CODE       #
        ITEM DBSAUXSTAT1  I(01,00,60);  # AUXILIARY STATUS WORD 1      #
        ITEM DBSFP        I(02,00,60);  # FILE POSITION                #
        ITEM DBSAUXSTAT3  I(03,00,60);  # AUXILIARY STATUS WORD 3      #
        ITEM DBSFUNCTION  C(04,00,10);  # FUNCTION IN DISPLAY CODE     #
        ITEM DBSRANKERR   I(05,00,60);  # RANK ON WHICH ERROR OCCURRED #
        ITEM DBSRANKCTLB  I(06,00,60);  # LOWEST RANK ON WHICH CONTROL #
                                        # BREAK OCCURRED               #
        ITEM DBSRANKNULL  I(07,00,60);  # LOWEST RANK FOR WHICH THERE  #
                                        # WAS A NULL RECORD            #
        ITEM DBSNAME      C(08,00,30);  # REALM OR AREA NAME ON WHICH  #
                                        # ERROR OCCURRED               #
        ITEM DBSFATALFLG  B(11,00,06);  # TRUE IF FATAL ERROR          #
        ITEM DBSMSGADDR   I(11,42,18);  # ADDR OF CDCS ERROR MSG BUFFER#
        END 
  
      XREF ARRAY KEYFLFIT;         # FIT FOR SEQUENTIAL FILE CONTAINING#
                                   # PRIMARY KEY VALUES                #
        BEGIN 
        ITEM KEYFLNAM I(0,0,42);   # FILE NAME                         #
        END 
  
      XREF ITEM CDCSUP B;          # TRUE IF ACTUALLY CALL CDCS        #
      XREF ITEM CURRELLOC I;       # ADDRESS OF RELATION TABLE IF QUERY#
                                   # BY RELATION, ELSE ZERO            #
      XREF ITEM RA0 I;             # ZERO FOR TERMINATING PARAM LISTS  #
      XREF ITEM RECDORD I;         # RECORD ORDINAL USED BY THIS XMISSN#
      XREF ITEM RTBLCALL I;        # NONZERO VALUE TELLS EXPEVAL IT IS #
                                   # A CALL FROM XXXXGET               #
  
      XREF BASED ARRAY RUSLIST;;   # RELATION USAGE LIST               #
  
#----------------------------------------------------------------------#
#     S T A R T    O F    D E F S                                      #
  
      DEF EOICODE      #1#;        # END OF INFORMATION                #
      DEF ERRFOUNDCODE #2#;        # CRM OR CDCS ERROR HAS OCCURRED    #
      DEF IKPSTKOFFSET #17#;       # OFFSET WITHIN IFKEYLOC WHERE      #
                                   # RGTABLE PREPARES PROGRAM STACK    #
                                   # TO BE USED FOR COMPARING KEYS     #
      DEF RECFOUNDCODE #0#;        # RECORD HAS BEEN FOUND             #
      DEF RETRYCODE    #-2#;       # CDCS REQUEST COULD NOT BE COMPLETD#
      DEF SEARCHCODE   #-1#;       # CONTINUE SEARCHING FOR RECORD     #
  
#----------------------------------------------------------------------#
#     S T A R T    O F    L O C A L    I T E M S                       #
  
      ITEM BITLOC I;               # BIT POSITION WITHIN WORD IN       #
                                   # RANGETABLE WHERE OFFSET TO RANGE  #
                                   # VALUE IS FOUND                    #
      ITEM BITPAIR I;              # TWO BITS FROM BITPATTERN GIVING   #
                                   # CODE FOR RELATION                 #
                                   # 00 - GREATER THAN                 #
                                   # 01 - EQUAL TO                     #
                                   # 10 - LESS THAN                    #
                                   # 11 - LESS THAN OR EQUAL TO        #
      ITEM BITPATTERN I;           # 1ST WORD OF RANGE TABLE CONTAINING#
                                   # BIT PATTERN                       #
      ITEM CHKLOWBOUND B;          # TRUE IF RANGE CONTAINS A LOWER    #
                                   # BOUND                             #
      ITEM DUMMY1 I;               # LOOP COUNTER VARIABLE             #
      ITEM DUMMY2 I;               # LOOP COUNTER VARIABLE             #
      ITEM HIGHKEYSORD I;          # ORDINAL OF BIT PAIR USED FOR      #
                                   # UPPER BOUND                       #
      ITEM I I;                    # PARTIAL TRANSFER LENGTH IN CHARS  #
                                   # FOR GETP ON SEQUENTIAL FILE       #
      ITEM KEEPSAMEREC B;          # DUMMY, ALLOWS CHECKKEY TO BE      #
                                   # COMMON DECK                       #
      ITEM KEYCTR I;               # NO OF KEYS TAKEN FROM *KEYLIST*   #
                                   # BUFFER                            #
      ITEM KEYLENC I;              # LENGTH OF SCHEMA PRIMARY KEY IN   #
                                   # CHARACTERS                        #
      ITEM KEYLENW I;              # LENGTH OF SCHEMA PRIM KEY IN WORDS#
      ITEM LOWKEYSORD I;           # ORDINAL OF BIT PAIR USED FOR      #
                                   # LOWER BOUND                       #
      ITEM NUMKEYS I;              # NUMBER OF KEYS - 1 THAT WILL FIT  #
                                   # IN *KEYLIST* BUFFER               #
      ITEM POSITIONED B;           # TRUE IF FILE OR RELATION IS       #
                                   # POSITIONED SO THAT SEQUENTIAL READ#
                                   # CAN BE DONE, ELSE RANDOM READ BY  #
                                   # PRIMARY KEY MUST BE DONE          #
      ITEM RC I;                   # RETURN CODE                       #
      ITEM RETRYANS C(1);          # ANSWER TO WHETHER TO RETRY CDCS   #
                                   # REQUEST                           #
      ITEM ROOTPOS B;              # SAVE VALUE OF *POSITIONED* FLAG   #
                                   # FOR ROOT AREA                     #
      ITEM TEMP I;                 # SCRATCH VARIABLE                  #
      ITEM USEHIBOUND B;           # TRUE IF RANGE CONTAINS AN UPPER   #
                                   # BOUND                             #
      ITEM WORDLOC I;              # INDEX INTO RANGETABLE WHERE OFFSET#
                                   # TO RANGE VALUE IS FOUND           #
  
#----------------------------------------------------------------------#
#     S T A R T    O F    L O C A L    A R R A Y S                     #
  
      ARRAY AREAORDINAL [0:0];     # AREA ORDINAL AS PASSED TO CDCS    #
        BEGIN 
        ITEM RECLENFLAG   B(00,00,01);  # IF TRUE CDCS WILL RETURN     #
                                        # RECORD LENGTH                #
        ITEM AREAORDCDCS  U(00,48,12);  # AREA ORDINAL                 #
        END 
  
      ARRAY PAKORD [0:0];          # KEY ITEM AND RECORD ORDINAL AS    #
                                   # PASSED TO CDCS                    #
        BEGIN 
        ITEM PAKNOMAP     B(00,00,01);  # TRUE IF KEY IN SCHEMA FORMAT #
        ITEM PAKRECDORD   U(00,36,12);  # KEY RECORD ORDINAL           #
        ITEM PAKITEMORD   U(00,48,12);  # KEY ITEM ORDINAL             #
                                        # HENCE NO MAPPING REQUIRED    #
        END 
  
#----------------------------------------------------------------------#
#     S T A R T    O F    L O C A L    B A S E D    A R R A Y S        #
  
      BASED ARRAY HIGHKEYVALUE; 
        BEGIN 
        ITEM HKEYVAL I(0,0,60); 
        END 
  
      BASED ARRAY KEYWSA;          # ARRAY TO READ PRIMARY KEY VALUES  #
        BEGIN 
        ITEM KWSA I(0,0,60);
        END 
  
      BASED ARRAY LOWKEYVALUE;
        BEGIN 
        ITEM LKEYVAL I(0,0,60); 
        END 
  
      BASED ARRAY RANGETABLE;      # RANGE TABLE PREPARED BY RGTABLE   #
        BEGIN 
        ITEM RTBLWORD I(0,0,60);
        END 
CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     CHKAREAFIT                                                       #
#                                                                      #
#     CHECKS DATA BASE STATUS BLOCK AND AREA FIT AND SETS RC           #
#     ACCORDINGLY.  IF DBSTAT INDICATES THAT CDCS COULD NOT COMPLETE   #
#     REQUEST, THIS PROC ASKS THE USER IF QU SHOULD RETRY REQUEST.     #
#                                                                      #
#     ON OUTPUT                                                        #
#     RC = EOICODE                 END OF INFORMATION                  #
#     RC = ERRFOUNDCODE            TERMINATE TRANSMISSION PROCESSING   #
#                                  DUE TO ERROR                        #
#     RC = RECFOUNDCODE            RECORD HAS BEEN READ                #
#     RC = RETRYCODE               QU MUST RETRY CDCS REQUEST          #
#     RC = SEARCHCODE              FILE IS POSITIONED, CONTINUE        #
#                                  SEARCHING                           #
#                                                                      #
#----------------------------------------------------------------------#
  
      PROC CHKAREAFIT;
      BEGIN 
      P<FIT> = P<AREAFIT>;
      IF DBSERRCODE EQ LOCKEDRCRD  # IF CDCS CANNOT COMPLETE REQUEST   #
                                   # BECAUSE RECORD IS LOCKED          #
        OR DBSERRCODE EQ WAITMEMORY  # BECAUSE CDCS WAIT FOR MEMORY    #
      THEN
        BEGIN 
                                   # CRM/CDCS ERROR -X- FILE/RELATION  #
                                   # -Y- FUNCTION -Z-                  #
        DIAG904;
        DIAG (1018);               # SHALL WE RETRY CDCS REQUEST -     #
                                   # ANSWER Y OR N                     #
        READ (RETRYANS, TEMP, 1, TEMP);  # READ USER-S RESPONSE        #
        IF RETRYANS EQ "Y"         # IF ANSWER IS YES                  #
        THEN
          BEGIN 
          RC = RETRYCODE;          # QU MUST RETRY CDCS REQUEST        #
          DBSERRCODE = 0;          # CLEAR ERROR FIELD                 #
          RETURN; 
          END 
  
        ELSE                       # USER DOES NOT WANT TO RETRY       #
          BEGIN 
          RC = ERRFOUNDCODE;       # TERMINATE TRANSMISSION PROCESSING #
          DBSERRCODE = 0;          # CLEAR ERROR FIELD                 #
          RETURN; 
          END 
        END 
  
  
# CDCS ADD ERROR 624, "RECORD TYPE NOT IN SUBSCHEMA".  QU SHOULD, UPON #
# RECEIPT OF THIS ERROR, READ THE NEXT READ (FOR SEQUENTIAL READS) OR  #
# REPORT THE ERROR (FOR RANDOM READ).                                  #
  
      IF   DBSERRCODE EQ O"624" 
       AND DBSFUNCTION EQ "SEQ-READ  "
      THEN
        BEGIN 
        RC = RETRYCODE; 
        DBSERRCODE = 0; 
        RETURN; 
        END 
      IF DBSERRCODE NQ 0           # IF ANY OTHER ERROR                #
      THEN
        BEGIN 
        IF NOT ( PKEY              # IF PROCESSING KEYS FROM RM$BLP    #
          OR ONEAKEY )             # NO OTHER ERRORS ARE EXPECTED      #
        THEN
          BEGIN 
          RC = ERRFOUNDCODE;       # TERMINATE TRANSMISSION PROCESSING #
                                   # CRM/CDCS ERROR -X- FILE/RELATION  #
                                   # -Y- FUNCTION -Z-                  #
          DIAG904;
          DBSERRCODE = 0;          # CLEAR ERROR FIELD                 #
          RETURN; 
          END 
  
        ELSE                       # IF PROCESSING RANGE TABLE, CRM    #
                                   # ERROR UNKNOWN KEY MAY OCCUR DURING#
                                   # POSITIONING                       #
          BEGIN 
          IF FITES EQ UNKNOWNKEY
            OR FITES EQ UNKNWNALTKEY
          THEN
            BEGIN 
            IF DBSFP EQ ENDOFILE   # IF END OF FILE ENCOUNTERED        #
            THEN
              RC = EOICODE;        # NORMAL TRANSMISSION TERMINATION   #
            ELSE
              RC = SEARCHCODE;     # FILE IS POSITIONED, CONTINUE      #
                                   # SEARCHING                         #
            END 
  
          ELSE                     # SOME UNEXPECTED ERROR             #
            BEGIN 
                                   # CRM/CDCS ERROR -X- FILE/RELATION  #
                                   # -Y- FUNCTION -Z-                  #
            DIAG904;
            RC = ERRFOUNDCODE;     # TERMINATE TRANSMISSION PROCESSING #
            END 
          DBSERRCODE = 0;          # CLEAR ERROR FIELD                 #
          RETURN; 
          END 
        END 
  
      IF DBSFP EQ ENDOFILE         # IF END OF FILE ENCOUNTERED        #
      THEN
        BEGIN 
        RC = EOICODE;              # NORMAL TRANSMISSION TERMINATION   #
        RETURN; 
        END 
  
      IOS = IOS + 1;               # ANOTHER LOGICAL IO PERFORMED      #
      RC = RECFOUNDCODE;           # RECORD HAS BEEN READ              #
      RETURN; 
      END                          # END PROC   C H K A R E A F I T    #
CONTROL EJECT;
*CALL CHECKKEY
CONTROL EJECT;
*CALL GETPRKEY
CONTROL EJECT;
*CALL INITPRKEY 
CONTROL EJECT;
*CALL SETBOUNDS 
CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     C D C S G E T                                                    #
#                                                                      #
#     THIS PROC CALLS CDCS TO READ RECORDS IF CURRELLOC IS ZERO        #
#     OR TO READ EXTENDED RECORDS IF CURRELLOC IS NONZERO              #
#                                                                      #
#     IF AKEY IS TRUE, RM$BLP HAS PREPARED A LIST OF PRIMARY KEYS IN   #
#     SCHEMA FORMAT IN *KEYLIST* OR ON PRIMARY KEY FILE.  CDCSGET WILL #
#     ONLY READ RECORDS WITH THESE PRIMARY KEYS.                       #
#                                                                      #
#     IF A RANGE TABLE EXISTS, CDCSGET WILL ONLY RETURN THE RECORDS    #
#     WHICH CONTAIN KEY VALUES WITHIN THE SPECIFIED RANGE.             #
#                                                                      #
#     OTHERWISE CDCSGET WILL SEQUENTIALLY READ THE ENTIRE AREA OR      #
#     RELATION.                                                        #
#                                                                      #
#     ON OUTPUT                                                        #
#     RC = 0, RECORD(S) IN WSA                                         #
#     RC = 1, END OF INFORMATION                                       #
#     RC = 2, CRM OR CDCS ERROR                                        #
#                                                                      #
#----------------------------------------------------------------------#
  
      RC = SEARCHCODE;             # INITIALIZE TO SEARCHING FOR RECORD#
      P<AREA$TABLE> = AREALOC;     # POSITION TO AREA TABLE            #
      P<KEY$TBL> = AT$PKEYDPTR;    # POSITION TO KEY DESCRIPTION TABLE #
      IF CURRELLOC NQ 0            # IF QUERY BY RELATION              #
      THEN
        BEGIN 
        P<REL$TABLE> = CURRELLOC;  # POSITION TO RELATION TABLE        #
        P<FITADDRTBL> = RT$FITADDR;  # POSITION TO FIT ADDRESS TABLE   #
        END 
      P<KEY> = P<AREA$TABLE> + AT$CURRKEY[0];  # POSITION TO KEY AREA  #
      P<AREAFIT> = LOC(AT$AFITPOS);  # POSITION TO FIT WITHIN AREA TBL #
      P<FIT> = P<AREAFIT>;
      IF ONEAKEY                   # IF SINGLE ALTERNATE KEY          # 
      THEN
        BEGIN 
        FITRKP = AKT$CPOS[0];      # CHAR POSITION IN RECORD           #
        FITKP  = 0;                # CHAR POSITION IN KA               #
        FITKL  = AKT$LENGTH[0];    # KEY LENGTH                        #
        FITRKW = AKT$WPOS[0];      # WORD POSITION                     #
        END 
      IF BITINDEX EQ -2            # IF FIRST CALL IN THIS PASS        #
      THEN
        BEGIN 
                                   # PREPARE PARAMETERS FOR CDCS       #
        PAKRECDORD[0] = KT$SBRCDORD[RECDORD];  # SUBSCHEMA RECORD ORD  #
        AREAORDCDCS[0] = AT$AREAORD;  # AREA ORDINAL                   #
        RECLENFLAG[0] = TRUE;      # CDCS WILL RETURN RECORD LENGTH    #
        IF ONEAKEY                 # IF SINGLE ALTERNATE KEY           #
        THEN
          BEGIN 
          PAKITEMORD[0] = AKT$ITEMORD[0];  # KEY ITEM ORDINAL          #
          END 
        ELSE                       # FOR PRIMARY KEY                   #
          BEGIN 
          PAKITEMORD[0] = KT$ITEMORD[RECDORD];  # KEY ITEM ORDINAL     #
          END 
  
        IF SCANALLAREA             # IF NO RANGE TABLE OR LIST OF KEYS #
        THEN
          BEGIN 
          POSITIONED = TRUE;       # ASSUME FILE IS POSITIONED         #
          AKEY = FALSE;            # NOT USING BLP LIST OF KEYS        #
          END 
  
        ELSE
          BEGIN 
          POSITIONED = FALSE;      # FILE IS NOT POSITIONED            #
  
          IF ONEAKEY               # IF ACCESSING BY ALT KEY           #
          THEN
            BEGIN 
            FOR DUMMY1 = 0
              WHILE RC LS 0        # LOOP UNTIL CDCS REQUEST COMPLETE  #
            DO
              BEGIN 
              DB$RWX( FIT, AREAORDINAL, PAKORD );  # REWIND INDEX FILE #
  
              CHKAREAFIT;          # CHECK FOR ERROR/RETRY STATUS      #
  
              IF RC EQ ERRFOUNDCODE  # IF ERROR                        #
              THEN
                BEGIN 
                RETURN;            # EXIT                              #
                END 
              ELSE                 # OTHERWISE                         #
                BEGIN 
                TEST DUMMY1;       # LOOP BACK TO RETRY                #
                END 
              END                  # END CDCS REQUEST LOOP             #
  
            RC = SEARCHCODE;       # RESET FOR SEARCHING               #
            END                    # END ALTERNATE KEY LOOP            #
  
          IF NOT ( PKEY            # IF RM$BLP HAS PREPARED A LIST     #
            OR ONEAKEY )           # PRIMARY KEYS                      #
          THEN
            BEGIN 
                                   # LENGTH OF PRIMARY KEY IN WORDS    #
            KEYLENC = KT$SCLEN[RECDORD];  # SCHEMA PRIM KEY LEN IN CHAR#
                                   # SCHEMA PRIM KEY LENGTH IN WORDS   #
            KEYLENW = (KEYLENC + 9) / 10; 
            PAKNOMAP = TRUE;       # NO MAPPING BECAUSE SCHEMA KEY     #
            INITPRKEY;             # INITIALIZE TO READ PRIMARY KEY    #
                                   # FILE OR FETCH KEY VALUES FROM     #
                                   # *KEYLIST* BUFFER                  #
            END 
          END 
        END                        # END -FIRST CALL- OPERATIONS       #
  
      IF NOT SCANALLAREA           # IF RANGETABLE EXISTS              #
      THEN
            BEGIN 
            P<RANGETABLE> = RTBLLOC;  # POSITION TO RANGETABLE         #
            BITPATTERN = RTBLWORD[0]; 
                                    # POSITION TO PSTACK PREPARED BY   #
                                    # RGTABLE TO BE USED FOR COMPARING #
                                    # KEYS                             #
            P<PROGRAMSTACK> = IFKEYLOC + IKPSTKOFFSET;
                                   # WORD POSITION WITHIN RECORD       #
            IF NOT ONEAKEY         # IF PRIMARY KEY                    #
            THEN
              BEGIN 
              TOWORDADDR[0] = FITWSA + KT$WPOS[RECDORD];
              END 
        END 
  
      IF AKEY                      # IF RM$BLP PREPARED A LIST OF      #
        AND NOT ( PKEY             # PRIMARY KEYS                      #
          OR ONEAKEY )
      THEN
        BEGIN 
        FITKL = KEYLENC;           # SCHEMA PRIMARY KEY LENGTH IN CHARS#
        IF NOT POSITIONED          # IF FILE IS NOT POSITIONED         #
        THEN
          BEGIN 
          GETPRKEY;                # FETCH NEXT PRIMARY KEY VALUE      #
          IF RC EQ EOICODE         # IF NO MORE PRIMARY KEY VALUES     #
          THEN
            BEGIN 
            RETURN;                # EXIT                              #
            END 
  
          P<RECORD> = P<AREA$TABLE> + AT$CURRKEY;  # POSITION TO KA    #
                                   # MOVE KEY VALUE INTO KA            #
          CMOVE (KEY, 0, KEYLENC, RECORD, 0); 
          END 
  
        FOR DUMMY1 = 1             # LOOP UNTIL CDCS REQUEST COMPLETED #
          WHILE RC LS 0 
        DO
          BEGIN 
          IF NOT POSITIONED        # IF READ BY PRIMARY KEY            #
          THEN
            BEGIN 
            IF CURRELLOC EQ 0      # IF ACCESSING A SINGLE AREA        #
            THEN
              BEGIN 
              P<FIT> = P<AREAFIT>;  # POSITION TO AREA FIT             #
                                    # GETPRKEY MAY HAVE CHANGED P<FIT> #
                                   # CDCS RANDOM READ ON AREA          #
IF CDCSUP THEN
              DB$RD2 (FIT, AREAORDINAL, PAKORD);
              END 
  
            ELSE
              BEGIN 
                                   # CDCS RANDOM READ ON RELATION      #
IF CDCSUP THEN
              DB$REL (FITADDRTBL, RT$ORDINAL, PAKORD, RUSLIST); 
              END 
            END 
  
          ELSE                     # IF POSITIONED (IMPLIES RELATION)  #
            BEGIN 
                                   # CDCS SEQUENTIAL READ ON RELATION  #
IF CDCSUP THEN
            DB$RELS (FITADDRTBL, RT$ORDINAL, RUSLIST);
            END 
  
          CHKAREAFIT;              # CHECK FOR ERROR/RETRY/EOI STATUS  #
          IF RC EQ RETRYCODE       # IF CDCS COULD NOT COMPLETE READ   #
          THEN
            BEGIN 
            TEST DUMMY1;           # LOOP BACK TO RETRY                #
            END 
  
          IF POSITIONED            # IF SEQUENTIAL READ ON RELATION    #
            AND RELFITES NQ NOREADRANK  # IF ROOT RANK CHANGED PRIM KEY#
          THEN
            BEGIN 
            POSITIONED = FALSE;    # FILE NO LONGER POSITIONED         #
            GETPRKEY;              # FETCH NEXT PRIMARY KEY VALUE      #
            IF RC EQ EOICODE       # IF NO MORE PRIMARY KEY VALUES     #
            THEN
              BEGIN 
              RETURN;              # EXIT                              #
              END 
  
            P<RECORD> = P<AREA$TABLE> + AT$CURRKEY;  # POSITION TO KA  #
                                   # MOVE KEY VALUE INTO KA            #
            CMOVE (KEY, 0, KEYLENC, RECORD, 0); 
            RC = SEARCHCODE;
            TEST DUMMY1;           # LOOP BACK TO READ NEXT KEY VALUE  #
            END 
          END                      # END DUMMY1 LOOP                   #
  
        IF NOT POSITIONED          # IF READ BY PRIMARY KEY            #
        THEN
          BEGIN 
          KEYCTR = KEYCTR + 1;     # INCREMENT NUMBER OF KEYS TAKEN    #
                                   # FROM *KEYLIST* BUFFER             #
          END 
  
        IF CURRELLOC NQ 0          # IF RELATIONAL READ                #
        THEN
          BEGIN 
          POSITIONED = TRUE;       # NEXT TIME DO SEQUENTIAL REL. READ #
          END 
  
        P<KEY> = P<AREA$TABLE> + AT$CURRKEY;  # POSITION TO KA         #
        P<RECORD> = FITWSA;        # POSITION TO KEY                   #
        IF FITFO EQ FOAK           # IF ACTUAL KEY ORGANIZATION        #
        THEN
          BEGIN 
          FITKL = KT$ACTKEYLNG[RECDORD];  # SUBSCHEMA PRIM KEY LEN CHAR#
                                   # MOVE SUBSCHEMA KEY VALUE TO KA    #
          CMOVE (RECORD, KT$WPOS[RECDORD] * 10 + KT$ACTKEYPOS[RECDORD], 
                 KT$ACTKEYLNG[RECDORD], KEY, 0);
          END 
  
        ELSE
          BEGIN 
          FITKL = KT$LENGTH[RECDORD];  # SUBSCHEMA PRIM KEY LEN IN CHAR#
                                   # MOVE SUBSCHEMA KEY VALUE TO KA    #
          CMOVE (RECORD, KT$WPOS[RECDORD] * 10 + KT$CPOS[RECDORD],
                 KT$LENGTH[RECDORD], KEY, 0); 
          END 
        END 
  
      ELSE                         # IF RM$BLP HAS NOT BEEN CALLED     #
        BEGIN 
        PROGSTACKLOC = P<PROGRAMSTACK>;    # PASS ADDRESS OF PROGRAM   #
                                           # STACK TO EXPEVAL          #
        IF FITFO NQ FODA           # IF NOT DIRECT ACCESS FILE         #
        THEN
          BEGIN 
          ROOTPOS = TRUE;          # ROOT RANK IS POSITIONED CORRECTLY #
          END 
  
        ELSE
          BEGIN 
          ROOTPOS = FALSE;         # WHEN NEXT CONTROL BREAK REACHED ON#
                                   # ROOT RANK, ROOT RANK WILL NOT BE  #
                                   # POSITIONED CORRECTLY              #
          END 
        FOR DUMMY1 = 0             # LOOP TO SEARCH FOR NEXT RECORD    #
          WHILE RC LS 0            # WHILE STILL SEARCHING             #
                                   # WHILE STILL ATTEMPTING CDCS REQUST#
        DO
          BEGIN 
          IF NOT POSITIONED        # IF NOT POSITIONED                 #
            AND RC NQ RETRYCODE    # IF NOT RETRYING CDCS REQUEST      #
          THEN
            BEGIN 
            SETBOUNDS;             # SET HIGH AND/OR LOW BOUNDS OF KEY #
                                   # SETBOUNDS MAY RESET *POSITIONED*  #
            IF RC EQ EOICODE       # IF END OF INFORMATION             #
            THEN
              BEGIN 
              RETURN;              # EXIT                              #
              END 
            END 
  
          IF NOT POSITIONED        # IF NOT POSITIONED                 #
          THEN
            BEGIN 
            IF ONEAKEY             # IF ACCESSING BY SINGLE ALT KEY    #
            THEN
              BEGIN 
              KEYLENW = AKT$LENGTH[0];  # SET KEY LENGTH               #
              END 
            ELSE                   # IF PRIMARY KEY                    #
              BEGIN 
              KEYLENW = KT$LENGTH;  # SET KEY LENGTH                   #
              END 
                                   # MOVE LOWKEYVALUE INTO KEY AREA    #
            CMOVE( LOWKEYVALUE, 0, KEYLENW, KEY, 0 ); 
            IF CURRELLOC EQ 0      # IF ACCESS BY SINGLE AREA          #
            THEN
              BEGIN 
                                   # CDCS RANDOM READ ON AREA          #
IF CDCSUP THEN
              DB$RD2 (FIT, AREAORDINAL, PAKORD);
              CHKAREAFIT;          # CHECK FOR ERROR/RETRY/EOI STATUS  #
              IF RC EQ RETRYCODE   # IF CDCS COULD NOT COMPLETE READ   #
              THEN
                BEGIN 
                TEST DUMMY1;       # LOOP BACK TO RETRY                #
                END 
  
              IF FITFO NQ FODA     # IF NOT DIRECT ACCESS FILE         #
                OR ONEAKEY         # ACCESSING BY SINGLE ALT KEY      # 
              THEN
                BEGIN 
                POSITIONED = TRUE; # FILE IS POSITIONED CORRECTLY      #
                END 
              END 
  
            ELSE                   # QUERY BY RELATION                 #
              BEGIN 
                                   # CDCS RANDOM READ ON RELATION      #
IF CDCSUP THEN
              DB$REL (FITADDRTBL, RT$ORDINAL, PAKORD, RUSLIST); 
              CHKAREAFIT;          # CHECK FOR ERROR/RETRY/EOI STATUS  #
              IF RC EQ RETRYCODE   # IF CDCS COULD NOT COMPLETE READ   #
              THEN
                BEGIN 
                TEST DUMMY1;       # LOOP BACK TO RETRY                #
                END 
  
              POSITIONED = TRUE;
              END 
            END 
  
          ELSE                     # IF POSITIONED                     #
            BEGIN 
            IF CURRELLOC EQ 0      # IF ACCESS BY SINGLE AREA          #
            THEN
              BEGIN 
                                   # CDCS SEQUENTIAL READ ON AREA      #
IF CDCSUP THEN
              DB$RD1 (FIT, AREAORDINAL);
              END 
  
            ELSE                   # IF QUERY BY RELATION              #
              BEGIN 
                                   # CDCS SEQUENTIAL READ ON RELATION  #
IF CDCSUP THEN
              DB$RELS (FITADDRTBL, RT$ORDINAL, RUSLIST);
              END 
  
            CHKAREAFIT;            # CHECK FOR ERROR/RETRY/EOI STATUS  #
            IF RC EQ RETRYCODE     # IF CDCS COULD NOT COMPLETE READ   #
            THEN
              BEGIN 
              TEST DUMMY1;         # LOOP BACK TO RETRY                #
              END 
  
            P<RECORD> = FITWSA; 
                                   # MOVE KEY VALUE INTO KEY AREA      #
            IF ONEAKEY             # IF ALTERNATE KEY                  #
            THEN
              BEGIN 
              CMOVE( RECORD, AKT$WPOS[0]*10+AKT$CPOS[0],
                     AKT$LENGTH[0], KEY, 0 ); 
              END 
            ELSE                   # IF PRIMARY KEY                    #
              BEGIN 
              CMOVE( RECORD, KT$WPOS[RECDORD]*10+KT$CPOS[RECDORD],
                     KT$LENGTH[RECDORD], KEY, 0 );
              END 
            IF NOT SCANALLAREA            # IF USING RANGETABLE        #
              AND CURRELLOC NQ 0          # IF QUERY BY RELATION       #
              AND RELFITES NQ NOREADRANK  # IF ROOT RANK HAS CHANGED   #
            THEN
              BEGIN 
              POSITIONED = ROOTPOS;  # RESTORE POSITION FLAG OF ROOT   #
              END 
            END 
  
          IF NOT SCANALLAREA        # IF USING RANGETABLE              #
            AND RC EQ RECFOUNDCODE  # IF RECORD HAS BEEN READ          #
          THEN
            BEGIN 
            CHECKKEY;              # SET RC TO SEARCHCODE IF KEY DOES  #
                                   # NOT SATISFY RANGE TABLE           #
            END 
          END                      # END DUMMY1 LOOP                   #
        END 
  
      IF RC EQ RECFOUNDCODE        # IF GOOD RECORD HAS BEEN READ      #
      THEN
        BEGIN 
                                   # IF ACCESSING BY SINGLE ALT KEY    #
        IF ONEAKEY                 # RESET FIT TO DESCRIBE PRIM KEY    #
        THEN
          BEGIN 
          FITRKW = KT$WPOS[1];     # WORD POSITION                     #
          IF FITFO EQ FOAK         # IF ACTUAL KEY                     #
          THEN
            BEGIN 
            FITRKP = KT$ACTKEYPOS[1];  # CHAR POS IN RECORD            #
            FITKP  = KT$ACTKEYPOS[1];  # CHAR POS IN KA                #
            FITKL  = KT$ACTKEYLNG[1];  # KEY LENGTH                    #
            END 
          ELSE                     # IF *IS* OR *DA* FILE              #
            BEGIN 
            FITRKP = KT$CPOS[1];   # CHAR POS IN RECORD                #
            FITKL  = KT$LENGTH[1]; # KEY LENGTH                        #
            END 
                                   # MOVE KEY FROM RECORD TO KA        #
          P<RECORD> = FITWSA; 
          CMOVE( RECORD, KT$WPOS[1]*10+KT$CPOS[1],
                 KT$LENGTH[1], KEY, 0 );
          END 
        IF FITRT GQ RTR            # IF VARIABLE LENGTH RECORD         #
          AND FITRT LQ RTT
        THEN
          BEGIN 
          AREALOC = P<AREA$TABLE>;
          BGFILL;                  # PAD RECORD WITH BACKGROUND IMAGE  #
          END 
  
        RECORDLENGTH = FITRL;      # SET RECORD LENGTH                 #
        IF CURRELLOC NQ 0          # IF QUERY BY RELATION              #
        THEN
          BEGIN 
          FOR DUMMY1 = 1 STEP 1    # LOOP THROUGH NON-ROOT AREAS IN    #
                                   # FIT ADDRESS TABLE                 #
            WHILE FITADDR[DUMMY1] NQ 0
          DO
            BEGIN 
            P<FIT> = FITADDR[DUMMY1];  # POSITION TO FIT               #
            AREALOC = P<FIT> - AT$FITOFFSET;  # CALCULATE AREATBL ADDR #
            IF DBSRANKNULL NQ 0    # IF NULL OCCURRENCE IN RELATION    #
                                   # THIS AREA HAS NULL OCCURRENCE     #
              AND DUMMY1 GQ DBSRANKNULL - 1 
            THEN
              BEGIN 
              BGIMAGE;             # COPY BACKGROUND IMAGE TO RECORD   #
              END 
  
            ELSE
              BEGIN 
              IF FITRT GQ RTR      # IF VARIABLE LENGTH RECORD         #
                AND FITRT LQ RTT
              THEN
                BEGIN 
                BGFILL;            # PAD RECORD WITH BACKGROUND IMAGE  #
                END 
              END 
            END                    # END DUMMY1 LOOP                   #
          AREALOC = FITADDR - AT$FITOFFSET;  # RESET AREALOC TO LOWEST #
                                             # RANK AREA               #
          END 
        END 
      RETURN; 
      END                          # END PROC    C D C S G E T         #
      TERM
