FTN4
      PROGRAM QY00(5,90),92069-16060 REV.1940 790523
C 
C 
C 
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-18063
C     RELOC:     92069-16060
C 
C 
C************************************************************ 
C 
C 
C     FIND COMMAND SERVICE MODULE 
C        QS00 
C        QS01 
C 
C     THE PURPOSE OF THIS MODULE IS TO BREAK DOWN 
C     A FIND PROCEDURE (IN DISJUNCTIVE NORMAL FORM) 
C     INTO A TABLE OF ELEMENTARY CONJUNCTS AND
C     DISJUNCTS.  THIS TABLE WILL BE USED BY A
C     'SEARCH' MODULE TO RETRIEVE RECORDS FROM A
C     DATA BASE.
C 
      LOGICAL ISPTH,MEMBR 
      INTEGER IBUF(51)
      INTEGER BUFF(130) 
      INTEGER SAVBF(130)
      INTEGER SAVE(5) 
      INTEGER ISTAT(10) 
      INTEGER FIND(2) 
      INTEGER NAME(2) 
      INTEGER AND(2),OR,END(2)
      INTEGER INE(2),ILT(2),INLT(2),IGT(2),INGT(2)
      INTEGER INA(3)
      INTEGER IREG(2) 
      INTEGER ERR1(14)
      INTEGER ERR2(12)
      INTEGER ERR3(15)
      INTEGER ERR4(14)
      INTEGER ERR6(22)
      INTEGER ERR7(16)
      INTEGER ERR8(14)
      INTEGER ERR9(13)
      INTEGER ERR10(19) 
      INTEGER ERR11(12) 
      INTEGER ERR12(19) 
      INTEGER ERR13(13) 
      INTEGER ERR16(19) 
      INTEGER ERR18(7)
      INTEGER ERR19(27) 
      INTEGER ERR20(15) 
      INTEGER R,X,D 
      INTEGER FIND
      INTEGER VALUE(11) 
C 
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 (REG,IREG,IA),(IREG(2),LEN) 
      DATA AND(1),AND(2)/2HAN,2HD / 
      DATA OR/2HOR/ 
      DATA END/2HEN,2HD;/ 
      DATA IS/2HIS/ 
      DATA IE/2HIE/ 
      DATA INE(1),INE(2)/2HIN,2HE / 
      DATA ILT(1),ILT(2)/2HIL,2HT / 
      DATA INLT(1),INLT(2)/2HIN,2HLT/ 
      DATA IGT(1),IGT(2)/2HIG,2HT / 
      DATA INGT(1),INGT(2)/2HIN,2HGT/ 
      DATA INA(1),INA(2),INA(3)/2HIS,2HNO,2HT / 
      DATA ERR1/2H N,2HO ,2H A,2HVA,2HIL,2HAB,2HLE,2H S,2HYS,2HTE,2HM , 
     &    2HTR,2HAC,2HKS/ 
      DATA ERR2/2H F,2HIN,2HD ,2HPR,2HOC, 
     1 2HED,2HUR,2HE ,2HTO,2HO ,2HLO,2HNG/
      DATA ERR3/2H I,2HLL,2HEG,2HAL,2H D, 
     1 2HAT,2HA ,2HIT,2HEM,2H N,2HAM,2HE ,
     2 2HXX,2HXX,2HXX/
      DATA ERR4/2H R,2HEL,2HAT,2HIO,2HNA,2HL ,
     1 2HOP,2HER,2HAT,2HOR,2H I,2HNV,2HAL,2HID/ 
      DATA ERR6/2H I,2HNV,2HAL,2HID,2H #,2H O,
     1 2HF ,2HVA,2HLU,2HES,2H F,2HOR,2H R,2HEL, 
     2 2HAT,2HIO,2HNA,2HL ,2HOP,2HER,2HAT,2HOR/ 
      DATA ERR7/2HIN,2HVA,2HLI,2HD ,2HLO,2HGI,
     1 2HCA,2HL ,2HCO,2HNN,2HEC,2HTO,2HR ,
     2 2HXX,2HXX,2HXX/
      DATA ERR8/2H N,2HOT,2H E,2HNO,2HUG,2HH ,2HSE,2HCT,2HOR,2HS ,2HIN, 
     12H Q,2HSK,2HIB/ 
      DATA ERR9/2H S,2HEL,2HEC,2HT-,2HFI,2HLE,                          ERR9
     1 2H N,2HOT,2H D,2HEC,2HLA,2HRE,2HD /                              ERR9
      DATA ERR10/2H R,2HET,2HRI,2HEV,2HAL,                              ERR10 
     1 2H F,2HRO,2HM ,2HMO,2HRE,2H T,2HHA,                              ERR10 
     2 2HN ,2HON,2HE ,2HDA,2HTA,2H-S,2HET/                              ERR10 
      DATA ERR11/2H D,2HAT,2HA-,2HBA,2HSE,
     1 2H N,2HOT,2H D,2HEC,2HLA,2HRE,2HD /
      DATA ERR12/2H N,2HON,2H-N,2HUM,2HER,2HIC,2H I,
     1 2HN ,2HRE,2HAL,2H O,2HR ,2HIN,2HTE,2HGE,2HR ,
     1 2HVA,2HLU,2HE /
      DATA ERR13/2H D,2HAT,2HA ,2HIT,2HEM,2H V,2HAL,
     1 2HUE,2H T,2HOO,2H L,2HON,2HG / 
      DATA ERR16/2H I,2HNV,2HAL,2HID,2H D,2HAT, 
     & 2HA ,2HIT,2HEM,2H V,2HAL,2HUE,2H O,2HR , 
     & 2HTE,2HRM,2HIN,2HAT,2HOR/
      DATA ERR18/2H B,2HAD,2H D,2HAT,2HA ,2HSE,2HT /
      DATA ERR19/2H I,2HTE,2HM ,2HNO,2HT ,2HME,2HMB,2HER, 
     &    2H O,2HF ,2HDA,2HTA,2H S,2HET,2H O,2HR ,2HDA,2HTA,
     &    2H S,2HET,2H N,2HOT,2H S,2HPE,2HCI,2HFI,2HED/ 
