FTN4
      PROGRAM QY01(5,90),92069-16060 REV. 1912 790112 
C 
C 
C*************************************************************
C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979.  ALL RIGHTS    *
C RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- *
C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH-  *
C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.  *
C*************************************************************
C 
C 
C     SOURCE:    92069-18064
C     RELOC:     92069-16060
C 
C 
C************************************************************ 
C 
C 
C***********************************************************************
C 
C     SEARCH SERVICE MODULE 
C 
C     QS01 ENTERS RECORD NUMBERS OF RECORDS WHICH SATISFY THE FIND
C         IN THE SELECT FILE, AND PRINTS ON TTY THE TOTAL NUMBER OF 
C         QUALIFYING RECORDS. QS01  OBTAINS INFORMATION ABOUT THE 
C         FIND FROM THE S-ARRAY, WHICH IS BUILT BY QS00 
C              S IS A  12,50 ARRAY. EACH ROW CONTAINS THE FOLLOWING 
C              INFORMATION ABOUT A RELATION:
C                  1. DATA ITEM NUMBER
C                  2. RELATION CODE 
C                       1-IS,IE 
C                       2-INE,ISNOT 
C                       3-ILT 
C                       4-INLT
C                       5-IGT 
C                       6-INGT
C                  3. QSKIB WORD OFFSET.  QSKIB IS A RTE DISC TRACK 
C                     WHICH CONTAINS ALL DATA ITEM VALUES IN A FIND,
C                     EACH VALUE IS 
C                     PRECEEDED BY ITS CHARACTER LENGTH. THIS PARAMETER 
C                     POINTS TO THE WORD OFFSET OF THE FIRST VALUE
C                     FOR THIS RELATION, FROM THE BEGINNING OF A BLOCK. 
C                  4. NUMBER OF DATA ITEM VALUES FOR THIS RELATION
C                  5. LOGICAL CONNECTOR CODE
C                     NEXT CONNECTOR IS:
C                       1-AND 
C                       2-OR
C                       3-END 
C                  6. QSKIB SECTOR OFFSET. CONTAINS THE SECTOR NUMBER,
C                     OF THE FIRST SECTOR IN THE BLOCK, OF THE FIRST
C                     VALUE FOR THIS RELATION 
C                  7. NUMBER OF DATA ITEM VALUES FOR THIS RELATION, 
C                     LESS VALUES FOR DUPLICATE KEYS. QS00 SETS THIS
C                     PARAMETER TO NUMBER OF DATA ITEM VALUES (SAME 
C                     AS ROW 4). IF A CHAINED OR KEYED READ IS
C                     POSSIBLE, QS01 SEARCHES FOR  DUPLICATE KEYS 
C                     WITH DUPLICATE ITEM VALUES. WHEN ONE IS FOUND,
C                     THIS PARAMETER IS DECREMENTED.
C                  8. DATA ITEM TYPE. ASCII CODE IN R1 FORMAT:
C                        "I"-INTEGER
C                        "R"-REAL 
C                        "X"-ASCII
C                  9. LENGTH OF DATA ITEM AS RETURNED FROM DBMS 
C                 10. OFFSET IN WORDS OF THIS ITEM FROM BEGINNING OF
C                     RECORD. 
C                 11. DATA SET TYPE 
C                 12. KEY CODE
C                       0-ITEM IS NOT A KEY 
C                       1-ITEM IS A KEY 
C                 13. FIRST WORD OF DOUBLE WORD CAPACITY
C                 14. SECOND WORD OF DOUBLE WORD CAPACITY 
C                 15. NUMBER OF SUBITEMS
C 
C 
C     STRATEGY
C 
C 
C        THERE ARE A FEW RULES FOR DETERMINING WHEN A CHAINED 
C        READ WILL BE USED VERUS A DIRECTED READ.  THE RULES
C        ARE AS FOLLOWS,
C 
C             EVERY "AND" PHRASE MUST CONTAIN A KEY ITEM
C             REFERENCE WITH A "IE" RELATION AND: 
C 
C             WHEN THE DATA SET IS A MASTER, ALL VALUES IN
C             EACH RELATION MUST NOT EXCEED THE "IBUFF" BUFFER. 
C 
C             WHEN THE DATA SET IS A DETAIL, ALL VALUES IN
C             EACH RELATION MUST NOT EXCEED THE "IBUFF" BUFFER, 
C             AND THE NUMBER OF DIFFERENT KEY ITEMS USED MUST 
C             NOT EXCEED ONE, AND THERE MUST NOT BE MORE THAN 
C             FIVE DIFFERENT VALUES FOR THE KEY ITEM. 
C 
C            THESE RULES WILL ALLOW QUERY TO DETERMINE WHETHER
C            A RECORD QUALIFIES TO BE PLACED IN THE SELECT FILE 
C            WITHOUT HAVING TO SELECT A RECORD TWICE, IE. 
C            IF A DETAIL DATA SET WERE TO HAVE TWO DIFFERENT
C            KEY ITEMS ONE RECORD MIGHT EXIST IN BOTH CHAINS. 
C 
C         ASSUME AN "AND STRING" IS THE LONGEST STRING OF <RETRIEVE 
C         STATEMENTS> PRECEEDING ANY "OR" OR "END" <LOGICAL CONNECTOR>. 
C         IF THERE IS AT LEAST ONE KEY ITEM WITH AN "IS" RELATION 
C         IN EVERY "AND STRING" 
C             1. A KEYED READ WILL BE PERFORMED IF THE SET IS MASTER
C             2. CHAIN READ(S) WILL BE PERFORMED IF THE SET IS DETAIL 
C           AND IF THE # OF CHAIN DOES NOT EXCEED A SPECIFIED MAXIMUM.
C           THE CHAIN OR KEYED READ WILL BE PERFORMED FOR EACH VALUE
C           OF THE KEY SPECIFIED IN THE RELATION
C         NOTE: THE KEY WILL BE THE FIRST KEY ENCOUNTERED ON KEY "IS" 
C         IN THE "AND STRING".  FOR MAX EFFICIENCY, THE USER SHOULD 
C         SPECIFY THE KEY WHOSE VALUES HAVE THE SHORTEST CHAIN(S) 
C         AS THE FIRST KEY IN AN "AND STRING" 
C 
C         IF THERE IS AT LEAST ONE "AND STRING" WHICH DOES NOT CONTAIN
C         AT LEAST ONE KEY ITEM WITH AN "IS" RELATION, A SERIAL 
C         READ IS PERFORMED.
C              A KEYED READ GETS ONLY ONE RECORD WITH THE SPECIFIED 
C              KEY ITEM VALUE IN THE MASTER SET.
C              A CHAIN READ GETS EVERY RECORD WITH THE KEY ITEM 
C              VALUE IN THE DETAIL SET. 
C              A SERIAL READ GETS EVERY RECORD IN THE DATA SET. 
C         EVERY RECORD IS EVALUATED FOR THE ENTIRE <RETRIEVE STATEMENT>.
C         IF IT QUALIFIES, THE RECORD # IS PLACED IN THE SELECT FILE. 
C         IF CHAIN OR CERTAIN KEYED READS ARE BEING PERFORMED, THE
C         QUALIFYING RECORD # IS ORED INTO A BITMAP TO PREVENT
C         DUPLICATION. UPON COMPLETION OF ALL RECORD READS, 
C         QUALIFYING RECORD NUMBERS IN THE BIT MAP ARE PLACED IN
C         THE SELECT FILE.
C 
C     DEFINITION OF VARIABLES 
C         KEYS-ARRAY OF INDICES TO S-ARRAY FOR ITEMS IN CHAIN OR KEYED
C              READS
C         NKEYS-COUNT OF KEY ITEMS FOR CHAIN READS
C         SELT-128-WORD BUFFER CONTAINING QUALIFYING RECORD #S. 
C              WHEN FULL, IT IS WRITTEN TO NEXT SECTOR OF SELECT BUFFER 
C         IPTR-POINTER TO SELT
C         RSEC-SECTOR POINTER TO SELT 
C         RRCNT-NUMBER OF RECORDS RETRIEVED 
C         IMA-CORE BUFFER CONTAINING VALUES (BLOCK FROM QSKIB)
C         SECNO -SECTOR # SPECIFYING QSKIB BLOCK CURRENTLY IN IMA 
C         IBUFF-BUFFER INTO WHICH DBMS DATA RECORD IS READ
C         BUFPTR-IBUFF POINTER. POINTS TO HALF OF IBUFF INTO WHICH
C              RECORD IS READ 
C         KEYPTR-IF A KEY "IS" IS FOUND IN "AND  STRING", KEYPTR
C              IS COLUMN NDX TO S-ARRAY FOR THAT RELATION, ELSE 
C              KEYPTR IS 0
C         MAXCHN-MAX # OF CHAINS FOR CHAIN READS IN DETAILS 
C         DSNUM-DATA SET #, SET BY QS00 
C         DINUM-DATA ITEM # 
C         ITYPE-DATA ITEM TYPE
C *LOOP1* KEYNDX-NDX IN DO LOOP FOR CHAIN OR KEYED READS. POINTS TO 
C              KEY ENTRY IN KEY ARRAY, ONE PASS THRU LOOP FOR EVERY KEY 
C         I-NDX TO S-ARRAY FOR CURRENT KEY ON KEY OR CHAIN READ,
C              POINTED TO BY KEYNDX 
C *LOOP2*  VALPTR-NDX IN DO LOOP FOR VALUES IN CHAIN OR KEY READS.
C              ONE PASS FOR EACH VALUE IN RELATION. 
C          NVAL-TERMINAL VALUE FOR DO LOOP. # OF VALUES FOR KEY IN
C              RELATION.
C          IOFF1-WORD OFFSET IN QSKIB FILE OF VALUE ARGUEMENT IN
C              CHAIN OR KEYED READ
C          ISEC1-SECTOR OFFSET IN QSKIB FILE OF VALUE ARGUEMENT IN
C              CHAIN OR KEYED READ
C          IARG1-ARRY CONTAINING DATA ITEM VALUE USED AS VALUE ARG
C              IN CHAIN OR KEYED READ. ENTERED BY VALUE SUBROUTINE
C *LOOP3*   ITEM-NDX IN DO LOOP WHICH READS AND EVALUATES:
C                  1.EACH RECORD IN CHAIN ON A CHAIN READ 
C                  2.1 RECORD ON A KEYED READ 
C                  3.EACH RECORD IN THE DATA SET ON A SERIAL READ 
C           LOOP-TERMINAL VALUE FOR LOOP. 
C                  1.ON CHAIN READ-# OF RECORDS IN CHAIN
C                  2.ON KEYED READ-1
C                  3.ON SERIAL READ-CAPACITY OF DATA SET
C           RECNO-RECORD # OF CURRENT RECORD BEING EVALUATED
C           AND-0 IF  "AND STRING" FALSE
C               1 IF  "AND STRING" TRUE 
C *LOOP4*    RDB-NDX TO DO LOOP FOR EVALUATING CURRENT RECORD FOR 
C              EVERY RELATION IN S-ARRAY. RDB IS COLUMN NDX 
C              TO S-ARRAY 
C            R3-TERMINAL VALUE IN DO LOOP. # OF ENTRIES IN S-ARRAY. 
C              SET BY QS00. 
C            LOGIC-0 IF RELATION FALSE IN <RETRIEVE STATEMENT>
C              (RELATION) IN CURRENT RECORD 
C                  1 IF RELATION TRUE IN CURRENT RECORD 
C              FOR MULTIVALUE: IS OR IE-SET TO 1 IF TRUE FOR AT LEAST 
C              1 DATA ITEM VALUE
C                              INE OR ISNOT-SET TO 1 IF TRUE FOR EVERY
C              DATA ITEM VALUE
C *LOOP5*     IVAL-NDX TO DO LOOP FOR EVALUATING RECORD FOR EVERY 
C              VALUE IN THE RELATIONAL. VALUE COUNTER 
C             IARG2-ARRAY CONTAINING DATA ITEM VALUE FOR EVALUATION 
C              OF RELATION. ENTERED BY VALUE SUBROUTINE.
C *LOOP5*     END 
C *LOOP4*    END
C *LOOP3*   END 
C *LOOP2*  END
C *LOOP1* END 
C         BITMAP-BITMAP OF RETRIEVED RECORDS.CORRESPONDING BIT SET TO 1 
C              IF RECORD QUALIFIES. 
C 
C***********************************************************************
C 
      INTEGER RDB 
      INTEGER LLIST(128)
      INTEGER YES(2)
      INTEGER VALPTR
      INTEGER SPTR1,SPTR2,VALNDX
      INTEGER CHANCT
      INTEGER VALSIZ
      INTEGER AND 
      INTEGER OFFSET
      INTEGER COMP1,COMP2 
      INTEGER DISK,OVFLO
      INTEGER QUALFY(17)
      INTEGER R,X 
