home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / CLIPPER / MISC / VPI1MANL.ZIP / CHARITY.ZIP / DONMENU.PRG < prev    next >
Encoding:
Text File  |  1991-12-29  |  8.4 KB  |  235 lines
  1. ***************************************************************************
  2. **  DONMENU.PRG
  3. **  (C) Copyright 1990, Sub Rosa Publishing Inc.
  4. **  A demonstration program provided to VP-Info users.
  5. **  This program may be copied freely. If it is used in commercial code,
  6. **  please credit the source, Sub Rosa Publishing Inc.
  7. **
  8. **  DONMENU is the initial program in a suite of programs provided as an
  9. **  actual example of a complete application, as described in accompanying
  10. **  documentation. Note: Since this is a demonstration, some techniques are
  11. **  used primarily to enrich the variety of examples used, even if they
  12. **  would usually not all be used in a single application.
  13. **
  14. **  DONMENU is compatible with all current versions of VP-Info.
  15. **
  16. **  Sid Bursten and Bernie Melman
  17. **  May 9,1990
  18. ***************************************************************************
  19. VARIABLES ans,finder,finish,kn,mfname,mname,num,ok,recnum,start,titleline,xcolumn,xfld,xline2,xline
  20. DIM char 32 label[3,3]     ;create matrix for 3-across labels
  21. DIM char 34 labelout[3,3]  ;create actual output matrix for 3-across labels
  22. ON escape                  ;this code is executed when <Esc> is pressed
  23.    WINDOW
  24.    CLEAR gets
  25.    CANCEL
  26. ENDON
  27. WINDOW                     ;cancel any esisting window before erasing screen
  28. ERASE
  29. SET library to donate      ;library contains texts for input screens
  30. WINDOW 1,2,23,77 double    ;draw border and force all display inside
  31. SET date to 'yymmdd'       ;default will have years first; allows date sort
  32. SET talk off               ;suppress messages like NO FIND
  33. SET text on                ;include display fields in GET TABLE for READ
  34. SET trim off               ;do not trim & macros in TEXT display
  35. SET execution off          ;don't force re-execution of ON FIELD on exit
  36. SELECT 1
  37. ERASE
  38. @ 1,3 SAY date(full)
  39. @ 3,3 SAY cen(:company,74) ;display company or organization name on menu
  40. @ 5,3 say cen('Main Menu',74)
  41. WINDOW 8,25,22,77 blank    ;create invisible window to position text in
  42. TEXT
  43.  0. Enter Conversational Mode
  44.  
  45.  1. Enter/Edit Donations
  46.  2. Enter/Edit Donors
  47.  3. Enter/Edit Solicitors
  48.  4. Post Donations
  49.  5. Report Donations
  50.  6. Report Solicitors
  51.  7. Print Labels
  52.  8. Reindex All Files
  53.  9. Exit to the Operating System
  54. ENDTEXT
  55. WINDOW                     ;window no longer needed
  56. SET width to 80            ;restore line width for later text displays
  57. CURSOR 10,23               ;position cursor where MENU( function should start
  58. CLEAR keyboard             ;empty type-ahead buffer
  59. ANS=menu(9,38)             ;9 options, with selection bar 38 characters wide
  60. IF ans=0                   ;do Conversational Info
  61.    ERASE
  62.    CANCEL
  63. ELSE
  64.    @ 9+ans,23 say chr(16)  ;display a triable beside choice
  65.    DO CASE
  66.    CASE ans=1
  67.       CHAIN entry          ;chain to program too large to be a procedure
  68.    CASE ans=2
  69.       DO DONEDIT           ;call a subroutine
  70.    CASE ans=3
  71.       DO SOLEDIT           ;call another subroutine
  72.    CASE ans=4
  73.       PERFORM post         ;procedure adds donations to donors & solicitors
  74.    CASE ans=5
  75.       PERFORM donrept
  76.    CASE ans=6
  77.       PERFORM solrept
  78.    CASE ans=7
  79.       PERFORM label        ;does labels for both donor and solicitor files
  80.    CASE ans=8
  81.       PERFORM index        ;creates indexes for all files
  82.    CASE ans=9
  83.       QUIT                 ;returns to DOS
  84.    ENDCASE
  85. ENDIF
  86. CHAIN DONMENU              ;after procedure or subroutine, do DONMENU again
  87. *
  88. PROCEDURE dates            ;set dates to be included in report
  89.    start=date(ymd)         ;initialize dates with today's date in yymmdd form
  90.    finish=date(ymd)
  91.    WINDOW 10,10,18,69 double
  92.    TEXT
  93. .. start,99/99/99
  94. .. finish,99/99/99
  95.  
  96.    Specify dates to be included.  You may include all
  97.    records from beginning or to end of file by leaving
  98.    either or both dates blank (Ctrl-Y blanks the field).
  99.  
  100.      Include all donations starting from... @start
  101.      Include all donations until........... @finish
  102.    ENDTEXT
  103.    WINDOW                  ;cancel window...no longer needed
  104.    READ
  105.    IF finish=' '
  106.       finish='999999'      ;force blank finish to largest possible date
  107.    ENDIF
  108. ENDPROC dates
  109. *
  110. PROCEDURE post
  111.    PERFORM dates           ;set date limits for posting
  112.    WINDOW 1,2,23,77 double
  113.    SET talk on
  114.    SET add on              ;if any donors or solicitors not in file, add them
  115.    SELECT 1
  116.    USE solicit
  117.    REPLACE all paid with 0,pledge with 0 ;initialize fields to post to
  118.    SET index to sol_code,sol_name        ;both indexes needed if records added
  119.    POST on solicitor from donor fields pledge
  120.    SELECT 2
  121.    USE donor
  122.    REPLACE all paid with 0               ;initialize a field in donors
  123.    SET index to don_code,don_name        ;both indexes needed if records added
  124.    SELECT 1
  125. *  use FOR clause only when required, and as simple as possible
  126.    DO CASE
  127.    CASE finish<'999999' .and. start>' '
  128.       POST on solicitor from donate fields paid with amount for date>=start .and. date<=finish
  129.       POST#2 on donor from donate fields paid with amount for date>=start .and. date<=finish
  130.    CASE finish<'999999'
  131.       POST on solicitor from donate fields paid with amount for date<=finish
  132.       POST#2 on donor from donate fields paid with amount for date<=finish
  133.    CASE start>' '
  134.       POST on solicitor from donate fields paid with amount for date>=start
  135.       POST#2 on donor from donate fields paid with amount for date>=start
  136.    OTHERWISE
  137.       POST on solicitor from donate fields paid with amount
  138.       POST#2 on donor from donate fields paid with amount
  139.    ENDCASE
  140.    SET deleted on
  141.    SET add off
  142.    SET talk off
  143.    ? '           Posting completed...press any key to print reports.'
  144.    ?
  145.    ok=inkey()              ;wait for a keystroke
  146.    REPORT#2 donor
  147.    REPORT solicit
  148.    CLOSE all               ;close files and turn special settings off
  149. ENDPROC post
  150. *
  151. PROCEDURE donrept
  152.    PERFORM dates
  153.    USE donate index donatdon      ;open all 3 data files and indexes required
  154.    USE#2 donor index don_code
  155.    USE#3 solicit index sol_code
  156.    SET relation on donor to 2     ;keep donor and solicitor files aligned
  157.    SET relation on solicitor to 3
  158. *  use FOR clause only when required, and as simple as possible
  159.    DO CASE
  160.    CASE finish<'999999' .and. start>' '
  161.       titleline='for period from '+pic(start,'xx/xx/xx')+' to '+pic(finish,'xx/xx/xx')
  162.       REPORT donate for date>=start .and. date<=finish
  163.    CASE finish<'999999'
  164.       titleline='for period until '+pic(finish,'xx/xx/xx')
  165.       REPORT donate for date<=finish
  166.    CASE start>' '
  167.       titleline='for period from '+pic(start,'xx/xx/xx')
  168.       REPORT donate for date>=start
  169.    OTHERWISE
  170.       titleline='for entire file'
  171.       REPORT donate
  172.    ENDCASE
  173.    CLOSE all
  174. ENDPROC donrept
  175. *
  176. PROCEDURE solrept
  177.    REPORT solrept
  178.    CLOSE all
  179. ENDPROC solrept
  180. *
  181. PROCEDURE label
  182.    WINDOW 1,2,23,77 double
  183. *  Here's a different way to get data input with verification...normally
  184. *  programmers would probably use @ GET with an ON FIELD and READ
  185.    @ 22,10 say cen('Print labels for (D)onors or (S)olicitors?',60)
  186.    ok=' '
  187.    DO WHILE t
  188.       CURSOR 23,39
  189.       ok=!(chr(inkey()))
  190.       ?? ok
  191.       IF @(ok,'DS')>0
  192.          BREAK
  193.       ENDIF
  194.    ENDDO
  195.    IF ok='D'               ;select which data file to use depending on input
  196.       USE donor            ;DONLABEL subroutine must be called twice, because
  197.       DO DONLABEL          ;  data file differs for each call
  198.    ELSE
  199.       USE solicit
  200.       DO DONLABEL
  201.    ENDIF
  202.    CLOSE all
  203. ENDPROC label
  204. *
  205. PROCEDURE index
  206.    WINDOW 1,2,23,77 double
  207.    SET talk on      ;shows progress of indexing...? lines show steps to do
  208.    ? "USE donate"
  209.    USE donate
  210.    ? "INDEX on donor+date to donatdon"
  211.    INDEX on donor+date to donatdon
  212.    ? "INDEX on solicitor+date to donatsol"
  213.    INDEX on solicitor+date to donatsol
  214.    ? "INDEX on date+donor to donatdat"
  215.    INDEX on date+donor to donatdat
  216.    ? "USE donor"
  217.    USE donor
  218.    ? "INDEX on !(name)+left(fname,1) to don_name"
  219.    INDEX on !(name)+left(fname,1) to don_name
  220.    ? "INDEX on donor to don_code"
  221.    INDEX on donor to don_code
  222.    ? "USE solicit"
  223.    USE solicit
  224.    ? "INDEX on !(name)+left(fname,1) to sol_name"
  225.    INDEX on !(name)+left(fname,1) to sol_name
  226.    ? "INDEX on solicitor to sol_code"
  227.    INDEX on solicitor to sol_code
  228.    SET talk off
  229.    ? '                  Indexing completed...press any key.'
  230.    ?
  231.    ok=inkey()              ;wait for a keystroke
  232. ENDPROC label
  233. *
  234. *                     *** end of program DONMENU.prg ***
  235.