*********** DBTALLY.CMD version 2.4
*
*           Use in conjunction with a database.dbf, Index.dbf 
*           Index.ndx & Text.dbf
*
*           DBTALLY.CMD is copywrited by Ellis B. Levin
*           for non-commercial use only
*
*           For more information see DBTALLY.DOC
ERASE
@ 5,0 SAY 'DBTALLY.CMD version 2.4'
@ 6,0 SAY 'Copywrite by Ellis B. Levin'
@ 7,0 SAY 'September, 1985'
@ 8,0 SAY 'Adopted from first version of Tally.cmd by Rich Malm'
SET TALK OFF
STORE 'Y' TO Y:AGAIN
STORE 'NONE' TO DISK
STORE 337 TO LASTKEY
STORE ' ' TO FILE
STORE 'N' TO SHOW
IF DATE() = '00/00/00'
STORE '  /  /  ' TO MDATE
STORE 'Y' TO SHOW
@ 12, 0 SAY 'Enter date as MM/DD/YY'
@ 12, 30 GET MDATE PICTURE '99/99/99'
READ
SET DATE TO &MDATE
ENDIF
DO WHILE Y:AGAIN = 'Y'
IF DISK = 'NONE'
IF SHOW = 'Y'
ERASE
ENDIF
?
ACCEPT 'Enter drive which your file is on ' TO DRIVE
STORE !(DRIVE) TO DRIVE
SET DEFA TO &DRIVE
ENDIF
STORE T TO NO:FILE
IF DISK = 'NONE' .OR. FILE = 'R'
?
? 'Disk in use is '
SET ALTERNATE TO A:DISK.TXT
SET ALTERNATE ON
DISP FILES ON &DRIVE LIKE -*.*
 SET ALTERNATE OFF
 SET ALTERNATE TO
USE A:TEXT
APPEND FROM A:DISK.TXT  SDF
STORE TEXT TO DISK
STORE $(DISK,2) TO DISK
DELETE ALL
PACK
USE
DELETE FILE A:DISK.TXT
ENDIF
*
IF NO:FILE
   ERASE
?
? '------ DBASE FILES ON DRIVE &DRIVE -------'
? '           ',DISK
?
   DISP FILES
?  'Enter file name for DBTALLY'
?  'HIT <RETURN> to quit'
?  'HIT (R) to change disk in B drive'
?
   ACCEPT 'Option' TO FILE
   STORE !(FILE) TO FILE
   IF FILE = ' '
      RETURN
   ENDIF
   IF FILE = 'R'
   SET CONS OFF
   STORE 49152 to I
   POKE I,0,17,2,0,14,37,205,5,0,201
   * above line resets ONLY Drive B:
   SET CALL TO I
   CALL I
   SET CONS ON
   LOOP
   ENDIF
   STORE FILE+'.DBF' TO CK:FILE
   IF .NOT. FILE('&CK:FILE')
      ?
      ? 'Sorry I did not list that file .....'
      STORE 0 TO COUNT
   DO WHILE COUNT # 50
      STORE COUNT + 1 TO COUNT
      ENDDO
      LOOP
   ELSE
      STORE F TO NO:FILE
   ENDIF
*
ENDIF
?
?
ACCEPT 'Would you like a print out of the list in name order (Y/ENTER)';
  TO QUESTION
STORE !(QUESTION) TO QUESTION
USE &FILE
COPY STRU EXTENDED TO STRU
USE STRU
STORE T TO NoItem
GO BOTTOM
STORE # TO MaxItem
DO WHILE NoItem
   ERASE
   ? '- FOLLOWING IS A DIRECTORY OF YOUR DATA BASE -'
   ?
   ? 'Item #   Item name'
   ?
   DISP ALL
   ?
   ACCEPT 'Enter item number for TALLY ' TO ITEM:NO
   IF VAL(ITEM:NO) < 1 .OR. VAL(ITEM:NO) > MaxItem
      ?
      ? 'Please enter a number betweem 1 and',MaxItem,'.....'
      STORE 0 TO COUNT
      DO WHILE COUNT # 50
  STORE COUNT + 1 TO COUNT
      ENDDO
      LOOP
   ELSE
      STORE F TO NoItem
ENDDO
GOTO &ITEM:NO
     * store item info to mem var
STORE FIELD:NAME TO FD:NAME
STORE FIELD:TYPE TO FD:TYPE
STORE FIELD:LEN TO FD:LEN
STORE FIELD:DEC TO FD:DEC
?
?'Doing setup ...'
*
GO TOP
DO WHILE .NOT. EOF
   DELETE
   SKIP
ENDDO
PACK
APPEND BLANK
REPLACE FIELD:NAME WITH 'ITEM:COUNT'
REPLACE FIELD:TYPE WITH 'N'
REPLACE FIELD:LEN WITH 10
APPEND BLANK
REPLACE FIELD:NAME WITH 'ITEM'
REPLACE FIELD:TYPE WITH 'C'
REPLACE FIELD:LEN WITH FD:LEN
APPEND BLANK
REPLACE FIELD:NAME WITH 'DATABASE'
REPLACE FIELD:TYPE WITH 'C'
REPLACE FIELD:LEN WITH FD:LEN
APPEND BLANK
REPLACE FIELD:NAME WITH 'FIELD:NAME'
REPLACE FIELD:TYPE WITH 'C'
REPLACE FIELD:LEN WITH FD:LEN
APPEND BLANK
REPLACE FIELD:NAME WITH 'DATE'
REPLACE FIELD:TYPE WITH 'C'
REPLACE FIELD:LEN WITH FD:LEN
APPEND BLANK
REPLACE FIELD:NAME WITH 'DISK:NAME'
REPLACE FIELD:TYPE WITH 'C'
REPLACE FIELD:LEN WITH FD:LEN
APPEND BLANK
REPLACE FIELD:NAME WITH 'RECORDS'
REPLACE FIELD:TYPE WITH 'N'
REPLACE FIELD:LEN WITH 10
USE
IF FILE('TALLY/WK.DBF')
   DELETE FILE TALLY/WK
