*DECK NEXTGET 
USETEXT TAREATB 
USETEXT TCOMMON 
USETEXT TCRMDEF 
USETEXT TDBPDEF 
USETEXT TENVIRN 
USETEXT TEXPRES 
USETEXT TFIT
USETEXT TLFNINF 
USETEXT TPSTACK 
USETEXT TSBASIC 
       PROC NEXTGET(RC);  BEGIN 
                                                                         NEXTGET
           XREF PROC GET; 
           XREF PROC GETN;
           XREF PROC EXPEVALUATE; 
           ITEM WLG;
           ITEM RC; 
      XREF ITEM ATPTR I;           # P<AREA$TABLE> AT CALL TO *NEXTGET*#
      ARRAY EXPRSTACK [9];
        ITEM STACKADDR I (0,42,18), 
             PSTKPTR I (0,24,18); 
  
          #FILE DEFINITION BLOCK (FDB) FOR THE AREA, CONTAINING 
           PERMANENT FILE NAME, LOCAL FILE NAME, ID, CYCLE, PASSWORDS 
           AS APPROPRIATE.  THIS ARRAY IS FILLED IN BY OVERLAY 1-2
           DURING USE SYNTAX ANALYSIS.  # 
          BASED ARRAY AREANAME;  ITEM ARNAM C(0,0,10),
                                      PFWORD I; 
  
          #FILE DEFINITION BLOCK (FDB) FOR THE SCHEMA.
           THIS ARRAY IS FILLED IN BY OVERLAY 5-0 AS PART OF THE
           FUNCTIONS PERFORMED BY THE USE EXECUTION MODULE.  #
          BASED ARRAY SCHNAME;     ITEM SCHNAM C(0,0,10), 
                                        SPFWORD I;
                                                                        000160
      XREF BASED ARRAY DESPTR;
        ITEM DESCOUNT I (0,0,12),  # NUNBER OF LOCAL FILES REFERENCING #
                                   # THIS LIST OF DESCRIBE ITEMS.      #
             DESADDR  U (0,42,18); # ADDRESS OF LIST OF ITEMS.         #
      BASED ARRAY FITMAPPER;; 
      XREF BASED ARRAY SAVDAREA;
        BEGIN 
        ITEM AREASAVE  U(0,42,18);
        END 
      XREF ITEM FROMKEYINFIT I;    # ADDRESS OF *FROM* OR *KEY IN* FIT #
      XREF ITEM RECDORD I;         # RECORD ORDINAL USED BY THIS XMISSN#
  
      XREF PROC CALLOWN;           # ATTEMPTS TO CALL DATABASE PROCS   #
      XREF PROC CHKRET;            # CALL *RETRIEVAL* DBP AND COUNT REJ#
      XREF ITEM DBP$DID B;         # TRUE IF WE DID CALL A DBP         #
      XREF PROC BGFILL;            # PAD RECORD WITH BACKGROUND IMAGE  #
      ITEM KEYCTR;
      XREF PROC GETP; 
      XREF PROC OPENM;
      XREF PROC RETURNM;
      XREF PROC REWND;             # CRM REWIND FILE                   #
      XREF PROC CLOSEM; 