C 
      INTEGER KEYS(50)
      INTEGER PROCED(12)
      INTEGER IANS(2) 
      INTEGER IARG1(128),IARG2(128) 
      INTEGER OVFLO(11) 
      INTEGER ISTAT(10) 
      INTEGER ITEMP(2)
      INTEGER IRRCNT(2),LOOP(2) 
      INTEGER IRECN(2)
      REAL ARG,RECNO,RARG 
C 
      LOGICAL DDS 
C$$$$$$$$$$$$$$$$$$$ NOVEMBER 3,1978   $$$$$$$$$$$$$$$$$$$$$
      INTEGER INLU,ITTY,ILP,IDCB,JDCB,XEQ 
      INTEGER DBNAM,DBLEV,DSNAM,DINAM,SELECT,SNAM 
      INTEGER DSNUM,DINUM,PARM,LPARM,ECHO,QSERR 
      INTEGER IMA,IB,IBSZ,SECNO,IEND,ISCAN
      LOGICAL BREAK 
      INTEGER IPFLAG,IOFLAG,RMOTE 
      LOGICAL BATCH,XQBCH 
      INTEGER PAGCNT,LNCNT
      INTEGER PAGLEN,COLLIM 
      REAL    RRCNT 
      REAL    SELT,RSEC 
      INTEGER IPTR
      REAL    RCOUNT
      INTEGER S,R3,TRKNM,IDILU
      INTEGER R6
      REAL    ATOTAL
      INTEGER LIST,L,T,U
      INTEGER LEVSTR,LEVLEN 
      INTEGER IBUFF 
      INTEGER SS(7,100) 
