Shareware Overload/ShartewareOverload.cdr/database/workdb.zip/SEARCH1.PRG

Text File | 1988-08-15 | 19KB | 525 lines

*!!* dBASE CONVERT - dBASE III File Conversion Aid  v2.01  1/10/86
*
SET HEADING OFF
SET SAFETY OFF
NOTE - SEARCH1.SIG - COMPREHENSIVE ORDERS SEARCH COMMAND FILE
NOTE -
NOTE - THIS COMMAND FILE WAS CREATED USING - fastBASE (TM)   (VERSION 1.3)
NOTE -      "THE dBASE II COMMAND FILE GENERATOR" DEVELOPED BY:
NOTE -              FOURCOLOR DATA SYSTEMS INC.
NOTE -              7011 MALABAR STREET
NOTE -              DAYTON, OHIO 45459
NOTE -              PHONE: [phone]
NOTE -
NOTE - SEARCH BY INDEX         - OPERATOR CAN SEARCH DATABASE IN ORDER
NOTE -                               OF ANY INDEX FILE.
NOTE -
NOTE - INDEX FILES             - INDICES ARE OF THE FOLLOWING FORM:
NOTE -                               A. CHARACTER FIELDS ARE MADE UPPERCASE.
NOTE -                                  (THIS WILL ALLOW THE FIND COMMAND TO
NOTE -                                   IGNORE UPPER AND LOWER CASE
NOTE -                                   DISTINCTIONS.)
NOTE -                               B. ALL NUMERIC FIELDS ARE CONVERTED TO
NOTE -                                  CHARACTER STRINGS.
NOTE -                               C. EXAMPLE:
NOTE -                                      IF AN INDEX CONSISTS OF A NUMERIC
NOTE -                                      FIELD - FIELDNUM (N,8,2) AND A
NOTE -                                      CHARACTER FIELD - FIELDCHAR, THEN
NOTE -                                      FASTBASE WILL DEFINE THE INDEX AS
NOTE -                                      STR(FIELDNUM,8,2) + !(FIELDCHAR).
NOTE -
NOTE - SEARCH BY PART OF FIELD - OPERATOR CAN SELECT ANY CHARACTER
NOTE -                               FIELD IN THE DATABASE. THEN OPERATOR
NOTE -                               CAN ENTER ANY POSSIBLE SUB-STRING.
NOTE -                               SEARCH WILL THEN DISPLAY EVERY
NOTE -                               RECORD WITH THIS SUB-STRING IN ANY
NOTE -                               PART OF THE SELECTED FIELD.
NOTE -
NOTE - IF ANY RECORD IS SELECTED BY OPERATOR, THEN THIS SEARCH ROUTINE
NOTE -     WILL RETURN TO THE CALLING COMMAND FILE THE DBASE II RECORD
NOTE -     NUMBER IN THE MEMORY VARIABLE 'RECNO' OTHERWISE 'RECNO'
NOTE -     WILL HAVE THE VALUE ZERO.
NOTE -
NOTE - WHEN CALLING THIS SEARCH ROUTINE, A MEMORY VARIABLE WITH THE
NOTE -     NAME 'DR' MUST EXIST. FURTHER THIS MEMORY VARIABLE MUST EITHER
NOTE -     HAVE THE VALUE ' ' OR 'X:' WHERE X IS ANY ALPHABETIC
NOTE -     CHARACTER CORRESPONDING TO A VALID DISK DRIVE (EG. A:).
NOTE -
STORE 'DETAILED SEARCH' TO MODE
STORE CHR(PEEK(063))TO dr
CLEAR
@ 1,20 SAY '*** SEARCH FOR ORDERS ***'
@ 3,20 SAY 'SEARCH METHOD:'
@ 5,25 SAY '1. SEARCH BY INDEX'
@ 6,25 SAY '2. SEARCH PART OF FIELD'
STORE ' ' TO EMETH
DO WHILE EMETH <> '1' .AND. EMETH <> '2'
   @ 8,25 SAY '   METHOD? (1,2) ' GET EMETH
   READ
