Shareware Overload/ShartewareOverload.cdr/database/db3mail.zip/STARTP.PRG

Text File | 1986-01-09 | 22KB | 778 lines

**************************************************************"
*         Set up menu for Address file manager"
*         Written by Glenn R. Abelson"
*                    P.O. Box 1031"
*                    Rockville Ctr. NY 11571"
*  If this came to you for free - a contribution would be nice"
*  Last update 05/12/85
PROC START
SET SAFE OFF
CLEA
TEXT
        This is a free program I wrote for dBASE III.

        If you use it, and like it -- a contribution between

        $5 and $30 would be appreciated.


 More important, however, to me... pass my name along to anyone wanting or
 needed a custom written sales application.

 Thank you.

                          GLENN R. ABELSON
                          P.O. BOX 1031
                          ROCKVILLE CTR. NY 11571

                          516-766-7782
ENDT
WAIT
PUBL mfil
CLEA
DO WHIL .T.
CLEA
?
?
?"                >>>>>>>>  ADDRESS FILE SETUP MENU <<<<<<<<"
?
?"                         1.  Use address file"
?
?"                         2.  Set Path (if different directory)"
?
?"                         3.  Change default drive/colors"
?
?'                         Q.  dBase prompt " . " '
?
?"                         X.  Quit to DOS"
?
?"                After setup, instructions for main program"
?"                are available from MAIN MENU letter H."
?
@ 19,0 SAY "Copyright 1985 GLENN ABELSON, P.O. BOX 1031, ;
ROCKVILLE CTR. NY 11571"
WAIT TO CHOICE
DO CASE CHOICE
CASE CHOICE = "1"
CLEA
DO ADDRESS
CASE CHOICE = "2"
ACCE 'What is path (i.e. b:\dbase )... ' to mpath
SET PATH TO &mpath
CASE CHOICE = "3"
ACCE "What drive is to be default drive. " to mdef
SET DEFA TO &mdef
?
?
?"                 *******  SET UP FILE DEFAULTS ******"
?
?"                          1.  SET COLORS"
?
?"                          Return - to main menu"
?
WAIT TO SETUPS
DO CASE SETUPS
CASE SETUPS = "1"
?"Colors - black - space bar    blue - B   green - G"
?"         cyan  - BG           red  - R   magenta-BR  "
?"         brown - GR           white - W or RB "
?"MONOCHROME ONLY   U - underline"
set color to w+/ ,w/ ,
?" HIGH INTESITY - add  +  after color"
set color to w+*/ ,w/ ,
?" BLINKING - add  *  after color"
set color to w+/ ,w/ ,
STOR '    ' TO mfore
STOR '    ' to mback
STOR '    ' to mdat
STOR '    ' to mdatb
STOR '    ' to mbord
ACCE "Select a foreground color, by number for headings... " to ;
 mfore
ACCE "Select a background color, by number for headings... " to ;
  mback
  ACCE "Select a foreground color, by number for data... " to ;
  mdat
  Acce "Select a background color, by number for data... " to ;
  mdatb
  ACCE "Select a border color... " to mbord
SET COLO TO &mfore/&mback,&mdat/&mdatb,&mbord
?
?      "Make these default start up colors Y/N? ... "
WAIT TO SETCOL
DO CASE SETCOL
CASE UPPE(SETCOL) ="Y"
SET SAFE OFF
SAVE ALL LIKE COLO* TO COLOR.MEM
SET SAFE ON
DO ADDRESS
OTHE
CLEA
ENDC
ENDD
OTHE
ENDC SETUPS
ENDD
DO ADDRESS
CASE CHOICE = "2"
ACCE "What is path be (i.e.  \dbase) ... " TO MPATH
SET PATH TO &MPATH
CASE UPPER(CHOICE) = "Q"
CANCEL
CASE UPPER(CHOICE) = "X"
CLEA ALL
QUIT
ENDC
ENDD
PROC ADDRESS
REST FROM COLOR.MEM
CLEA
SET BELL OFF
SELE 1
USE ADDRESS INDEX KEY,COMPANY,LAST
DO WHIL .T.
CLEA
?"  ******************** ADDRESS FILE MANAGER ********************"
?"                     1.  Add a record "
?"                     2.  Find/Change/Review/Index records"
?"                     3.  Browse through names in general*"
?"                         Best area to add $ Paid & Due"
?"                     4.  List records "
?
?"                     5.  Print lists or labels*"
?"                     6.  Send  names to Mail Merge*"
?
?"                     *.  Set filter on/off to explanation "
?"                     !.  Set any filter off"
?
?"                     7.  DELETE RECORDS        "
?"                     8.  AUTOMATIC MAINTENCE"
?
?"                     E.  Error notes"
?"                     H.  Help/Instructions"
?"                     S.  SAVE AND CONTINUE"
?"                     Q.  TO dBase Prompt "
?"                     X.  Quit to DOS"
?"                     Return to Main Menu"
?"                     (Return from any menu brings"
?"                      you up one level)."
WAIT TO ACTION
 DO CASE ACTION