C 
      COMMON INLU(145),ITTY(145),ILP(145),IDCB(145),JDCB(144),XEQ(145)
      COMMON DBNAM(10),DBLEV(3),DSNAM(3),DINAM(3),SELECT(6),SNAM(3) 
      COMMON DSNUM,DINUM,PARM(40),LPARM,ECHO,QSERR
      COMMON IMA(37),IB(896),IBSZ,SECNO,IEND,ISCAN
      COMMON BREAK
      COMMON IPFLAG,IOFLAG,RMOTE
      COMMON BATCH,XQBCH
      COMMON PAGCNT,LNCNT 
      COMMON PAGLEN,COLLIM
      COMMON RRCNT
      COMMON SELT(64),RSEC
      COMMON IPTR 
      COMMON RCOUNT 
      COMMON S(15,50),R3,TRKNM,IDILU
      COMMON R6 
      COMMON ATOTAL(6,5)
      COMMON LIST(101,6),L(7),T(5),U(7,5) 
      COMMON LEVSTR(66,5),LEVLEN(5) 
      COMMON IBUFF(2048)
C 
      EQUIVALENCE (S,SS)
C$$$$$$$$$$$$$$$$$$$ NOVEMBER 3,1978   $$$$$$$$$$$$$$$$$$$$$
      EQUIVALENCE(ITEMP(1),RSORT),(IARG2(2),RARG) 
      EQUIVALENCE(RECNO,IRECN)
      EQUIVALENCE(LLIST,LIST) 