BASED ARRAY KEYWSA; ITEM KWSA;
      XREF ARRAY KEYFLFIT;
        BEGIN 
        ITEM KEYFLNAM  U(0,0,42);  # FILE NAME                         #
        END 
  
      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 
  
          ITEM I; 
      XREF ITEM RA0;
      XREF ITEM DUMMY;                                                   NEXTGET
      XREF ITEM UNIVERSAL;
        DEF EOICODE #1#;
        DEF ERRFOUNDCODE #2#; 
        DEF IKPSTKOFFSET #17#;     # OFFSET WITHIN IFKEYLOC WHERE      #
                                   # RGTABLE PREPARES PROGRAM STACK    #
                                   # TO BE USED FOR COMPARING KEYS     #
        DEF RECFOUNDCODE #0#; 
        DEF SEARCHCODE #-1#;
        XREF PROC BEFIMAGE; 
        XREF PROC CMOVE;
        XREF ITEM RTBLCALL; 
        ITEM BITPATTERN;
        ITEM USEHIBOUND B;
        ITEM CHKLOWBOUND B;    # APPLIES TO SEQFILE PROCESSING #
        ITEM KEEPSAMEREC B; 
        ITEM BITPAIR; 
        ITEM LOWKEYSORD;
        ITEM HIGHKEYSORD; 
        ITEM BITLOC;
        ITEM WORDLOC; 
      ITEM NUMKEYS I;              # NUMBER OF KEYS - 1 THAT WILL FIT  #
                                   # IN *KEYLIST* BUFFER               #
      ITEM KEYLENW I;              # LENGTH OF PRIMARY KEY IN WORDS    #
      ITEM DBPRC I;                # RETURN CODE FROM CALL TO A DBP    #
      XREF ITEM DBP$ACTION I;      # DBP PARAMETER INDICATES WHAT CRM  #
                                   # FUNCTION IS NEEDED FROM DBP.      #
      ITEM REJ B;                  # TRUE IF DBP REJECTS THE RECORD    #
        ITEM DUMMY1;
        ITEM DUMMY2;
        ITEM POSITIONED B;
        ITEM LOOPCON B;                        # LOOP CONTROL VARIABLE #
        ITEM LOWWORD I;                        # ITEMS USED FOR        #
        ITEM LOWCHAR I;                        # HOLDING VALUES.       #
        BASED ARRAY LOWKEYVALUE; ITEM LKEYVAL;
        BASED ARRAY HIGHKEYVALUE; ITEM HKEYVAL; 
        BASED ARRAY RANGETABLE; ITEM RTBLWORD I(0,0,60);
        ITEM SUBSTCHAR; 
         ITEM SAVELOWLOC; 
         BASED ARRAY SAVELOWKEY;  ITEM SAVELOW; 
         BASED ARRAY COLSEQ;
         BEGIN
               ITEM ICOL C (0,54,1),
                    COLWORD I (0,0,60); 
         END
CONTROL EJECT;                                                           NEXTGET
        PROC CHKAREAFIT;
      BEGIN 
      P<FIT > = P<AREAFIT>; 
  
      IF DBP$DID                   # IF WE DID CALL A DBP              #
      THEN
        BEGIN 
        IF DBPRC EQ 1              # AND NO RECORD WAS RETRIEVED       #
        THEN
          BEGIN 
          IF FITES NQ UNKNOWNKEY   #   IF NOT UNKNOWN KEY ERROR        #
            AND FITES NQ UNKNWNALTKEY 
          THEN
            BEGIN                  #       SEARCH NO MORE.             #
            RC = EOICODE; 
            END                    #   ELSE, CONTINUE SEARCHING.       #
          END 
        ELSE
          BEGIN                    # ELSE, IF A RECORD IS RETRIEVED,   #
          IOS = IOS + 1;
          RC = RECFOUNDCODE;       #      SET RECORD FOUND FLAG.       #
          END 
        RETURN;                    # RETURN IN ALL DBP CASES.          #
        END 
  
      IF FITES NQ 0                # IF ERROR DETECTED                 #
        AND FITES NQ UNKNOWNKEY    # IGNORE UNKNOWN KEY ERROR          #
        AND FITES NQ UNKNWNALTKEY  # IGNORE UNKNOWN KEY ERROR          #
      THEN
        BEGIN 
        RC = ERRFOUNDCODE;
        RETURN; 
        END 
  
      IF FITFP EQ O"100"           # IF AT EOI                         #
      THEN
        BEGIN 
        RC = EOICODE; 
        RETURN; 
        END 
  
      IF ONEAKEY                   # IF ACCESSING BY ALTERNATE KEY     #
      THEN
        BEGIN 
        IF FITES EQ UNKNWNALTKEY   # IF UNKNOWN KEY, TRY AGAIN         #
        THEN
          BEGIN 
          RETURN; 
          END 
        END 
  
      ELSE                         # IF ACCESSING BY PRIMARY KEY       #
        BEGIN 
        IF FITFP NQ O"20"          # IF NOT AN EOR, MUST BE EOF        #
          OR FITES EQ UNKNOWNKEY   # IF UNKNOWN KEY, TRY AGAIN         #
        THEN
          BEGIN 
          RETURN; 
          END 
        END 
  
      IOS = IOS + 1;               # INCREMENT NO. OF RECORDS READ FOR #
                                   # DIAG 1006 MESSAGE                 #
      RC = RECFOUNDCODE;           # FLAG RECORD READ                  #
      RETURN; 
      END 
CONTROL EJECT;
*CALL CHECKKEY
CONTROL EJECT;
*CALL GETPRKEY
CONTROL EJECT;
*CALL INITPRKEY 
CONTROL EJECT;
*CALL SETBOUNDS 
      CONTROL EJECT;