C CAN'T ACCESS AUTOMATIC MASTER 
      DATA ERR20/2H C,2HAN,2H'T,2H A,2HCC,2HES,2HS ,2HAU,2HTO,
     &   2HMA,2HTI,2HC ,2HMA,2HST,2HER/ 
      DATA NAME/2HNA,2HME/
      DATA FIND/2HFI,2HND/
      DATA X/130B/
      DATA R/122B/
      DATA D/104B/
      DATA VALUE/2HWH,2HAT,2H I,2HS ,2HTH,
     1 2HE ,2HVA,2HLU,2HE ,2HOF,2H _/ 
      DATA IQSEC/6/ 
      DATA MAXLN/255/ 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C BEGIN 
C 
      DO 1 J=1,50 
      DO 1 I=1,15 
      S(I,J) = 0
    1 CONTINUE
      RRCNT = 0 
      IF(DBNAM.NE.2H  ) GOTO 5
C  ERROR DATA-BASE NOT DECLARED 
      CALL ERIO(2,ITTY,ERR11,12)
      GOTO 10 
5     CONTINUE
C 
C GET SYSTEM TRACKS 
C 
C  RELEASE ANY PREVIOUS QSKIB TRACKS
C 
      CALL EXEC(100005B,1,TRKNM,IDILU)
      I=I 
      GOTO 6
C 
C  GET A NEW TRACK FOR QSKIB
C 
6     CALL EXEC(4,1,TRKNM,IDILU,NSEC) 
      NSEC=NSEC/2 
      IF (TRKNM.GE.0)GOTO15 
C  ERROR - NOT ANY TRACKS AVAILABLE FOR QSKIB 
      CALL ERIO(2,ITTY,ERR1,14) 
C 
C EXIT FIND WITH ERROR
C 
10    CONTINUE
      SNAM(2)=2H
      CALL LOAD(SNAM) 
C 
C VERIFY THE SELECT FILE
C 
   15 IF(SELECT.NE.2H  ) GOTO 110 
C  ERROR - SELECT-FILE NOT DECLARED 
      CALL ERIO(2,ITTY,ERR9,13) 
      GO TO 10