CASE ACTION = "1"
do xxaddnam
CLEA
USE
SELE 1
USE ADDRESS INDE KEY,COMPANY,LAST
CASE ACTION = "2"
SET INDE TO
DO LOOKFOR
CASE ACTION = "3"
DO SETFIL
BROW
CLEA
CASE ACTION = "4"
DO LISTFOR
CASE ACTION = "5"
DO SETFIL
DO LABELS
CASE ACTION = "6"
DO SETFIL
DO MAILMERG
CASE ACTION = "7"
DO GETRIDOF
CASE ACTION = "*"
DO FILTER
CASE ACTION = "!"
SET FILTER TO
? " FILTER IS OFF"
CASE ACTION = "8"
DO MAILFIX
CASE UPPE(ACTION) = "E"
DO ERNOTE
CASE UPPER(ACTION) = "H"
DO HELP
CASE UPPER(ACTION) = "S"
CLOSE DATABASES
select 1
USE ADDRESS INDEX KEY,COMPANY,LAST
CLEA
CASE UPPER(ACTION) = "Q"
USE
CANCEL
CASE UPPER(ACTION) = "X"
CLOS DATABASES
QUIT
OTHE
CLOS DATABASES
CLEA
RETU
ENDC
ENDD
PROC DRIVES
?
?"Current default drive is drive for which you set program files "
?"enter new default drive..."
?"or else press Return"
ACCE "New default drive is... " to mdef
set default to &mdef
CLEA
return
PROC ERNOTE
?
?" COMMON ERRORS: "
?
?"   1.  Variable not found -  you either/or:"
?'                did not enclose a string in "quotes" '
?"                did not spell a field name right"
?"                put a comma anyplace but between field names"
?
?"   2.  Syntax error - unrecognized phrase"
?"                the idea is right, the format is not"
?
?
?"   3.  Can't find or file not accessible -"
?"                from   .   prompt try CLEA ALL"
?"                you may have exceeded memory limits"
?"                file could be in a different directory"
?
?"   4.  Alias already in use - "
?"                usually occurs when dropping in and out"
?"                of programs.   From   .   prompt type"
?"                CLOSE DATABASES"
?"                Re start program."
?
?"   See manual for more"
wait
PROC F
 ACCE "Type field name... " to mfield
 ACCE "Type string to locate... " to mstring