C 
      DATA PROCED/2H S,2HER,2HIA,2HL ,2HRE,2HAD,2H I,2HN ,2HPR, 
     & 2HOG,2HRE,2HSS / 
      DATA YES/2HYE,2HS / 
      DATA NO/2HNO/ 
      DATA MAXCHN/5/
      DATA VALSIZ/128/
      DATA ISPACE/2H  / 
      DATA DISK/2/
      DATA R/122B/
      DATA X/130B/
C     SELECT FILE OVERFLOW
      DATA OVFLO/2H S,2HEL,2HEC,2HT ,2HFI,2HLE,2H E,2HRR,2H0R,2H  ,2H  /
      DATA QUALFY/2H  ,2HXX,2HXX,2HXX,2HXX,2HXX,2H E,2HNT,2HRI,2HES,
     &2H Q,2HUA,2HLI,2HFI,2HED/ 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C BEGIN 
C 
C 
C 
C     INITIALIZE PARAMETERS 
C 
      NKEYS=0 
      RSEC = DBLEI(1) 
      RRCNT=0 
C 
C PUT OVERHEAD IN SELECT BUFFER 
C 
C     OVERHEAD CONSISTS OF 18 BYTES OF DATA BASE NAME 
C                           2 BYTES CONTAINING DATA SET NUMBER
C                           4 BYTES CONTAINING DOUBLE INTEGER COUNT 
C                           8 BYTES FOR FUTURE USE
C 
C 
      CALL SMOVE(DBNAM,3,20,SELT,1) 
      CALL SMOVE(DSNUM,1,2,SELT,19) 
      CALL SMOVE(RRCNT,1,4,SELT,21) 
      CALL SFILL(SELT,25,32,0)
      IPTR = 8
