ftp.update.uu.se/ftp.update.uu.se.2014.03.zip/ftp.update.uu.se/pub/rainbow/msdos/decus/RB123/decusinv.prg

Text File | 1995-05-28 | 5KB | 213 lines

* Program   : DECUSINV.PRG
* Version   : V4.2
* Author(s) : Joe Tomas
* Date      : 08/28/86
* Notice    :
* Called by : FMAINT.PRG
* Call(s)   :
* Notes     : CREATES MASTER DATA FILE AND ALLOWS MASTER FILE UPDATES
*           : FROM DATA DISKS
CLEAR
STORE .F. TO NEW
SET COLOR TO I
@ 01,00
?? VWIDE+SPACE(40)
SET COLOR TO I+
@ 02,00
?? VWIDE+'     *** MASTER FILE MAINTENANCE ***    '
SET COLOR TO I
@ 03,00
?? VWIDE+SPACE(40)
SET COLOR TO +
STORE ' ' TO ANS
@ 10,10 SAY 'ARE YOU CREATING THE MASTER FILE FOR THE FIRST TIME? (Y/N)' ;
GET ANS PICTURE '!'
READ

IF ANS= 'Y'
   @ 12,20 SAY ' '
   TEXT
                   WARNING:  IF YOU RESPOND WITH "YES" AT
                             THE NEXT PROMPT, ANY EXISTING
                             DATA IN THE MASTER FILE WILL
                             BE DESTROYED!
   ENDTEXT
   STORE ' ' TO ANS1
   @ 20,18 SAY 'SHALL WE PURGE OLD MASTER FILE (Y/N) ' GET ANS1 PICTURE '!'
   READ

   IF ANS1 = 'Y'
      SET COLOR TO
      @ 10,00 CLEAR
      SET COLOR TO I+*
      @ 10,28 SAY ' WORKING....PLEASE WAIT '
      SET COLOR TO

      USE MASTER INDEX MASTER
      ZAP
      DELETE FILE PRODUC.DBF
      DELETE FILE PRODUC.NDX
      REINDEX
      * DELETE FILE OE-OK.MEM TO INDICATE THAT PRODUC DATA FILE IS NOT
      * THE SAME AS MASTER.  CHECK FOR THIS FILE WHEN GOING TO ORDER ENTRY.

      IF FILE("OE-OK.MEM")
         DELETE FILE OE-OK.MEM
      ENDIF

      * DELETE FILE "OK.MEM" - THIS IS THE REPORT FLAG CREATED AFTER
      * THE CONSOLIDATION OF DATA DISKS AS BEEN PERFORMED.

      IF FILE("OK.MEM")
         DELETE FILE OK.MEM
      ENDIF

   ENDIF ANS1='Y'

   * RESET CASHTAKE.MEM FILE TO ZERO - THIS IS THE RUNNING DAILY TOTAL $$$
   STORE 0 TO TOTAL
   SAVE TO CASHTAKE ALL LIKE TOTAL

ENDIF ANS='Y'

@ 05,00 CLEAR

USE MASTER INDEX MASTER
GOTO BOTTOM
STORE ' ' TO ANS
STORE .T. TO DISK