LIST COMPANY, &mfield FOR ("&mstring"$&mfield)
?
?"No record listings means there are no matches."
?"To edit a particular record, note its # and select #4 from menu. "
wait
PROC FILTER
CLEA
?" Filters instruct the database/file manager to pretend that ;
only the records that meet the filter conditions actually exist."
?
?" You can, for example set a filter to tell the database to ;
find, list, mailmerge, print labels or whatever -- but only for ;
names where the LAST name begins with A AND/OR the STATE is not ;
NY."
?
?" On the three submenus that allow filters to be set, the format ;
is -- > FIELD (field name) , CONDITION [ =, <>, >, < ], STRING ;
(the information you want to find or restrict - IN DOUBLE ;
QUOTES)."
?
?"To set multiple conditions, follow above with  .AND.  .NOT.  or ;
.OR.  (include .  on either side), and enter second format."
?
? 'An example would be   LAST = "A"  for all last names ;
beginning with A '
?
?' SEE TUTORIAL AND MANUAL FOR MORE ON CORRECT SYNTAX '
wait
return
PROC GETRIDOF
CLEA
DO WHIL .T.
?" Find record numbers with Change/Edit commands."
?" 1. Delete a record."
?" 2. Bring back  deleted records."
?" 3. Destroy deleted records from database. "
?
?
WAIT TO GETRIDOF
DO CASE GETRIDOF
CASE GETRIDOF = "1"
ACCE "Number of record to delete... " to mdel
delete record &mdel
CASE GETRIDOF = "2"
ACCE "Number of record to restore... " to mres
recall record &mres
CASE GETRIDOF = "3"
ACCE "Permanently remove deleted records from ;
database - press return... " to mdes
SET INDEX TO
PACK &mdes
INDEX ON LAST TO LAST
INDEX ON COMPANY TO COMPANY
INDEX ON KEY TO KEY
OTHERWISE
CLEA
RETURN
ENDCASE GETRIDOF
ENDDO
PROC HELP
?
?"    This program restricts error checking to new name"
?"    entry only.   Handling of errors from improper input"
?"    in other areas is best explained on submenu 2"
?
wait
CLEA
?" 1. To add names, prepare a 7 string/number for your key."
?"    This is to prevent duplication in entering names."
?"    Several alternatives would be:"
?"     ... First letter of first name, two of second name and"
?"         and a two digit number -- Joseph Jones might read"
?"         KEY jjo01  (use upper or lower case, but be"
?"         consistent)"
?"     ... First two of first name, and three of second"
?"     ... A number, but its hard to associate names that way"
?
?"     Database is also indexed by last name and company."
?
?" 2. Use #2 when you know the name, string, record #, or some "
?"    data about what you are looking for -- A NO FIND will "
?"    return you to the main menu -- a FIND will continue past"
?"    the parameters you requested with PgUP or PgDn"
?
?" 3. Use this option if you are not sure what you want to find."
?"    IN  BROWSE MODE,  F1 gives more help, ESC returns to menu."
wait
?
?" 4. You may select the fields you wish to list.  If you have "
?"    some knowledge of dBASE you may add extensions and conditions"
?"    to your field list -- like  TO PRINT  or  FOR LAST = ? "
?
?"   The remainder items are pretty self explanatory."
?
?"   BEFORE DELETING - use list or search to find the records to ;
"
?"   delete.  When in any edit mode  CTRL/U will delete (but not ;
"
ì
?"   destroy) that record.  Only PACK (from delete menu) will"
?"   eradicate records."
?
?"   The FILTER set restricts output to the conditions you set, "
?"   or until you turn the filter off with  !  . "
?
?"   The LABEL and MAILMERGE programs are preset.  You may "
?"   develop others through dBase command mode or  F2  menu."
wait
CLEA
PROC LABELS
DO WHIL .T.
CLEA
set escape off
?"                   LABEL PRINTING PROGRAM"
?"          You will be able to establish guidelines"
?
?"               ONE    Single row labels"
?"               TWO    Two across labels"
?"             THREE    Three across labels"
?"              FOUR    Four across labels"
?
?"                  ========================"
?"                    RETURN - 2X TO EXIT"
?"                  ========================"
?
?"                    MAIL CODE -- PRESS #"
?"                        A          1"
?"                        B          2"
?"                        C          3"
?"                       AB          4"
?"                       AC          5"
?"                       BC          6"
?"                  ENTIRE LIST      7"
?
SELECT 1
ACCE "Label type (ONE  etc.) please... " to mlabl
WAIT  " code... " TO LBL
DO CASE LBL
CASE LBL = "1"
LABEL FORM &MLABL TO PRINT SAMPLE FOR X="A"
CASE LBL = "2"
LABEL FORM &MLABL TO PRINT SAMPLE FOR X="B"
CASE LBL = "3"
LABEL FORM &MLABL TO PRINT SAMPLE FOR X="C"
CASE LBL = "4"
LABEL FORM &MLABL TO PRINT SAMPLE FOR X="A" .OR. X="B"
CASE LBL = "5"
LABEL FORM &MLABL TO PRINT SAMPLE FOR X="A" .OR. X="C"
CASE LBL = "6"
LABEL FORM &MLABL TO PRINT SAMPLE FOR X="C" .OR. X = "B"
CASE LBL = "7"
LABEL FORM &MLABL TO PRINT SAMPLE
OTHERWISE
CLEA
RETURN
CLOSE DATABASE
ENDCASE
ENDDO
PROC LISTFOR
SELECT 1
SET INDEX TO LAST
DO WHILE .T.
CLEA
?' LISTS ARE PRESENTED ALPHABETICALLY BY LAST NAME'
?' Press ^PrtSc to toggle printer'
?
?" FIELDS - First, Last, Title, Phone, Company, Address, State,"
?
?"            Zip, Country, Postal, Crossref, Comments"
?
?" Number fields - DUE, Paid, Balance"
?
?" Use Ctrl/NumLock to stop scroll"
?

