*DECK NEXTREC 
USETEXT TIMF
USETEXT TIMFDEF 
USETEXT TPSTACK 
USETEXT TSBASIC 
PROC NEXTREC (RANGETABLE, LEVEL); 
BEGIN 
  
  
  
    ARRAY RANGETABLE[0:MAXRANGE]; 
    BEGIN 
      ITEM RANGEINDX U( 0, 6, 6); 
      ITEM RANGEWORD I( 0, 0,60); 
      ITEM INTERVAL  B( 0, 0, 1); 
      ITEM SPOT      B( 0, 1, 1); 
      ITEM LITERAL   U( 0,24,18); 
      ITEM KEYITEM   U( 0,42,18); 
    END 
  
ITEM LEVEL I;                # SET TO 0 BY CALLER TO INDICATE BEGINNING#
                             # OF QUERY.  SET TO 0 BY NEXTREC TO       #
                             # INDICATE END OF QUERY, OR TO 1 TO N     #
                             # TO INDICATE THE NUMBER OF RECORDS IN    #
                             # THE EXTENDED TUPLE.                     #
  
XREF PROC DIAG510;                 # DIAGNOSE ERROR AND CLEANUP        #
                                   # AND EXIT OVERLAY                  #
XREF PROC MOVEC;             # MOVES CHARACTER STRINGS                 #
XREF FUNC COMPARE B;
XREF FUNC EXEC$ C(10);
 XREF PROC DIAG;
  
XREF ITEM ENDREC B;                # TRUE IF ERROR FATAL AND MUST EXIT #
                                   # OVERLAY                           #
  
ARRAY MOVEPARAM[0:0] S(2);         # PARAMETER TO MOVE LITERAL TO KEY  #
  BEGIN 
    ITEM FCHAR    U(0,04,04); 
    ITEM TCHAR    U(0,08,04); 
    ITEM NCHAR    U(0,12,12); 
    ITEM FWORDREL U(0,24,18); 
    ITEM TWORDREL U(0,42,18); 
    ITEM FWORDABS U(1,24,18); 
    ITEM TWORDABS U(1,42,18); 
  END 
  
BASED ARRAY RECORD;    ITEM CRECORD  C(0,0,10),  IRECORD  I(0,0,60);
  
ITEM CODE;
ITEM CHARPTR I;                    # CHARACTER POINTER                 #
ITEM WORDPTR I;                    # WORD POINTER                      #
ITEM KEYCHARS I;             # NBR OF CHARS IN KEY                     #
ITEM M I;                    # SCRATCH VARIABLE                        #
ITEM J, K, L;                # SCRATCH VARIABLES                       #
  
DEF  CODEEQ        # O"36" # ;
DEF  CODEGR        # O"55" # ;
DEF  CODEGQ        # O"57" # ;
DEF  OBTAIN        # 41 # ; 
DEF  OBTORHIGHER   # 43 # ; 
DEF  OBTFIRST      # 61 # ; 
DEF  OBTNEXT       # 63 # ; 
DEF  OBTNXTDUPLIC  # 65 # ; 
DEF  OBTNXTDIFFER  # 66 # ; 
DEF  OBTFIRSTMEM   # 71 # ; 
DEF  OBTNEXTMEM    # 72 # ; 
DEF  OBTOWNER      # 75 # ; 
DEF  RANGEPTR      # RANGEINDX[0] # ; 
DEF  CALL          #  # ; 
  
  
  