ENDDO
IF EMETH = '1'
   STORE '                    ' TO KEYVAR1
   @ 10,20 SAY 'ENTER LASTNAME ' GET KEYVAR1
   READ
   STORE KEYVAR1 TO FINDSTRING
   RELEASE KEYVAR1
   USE &DR.:SIG/M.DBF INDEX &DR.:ORDERS.NDX
   NOTE -
   NOTE - DETERMINE RECORD NUMBER OF FIRST AND LAST RECORD IN DATABASE
   NOTE -
   IF RECNO() > 0
      STORE RECNO() TO FIRSTREC
      GOTO BOTTOM
      STORE RECNO() TO LASTREC
      NOTE -
      NOTE - TRIM RIGHT HAND SPACES AND ZEROES FROM FINDSTRING
      NOTE - ALSO SET FINDSTRING TO UPPER CASE
      NOTE -
      STORE TRIM(UPPER(FINDSTRING)) TO FINDSTRING
      STORE .T. TO SHRINK
      DO WHILE SHRINK
         STORE .F. TO SHRINK
         STORE .T. TO TRIMZERO
         DO WHILE TRIMZERO .AND. LEN(FINDSTRING) > 1
            STORE SUBSTR(FINDSTRING,LEN(FINDSTRING),1) TO LASTCHAR
            IF LASTCHAR = '0' .OR. LASTCHAR = ' '
               STORE SUBSTR(FINDSTRING,1,LEN(FINDSTRING)-1) TO FINDSTRING
               LOOP
            ENDIF
            STORE .F. TO TRIMZERO
         ENDDO
         *!! EOF() will be true if NO FIND, and RECNO() will equal BOTTOM, not 0.
         FIND '&FINDSTRING'
         IF .NOT. (EOF() .OR. BOF())
            STORE RECNO() TO FINDRECNO
            LOOP
         ENDIF
         STORE FINDSTRING + '   ' TO FINDSTRING
         NOTE -
         NOTE - USE FIRST 3 CHARACTERS OF FINDSTRING FOR 'FIND' COMMAND
         NOTE -
         STORE SUBSTR(FINDSTRING,1,3) TO FINDSTRING
         *!! EOF() will be true if NO FIND, and RECNO() will equal BOTTOM, not 0.
         FIND '&FINDSTRING'
         IF .NOT. (EOF() .OR. BOF())
            STORE RECNO() TO FINDRECNO
            LOOP
         ENDIF
         STORE FINDSTRING + ' ' TO FINDSTRING
         STORE SUBSTR(FINDSTRING,1,1) TO FINDSTRING
         *!! EOF() will be true if NO FIND, and RECNO() will equal BOTTOM, not 0.
         FIND '&FINDSTRING'
         IF .NOT. (EOF() .OR. BOF())
            STORE RECNO() TO FINDRECNO
            LOOP
         ENDIF
         GOTO TOP
         STORE RECNO() TO FINDRECNO
      ENDDO
      STORE FINDRECNO TO STARTREC
      RELEASE FINDRECNO, FINDSTRING, SHRINK, LASTCHAR, TRIMZERO
      STORE .T. TO FILESRCH
      STORE 'F' TO EOPTION
      DO WHILE FILESRCH
         NOTE -
         NOTE - IF DATABASE HAS AT LEAST 10 RECORDS THEN SEARCH CAN OPERATE
         NOTE -     IN 'FAST' MODE. IN THIS MODE, 10 RECORDS AT A TIME ARE
         NOTE -     DISPLAYED ON THE CRT.
         NOTE -
         IF EOPTION = 'F'
            STORE 'FAST' TO SRCHMODE
            GOTO TOP
            SKIP 9
            IF RECNO() = LASTREC
               STORE 'D' TO EOPTION
            ENDIF
            GOTO STARTREC
         ENDIF
         IF EOPTION = 'D'
            STORE 'DETAIL' TO SRCHMODE
         ENDIF
         IF EOPTION = 'R'
            STORE 0 TO RECNO
            *!! Logical constant converted.
            STORE .F. TO FILESRCH
            LOOP
         ENDIF
         IF SRCHMODE = 'FAST'
            STORE ' ' TO EOPTION
            STORE .T. TO FASTSRCH
            DO WHILE FASTSRCH
               CLEAR
               STORE 1 TO SEARCHLINE
               STORE RECNO() TO RECNO
               STORE .T. TO CHECKPOS1
               DO WHILE CHECKPOS1
                  IF RECNO = LASTREC
                     STORE 10 TO SEARCHLINE
                     SKIP - 9
                     STORE .F. TO CHECKPOS1
                     LOOP
                  ENDIF
                  SKIP 8
                  IF RECNO() <> LASTREC
                     SKIP - 8
                     STORE .F. TO CHECKPOS1
                     LOOP
                  ENDIF
                  IF RECNO() = LASTREC
                     DO WHILE RECNO <> RECNO()
                        SKIP - 1
                     ENDDO
                     STORE 10 TO SEARCHLINE
                     STORE .T. TO CHECKPOS2
                     DO WHILE CHECKPOS2
                        STORE SEARCHLINE - 1 TO SEARCHLINE
                        SKIP 1
                        IF RECNO() = LASTREC
                           STORE .F. TO CHECKPOS2
                           LOOP
                        ENDIF
                        IF SEARCHLINE < 0
                           STORE .F. TO CHECKPOS2
                           LOOP
                        ENDIF
                     ENDDO
                     SKIP - 9
                     STORE .F. TO CHECKPOS1
                  ENDIF
               ENDDO
               STORE RECNO() TO STARTREC
               NOTE -
               NOTE - USE THE SEARCH AND LIST REPORT CREATED BY FASTBASE, TO DISPLAY
               NOTE -     10 RECORDS ON THE CRT AT ONE TIME.
               NOTE -
               REPORT NEXT 10 FORM &DR.:SIG/M.FRM PLAIN
               @ 23,0 SAY 'N (NEXT), P (PREVIOUS), J (JUMP), D (DISPLAY),  R (RETURN).'
               GOTO STARTREC
               IF EOPTION = 'P'
                  STORE 10 TO SEARCHLINE
                  SKIP 9
                  DO WHILE RECNO() <> PREVREC .AND. SEARCHLINE > 1
                     STORE SEARCHLINE - 1 TO SEARCHLINE
                     SKIP - 1
                  ENDDO
               ENDIF
               IF EOPTION <> 'P'
                  IF SEARCHLINE <> 1
                     STORE SEARCHLINE - 1 TO SEARCHLINE
                     SKIP SEARCHLINE
                     STORE SEARCHLINE + 1 TO SEARCHLINE
                  ENDIF
               ENDIF
               SET DELIMITER OFF
               DO WHILE SEARCHLINE > 0 .AND. SEARCHLINE < 11
                  STORE ' ' TO EOPTION
                  DO WHILE EOPTION <> 'N' .AND. EOPTION <> 'P' .AND. EOPTION <> 'J' .AND. EOPT
                     @ (2 * SEARCHLINE) + 1, 0 GET EOPTION
                     READ
                     STORE UPPER(EOPTION) TO EOPTION
                     IF EOPTION = 'N' .AND. RECNO() = LASTREC
                        STORE ' ' TO EOPTION
                     ENDIF
                     IF EOPTION = 'P' .AND. RECNO() = FIRSTREC
                        STORE ' ' TO EOPTION
                     ENDIF
                  ENDDO
                  @ (2 * SEARCHLINE) + 1, 0 SAY ' '
                  IF EOPTION = 'N'
                     STORE SEARCHLINE + 1 TO SEARCHLINE
                     SKIP 1
                     LOOP
                  ENDIF
                  IF EOPTION = 'P'
                     STORE SEARCHLINE - 1 TO SEARCHLINE
                     SKIP - 1
                     STORE RECNO() TO PREVREC
                     LOOP
                  ENDIF
                  STORE 0 TO SEARCHLINE
               ENDDO
               IF EOPTION = 'P'
                  SKIP - 9
               ENDIF
               IF EOPTION = 'J'
                  SET DELIMITER ON
                  STORE 0 TO INCREMENT
                  @ 23,0 SAY '               ENTER JUMP INCREMENT (+ OR -)
                  @ 23,45 GET INCREMENT
                  READ
                  SET DELIMITER OFF
                  IF INCREMENT > 0
                     SKIP INCREMENT
                  ENDIF
                  IF INCREMENT < 0
                     STORE 0 - INCREMENT TO INCREMENT
                     SKIP - INCREMENT
                  ENDIF
               ENDIF
               IF EOPTION = 'D' .OR.  EOPTION = 'R'
               STORE .F. TO FASTSRCH
               ENDIF
            ENDDO
            RELEASE FASTSRCH, SEARCHLINE, PREVREC, CHECKPOS1, CHECKPOS2
            SET DELIMITER ON
         ENDIF
         IF SRCHMODE = 'DETAIL'
            STORE .T. TO DETLSRCH
            DO WHILE DETLSRCH
               CLEAR
               @ 1,25 SAY MODE
               @ 2,0  SAY '+---------------------------------------'
               @ 2,39 SAY '--------------------------------------+'
               @ 4,5 SAY 'ORDER NUMBER                          COMPLETE'
               @ 5,8 SAY 'LAST NAME                             FIRST'
               @ 6,10 SAY 'ADDRESS'
               @ 7,9 SAY '(line 2)'
               @ 8,9 SAY '(line 3)'
               @ 9,13 SAY 'CITY                             STATE              ZIP'
               @ 11,2 SAY 'VOLUMES'
               @ 13,3 SAY 'AMOUNT                                     ENTER             SHIP'
               @ 14,2 SAY 'REMARKS'
               @ 15,2 SAY 'REMARKS'
               @ 17,0 SAY 'BACKORDER'
               @ 18,44 SAY 'CATALOG'
               @ 19,2 SAY 'SHIPPED                 SHIPPED                             UPDATE'
               @ 20,0 SAY '+--------------------------------------'
               @ 20,39 SAY '--------------------------------------+'
               @ 4,18 GET ORDER
               @ 5,18 GET LNAME
               @ 5,52 GET FNAME
               @ 6,18 GET ADDR1
               @ 7,18 GET ADDR2
               @ 8,18 GET ADDR3
               @ 9,18 GET CITY
               @ 9,52 GET STATE
               @ 9,70 GET ZIP
               @ 11,10 GET VOL1
               @ 13,10 GET AMT
               @ 13,52 GET ENTERED
               @ 13,69 GET SHIPPED
               @ 14,10 GET REM1
               @ 15,10 GET REM2
               @ 17,10 GET BO
               @ 18,53 GET CATALOG
               @ 19,10 GET BO_SHIP
               @ 19,34 GET BO2_SHIP
               @ 19,69 GET DAYU
               @ 4,52 GET COMP
               CLEAR GETS
               @ 23,0 SAY 'N (NEXT), P (PREVIOUS), J (JUMP), F (FAST SEARCH), R (RETURN)'
               STORE ' ' TO EOPTION
               DO WHILE EOPTION <> 'N' .AND. EOPTION <> 'P' .AND. EOPTION <> 'J' .AND. EOPTION
                  @ 23,74 GET EOPTION
                  READ
                  STORE UPPER(EOPTION) TO EOPTION
                  IF EOPTION = 'N' .AND. RECNO() = LASTREC
                     STORE ' ' TO EOPTION
                  ENDIF
                  IF EOPTION = 'P' .AND. RECNO() = FIRSTREC
                     STORE ' ' TO EOPTION
                  ENDIF
               ENDDO
               IF EOPTION = 'N'
                  IF RECNO() = LASTREC
                     LOOP
                  ENDIF
                  SKIP 1
               ENDIF
               IF EOPTION = 'P'
                  SKIP - 1
               ENDIF
               IF EOPTION = 'J'
                  STORE 0 TO INCREMENT
                  @ 23,0 SAY '               ENTER JUMP INCREMENT (+ OR -)
                  @ 23,45 GET INCREMENT
                  READ
                  IF ((EOF() .OR. BOF())) .OR. (INCREMENT = 0)
                     LOOP
                  ENDIF
                  IF INCREMENT > 0
                     SKIP INCREMENT
                  ENDIF
                  IF INCREMENT < 0
                     STORE 0 - INCREMENT TO INCREMENT
                     SKIP - INCREMENT
                  ENDIF
               ENDIF
               IF EOPTION = 'F' .OR. EOPTION =  'R'
                  STORE .F. TO DETLSRCH
                  STORE RECNO() TO STARTREC
               ENDIF
            ENDDO
            RELEASE DETLSRCH
         ENDIF
         RELEASE SRCHMODE
      ENDDO
   ENDIF
