home *** CD-ROM | disk | FTP | other *** search
/ Share Gallery 1 / share_gal_1.zip / share_gal_1 / DB / DB012B.ZIP / VPI1MANL.ZIP / CHARITY.ZIP / DONEDIT.PRG < prev    next >
Text File  |  1991-12-29  |  5KB  |  139 lines
  1. ***************************************************************************
  2. **  DONEDIT.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. **  DONEDIT is a subroutine on MENU.PRG, used to edit and add donor
  9. **  records to DONOR.DBF.
  10. **
  11. **  DONEDIT is compatible with all current versions of VP-Info.
  12. **
  13. **  Sid Bursten and Bernie Melman
  14. **  May 9,1990
  15. ***************************************************************************
  16. ON escape                    ;what to do when <Esc> is pressed
  17.    WINDOW
  18.    CLEAR gets
  19.    CANCEL
  20. ENDON
  21. SET deleted off
  22. USE donor index don_name,don_code
  23. USE#2 solicit index sol_code
  24. IF recno(1)=0
  25.    APPEND blank
  26. ENDIF
  27. goto dbf(recs)               ;goto last record added to file
  28. PERFORM inputscrn
  29. DO WHILE t
  30.    IF donor=' '              ;this means it's a new record
  31.       mfname=fname           ;initialize memory variables with 1st name
  32.       mname=name             ;  also last name
  33.       recnum=#               ;save record number to allow return to same record
  34.       WINDOW 10,10,17,69 double
  35.       CLEAR gets
  36.       TEXT
  37. .. donor,!!!-!-99
  38.  
  39.                      Record to add
  40.  
  41.   First Name... @mfname
  42.    Last Name... @mname
  43.       ENDTEXT
  44.       WINDOW
  45.       READ
  46. *  build a donor code--3 characters from last name, plus first initial, plus
  47. *  a 2-digit serial number to force every donor to have a unique code
  48.       finder=!(left(mname,3)+left(mfname,1))  ;build alpha part of code
  49.       finder=replace(finder,' ','*')   ;fill in blanks in code with asterisks
  50. *     LAST &finder     ;only in Professional...for Level 1 use commented lines below
  51. *****************************Level 1 version*******************************
  52.       FIND &finder     ;these 6 lines are equivalent to above single line,
  53.       IF #>0           ;  although LAST is substantially faster. Essentially,
  54.          LIMIT 4       ;  all we have to do is find if a record exists with the
  55.          GOTO bottom   ;  same 1st 4 letters of the code, and find out what the
  56.          LIMIT         ;  last serial number is so we can increment it
  57.       ENDIF
  58.       IF #=0
  59.          finder=finder+'01'
  60.       ELSE
  61.          num=val(right(donor,2))  ;get number of last matching record
  62.          IF num<99                ;only allow numbers up to 99
  63.             finder=finder+right(str(101+num,3),2) ;increment with leading zero
  64.          ELSE
  65.             finder='******'  ;overflow if already 99 records with same letters
  66.          ENDIF
  67.       ENDIF
  68.       GOTO recnum      ;go back to original record and fill in name and code
  69.       REPLACE fname with mfname,name with mname,donor with finder
  70.       PERFORM inputscrn           ;rebuild original input screen
  71.       :field=field(address)       ;start with address
  72.    ELSE
  73.       :field=field(fname)         ;start with fisrt name
  74.    ENDIF
  75.    IF solicitor<>solicitor#2      ;align solicitor file
  76.       FIND#2 &solicitor#1
  77.    ENDIF
  78.    @ 0,0 say pic(#,'999,999')
  79.    @ 0,77 say iff(deleted(1),'DEL','   ')
  80.    READ
  81.    kn=:key                        ;save key used to get out of READ
  82.    DO CASE kn
  83.    CASE kn=17                     ; ^Q=no update
  84.       NOUPDATE                    ;cancel any changes already made
  85.    CASE kn=329                    ; <PgUp>=Beginning of file
  86.       SKIP -1
  87.       IF #=0                      ;don't back up past beginning of file
  88.          GOTO top
  89.          RING                     ;notify user end of file reached
  90.       ENDIF
  91.    CASE kn=337                    ; <PgDn>=End of file
  92.       SKIP
  93.       IF eof
  94.          GOTO bottom
  95.          RING                     ;notify user end of file reached
  96.       ENDIF
  97.    CASE kn=375                    ; ^<Home>=Beginning of file
  98.       GO top
  99.    CASE kn=373                    ; ^<End>=End of file
  100.       GOTO bottom
  101.    CASE kn=374                    ; ^<PgDn>=Add a record
  102.       GOTO top
  103.       IF donor>' '
  104.          APPEND blank             ;append only if not already an empty record
  105.       ENDIF
  106.    CASE kn=335                    ; <End>=Quit
  107.       BREAK
  108.    ENDCASE kn
  109. ENDDO
  110. CLOSE all
  111. RETURN
  112. *
  113. PROCEDURE inputscrn
  114.    WINDOW               ;cancel any existing window before erasing screen
  115.    ERASE
  116.    TEXT .1              ;get screen text from library, volume number 1
  117.    ON field
  118.    FIELD solicitor
  119.       IF @(' ',solicitor)>0
  120.          :field=field(solicitor)
  121.          @ 23,0 say cen('Solicitor code must be specified.',80)
  122.       ELSE
  123.          @ 23,0
  124.          IF solicitor<>solicitor#2
  125.             FIND#2 &solicitor#1  ;align file when solicitor code filled in
  126.             IF recno(2)=0
  127.                :field=field(solicitor)
  128.                @ 23,0 say cen('No solicitor found with this code number.',80)
  129.             ELSE
  130.                :field=field(fname)
  131.                @ 23,0
  132.             ENDIF
  133.          ENDIF
  134.       ENDIF
  135.    ENDON
  136. ENDPROC inputscrn
  137. *
  138. *                     *** end of program donedit.prg ***
  139.