#----------------------------------------------------------------------#
  
          IF LEVEL EQ 0 THEN
          BEGIN 
             LEVEL = 1; 
             BOI [1] = TRUE;
          END 
                                   #  CHECK TO SEE IF THERE EXISTS     #
                                   #  AN ACCESS PATH FOR THE RECORD    #
  
  
          IF PATHCOSETID[LEVEL] EQ 0
          THEN
            BEGIN 
            CALL DIAG(541); 
            LEVEL = 0;             #  ENABLES A PROPER EXIT            #
            RETURN; 
            END 
  
                             # CLEAR THE RECORD AREAS FROM THE CURRENT #
                             # LEVEL UP TO THE HIGHEST LEVEL.          #
          FOR L=LEVEL STEP 1 WHILE THREADENTRY [L] NQ 0 DO
          BEGIN 
             P<RECORD> = RECORDWSA [THISRECORDID [L] ]; 
             K         = RECORDLGW [THISRECORDID [L] ] - 1; 
             FOR J=0 STEP 1 UNTIL K DO  CRECORD [J] = " ";
          END 
  
          FOR K=K  DO 
          BEGIN 
          P<RECORD> = RECORDWSA [THISRECORDID [LEVEL ] ]; 
          RECORDID = THISRECORDID [LEVEL];
          PATHID = PATHCOSETID [LEVEL]; 
          COSETID = PATHCOSETID [LEVEL];
             IF LEVEL EQ 1   THEN  CALL NEXTROOT; 
                             ELSE  CALL NEXTTWIG; 
  
             IF ERRSTATEMENT NQ STV$OK THEN 
             BEGIN
                LEVEL = LEVEL - 1;
                IF LEVEL EQ 0 OR BOI [LEVEL+1] THEN RETURN; 
                                                    #-----# 
             END
             ELSE 
             BEGIN
                BOI [LEVEL] = FALSE;
                IF THREADENTRY [LEVEL+1] EQ 0 THEN RETURN;
                                                   #-----#
                LEVEL = LEVEL + 1;
                BOI [LEVEL] = TRUE; 
             END
          END 
          RETURN; 
          #-----# 
  
  
  
#----------------------------------------------------------------------#
  
PROC NEXTROOT;
  BEGIN 
          FOR J=0 STEP 1 UNTIL RECORDLGW [THISRECORDID [LEVEL ]] - 1
                   DO  IRECORD [J] = 0;  # PRESET TO 0 SO THAT ACCESSES#
                                         # ON MAJOR SEARCH KEYS HAVE   #
                                         # MINOR KEYS SET TO LOWEST    #
                                         # COLLATING SEQUENCE CHARACTER#
  
          IF BOI [LEVEL] THEN 
          BEGIN 
            RANGEPTR = 0; 
            DML = OBTFIRST; 
          END 
          ELSE
            DML = OBTNEXT;
  
          IF RANGEWORD[RANGEPTR] EQ 0 THEN
          BEGIN 
            ERRSTATEMENT = STV$EOI;        # END OF INFORMATION REACHED#
            RETURN; 
          END 
  
          IF LITERAL [RANGEPTR] NQ 0 THEN 
                             # PLACE KEY VALUE IN RECORD AREA          #
          BEGIN 
            P<PROGRAMSTACK> = KEYITEM [RANGEPTR]; 
            TCHAR = RELTOCHAR;
            KEYCHARS = NBRCHARS;   # NBR OF CHARS IN KEY               #
            TWORDREL = TOWORDADDR;
            TWORDABS = TOWORDBASE;
            P<PROGRAMSTACK> = LITERAL [RANGEPTR]; 
            NCHAR = ALTKEYSIZE; 
            FCHAR = RELFROMCHAR;
            FWORDREL = FROMWORDADDR;
            FWORDABS = FROMWORDBASE;
            CALL MOVEC(MOVEPARAM);
            IF NCHAR LS NBRCHARS THEN    # A UNIVERSAL CHARACTER IS IN #
            BEGIN                        # THE LITERAL.  A BINARY ZERO #
              BASED ARRAY W; ITEM CW;    # MUST BE APPENDED TO IT IN   #
              P<W> = TWORDABS;           # THE RECORD AREA BECAUSE OF  #
              P<W> = CW + TWORDREL;      # THE DISPLAY CODE COLLATING  #
                                         # SEQUENCE USED BY IMF 0.     #
              WORDPTR = (TCHAR + NCHAR) / 10; 
              CHARPTR = TCHAR + NCHAR - (WORDPTR * 10); 
              C<CHARPTR,1>CW[WORDPTR] = O"00";
            END 
            ELSE
              BEGIN 
              IF NBRCHARS LS KEYCHARS  # IF LITERAL SHORTER THAN KEY   #
              THEN
                BEGIN 
                P<W> = TWORDABS;
                P<W> = CW + TWORDREL;  # POSITION TO RECORD AREA       #
                WORDPTR = (TCHAR + NBRCHARS) / 10;
                CHARPTR = TCHAR + NBRCHARS - (WORDPTR * 10);
                FOR M = NBRCHARS STEP 1 
                  UNTIL KEYCHARS - 1
                DO
                  BEGIN 
                  C<CHARPTR,1>CW[WORDPTR] = " ";  # BLANK FILL KEY AREA#
                  CHARPTR = CHARPTR + 1;  # INCREMENT TO NEXT CHAR     #
                  IF CHARPTR EQ 10  # IF NEXT WORD                     #
                  THEN
                    BEGIN 
                    WORDPTR = WORDPTR + 1;  # INCREMENT TO NEXT WORD   #
                    CHARPTR = 0;
                    END 
                  END 
                END 
              END 
  
          END 
  
          IF NOT INTERVAL [RANGEPTR] THEN DML = OBTORHIGHER;
  
            ERRSTATEMENT = EXEC$ (RECORD);
            IF ERRCODE GQ STV$FILEBUSY  # IF SOME ERROR OTHER THAN     #
                                        # RECORD NOT FOUND             #
            THEN
              BEGIN 
              DIAG510 ("OBTAIN");  # ISSUE DIAG, CLEANUP AND EXIT OVLAY#
              IF ENDREC            # IF SERIOUS IMF ERROR              #
              THEN
                BEGIN 
                RETURN;            # RETURN TO EXIT OVERLAY            #
                END 
              END 
  
            IOS = IOS + 1;
            IF ERRSTATEMENT NQ STV$OK THEN RETURN;
  
          IF INTERVAL [RANGEPTR] THEN 
          BEGIN 
            IF SPOT [RANGEPTR] THEN CODE = CODEGR;
                               ELSE CODE = CODEGQ;
            IF LITERAL [RANGEPTR] NQ 0
            AND COMPARE(KEYITEM [RANGEPTR], CODE, LITERAL [RANGEPTR]) 
            THEN  RANGEPTR = RANGEPTR + 1;
          END 
          ELSE
          BEGIN 
            IF NOT SPOT [RANGEPTR]
            AND LITERAL [RANGEPTR] NQ 0 
            AND COMPARE(KEYITEM [RANGEPTR], CODEEQ, LITERAL [RANGEPTR]) 
            THEN
            BEGIN 
              DML = OBTNXTDIFFER; 
              ERRSTATEMENT = EXEC$ (RECORD);
              IF ERRCODE GQ STV$FILEBUSY  # IF SOME ERROR OTHER THAN   #
                                          # RECORD NOT FOUND           #
              THEN
                BEGIN 
                DIAG510 ("OBTAIN");  # ISSUE DIAG, EXIT OVERLAY        #
                IF ENDREC          # IF SERIOUS IMF ERROR              #
                THEN
                  BEGIN 
                  RETURN;          # RETURN TO EXIT OVERLAY            #
                  END 
                END 
  
              IOS = IOS + 1;
            END 
            RANGEPTR = RANGEPTR + 1;
          END 
  
          RETURN; 
  END 
  
  