C 
C CREATE THE LIST PARAMETER FOR THE DBMS CALLS
C 
      LLIST(1) = 0
      DO 110 I=1,R3 
      IF(LLIST .LE. 0) GOTO 117 
      DO 115 I2 = 2,LLIST(1) + 1
      IF(LLIST(I2) .EQ. S(1,I) ) GOTO 110 
115   CONTINUE
117   LLIST = LLIST + 1 
      LLIST(LLIST + 1) = S(1,I) 
110    CONTINUE 
C 
C 
C     DETERMINE WHETHER CHAIN OR KEY READ POSSIBLE, AND SAVE KEY PTRS 
C     IN KEYS ARRAY 
C 
      KEYPTR=0
      DO 100 RDB=1,R3 
C         IS ITEM A KEY?
          IF (S(12,RDB).EQ.0) GO TO 1 
C         IS RELATION 'IS'? 
          IF (S(2,RDB).NE.1) GO TO 1
C         KEY "IS" ENCOUNTERED YET? IF NOT, SAVE PTR TO KEY ENTRY IN S. 
          IF(KEYPTR.EQ.0) KEYPTR=RDB
C         AND CONNECTOR?
1         IF (S(5,RDB).EQ.1) GO TO 100
C         IF NO KEY "IS" IN "AND STRING" GO TO SERIAL READ. 
          IF(KEYPTR.EQ.0) GO TO 2 
C         ENTER S-ARRAY NDX OF KEY IN KEYS ARRAY
          NKEYS=NKEYS+1 
          KEYS(NKEYS)=KEYPTR
          KEYPTR=0
100   CONTINUE
C     KEYED OR CHAIN READ POSSIBLE
      GO TO 7 
C 
C     SERIAL READ 
C     "SERIAL READ IN PROGRESS "
2     CALL QRIO(2,ITTY,PROCED,12) 
      GOTO 6
C     SET RETRIEVE COUNT TO ZERO
C 
C 
C 
C     RETURN TO NEXT? 
C 
C 
4     SNAM(2)=2H
      CALL LOAD(SNAM) 
C 
C SELECT FILE OVERFLOW
C 
41    CONTINUE
      CALL QRIO(2,ITTY,OVFLO,11)
C 
C     ERROR - DBMS  OR FMP ERROR PROCESSOR
C 
5     CONTINUE
      RRCNT = 0 
      QSERR = ISTAT 
      SNAM(2) = 2H23
      CALL LOAD(SNAM) 
C 
C     DO DIRECTED READ TO RESET RECORD PTR
C 
6     IMODE=2 
      ARG = 0 
      CALL DBGET(DBNAM,DSNUM,4,ISTAT,LLIST,IBUFF,ARG) 
      IF (ISTAT.NE.0) GO TO 5 