#                                                                #
#  NEXTGET---THIS PROC READS RECORDS FROM THE AREA FILE AND      #
#            RETURNS THE RECORD TO CTL40.  IF A RANGE TABLE      #
#            EXISTS, ONLY THE RECORDS WHICH CONTAIN KEY VALUES   #
#            WITHIN THE SPECIFIED RANGE WILL BE RETURNED.        #
        RC = SEARCHCODE;
        P<AREA$TABLE> = ATPTR;     # POSITION AREA$TABLE               #
        IF FROMKEYINFIT NQ 0       # IF *FROM* FILE                    #
          AND DESPASS 
        THEN
          BEGIN 
          P<FIT> = FROMKEYINFIT;
          P<RECORD> = CURRENTSOURC; 
          FOR DUMMY1=0 WHILE RC EQ SEARCHCODE DO
            BEGIN 
            GET(FIT, RECORD, RA0);
            IF FITFP EQ O"100" THEN                                      NEXTGET
              BEGIN                                                      NEXTGET
              RC = EOICODE;                                              NEXTGET
              END                                                        NEXTGET
                                                                         NEXTGET
            IF FITES NQ 0          # IF A CRM ERROR OCCURED            #
            THEN
              BEGIN 
              RC = ERRFOUNDCODE;   # SET FLAG FOR CRM ERROR            #
              END 
            ELSE                                                         NEXTGET
              BEGIN                                                      NEXTGET
              IF FITFP EQ O"20"                                          NEXTGET
              THEN                                                       NEXTGET
                BEGIN                                                    NEXTGET
              IOS = IOS + 1;       # INCREMENT NO. OF CRM ACCESSES FOR #
                                   # DIAG 1006 MESSAGE                 #
                RC = RECFOUNDCODE; # FLAG RECORD READ                  #
                END                                                      NEXTGET
              END                                                        NEXTGET
            END 
          END 
          ELSE               # READ RECORDS FROM THE AREA FILE       #
          BEGIN 
          P<AREA$TABLE> = AREALOC;             # GET CURRENT AREA INFO #
          P<KEY$TBL> = AT$PKEYDPTR;  # POSITION TO KEY DESC TABLE      #
          ATPTR = P<AREA$TABLE>;   # RETURN NEW POSITION TO CALLER     #
          P<KEY> = P<AREA$TABLE> + AT$CURRKEY[0]; 
          P<AREAFIT> = LOC(AT$AFITPOS[0]);
          P<FIT> = P<AREAFIT>;                                           NEXTGET
          P<RECORD> = FITWSA;      #POINT TO THE WORKING STORAGE AREA  # NEXTGET
          IF ONEAKEY               # IF ACCESSING BY SINGLE ALT KEY    #
          THEN                     # SET FIT TO DESCRIBE ALT KEY       #
            BEGIN 
            FITRKP = AKT$CPOS[0];  # CHARACTER POSITION IN RECORD      #
            FITKP  = 0;            # CHARACTER POSITION IN KA          #
            FITKL  = AKT$LENGTH[0];  # KEY LENGTH                      #
            FITRKW = AKT$WPOS[0];  # WORD POSITION                     #
            END 
  
                                                                         NEXTGET
          P<CCOMMON> = CCOMLOC; 
            KEEPSAMEREC = FALSE;
            IF SCANALLAREA         # IF NO RANGE TABLE EXISTS          #
            THEN
              BEGIN 
              POSITIONED = TRUE;   # CONSIDER FILE POSITIONED          #
              END 
            ELSE
              BEGIN 
              IF NOT (PKEY         # IF ACCESS BY NEITHER PRIMARY KEY  #
                OR ONEAKEY)        # NOR BY LONE ALTERNATE KEY         #
              THEN
                BEGIN 
                GOTO PROCKEY;      # GO TO PROC FOR ALTERNATE KEYS     #
                END 
              ELSE
                BEGIN 
                                   # ACCESSING BY PRIMARY OR           #
                                   # BY SINGLE ALTERNATE KEY           #
                IF BITINDEX EQ -2  # IF FIRST CALL IN THIS PASS        #
                THEN
                  BEGIN 
                  POSITIONED = FALSE;  # ASSUME FILE IS NOT POSITIONED #
                  IF ONEAKEY       # IF ACCESSING BY ALTERNATE KEY     #
                    AND FITORG     # IF MIP NEW                        #
                  THEN
                    BEGIN 
                    DBP$ACTION = 1;          # DBP SHOULD DO *REWIND*  #
                    CALLOWN(ON"SEARCH", DBPRC); 
                    IF NOT DBP$DID           # IF NO DBP WAS CALLED,   #
                    THEN
                      BEGIN 
                      REWND (FIT);           # LET CRM DO REWIND.      #
                      END 
                    END 
  
                  END 
                P<RANGETABLE> = RTBLLOC;
                BITPATTERN = RTBLWORD[0]; 
                P<PROGRAMSTACK> = IFKEYLOC + IKPSTKOFFSET;
                                   # POSITION TO PSTACK PREPARED BY    #
                                   # RGTABLE TO BE USED FOR COMPARING  #
                                   # KEYS                              #
                PROGSTACKLOC = P<PROGRAMSTACK>; 
                IF NOT (AT$KEYEXCL[0]  # IF KEY WITHIN RECORD          #
                  OR ONEAKEY)      # IF ACCESSING BY PRIMARY KEY       #
                THEN
                  BEGIN 
                                   # WORD POSITION WITHIN RECORD       #
                  TOWORDADDR[0] = FITWSA + KT$WPOS[RECDORD];
                  END 
                END 
              END 
  
            FOR DUMMY1=0 WHILE RC EQ SEARCHCODE DO
              BEGIN 
              IF NOT POSITIONED 
                THEN
                BEGIN 
                SETBOUNDS;
                IF RC EQ EOICODE THEN TEST DUMMY1;
                END 
                                                                         NEXTGET
              P<FIT> = LOC(AT$AFITPOS);  #RESET FOR ADDED SECURITY     # NEXTGET
              IF NOT KEEPSAMEREC   # IF READY FOR NEXT RECORD          #
              THEN
                BEGIN 
                IF POSITIONED      # IF FILE IS POSITIONED             #
                THEN
                  BEGIN 
                  IF FITFO EQ FOSQ       # IF SEQUENTIAL FILE          #
                  THEN
                    BEGIN 
                    DBP$ACTION = 2;          # DBP SHOULD DO *GET*     #
                    CALLOWN(ON"SEARCH", DBPRC); 
                    IF NOT DBP$DID           # IF NO DBP WAS CALLED    #
                    THEN
                      BEGIN 
                      GET(AREAFIT, RA0);     # DO CRM GET.             #
                      END 
                    END 
                  ELSE
                    BEGIN 
                                   # FILE IS NOT SEQUENTIAL            #
                    DBP$ACTION = 3;          # DBP SHOULD DO *GETN*    #
                    CALLOWN(ON"SEARCH", DBPRC); 
                    IF NOT DBP$DID           # IF NO DBP WAS CALLED    #
                    THEN
                      BEGIN 
                      GETN(AREAFIT,RA0);     # DO CRM GETN.            #
                      END 
                    IF FITFO EQ FODA     # IF DIRECT ACCESS FILE       #
                      AND NOT ONEAKEY  # ACCESSING BY PRIMARY KEY      #
                    THEN
                      BEGIN 
                                          # SET -KEY- TO KEY IN CURRENT#
                                          # RECORD                     #
                      P<RECORD> = FITWSA; 
                      CMOVE(RECORD, KT$WPOS[1] * 10 + KT$CPOS[1], 
                            KT$LENGTH[1], KEY, 0);
                      END 
                    END 
                  END 
                ELSE
                  BEGIN 