ACCE "Type each field, followed by a comma, that you want ;
included in the list ........ " to mlist
  IF mlist < "!"
    CLEA
    RETURN
  ELSE
LIST &mlist
WAIT
CLEA
ENDIF
ENDD
PROC LOOKFOR
CLEA
SET FORMAT TO ADDRESS
DO WHILE .T.
?
?"--------------------------------------------------------------"
?"| In order to keep program from running too slow, extensive |"
?"| error checking has been omitted from this section.  If you|"
?"| enter wrong data, or no data, except off this menu, you   |"
?"| may get an error reading.  Continually pressing  N  to    |"
?"| Y/N will eventually return you to the program.            |"
?"-------------------------------------------------------------"
?
?
?"                        Search by"
?"                         1. KEY Index"
?"                         2. OTHER Index"
?"                         3. Other field(s)"
?"                         4. By record #"
?"                         5. Search from middle/end of a field."
?
?"                        Index (under normal conditions all"
?"                               indexes are auto updated)"
?"                         6. Reindex an indexed field"
?"                         7. Index on a new field(s)"
?
?"                         8. Update BALANCES (Amt due - Amt paid) "
?
?"                         Return to Menu"
?
WAIT TO LOOKFOR
  DO CASE LOOKFOR
         CASE LOOKFOR = "1"
         SET INDEX TO key
            ACCE "Key word or phrase ... Caps/lower case counts... " to mseek

            IF mseek <"!"
               loop
            ELSE
         FIND "&mseek"
            IF .NOT. EOF()
              EDIT
              CLEA
            LOOP
              ELSE
                ? CHR(7)
                ?" CAN'T FIND IT"
                CLEA
             LOOP
ENDIF
        CASE LOOKFOR = "2"
        ACCE "Index name (do not include  .NDX  extension)..." TO mindexi

            IF mindex = '       '
                CLEA
            ELSE
         SET INDEX TO &mindex
            ACCE "What to look for ... " to mseek
            IF mseek = '    '
                CLEA
                 LOOP
            ELSE
         FIND "&mseek"
            IF .NOT. EOF()
         EDIT
         CLEA
        LOOP
            ELSE
                CLEA
     CASE LOOKFOR = "3"
             DISP STRU
            STORE '        ' to mfield
            ACCE "Field to search... " to mfield
            IF mfield = '    '
                CLEA
            else
         ACCE "Look for... "to mlook
         LOCATE ALL FOR &mlook $ &mfield
         EDIT
         CLEA
            LOOP
     CASE LOOKFOR = "4"
         ACCE "Record # to edit... " to medit
         EDIT &medit
         CLEA
         LOOP
     CASE LOOKFOR = "5"
          DISP STRU
          *STRING SEARCH
 ACCE "Type field name... " to mfield
 ACCE "Type string to locate... " to mstring
LIST COMPANY, &mfield FOR ("&mstring"$&mfield)
?
?"No record listings means there are no matches."
?"To edit a particular record, note its # and select #4 from menu. "
wait
* PROGRAM RETURNS TO LOOKFOR MENU

         CLEA
         LOOP
    CASE LOOKFOR = "6"
         ?" INDEXED FIELDS ARE:"
          DIR *.NDX
  ACCE " WHICH ONE TO  REINDEX  (do not include  .NDX )..." to mrein
   set index to &mrein
   reindex
   set index to
   CLEA
    LOOP
    CASE LOOKFOR = "7"
         ?" INDEXED FIELDS ARE: "
          DIR *.NDX
     ACCE "NEW FIELD(S) TO INDEX... " TO MNEWIN
     INDEX ON &MNEWIN TO &MNEWIN
     LOOP
        CASE LOOKFOR = "8"
     ?" REPLACING ALL  $BALANCE WITH   $AMOUNT DUE - $AMOUNT PAID"
    SET TALK ON
    REPLACE ALL BALANCE WITH DUE - PAID FOR DUE > .01 .OR. PAID > .01
     LOOP