C     INITIALIZE DO-LOOP PARAMETERS TO GO THRU KEYED READ LOOPS ONCE
C     SET LOOP COUNT TO CAPACITY
      LOOP = S(13,1)
      LOOP(2) = S(14,1) 
      KEYNDX=0
      NKEYS=0 
      VALPTR=1
      NVAL=1
      GO TO 14
C 
C CHAINED OR HASHED READ
C 
C 
C 
C 
C     SEARCH FOR DUPLICATE KEYS IF # OF KEYS>1 AND ALL VALUES IN CORE 
C        NOTE: SECNO IS PASSED TO QS01 BY QS00, IT IS THE 
C              CURRENT SECTOR # OF QSKIB.  IF IT IS ZERO THEN 
C              EVERYTHING IS STILL IN MEMORY. 
C 
C 
C 
7     IF (NKEYS.EQ.1) GO TO 9 
      IF (SECNO.NE.0) GO TO 9 
C     LOOP FOR EACH KEY IN KEYS ARRAY 
      DO 600 KEYPT1=1,(NKEYS-1) 
          SPTR1=KEYS(KEYPT1)
          ITEM1=S(1,SPTR1)
C         LOOP FOR ALL FOLLOWING KEYS IN KEYS ARRAY 
          DO 500 KEYPT2=(KEYPT1+1),NKEYS
               SPTR2=KEYS(KEYPT2) 
               ITEM2=S(1,SPTR2) 
               IF (ITEM1.NE.ITEM2) GO TO 500
C              TWO KEYS HAVE SAME ITEM #, NOW SEE IF VALUES MATCH 
               IOFF1=S(3,SPTR1) 
C              LOOP FOR ALL VALUES OF 1ST ITEM
               DO 400 IVAL1=1,S(4,SPTR1)
                    LEN1=IABS(IMA(IOFF1)) 
                    IOFF2=S(3,SPTR2)
C                   LOOP FOR ALL VALUES OF 2ND ITEM 
                    DO 300 IVAL2=1,S(4,SPTR2) 
                         LEN2=IABS(IMA(IOFF2))
                         IF (LEN1.NE.LEN2) GO TO 8
                         IPTR1=IOFF1+1
                         IPTR2=IOFF2+1
C                        COMPARE VALUES 
                         DO 200 VALNDX=1,LEN1 
                              IF (IMA(IPTR1).NE.IMA(IPTR2)) GO TO 8 
                              IPTR1=IPTR1+1 
                              IPTR2=IPTR2+1 
200                      CONTINUE 
C*****                   IDENTICAL VALUES HAVE BEEN FOUND - NEGATE
C                        LENGTH FOR 2ND VALUE AND DECREMENT # OF VALUES 
C                        IN S ARRAY 
                         IMA(IOFF2)=-IMA(IOFF2) 
                         S(7,SPTR2)=S(7,SPTR2)-1
8                        IOFF2=IOFF2+LEN2+1 
300                 CONTINUE
                    IOFF1=IOFF1+LEN1+1
400            CONTINUE 
500       CONTINUE
600   CONTINUE
C 
C     IF DETAIL SET AND CHAIN READS CAN BE PERFORMED, CHECK WHETHER 
C     TOTAL # OF CHAINS EXCEEDS MAX. IF SO, DO SERIAL READ. 
C 
9     IF (S(11,1).NE. 104B) GOTO 10 
      CHANCT=0
      DO 700 KEYCNT=1,NKEYS 
          RDB=KEYS(KEYCNT)
          CHANCT=CHANCT+S(7,RDB)
          IF (CHANCT.GT.MAXCHN) GO TO 2 
700   CONTINUE
C 
C     DO SERIAL READ IF MORE THAN 1 KEY AND 
C        A. DETAIL OR 
C        B. MASTER WITH ALL VALUES NOT IN CORE (IN WHICH CASE 
C           DUPLICATE KEY VALUES NOT ELIMINATED)
C 
10    IF (NKEYS.EQ.1) GO TO 12
      IF (S(11,1) .EQ. 104B) GOTO 11
      IF (SECNO.EQ.0) GO TO 12