C 
C 
C 
C  BEGIN PROCESSING FIND COMMAND
C 
C 
C FIND SETNM.ITEM  <RELATIONAL OPERATOR> "VALUE" END; 
C   OR
C FIND SETNM.ITEM <RELATIONAL OPERATOR> "VALUE","VALUE" END;
C   OR
C FIND SETNM.ITEM <RELATIONAL OPERATOR> "VALUE" <CONNECTOR> 
C   ITEM <RELATIONAL OPERATOR> "VALUE" END; 
C 
C 
C 
  110 CONTINUE
      IOFF=1
      NOWSEC=0
      R3 = 1
      DSNUM = 0 
      IDISP = 1 
C 
C 
C 
C 
C  LOOP TO SET UP S-ARRAY 
C 
C 
C 
C 
200   CONTINUE
      IF (R3.LE.50) GO TO 230 
C  ERROR - FIND PROCEDURE TOO LONG
      CALL ERIO(2,ITTY,ERR2,12) 
      GO TO 10
230   CALL LSCAN(IB,I,J,K)
      I1 = I
      J1 = J
C SYMBOL? 
      IF (K.EQ.2) GO TO 280 
C  ERROR - ILLEGAL DATA ITEM NAME 
250   DO 251 M=13,15
251   ERR3(M)=2H
      IF ((J1-I1+1).GT.6) J1=I1+5 
      CALL SMOVE(IB,I1,J1,ERR3,25)
      CALL ERIO (2,ITTY,ERR3,15)
      GO TO 10
C  ERROR - RETRIEVAL FROM MORE THAN ONE DATA-SET
260   CALL ERIO(2,ITTY,ERR10,19)
      GO TO 10
C 
C ERROR - BAD SET 
C 
265   CALL ERIO(2,ITTY,ERR18,7) 
      GOTO 10 
C 
C OUTPUT "ITEM NOT MEMBER OF DATA SET"
C 
267   CALL ERIO(2,ITTY,ERR19,27)
      GOTO 10 
C 
C     VERIFY VALID DATA-ITEM
C 
280   CALL SFILL(DINAM,1,6,40B) 
      IF(J-I.GT.5) GOTO 250 
      CALL SMOVE(IB,I,J,DINAM,1)
C  CHECK FOR PROCEDURE
C  "NAME="? 
C  SCAN FOR "=" 
C 
      CALL LSCAN(IB,I,J,K)
      IF (R3.NE.1) GO TO 281
      IF (J1-I1+1.NE.4) GO TO 281 
      IF (JSCOM(NAME,1,4,DINAM,1,IERR).NE.0) GO TO 281
      IF (K .NE. 6) GOTO 281
C 
C GET THE PROCEDURE NAME
C 
      CALL GTPRC(FIND,4,IERR) 
      IF(IERR .NE. 0) GOTO 10 
      IOFLAG = 1
      GOTO 110
C 
C WAS A DATA SET GIVEN WITH THE ITEM? 
C 
281   CONTINUE
      IF(K .NE. 7) GOTO 283 
      CALL DBINF(DBNAM,DINAM,201,ISTAT,IBUF)
      IF(ISTAT .NE. 0) GOTO 265 
      IBUF = IABS(IBUF) 
C 
C VERIFY THAT THIS DATA SET IS THE FIRST TO BE DEFINED, 
C OR ELSE MATCHES THE DATA SET ALREADY DEFINED
C 
      IF(DSNUM .EQ. 0) DSNUM = IBUF 
      IF(DSNUM .NE. IBUF) GOTO 260
C 
C GET THE ITEM NAME 
C 
      CALL LSCAN(IB,I,J,K)
       I1=I 
      J1=J
C COMMA?
      IF(K .NE. 2) GOTO 250 
      CALL SFILL(DINAM,1,6,40B) 
      IF(J-I .GT. 5) GOTO 250 
      CALL SMOVE(IB,I,J,DINAM,1)
      CALL LSCAN(IB,I,J,K)
C 
C GET THE ITEM'S NUMBER 
C 
283   CONTINUE
      CALL DBINF(DBNAM,DINAM,101,ISTAT,IBUF)
      IF(ISTAT .NE. 0) GOTO 250 
      DINUM = IABS(IBUF)
      S(1,R3) = DINUM 
C 
C VERIFY ITEM BELONGS TO DECLARED SET 
C 
      IF ( MEMBR(DBNAM,DSNUM,DINUM,ISTAT) .EQ. .FALSE. ) GOTO 267 