OTHERWISE
     CLEA
     RETURN
    ENDIF
        ENDIF
            ENDIF
                ENDIF
                    ENDIF
                        ENDIF
ENDCASE
ENDDO
PROC MAILFIX
CLEA
 DO WHILE .T.
SET TALK ON
USE address
?" The 3 default indexes - KEY, LAST & COMPANY, will be updated."
INDEX ON KEY TO KEY
INDEX ON LAST TO LAST
INDEX ON COMPANY TO COMPANY
?" Note the total number of RECORDS in database... if auto count ;
= that #, file is okay, if it is lower, you have duplicates."
display stru
wait
set index to key
count
wait
CLEA
return
PROC MAILMERG
CLEA
?
?
COPY TO MAILLIST.DAT FIELDS MR_S, FIRST, I, LAST, TITLE, COMPANY, ADDRESS, CITY, ;
STATE, ZIP, COUNTRY, POSTAL  DELIMITED WITH "

WAIT
CLEA
return
PROC SETFIL
CLEA
SET MENU ON
DO WHILE .T.
TEXT
Field list -- KEY, FIRST, LAST, COMPANY, STATE, DUE, PAID, BALANCE
------------------------------------------------------------------
If you wish to instruct the database to behave as if only certain
types of accounts exist (i.e. NY state only,  Balance due only)
set a filter for that condition.  The syntax is ->

FIELD1 = "INFORMATION" .AND. FIELD2 > BALANCE

In English this means  THE FIELD NAME (First, Last Company etc.)
is TO EQUAL, NOT EQUAL, BE GREATER THAN, LESS THAN OR COMBO
       =       <>           >               <         >=