#----------------------------------------------------------------------#
  
PROC NEXTTWIG;
  BEGIN 
          FOR J=0 STEP 1 UNTIL RECORDLGW [THISRECORDID [LEVEL ]] - 1
                   DO  CRECORD [J] = " ";# PRESET TO SPACES SO THAT    #
                                         # MISSING DEPENDENT RECORDS   #
                                         # DO NOT SUPPLY ANY VALUE.    #
  
          IF BOI [LEVEL]
                    THEN BEGIN
                             IF OWNER  [LEVEL]
                                THEN DML = OBTOWNER;
                                ELSE DML = OBTFIRSTMEM; 
                         END
                    ELSE BEGIN
                             IF OWNER  [LEVEL]
                                THEN BEGIN
                                       ERRSTATEMENT = STV$NOTFOUND; 
                                       RETURN;
                                     END
                                ELSE DML = OBTNEXTMEM;
                         END
  
          ERRSTATEMENT = EXEC$ (RECORD);
          IF ERRCODE GQ STV$FILEBUSY  # IF SOME ERROR OTHER THAN       #
                                      # RECORD NOT FOUND               #
          THEN
            BEGIN 
            DIAG510 ("OBTAIN");    # ISSUE DIAG, CLEANUP AND EXIT OVLAY#
            IF ENDREC              # IF SERIOUS IMF ERROR              #
            THEN
              BEGIN 
              RETURN;              # RETURN TO EXIT OVERLAY            #
              END 
            END 
  
          IOS = IOS + 1;
          RETURN; 
  END 
  
  
END 
TERM