C 
C GET ITEM'S CHARACTERISTICS
C 
      CALL DBINF(DBNAM,DINUM,102,ISTAT,IBUF)
      IF(ISTAT .NE. 0) GOTO 250 
C 
C GET THE ITEM TYPE 
C 
      CALL SGET(IBUF,17,ITYPE)
      S(8,R3) = ITYPE 
C 
C GET ITEM LENGTH 
C 
      S(9,R3) = IBUF(10)
      S(15,R3) = IBUF(11) 
C 
C CALCULATE OFFSET INTO RECORD
C 
      IF(R3 .LE. 1) GOTO 35 
      DO 30 INDX = R3-1,1,-1
      IF(S(1,INDX) .EQ. DINUM) GOTO 40
30    CONTINUE
35    CONTINUE
      S(10,R3) = IDISP
      INDX = IBUF(10) * IBUF(11)
      IF(ITYPE .EQ. X) INDX = INDX/2
      IDISP = IDISP + INDX
      GOTO 45 
C 
C OFFSET IS THE SAME AS THE EARLIER DECLARED ITEM 
C 
40    S(10,R3) = S(10,INDX) 
C 
C SET PATH FLAG 
C 
45    CONTINUE
      S(12,R3) = 1
      IF(ISPTH(DBNAM,DSNUM,DINUM,ISTAT) .EQ. .FALSE.) S(12,R3) = 0
      IF(ISTAT .NE. 0) GOTO 250 
C 
C GET CAPACTY AND TYPE
C 
      CALL DBINF(DBNAM,DSNUM,202,ISTAT,IBUF)
      IF(ISTAT .NE. 0) GOTO 265 
      CALL SGET(IBUF,17,S(11,R3) )
      S(13,R3) =IBUF(14)
      S(14,R3) = IBUF(15) 
C 
C     DECODE RELATIONAL OPERATOR
C 
290   CONTINUE
      GO TO (291,292,293,294,295) (J-I+1) 
C 
C  ERROR - RELATIONAL OPERATOR INVALID
C 
291   CALL ERIO(2,ITTY,ERR4,14) 
      GO TO 10
292   S(2,R3)=1 
      IF(JSCOM(IB,I,J,IS,1,IERR).EQ.0) GO TO 300
      IF(JSCOM(IB,I,J,IE,1,IERR).EQ.0) GO TO 300
      GO TO 291 
293   S(2,R3)=2 
      IF(JSCOM(IB,I,J,INE,1,IERR).EQ.0) GO TO 300 
      S (2,R3) = 3
      IF(JSCOM(IB,I,J,ILT,1,IERR).EQ.0) GO TO 300 
      S(2,R3) = 5 
      IF(JSCOM(IB,I,J,IGT,1,IERR).EQ.0) GO TO 300 
      GO TO 291 
294   S(2,R3)=4 
      IF(JSCOM(IB,I,J,INLT,1,IERR).EQ.0) GO TO 300
      S(2,R3) = 6 
      IF(JSCOM(IB,I,J,INGT,1,IERR).EQ.0) GO TO 300
      GO TO 291 
295   S(2,R3)=2 
      IF (JSCOM(IB,I,J,INA,1,IERR).NE.0) GO TO 291
C  GET DATA ITEM VALUE AND PUT IN QSKIB FILE
C  ENTER SECTOR AND WORD OFFSET OF VALUE
300   S(3,R3)=IOFF
      S(6,R3)=NOWSEC
350   CALL LSCAN(IB,I,J,K)
      IF (K.EQ.3) GO TO 400 
C  ERROR - ILLEGAL DATA ITEM VALUE OR TERMINATOR
      CALL ERIO(2,ITTY,ERR16,19)
      GO TO 10
400   LEN=J-I+1 
      IF (LEN.EQ.0) GO TO 405 
C  MOVE VALUE FOR CONVERSION
      IF (LEN.LE.MAXLN) GO TO 421 
C  DATA ITEM VALUE TOO LONG 
      CALL ERIO(2,ITTY,ERR13,13)
      GO TO 10
421   CALL SMOVE(IB,I,J,BUFF,1) 
      GO TO 410 