THE "DATA NON NUMERIC INFORMATION " or NUMBER (no quotes with #)

If more than one condition is to be set use .NOT. or .AND. or
.OR.  and start the FIELD = "STRING" all over again.

example -> STATE="NY"    example -> DUE > 0
combination example -> STATE="NY" .AND. DUE > 0
Use database only for names where state equals NY and amount due
is greater than 0
ENDTEXT
ACCE "Filter data or just return for none... " to mfil
SET FILTER TO &mfil
PROC XXADDNAM
CLOS DATABASES
SELE 1
USE ADDRESS INDEX KEY,COMPANY,LAST
CLEA
DO WHIL .T.
CLEAR
@ 5,10 SAY "RETURN on empty KEY exits"
@ 6,0 SAY "KEY should be up to 7 letters/numbers to serve as quick find"
@ 7,0 say "code for various accounts.  If key is not in use data will be"
@ 8,0 say "entered.  If it is -- you will be shown where and how."
ACCEPT 'Key code for new name ... ' TO m_key
IF m_key <"!"
USE
CLEA
RETURN
ENDIF
SET TALK OFF
SEEK "&m_key"
IF .NOT. EOF()
?" KEY IN USE: "
SET HEADING OFF
DISP KEY,FIRST,LAST,COMPANY WHILE KEY = '&m_key'
SET HEADING ON
WAIT
CLEA
LOOP
ENDI
CLEA

m_address  = Address
m_city     = City
m_comments = Comments
m_company  = Company
m_country  = Country
m_crossref = Crossref
m_date     = Date
m_first    = First
m_i        = I
m_last     = Last
m_mr_s     = Mr_s
m_nickname = Nickname
m_phone    = Phone
m_postal   = Postal
m_state    = State
m_title    = Title
m_x        = X
m_zip      = Zip
m_balance  = Balance
m_dues     = Due
m_paid     = Paid

@ 2,0 SAY "KEY"
@ 2,4 get m_key
@ 2,11 SAY "DATE" GET m_date
@ 2,30 SAY "-------------------------------------"
@ 3,0 SAY "MR_S"
@ 3,6 GET m_mr_s PICTURE "!X."
@ 3,12 SAY "First"
@ 3,19 GET m_first PICTURE "!XXXXXXXXXXXXXXXXXXX"
@ 3,40 SAY "Initial"
@ 3,49 GET m_i PICTURE "!X"
@ 3,52 SAY "Last"
@ 3,58 GET m_last PICTURE "!XXXXXXXXXXXXXXX"
@ 5,0 SAY "Title"
@ 5,7 GET m_title PICTURE "!XXXXXXXXXXXXXXXXX"
@ 5,40 SAY "Nickname"
@ 5,50 GET m_nickname PICTURE "!XXXXXXXXXXX"
@ 5,62 SAY "MAILCODE A,B,C " GET m_x
@ 6,0 SAY "-------------------------------------------------------"
@ 6,55 SAY "-------------------------"
@ 7,0 SAY "Telephone"
@ 7,11 GET m_phone PICTURE "9-999-999-9999"
@ 8,0 SAY "-------------------------------------------------------"
@ 8,55 SAY "-------------------------"
@ 9,0 SAY "COMPANY"
@ 9,9 get m_company PICTURE "!XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
@ 10,0 SAY "ADDRESS"
@ 10,9 GET m_address
@ 11,3 SAY "CITY"
@ 11,9 GET m_city PICTURE "!XXXXXXXXXXXXXXXXXXXX"
@ 11,43 SAY "STATE"
@ 11,50 GET m_state PICTURE "!!"
@ 11,57 SAY "ZIP"
@ 11,61 GET m_zip PICTURE "99999"
@ 12,23 SAY "COUNTRY"
@ 12,30 GET m_country PICTURE "!XXXXXXXXXXXXXXXXXXXX"
@ 12,60 SAY "POSTAL"
@ 12,70 GET m_postal
@ 13,0 SAY "DUE $"
@ 13,6 GET m_dues PICTURE "99999.99"
@ 13,20 SAY "PAID $"
@ 13,26 GET m_paid PICTURE "99999.99"
@ 13,40 SAY "BALANCE DUE $"
@ 13,53 GET m_balance PICTURE "99999.99"
@ 14,0 SAY "See also"
@ 14,10 GET m_crossref
@ 16,0 SAY "Comments"
@ 16,10 GET m_comments
@ 19,0 SAY "======================================================="
@ 19,55 SAY "========================="
DO WHIL .T.
   @ 20,15 SAY "╔═══════════════════════════════════════════════════╗"
   @ 21,15 SAY "║   Press any key to edit, <S> to Save changes,     ║"
   @ 22,15 SAY "║   or ENTER to return to menu without saving...    ║"
   @ 23,15 SAY "╚═══════════════════════════════════════════════════╝"

SET CONS OFF
WAIT TO  CHOICE
SET CONS ON
 DO CASE
   CASE ""=CHOICE
    EXIT
   CASE UPPER(CHOICE)="S"
         APPEND BLANK
REPLACE Address    WITH m_address
REPLACE City       WITH m_city
REPLACE Comments   WITH m_comments
REPLACE Company    WITH m_company
REPLACE Country    WITH m_country
REPLACE Crossref   WITH m_crossref
REPLACE Date       WITH m_date
REPLACE First      WITH m_first
REPLACE I          WITH m_i
REPLACE Key        WITH m_key
REPLACE Last       WITH m_last
REPLACE Mr_s       WITH m_mr_s
REPLACE Nickname   WITH m_nickname
REPLACE Phone      WITH m_phone
REPLACE Postal     WITH m_postal
REPLACE State      WITH m_state
REPLACE Title      WITH m_title
REPLACE X          WITH m_x
REPLACE Zip        WITH m_zip
REPLACE Balance    WITH m_balance
REPLACE Due        WITH m_dues
REPLACE Paid       WITH m_paid

@ 24,1 SAY "NAME ADDED"
?CHR(7)
EXIT
    OTHERWISE
     @ 20,0 CLEAR
     @ 22,20 say "PgDn ends entries"
     READ SAVE
     LOOP
ENDCASE CHOICE
ENDD
CLEA
ENDDO