DO WHILE DISK

   DO WHILE ANS <> 'Y' .AND. ANS <> 'N'
      SET COLOR TO
      @ 10,00 CLEAR
      ?? VBELL1
      SET COLOR TO +
      @ 10,22 SAY 'UPDATE MASTER FILE FROM A DISK (Y/N)? ' GET ANS PICTURE '!'
      SET COLOR TO
      READ
   ENDDO

   IF ANS = 'Y'
      @ 12,22
      ?? VBELL1
      SET COLOR TO +
      @ 12,26 SAY 'PLACE DATA DISK IN DRIVE A:'
      SET COLOR TO
      @ 23,30 SAY 'PRESS ANY KEY TO UPDATE'

      DO WHILE INKEY() = 0
         SET COLOR TO +
         @ 23,36 SAY 'ANY KEY'
         SET COLOR TO
         @ 23,36 SAY 'ANY KEY'
      ENDDO
      SET COLOR TO
      @ 23,00
      * CHECK FOR A:MASTER
      IF .NOT. FILE("A:MASTER.DBF")
         @ 12,00
         ?? VBELL3
         SET COLOR TO I+*
         @ 12,26 SAY ' A:MASTER.DBF FILE NOT FOUND '
         SET COLOR TO

         @ 23,30 SAY 'PRESS ANY KEY TO CONTINUE'

         DO WHILE INKEY() = 0
            SET COLOR TO +
            @ 23,36 SAY 'ANY KEY'
            SET COLOR TO
            @ 23,36 SAY 'ANY KEY'
         ENDDO
         SET COLOR TO
         @ 23,00
         STORE ' ' TO ANS
         LOOP
      ENDIF

      @ 12,00
      ?? VBELL1
      SET COLOR TO I+*
      @ 12,24 SAY ' UPDATING MASTER FILE FROM DISK '
      SET COLOR TO
      APPEND FROM A:MASTER
      STORE ' ' TO ANS
   ELSE
      STORE .F. TO DISK
      EXIT
   ENDIF

ENDDO

@ 05,00 CLEAR
STORE VAL(PROCOD)+1 TO CODE1
STORE STR(CODE1,3) TO CODE
STORE .T. TO VALID

DO WHILE CODE <> 'END' .AND. VALID
   SET INTENSITY ON
   STORE SPACE(3) TO N_CODE
   STORE SPACE(11) TO N_PARTNO
   STORE SPACE(30) TO N_DESCRI
   STORE 0 TO N_MLP
   STORE ' ' TO N_NEW
   STORE DESCRI TO LAST_DES

   @ 06,14 SAY 'LAST PRODUCT ENTERED WAS...'
   SET COLOR TO I
   @ 07,14 SAY STR(CODE1-1,3)+'  '+LAST_DES
   SET COLOR TO
   @ 09,14 SAY 'DECUS PRODUCT CODE...' GET CODE
   @ 11,14 SAY 'DEC PART NUMBER......' GET N_PARTNO PICTURE '!!-!!!!!-!!'
   @ 13,14 SAY 'ITEM DESCRIPTION.....' GET N_DESCRI
   @ 15,14 SAY 'DEC MLP..............' GET N_MLP PICTURE '9999.99'
   @ 17,14 SAY 'NEW ITEM (Y/N).......' GET N_NEW
   @ 20,14
   SET COLOR TO I+
   @ 23,23 SAY ' ENTER <END> TO EXIT @ PRODUCT CODE '
   SET COLOR TO
   READ

   IF UPPER(CODE) = 'END'
      CLEAR
      RETURN
   ENDIF

   STORE ' ' TO ANS

   DO WHILE ANS <> 'Y' .AND. ANS <> 'N'
      @ 20,00
      ?? VBELL1
      SET COLOR TO +
      @ 20,14 SAY 'OK TO ADD ?  ( Y/N ) ' GET ANS PICTURE '!'
      SET COLOR TO
      READ
   ENDDO

   IF ANS = 'N'
      LOOP
   ENDIF

   IF VALID
      APPEND BLANK
      REPLACE PROCOD WITH UPPER(CODE),PARTNO WITH UPPER(N_PARTNO),DESCRI WITH ;
      UPPER(N_DESCRI),DISC WITH 1.00,MLP WITH N_MLP

      IF UPPER(N_NEW) = 'Y'
         REPLACE NEW WITH 'NEW'
      ELSE
         REPLACE NEW WITH '   '
      ENDIF

      STORE VAL(CODE)+1 TO CODE1
      STORE STR(CODE1,3) TO CODE
      CLEAR GETS
      GOTO BOTTOM

   ENDIF VALID

   STORE .T. TO VALID
ENDDO