C 
C  REQUEST VALUE FORM USER
C  THE FOLLOWING CODE IS KLUDGED UP BECAUSE THE SUBROUTINES 
C  INPUT AND LSCAN GET THEIR PARAMETERS FROM COMMON AND ARE 
C  VERY INFLEXIBLE.   SINCE INPUT READS INTO THE BUFFER IB
C  UNTIL IT REACHES THE CHARACTER LIMIT IBSZ, MODIFYING ISCAN 
C  AND IEND, THE BUFFER IB, ISCAN, AND IEND MUST BE SAVED.
C  IBSZ WILL BE MODIFIED TO INDICATE THE LENGTH OF THE SECONDARY
C  BUFFER CALLED BUFF, SO IBSZ MUST ALSO BE SAVED.  THERE IS NO 
C  NEED TO ECHO THE INPUT BECAUSE THE INPUT IS NOT FROM A PROCEDURE 
C  FILE, SO IPFLAG AND IOFLAG MUST BE SAVED THEN SET TO ZERO. 
C  ALL THE PARAMETERS MUST BE RESTORED BEFORE CALLING THE SUBROUTINE
C  ERIO, BECAUSE ERIO RETURNS TO QS WHENEVER A BATCH FILE IS BEING
C  EXECUTED.
C 
C 
C 
405   CONTINUE
      CALL SFILL(BUFF,1,260,40B)
      CALL SMOVE(IB,1,260,SAVBF,1)
      SAVE(1) = IBSZ
      SAVE(2) = ISCAN 
      SAVE(3) = IEND
      SAVE(4) = IPFLAG
      SAVE(5) = IOFLAG
C 
C RESET IBSZ TO INDICATE THE SMALL BUFFER 
C 
      IBSZ = 130
      IPFLAG = 0
      IOFLAG = 0
C 
C IF THIS IS BATCH SKIP THE PROMPT
C 
      IF(BATCH) GOTO 4052 
      CALL QRIO(2,INLU,VALUE,11)
      CALL QRIO(2,INLU,DINAM,3) 
C 
C GET THE INPUT 
C 
4052  CONTINUE
      CALL INPUT
      CALL LSCAN(IB,I,J,K)
      LEN = 0 
      IF(K .EQ. 5) GOTO 4054
      IF(K .EQ. 3) GOTO 4053
C 
C ERROR - RESTORE THE PARAMETERS
C 
      CALL SMOVE(SAVBF,1,260,IB,1)
      IBSZ = SAVE(1)
      ISCAN = SAVE(2) 
      IEND = SAVE(3)
      IPFLAG = SAVE(4)
      IOFLAG = SAVE(5)
C 
      CALL ERIO(2,ITTY,ERR16,19)
      GOTO 405
C 
C PUT THE BUFFER INTO BUFF FOR PROCESSING 
C 
4053  CONTINUE
      LEN = J-I+1 
      IF(LEN .EQ. 0) GOTO 4054
      CALL SMOVE(IB,I,J,BUFF,1) 
C 
C RESTORE THE ORIGINAL INPUT BUFFER 
C 
4054  CONTINUE
      CALL SMOVE(SAVBF,1,260,IB,1)
      IBSZ = SAVE(1)
      ISCAN = SAVE(2) 
      IEND = SAVE(3)
      IPFLAG = SAVE(4)
      IOFLAG = SAVE(5)
C 
C IF THE INPUT IS NULL THEN DEFAULT IT
C 
      IF (LEN.EQ.0) LEN = 1 
C 
C  FILL LAST BYTE WITH BLANK
C 
410   CALL SPUT(BUFF,(LEN+1),40B) 
C 
C  CONVERT REAL OR INTEGER VALUE FORM ASCII 
C 
      IF (ITYPE.EQ.X) GO TO 416 
      IF (ITYPE.EQ.R) GO TO 417 
C  CONVERT TO INTEGER 
      CALL CATI(BUFF,1,LEN,INT,ISTAT) 
      IF (ISTAT.EQ.0) GO TO 418 
C  NON-NUMERIC IN REAL OR INTEGER VALUE 
419   CALL ERIO (2,ITTY,ERR12,19) 
      GO TO 10
418   CONTINUE
      BUFF(1)=INT 
      LEN=2 
      GO TO 416 