11    GOTO 2
C 
C 
C     THE FOLLOWING SERIES OF LOOPS READS RECORDS,EVALUATES THEM
C     FOR THE FIND, AND PUTS THEM IN SELECT FILE IF 
C     THEY QUALIFY
C 
C     LOOP TO PERFORM CHAIN OR KEYED READS FOR EACH KEY IN KEYS ARRAY 
12    DO 1500 KEYNDX=1,NKEYS
          I=KEYS(KEYNDX)
          IOFF1=S(3,I)
          ISEC1=S(6,I)
          NVAL=S(4,I) 
C 
C         LOOP TO PERFORM CHAIN OR KEYED READS FOR EACH VALUE 
C         ASSOCIATED WITH KEY ITEM
          DO 1400 VALPTR=1,NVAL 
               DO 800 J1=1,VALSIZ 
800            IARG1(J1)=ISPACE 
C              PICK UP VALUE OF KEY ITEM IN IARG1 
               CALL VALUE(IARG1,ISEC1,IOFF1)
C              IF KEY VALUE DUPLICATE, LOOP TO GET NEXT VALUE 
               IF (IARG1(1).LT.0) GO TO 1400
               IF (S(11,I) .EQ. 104B) GOTO 13 
C              FOR MASTER, CHAIN COUNT IS ALWAYS 1, SET MODE FOR KEYED
C              READ 
C 
               IMODE = 7
               LOOP(1) = 0
               LOOP(2) = 1
               GO TO 14 
13             IMODE = 5
               DINUM=S(1,I) 
C 
C              FOR DETAIL,SET UP FOR CHAIN READ AND PICK UP CHAIN COUNT 
C 
               CALL DBFND(DBNAM,DSNUM,1,ISTAT,DINUM,IARG1(2) )
               IF(ISTAT .EQ. 156 .OR. ISTAT .EQ. 107) GOTO 1400 
               IF (ISTAT.NE.0) GO TO 5
               LOOP(1) = ISTAT(5) 
               LOOP(2) = ISTAT(6) 
C 
C              LOOP TO READ EACH RECORD IN A CHAIN OR, ON SERIAL READ,
C              EACH RECORD IN THE DATA SET
C 
14             CONTINUE 
                         IF (IFBRK(IDUM).NE.0) GOTO 4 
                    CALL DBGET(DBNAM,DSNUM,IMODE,ISTAT,LLIST,IBUFF, 
     &                                              IARG1(2) )
C 
C                   END OF SERIAL READ? 
C 
                    IF (ISTAT.EQ.12) GO TO 26 
                    IF(ISTAT .EQ. 107 .OR. ISTAT .EQ. 155) GOTO 1400
                    IF(ISTAT .NE. 0) GOTO 5 
C 
C                   RECORD #
C 
                    IRECN(1) = ISTAT (3)
                    IRECN(2) = ISTAT (4)
C 
C                   INITIALIZE EVALUATOR FOR "AND STRING" 
C 
                    AND=1 
C 
C                   LOOP TO EVALUATE ALL RELATIONS FOR THIS RECORD
C 
                    DO 1200 RDB=1,R3
C 
C                        INITIALIZE RELATION INDICATOR
C 
                         LOGIC=0
                         OFFSET=S(10,RDB) 
                         LEN=S(9,RDB) 
                         IOFF2=S(3,RDB) 
                         ISEC2=S(6,RDB) 
C 
C                        LOOP FOR MULTI-VALUE RELATION
C 
                         DO 1100 IVAL=1,S(4,RDB)
                              DO 900 J2=1,VALSIZ
900                           IARG2(J2)=ISPACE
C 
C                             PICK UP VALUE IN IARG2
C 
                              CALL VALUE(IARG2,ISEC2,IOFF2) 
                              IF (S(8,RDB).EQ.R) GO TO 170
                              COMP1 = OFFSET * 2 - 1
                              IF(S(8,RDB) .EQ.X) GOTO 150 
C 
C                             COMPARE INTEGER RECORD VALUE WITH FIND VAL
C 
                               INTGR = IBUFF(OFFSET)
                               INTGR2 = IARG2(2)
                               IF(INTGR) 910,920,920