ENDIF
NOTE -
NOTE - SEARCH FOR SUB-STRING THAT IS PART OF A SELECTED FIELD.
NOTE -
IF EMETH = '2'
   CLOSE INDEX
   CLEAR
   STORE 'DETAILED SEARCH' TO MODE
   @ 10,20 SAY 'SELECT FIELD NUMBER '
   @ 12,20 SAY 'ENTER SEARCH DATA '
   @ 14,0 SAY ' 1. ORDER NO.   2. COMPLETED   3. LASTNAME    4. FIRST NAME  5.ADDRESS'
   @ 15,0 SAY ' 6. ADDR-LINE2  7. ADDR-LINE3  8. CITY        9. STATE      10. ZIP'
   @ 16,0 SAY '11. VOLUMES    12. ENTERED    13. SHIPPED    14. REMARKS    15. REMARKS-2'
   @ 17,0 SAY '16. BACKORDER  17. SHIPPED    18. SHIPPED    19. UPDATE     '
   STORE '  ' TO EVAR
   DO WHILE VAL(EVAR) < 1 .OR. VAL(EVAR) > 23
      @ 10,20 SAY 'SELECT FIELD NUMBER ' GET EVAR PICTURE '99'
      READ
   ENDDO
   STORE '                              ' TO EPART
   @ 12,20 SAY 'ENTER SEARCH DATA ' GET EPART
   READ
   IF VAL(EVAR) = 1
      STORE 'ORDER' TO PARTFIELD
   ENDIF
   IF VAL(EVAR) = 2
      STORE 'COMP' TO PARTFIELD
   ENDIF
   IF VAL(EVAR) = 3
      STORE 'LNAME' TO PARTFIELD
   ENDIF
   IF VAL(EVAR) = 4
      STORE 'FNAME' TO PARTFIELD
   ENDIF
   IF VAL(EVAR) = 5
      STORE 'ADDR1' TO PARTFIELD
   ENDIF
   IF VAL(EVAR) = 6
      STORE 'ADDR2' TO PARTFIELD
   ENDIF
   IF VAL(EVAR) = 7
      STORE 'ADDR3' TO PARTFIELD
   ENDIF
   IF VAL(EVAR) = 8
      STORE 'CITY' TO PARTFIELD
   ENDIF
   IF VAL(EVAR) = 9
      STORE 'STATE' TO PARTFIELD
   ENDIF
   IF VAL(EVAR) = 10
      STORE 'ZIP' TO PARTFIELD
   ENDIF
   IF VAL(EVAR) = 11
      STORE 'VOL1' TO PARTFIELD
   ENDIF
   IF VAL(EVAR) = 12
      STORE 'ENTERED' TO PARTFIELD
   ENDIF
   IF VAL(EVAR) = 13
      STORE 'SHIPPED' TO PARTFIELD
   ENDIF
   IF VAL(EVAR) = 14
      STORE 'REM1' TO PARTFIELD
   ENDIF
   IF VAL(EVAR) = 15
      STORE 'REM2' TO PARTFIELD
   ENDIF
   IF VAL(EVAR) = 16
      STORE 'BO' TO PARTFIELD
   ENDIF
   IF VAL(EVAR) = 17
      STORE 'BO:SHIP' TO PARTFIELD
   ENDIF
   IF VAL(EVAR) = 18
      STORE 'BO2:SHIP' TO PARTFIELD
   ENDIF
   IF VAL(EVAR) = 19
      STORE 'DAYU' TO PARTFIELD
   ENDIF
   USE &DR.:SIG/M.DBF
   STORE TRIM(EPART) TO EPART
   RELEASE EVAR
   GOTO BOTTOM
   STORE RECNO() TO LASTREC
   GOTO TOP
   STORE 0 TO RECNO
   STORE .T. TO PARTSRCH
   STORE ' ' TO EOPTION
   STORE .T. TO FIRSTLOOP
   DO WHILE PARTSRCH
      IF EOPTION = 'R'
         STORE 0 TO RECNO
         STORE .F. TO PARTSRCH
         LOOP
      ENDIF
      IF RECNO = LASTREC
         STORE 'R' TO EOPTION
         LOOP
      ENDIF
      IF FIRSTLOOP
         LOCATE FOR UPPER(EPART) $ UPPER(&PARTFIELD)
      ENDIF
      IF .NOT.FIRSTLOOP
         CONTINUE
      ENDIF
      STORE .F. TO FIRSTLOOP
      STORE RECNO() TO RECNO
      IF RECNO() = LASTREC .AND.(.NOT. EPART $ &PARTFIELD)
         STORE 'R' TO EOPTION
         LOOP
      ENDIF
      CLEAR
      @ 1,25 SAY MODE
      @ 2,0  SAY '+---------------------------------------'
      @ 2,39 SAY '--------------------------------------+'
      @ 4,5 SAY 'ORDER NUMBER                          COMPLETE'
      @ 5,8 SAY 'LAST NAME                             FIRST'
      @ 6,10 SAY 'ADDRESS'
      @ 7,9 SAY '(line 2)'
      @ 8,9 SAY '(line 3)'
      @ 9,13 SAY 'CITY                             STATE              ZIP'
      @ 11,2 SAY 'VOLUMES'
      @ 13,3 SAY 'AMOUNT                                     ENTER             SHIP'
      @ 14,2 SAY 'REMARKS'
      @ 15,2 SAY 'REMARKS'
      @ 17,0 SAY 'BACKORDER'
      @ 18,44 SAY 'CATALOG'
      @ 19,2 SAY 'SHIPPED                 SHIPPED                             UPDATE'
      @ 20,0 SAY '+--------------------------------------'
      @ 20,39 SAY '--------------------------------------+'
      @ 4,18 GET ORDER
      @ 5,18 GET LNAME
      @ 5,52 GET FNAME
      @ 6,18 GET ADDR1
      @ 7,18 GET ADDR2
      @ 8,18 GET ADDR3
      @ 9,18 GET CITY
      @ 9,52 GET STATE
      @ 9,70 GET ZIP
      @ 11,10 GET VOL1
      @ 13,10 GET AMT
      @ 13,52 GET ENTERED
      @ 13,69 GET SHIPPED
      @ 14,10 GET REM1
      @ 15,10 GET REM2
      @ 17,10 GET BO
      @ 18,53 GET CATALOG
      @ 19,10 GET BO_SHIP
      @ 19,34 GET BO2_SHIP
      @ 19,69 GET DAYU
      @ 4,52 GET COMP
      CLEAR GETS
      STORE ' ' TO EOPTION
      @ 22,12 SAY 'N (NEXT), R (RETURN)'
      DO WHILE EOPTION <> 'N' .AND. EOPTION <> 'R'
         @ 22,37 GET EOPTION PICTURE '!'
         READ
      ENDDO
   ENDDO
   RELEASE PARTSRCH
ENDIF
RELEASE EMETH, EOPTION, EPART, FILESRCH, LASTREC, FIRSTREC, STARTREC
RELEASE PARTFIELD, NUMREC, FIRSTLOOP, EKEYOPT, INCREMENT, MODE
SET INDEX TO &DR.:ORDERS
STORE .T. TO FIRST
RETURN