C  CONVERT TO REAL
417   REAL=CATR(BUFF,1,LEN,ISTAT) 
      IF (ISTAT.NE.0) GO TO 419 
      CALL SMOVE (REAL,1,4,BUFF,1)
      LEN=4 
C  ENTER VALUE
416   LENFLG=0
C  LENGTH IN WORDS
      LEN=(LEN+1)/2 
      DO 411 MOVE=0,LEN 
      IF (LENFLG.EQ.1) GO TO 414
      IBUFF(IOFF)=LEN 
      LENFLG=1
      GO TO 415 
414   IBUFF(IOFF)=BUFF(MOVE)
415   IOFF=IOFF+1 
      IF (IOFF.LE.IBSZ) GO TO 411 
C  BUFFER FULL - WRITE TO QSKIB 
      IF ((NOWSEC+IQSEC).LE.NSEC) GO TO 412 
C  NOT ENOUGH SECTORS IN QSKIB
413   CALL ERIO(2,ITTY,ERR8,14) 
      GO TO 10
412   CALL EXEC (2,IDILU,IBUFF,IBSZ,TRKNM,NOWSEC) 
      NOWSEC=NOWSEC+IQSEC 
      IOFF=1
411   CONTINUE
      S(4,R3)=S(4,R3)+1 
      S(7,R3)=S(7,R3)+1 
      IF (S(2,R3).LT.3) GO TO 620 
      IF (S(4,R3).EQ.1) GO TO 620 
C  ERROR - INVALID # OF VALUES FOR RELATIONAL OPERATOR
      CALL ERIO(2,ITTY,ERR6,22) 
      GO TO 10
C 
C 
C 
C  ERROR - INVALID LOGICAL CONNECTOR
C 
610   DO 611 M=14,16
611   ERR7(M)=2H
      M=J 
      IF((M-I+1).GT.6) M=I+5
      CALL SMOVE(IB,I,M,ERR7,27)
C 
C  ERROR - ILLEGAL DATA ITEM VALUE OR TERMINATOR
C 
      CALL ERIO(2,ITTY,ERR7,16) 
      GO TO 10
C 
C 
C 
620   CONTINUE
      CALL LSCAN (IB,I,J,K) 
      IF (K.EQ.4) GO TO 350 
      IF (K.EQ.2) GO TO 500 
C  ERROR - ILLEGAL DATA ITEM VALUE OR TERMINATOR
      CALL ERIO (2,ITTY,ERR16,19) 
      GO TO 10
C 
C IS THIS AN "AND" CONNECTOR? 
C 
500   IF (J-I+1.NE.3) GO TO 640 
      IF (JSCOM(IB,I,J,AND,1,IERR).NE.0) GO TO 650
      S(5,R3) = 1 
  630 R3 = R3 + 1 
      GO TO 200 
C 
C IS THIS AN "OR" CONNECTOR 
C 
640   IF (J-I+1.NE.2) GO TO 610 
      IF (JSCOM(IB,I,J,OR,1,IERR).NE.0) GO TO 610 
      S(5,R3) = 2 
      GO TO 630 
C 
C IS THIS AN "END" STATEMENT
C 
650   IF(JSCOM(IB,I,J,END,1,IERR).NE.0) GO TO 610 
      CALL LSCAN(IB,I,J,K)
      IF(K .NE. 5) GOTO 610 
      S(5,R3) = 3 
C 
C  MOVE VALUES ARRAY, IBUFF, TO BUFF
C 
      DO 720 J=1,(IOFF-1) 
      IMA(J)=IBUFF(J) 
720   CONTINUE
C 
C 
C 
      IF (NOWSEC.EQ.0) GO TO 750
C  WRITE LAST SECTORS TO QSKIB FILE 
      IF ((NOWSEC+IQSEC).GT.NSEC) GO TO 413 
      CALL EXEC (2,IDILU,IBUFF,IBSZ,TRKNM,NOWSEC) 
C  SAVE CURRENT SECTOR NUMBER OF QSKIB
750   SECNO =NOWSEC 
C 
C  CALL SEARCH TO RETRIEVE RECORDS
C 
      SNAM(2) = 2H01
      CALL LOAD(SNAM) 
      END 
$ 
  