910                            IF(INTGR2) 930,15,15 
920                            IF(INTGR2) 16,930,930
930                            IF(INTGR-INTGR2) 15,17,16
C 
C                            COMPARE ASCII VALUES 
C 
150                            IF(JSCOM(IBUFF,COMP1,COMP1+LEN-1,
     &                                   IARG2,3,IERR) ) 15,17,16 
C 
C                             COMPARE REAL RECORD VAL WITH REAL FIND VAL
C 
170                           ITEMP(1)=IBUFF(OFFSET)
                              ITEMP(2)=IBUFF(OFFSET+1)
                              IF(RSORT) 171,172,172 
171                           IF(RARG) 173,15,15
172                           IF(RARG) 16,173,173 
173                           IF(RSORT-RARG) 15,17,16 
C 
C                             REC VAL < FIND VAL AND ILT,INGT - TRUE
C 
15                            GOTO (1100,1100,18,1100,1100,18)S(2,RDB)
C 
C                             REC VAL > FIND VAL AND INLT,IGT - TRUE
C 
16                            GOTO(1100,1100,1100,18,18,1100)S(2,RDB) 
C 
C                             REC VAL=FIND VAL---IS,INLT,INGT-TRUE; 
C                             ILT,IGT,ISNOT-FALSE 
17                            GO TO (18,19,19,18,19,18) S(2,RDB)
C 
C                             TRUE FOR AT LEAST 1 VALUE,JUMP OUT OF LOOP
C 
18                            LOGIC=1 
                              GO TO 19
C 
C                             NOT TRUE FOR THIS VALUE 
C 
1100                     CONTINUE 
C 
C                        RELATION FALSE FOR ALL VALUES, SO TRUE IF ISNOT
C 
                         IF (S(2,RDB).EQ.2) LOGIC=1 
C 
C                        SUCCESSIVELY EVALUATE "AND STRING" 
C 
19                       AND=AND*LOGIC
                         IF (S(5,RDB).EQ.1) GO TO 1200
C 
C                        END OF "AND STRING". IF TRUE FOR 1 "AND STRING"
C                        RECORD QUALIFIES, SO JUMP OUT OF LOOP
C 
                         IF (AND.EQ.1) GO TO 20 
                         AND=1
1200                CONTINUE
C 
C                   ALL RELATIONS FALSE FOR THIS RECORD 
C 
                    GO TO 1300
C 
C                   RECORD QUALIFIES, SAVE RECORD 
C 
20                  CONTINUE
                    IPTR=IPTR+1 
                    IF (IPTR.LT.65) GO TO 22
                    CALL EWRIT(JDCB,ISTAT,SELT,128,RSEC)
                    IF (ISTAT.LT.0) GOTO 41 
                    RSEC=DIN(RSEC)
                    IPTR=1
22                  SELT(IPTR)=RECNO
C 
C                   INCREMENT RECORD COUNT
C 
                    RRCNT = DIN(RRCNT)
1300           CONTINUE 
               IF( DDS(LOOP)) GOTO 1400 
               GOTO 14
C 
1400      CONTINUE
C 
1500  CONTINUE
C 
C 
C     FINAL WRAPUP - ALL RECORDS HAVE BEEN COMPARED 
C 
C     IF ANY RECORDS QUALIFY WRITE BUFFER TO SELECT FILE
C 
26    CONTINUE
      IF(IPTR .EQ. 0) GOTO 30 
      CALL EWRIT(JDCB,ISTAT,SELT,128,RSEC)
      IF(ISTAT.LT.0)GOTO 41 
C 
C PUT COUNT IN OVERHEAD 
C 
30    CONTINUE
      RSEC = DBLEI(1) 
      CALL EREAD(JDCB,ISTAT,SELT,128,LEN,RSEC)
      IF(ISTAT .LT. 0) GOTO 41
      CALL SMOVE(RRCNT,1,4,SELT,21) 
      CALL EWRIT(JDCB,ISTAT,SELT,128,RSEC)
      IF(ISTAT .LT.0) GOTO 41 
C 
C OUTPUT THE RECORD COUNT TO THE USER 
C 
      CALL DCITA(RRCNT,QUALFY(2)) 
      CALL QRIO(2,ILP,QUALFY,15)
      GO TO 4 
C 
      END 
      END$