ENDIF
CREATE TALLY/WK FROM STRU
USE
DELETE FILE STRU
SELE PRIM
  USE &FILE
  GO TOP
  STORE PEEK(28337)*256 + PEEK(28336) TO TOT:RCDS
SELE SECO
  USE TALLY/WK
STORE T TO FIRST:TM
SELE PRIM
STORE 0 TO REC
DO WHILE .NOT. EOF .AND. PEEK(LASTKEY)<>3
STORE REC+1 TO REC
IF REC=50
   STORE 0 TO REC
   DISP 'Records processed'
ENDIF
   * if item of interest is numeric convert to a string
   IF FD:TYPE='N'
      STORE STR(&FD:NAME,FD:LEN,FD:DEC) TO STRING
   ELSE
      STORE &FD:NAME TO STRING
   ENDIF
   SELE SECO
*
   IF FIRST:TM
      APPEND BLANK
      REPLACE ITEM:COUNT WITH 1
      REPLACE ITEM WITH STRING
      INDEX ON ITEM TO TALLY/WK
      SET INDEX TO TALLY/WK
      STORE F TO FIRST:TM
      ERASE
      ? 'Reading data file....'
   ELSE
      FIND '&STRING'
      IF # <> 0
  REPLACE ITEM:COUNT WITH ITEM:COUNT+1
      ELSE
  APPEND BLANK
  REPLACE ITEM:COUNT WITH 1
  REPLACE ITEM WITH STRING
       ENDIF
   ENDIF FIRST:TM
  SELE PRIM
  SKIP
ENDDO WHILE.NOT. EOF
IF PEEK(LASTKEY) = 3
?
?  'Control-C applied. Operation aborted (1).'
SELECT SECONDARY
   USE
SELECT PRIMARY
   USE
   DELETE FILE TALLY/WK
   DELETE FILE TALLY/WK.NDX
?  'All work files deleted'
?  'Returning to DBASE II'
RETURN
USE
ENDIF
SELE SECO
GO TOP
REPLACE DATABASE WITH CK:FILE
REPLACE FIELD:NAME WITH FD:NAME
REPLACE DATE WITH DATE()
REPLACE DISK:NAME WITH DISK
REPLACE RECORDS WITH TOT:RCDS
SKIP
DO WHILE .NOT.  EOF
REPLACE DATABASE WITH CK:FILE
REPLACE FIELD:NAME WITH FD:NAME
REPLACE DATE WITH DATE()
REPLACE DISK:NAME WITH DISK
REPLACE RECORDS WITH TOT:RCDS
SKIP
ENDDO
ERASE
DISP 'LIST OF',TRIM(FD:NAME),'COUNT, IN NAME ORDER - file is &FILE' OFF
?
LIST ITEM:COUNT ITEM DATABASE TRIM(FIELD:NAME);
TRIM(DATE) TRIM(DISK:NAME) RECORDS OFF
?
GO BOTTOM
COUNT TO REC:NO
IF QUESTION = 'Y'
   SET PRINT ON
DISP 'LIST OF',TRIM(FD:NAME),'COUNT, IN NAME ORDER - file is &FILE' OFF
?
LIST ITEM:COUNT ITEM DATABASE TRIM(FIELD:NAME);
  TRIM(DATE) TRIM(DISK:NAME) RECORDS OFF
? '  '
GO BOTTOM
COUNT TO REC:NO
SET PRINT OFF
ENDIF
?
? 'Copying results to INDEX.DBF'
STORE 0 TO COUNT
SELECT PRIMARY
USE A:INDEX  INDEX A:INDEX
GO TOP
DELETE NEXT 500 FOR DATABASE = '&CK:FILE' .AND. FIELD:NAME = '&FD:NAME'
DO WHILE REC:NO > 0 .AND. PEEK(LASTKEY)<>3
SELECT PRIMARY
APPEND BLANK
REPLACE ITEM:COUNT WITH S.ITEM:COUNT,ITEM WITH S.ITEM,DATABASE;
 WITH S.DATABASE,FIELD:NAME WITH S.FIELD:NAME,DATE WITH S.DATE,;
DISK:NAME WITH S.DISK:NAME,RECORDS WITH S.RECORDS
SELECT SECONDARY
   SKIP-1
   STORE REC:NO-1 TO REC:NO
*  STORE COUNT+1 TO COUNT
*  IF COUNT = 20
*     STORE 0 TO COUNT
   ENDIF
ENDDO
ACCEPT 'Do you wish to tally another database ' TO Y:AGAIN
STORE !(Y:AGAIN) TO Y:AGAIN
   USE
SELECT PRIMARY
   USE
   DELETE FILE TALLY/WK
   DELETE FILE TALLY/WK.NDX
   ? 'All work files deleted'
ENDDO
IF PEEK(LASTKEY) = 3
?
?  'Control-C applied. Operation aborted (2).'
SELECT SECONDARY
   USE
SELECT PRIMARY
   USE
   DELETE FILE TALLY/WK
   DELETE FILE TALLY/WK.NDX
?  'All work files deleted'
?  'Returning to DBASE II'
RETURN
USE
ENDIF
USE A:INDEX INDEX A:INDEX
?
? 'Packing Index'
PACK
? 'Packing done'
  STORE PEEK(28337)*256 + PEEK(28336) TO TRECORDS
? 'Total number of records',TRECORDS
USE
SET TALK ON
RETURN