# IF THE FILE IS NOT POSITIONED, MOVE THE LOWKEYVALUE INTO THE KEY     #
# FIELD USED FOR RECORD RETRIEVAL, THEN POSITION ACCORDING TO THAT     #
# KEY VALUE.                                                           #
                  IF ONEAKEY       # IF ACCESSING BY ALTERNATE KEY     #
                  THEN
                    BEGIN 
                    KEYLENW = AKT$LENGTH[0];  # LENGTH OF ALTERNATE KEY#
                    END 
  
                  ELSE             # IF ACCESSING BY PRIMARY KEY       #
                    BEGIN 
                    KEYLENW = KT$LENGTH[1];  # LENGTH OF PRIMARY KEY   #
                    END 
  
                  CMOVE (LOWKEYVALUE, 0, KEYLENW, KEY, 0);
                  DBP$ACTION = 2;            # DBP SHOULD DO *GET*     #
                  CALLOWN(ON"SEARCH", DBPRC); 
                  IF NOT DBP$DID             # IF NO DBP WAS CALLED    #
                  THEN
                    BEGIN 
                    GET(FIT, RA0);           # DO CRM GET.             #
                    END 
                  IF FITFO NQ FODA      # IF NOT DIRECT ACCESS FILE    #
                    OR ONEAKEY     # ACCESSING BY ALTERNATE KEY        #
                  THEN
                    BEGIN 
                    POSITIONED = TRUE;  # FILE IS POSITIONED CORRECTLY #
                    END 
                  END 
                CHKAREAFIT;        # CHECK FILE POS. AND ERROR STATUS  #
                END 
              ELSE
                BEGIN 
                KEEPSAMEREC = FALSE;  # SET FLAG TO INDICATE NEXT      #
                                      # RECORD SHOULD BE READ          #
                END 
              IF RC EQ RECFOUNDCODE  # IF RECORD WAS RETRIEVED         #
                AND NOT DBP$DID 
              THEN
                BEGIN 
                CHKRET(REJ);       # CHECK *ON RETRIEVAL* PROCEDURE    #
                IF REJ             # IF DBP SAID IGNORE THE RECORD     #
                THEN
                  BEGIN 
                  RC = SEARCHCODE; # NO RECORD READ                    #
                  END 
                END 
  
              IF NOT SCANALLAREA AND RC EQ RECFOUNDCODE 
                THEN CHECKKEY;
              END 
          END 
      CHKRC: # #
        IF RC EQ RECFOUNDCODE 
          THEN
          BEGIN 
          IF ONEAKEY               # IF ACCESSING BY SINGLE ALT KEY    #
          THEN                     # RESET FIT TO DESCRIBE PRIM KEY    #
            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*                   #
              BEGIN 
              FITRKP = KT$CPOS[1];  # CHAR POS IN RECORD               #
              FITKL  = KT$LENGTH[1];  # KEY LENGTH                     #
              END 
  
                                   # MOVE KEY FROM RECORD TO KA        #
            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
            AND NOT DESPASS        # NOT DISPLAY FROM                  #
          THEN
            BEGIN 
            AREALOC = P<AREA$TABLE>;
            BGFILL;                # PAD RECORD WITH BACKGROUND IMAGE  #
            END 
          IF FROMKEYINFIT NQ 0     # IF *FROM* FILE                    #
            AND DESPASS                                                  NEXTGET
          THEN                                                           NEXTGET
            BEGIN                                                        NEXTGET
            P<FIT> = LOC(L$FITLOC);                                      NEXTGET
            END                                                          NEXTGET
                                                                         NEXTGET
          ELSE                                                           NEXTGET
            BEGIN                                                        NEXTGET
            P<FIT> = P<AREAFIT>;                                         NEXTGET
            END                                                          NEXTGET
                                                                         NEXTGET
          P<RECORD> = FITWSA; 
          BEFIMAGE (RECORD);       # SAVE THE BEFORE IMAGE OF RECORD   #
          RECORDLENGTH = FITRL;                                          NEXTGET
          END 
        RETURN; 
   PROCKEY: # # 
      P<FIT> = P<AREAFIT>;                                               NEXTGET
      P<RECORD> = FITWSA;                                                NEXTGET
      IF BITINDEX EQ -2 THEN
        BEGIN 
                                   # LENGTH OF PRIMARY KEY IN WORDS    #
        KEYLENW = (KT$LENGTH[RECDORD] + 9) / 10;
        INITPRKEY;                 # INITIALIZE TO READ PRIMARY KEY    #
                                   # FILE OR FETCH KEY VALUES FROM     #
                                   # *KEYLIST* BUFFER                  #
        END 
  
      GETPRKEY;                    # POSITION P<KEY> TO NEXT PRIMARY   #
                                   # KEY VALUE                         #
      IF RC EQ EOICODE             # IF NO MORE PRIMARY KEYS           #
      THEN
        BEGIN 
        RETURN; 
        END 
  
      P<FIT> = P<AREAFIT>;                                               NEXTGET
      FITKA = P<KEY>;                                                    NEXTGET
      GET(FIT, RECORD, KEY, RA0);                                        NEXTGET
      P<RECORD> = P<AREA$TABLE> + AT$CURRKEY[0];
      CMOVE (KEY, 0, KT$LENGTH[1], RECORD, 0);  # MOVE KEY FROM RECORD #
                                               # TO -KEY-.             #
      CHKAREAFIT; 
      IF RC EQ RECFOUNDCODE        # IF RECORD WAS RETRIEVED           #
        AND NOT DBP$DID 
      THEN
        BEGIN 
        CHKRET(REJ);               # CHECK *ON RETRIEVAL* PROCEDURE    #
        IF REJ                     # IF DBP SAID IGNORE THE RECORD     #
        THEN
          BEGIN 
          RC = SEARCHCODE;         # NO RECORD READ                    #
          END 
        END 
  
      KEYCTR = KEYCTR + 1;
      GOTO CHKRC; 
        END 
        TERM
