home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Share Gallery 1
/
share_gal_1.zip
/
share_gal_1
/
DB
/
DB012B.ZIP
/
VPI1MANL.ZIP
/
CHARITY.ZIP
/
DONMENU.PRG
< prev
next >
Wrap
Text File
|
1991-12-29
|
9KB
|
235 lines
***************************************************************************
** DONMENU.PRG
** (C) Copyright 1990, Sub Rosa Publishing Inc.
** A demonstration program provided to VP-Info users.
** This program may be copied freely. If it is used in commercial code,
** please credit the source, Sub Rosa Publishing Inc.
**
** DONMENU is the initial program in a suite of programs provided as an
** actual example of a complete application, as described in accompanying
** documentation. Note: Since this is a demonstration, some techniques are
** used primarily to enrich the variety of examples used, even if they
** would usually not all be used in a single application.
**
** DONMENU is compatible with all current versions of VP-Info.
**
** Sid Bursten and Bernie Melman
** May 9,1990
***************************************************************************
VARIABLES ans,finder,finish,kn,mfname,mname,num,ok,recnum,start,titleline,xcolumn,xfld,xline2,xline
DIM char 32 label[3,3] ;create matrix for 3-across labels
DIM char 34 labelout[3,3] ;create actual output matrix for 3-across labels
ON escape ;this code is executed when <Esc> is pressed
WINDOW
CLEAR gets
CANCEL
ENDON
WINDOW ;cancel any esisting window before erasing screen
ERASE
SET library to donate ;library contains texts for input screens
WINDOW 1,2,23,77 double ;draw border and force all display inside
SET date to 'yymmdd' ;default will have years first; allows date sort
SET talk off ;suppress messages like NO FIND
SET text on ;include display fields in GET TABLE for READ
SET trim off ;do not trim & macros in TEXT display
SET execution off ;don't force re-execution of ON FIELD on exit
SELECT 1
ERASE
@ 1,3 SAY date(full)
@ 3,3 SAY cen(:company,74) ;display company or organization name on menu
@ 5,3 say cen('Main Menu',74)
WINDOW 8,25,22,77 blank ;create invisible window to position text in
TEXT
0. Enter Conversational Mode
1. Enter/Edit Donations
2. Enter/Edit Donors
3. Enter/Edit Solicitors
4. Post Donations
5. Report Donations
6. Report Solicitors
7. Print Labels
8. Reindex All Files
9. Exit to the Operating System
ENDTEXT
WINDOW ;window no longer needed
SET width to 80 ;restore line width for later text displays
CURSOR 10,23 ;position cursor where MENU( function should start
CLEAR keyboard ;empty type-ahead buffer
ANS=menu(9,38) ;9 options, with selection bar 38 characters wide
IF ans=0 ;do Conversational Info
ERASE
CANCEL
ELSE
@ 9+ans,23 say chr(16) ;display a triable beside choice
DO CASE
CASE ans=1
CHAIN entry ;chain to program too large to be a procedure
CASE ans=2
DO DONEDIT ;call a subroutine
CASE ans=3
DO SOLEDIT ;call another subroutine
CASE ans=4
PERFORM post ;procedure adds donations to donors & solicitors
CASE ans=5
PERFORM donrept
CASE ans=6
PERFORM solrept
CASE ans=7
PERFORM label ;does labels for both donor and solicitor files
CASE ans=8
PERFORM index ;creates indexes for all files
CASE ans=9
QUIT ;returns to DOS
ENDCASE
ENDIF
CHAIN DONMENU ;after procedure or subroutine, do DONMENU again
*
PROCEDURE dates ;set dates to be included in report
start=date(ymd) ;initialize dates with today's date in yymmdd form
finish=date(ymd)
WINDOW 10,10,18,69 double
TEXT
.. start,99/99/99
.. finish,99/99/99
Specify dates to be included. You may include all
records from beginning or to end of file by leaving
either or both dates blank (Ctrl-Y blanks the field).
Include all donations starting from... @start
Include all donations until........... @finish
ENDTEXT
WINDOW ;cancel window...no longer needed
READ
IF finish=' '
finish='999999' ;force blank finish to largest possible date
ENDIF
ENDPROC dates
*
PROCEDURE post
PERFORM dates ;set date limits for posting
WINDOW 1,2,23,77 double
SET talk on
SET add on ;if any donors or solicitors not in file, add them
SELECT 1
USE solicit
REPLACE all paid with 0,pledge with 0 ;initialize fields to post to
SET index to sol_code,sol_name ;both indexes needed if records added
POST on solicitor from donor fields pledge
SELECT 2
USE donor
REPLACE all paid with 0 ;initialize a field in donors
SET index to don_code,don_name ;both indexes needed if records added
SELECT 1
* use FOR clause only when required, and as simple as possible
DO CASE
CASE finish<'999999' .and. start>' '
POST on solicitor from donate fields paid with amount for date>=start .and. date<=finish
POST#2 on donor from donate fields paid with amount for date>=start .and. date<=finish
CASE finish<'999999'
POST on solicitor from donate fields paid with amount for date<=finish
POST#2 on donor from donate fields paid with amount for date<=finish
CASE start>' '
POST on solicitor from donate fields paid with amount for date>=start
POST#2 on donor from donate fields paid with amount for date>=start
OTHERWISE
POST on solicitor from donate fields paid with amount
POST#2 on donor from donate fields paid with amount
ENDCASE
SET deleted on
SET add off
SET talk off
? ' Posting completed...press any key to print reports.'
?
ok=inkey() ;wait for a keystroke
REPORT#2 donor
REPORT solicit
CLOSE all ;close files and turn special settings off
ENDPROC post
*
PROCEDURE donrept
PERFORM dates
USE donate index donatdon ;open all 3 data files and indexes required
USE#2 donor index don_code
USE#3 solicit index sol_code
SET relation on donor to 2 ;keep donor and solicitor files aligned
SET relation on solicitor to 3
* use FOR clause only when required, and as simple as possible
DO CASE
CASE finish<'999999' .and. start>' '
titleline='for period from '+pic(start,'xx/xx/xx')+' to '+pic(finish,'xx/xx/xx')
REPORT donate for date>=start .and. date<=finish
CASE finish<'999999'
titleline='for period until '+pic(finish,'xx/xx/xx')
REPORT donate for date<=finish
CASE start>' '
titleline='for period from '+pic(start,'xx/xx/xx')
REPORT donate for date>=start
OTHERWISE
titleline='for entire file'
REPORT donate
ENDCASE
CLOSE all
ENDPROC donrept
*
PROCEDURE solrept
REPORT solrept
CLOSE all
ENDPROC solrept
*
PROCEDURE label
WINDOW 1,2,23,77 double
* Here's a different way to get data input with verification...normally
* programmers would probably use @ GET with an ON FIELD and READ
@ 22,10 say cen('Print labels for (D)onors or (S)olicitors?',60)
ok=' '
DO WHILE t
CURSOR 23,39
ok=!(chr(inkey()))
?? ok
IF @(ok,'DS')>0
BREAK
ENDIF
ENDDO
IF ok='D' ;select which data file to use depending on input
USE donor ;DONLABEL subroutine must be called twice, because
DO DONLABEL ; data file differs for each call
ELSE
USE solicit
DO DONLABEL
ENDIF
CLOSE all
ENDPROC label
*
PROCEDURE index
WINDOW 1,2,23,77 double
SET talk on ;shows progress of indexing...? lines show steps to do
? "USE donate"
USE donate
? "INDEX on donor+date to donatdon"
INDEX on donor+date to donatdon
? "INDEX on solicitor+date to donatsol"
INDEX on solicitor+date to donatsol
? "INDEX on date+donor to donatdat"
INDEX on date+donor to donatdat
? "USE donor"
USE donor
? "INDEX on !(name)+left(fname,1) to don_name"
INDEX on !(name)+left(fname,1) to don_name
? "INDEX on donor to don_code"
INDEX on donor to don_code
? "USE solicit"
USE solicit
? "INDEX on !(name)+left(fname,1) to sol_name"
INDEX on !(name)+left(fname,1) to sol_name
? "INDEX on solicitor to sol_code"
INDEX on solicitor to sol_code
SET talk off
? ' Indexing completed...press any key.'
?
ok=inkey() ;wait for a keystroke
ENDPROC label
*
* *** end of program DONMENU.prg ***