home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload / ShartewareOverload.cdr / database / srinf14b.zip / CHARITY.ZIP / ENTRY.PRG < prev    next >
Text File  |  1990-05-11  |  4KB  |  116 lines
  1. ***************************************************************************
  2. **  ENTRY.PRG
  3. **  (C) Copyright 1990, Sub Rosa Publishing Inc.
  4. **  A demonstration program provided to SR-Info and 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. **  ENTRY is a free-standing program chained to from DONMENU.PRG, used to
  9. **  enter and edit donations.
  10. **
  11. **  ENTRY is compatible with all current versions of SR-Info and
  12. **  VP-Info, but VP-Info actually has an easier way of accomplishing the
  13. **  same task.  EDIT OFF can be used instead of READ, thus eliminating the
  14. **  need to program function keys by yourself.  In addition, the code
  15. **  that creates new code numbers could be moved into an ON FIELD structure.
  16. **
  17. **  Sid Bursten and Bernie Melman
  18. **  May 9,1990
  19. ***************************************************************************
  20. ON escape                    ;what to do when <Esc> is pressed
  21.    WINDOW
  22.    CANCEL
  23. ENDON
  24. SET text on                ;include display fields in GET TABLE for READ
  25. SET trim off               ;do not trim & macros in TEXT display
  26. SET execution off          ;don't force re-execution of ON FIELD on exit
  27. SET deleted on             ;don't show deleted records
  28. SET talk off               ;suppress messages like NO FIND
  29. USE donate index donatdon,donatsol,donatdat
  30. USE#2 donor index don_code
  31. USE#3 solicit index sol_code
  32. IF recno(1)=0
  33.    APPEND blank
  34. ENDIF
  35. goto dbf(recs)               ;goto last record added to file
  36. PERFORM inputscrn
  37. DO WHILE t
  38.    :field=field(donor)            ;start with first name
  39.    IF donor<>donor#2
  40.       FIND#2 &donor#1  ;align file when donor code filled in
  41.       REPLACE solicitor with solicitor#2
  42.    ENDIF
  43.    IF solicitor<>solicitor#3      ;align solicitor file
  44.       FIND#3 solicitor#1
  45.    ENDIF
  46.    @ 0,0 say pic(#,'999,999')
  47.    @ 0,77 say iff(deleted(1),'DEL','   ')
  48.    READ
  49.    kn=:key                        ;save key used to get out of READ
  50.    DO CASE kn
  51.    CASE kn=17                     ; ^Q=no update
  52.       NOUPDATE                    ;cancel any changes already made
  53.    CASE kn=329                    ; <PgUp>=Beginning of file
  54.       SKIP -1
  55.       IF #=0                      ;don't back up past beginning of file
  56.          GOTO top
  57.          RING                     ;notify user end of file reached
  58.       ENDIF
  59.    CASE kn=337                    ; <PgDn>=End of file
  60.       SKIP
  61.       IF eof
  62.          GOTO bottom
  63.          RING                     ;notify user end of file reached
  64.       ENDIF
  65.    CASE kn=375                    ; ^<Home>=Beginning of file
  66.       GO top
  67.    CASE kn=373                    ; ^<End>=End of file
  68.       GOTO bottom
  69.    CASE kn=374                    ; ^<PgDn>=Add a record
  70.       GOTO top
  71.       IF donor>' '
  72.          APPEND blank             ;append only if not already an empty record
  73.          REPLACE date with date(ymd)
  74.       ENDIF
  75.    CASE kn=335                    ; <End>=Quit
  76.       BREAK
  77.    ENDCASE kn
  78. ENDDO
  79. CHAIN DONMENU
  80. *
  81. PROCEDURE inputscrn
  82.    WINDOW               ;cancel any existing window before erasing screen
  83.    ERASE
  84.    SET width to 80
  85.    TEXT .3              ;get screen text from library, volume number 3
  86.    ON field
  87.    FIELD donor
  88.       IF @(' ',donor)>0
  89.          :field=field(donor)
  90.       ELSE
  91.          IF donor<>donor#2
  92.             FIND#2 &donor#1  ;align file when donor code filled in
  93.             IF recno(2)>0
  94.                IF solicitor<>solicitor#3
  95.                   FIND#3 &solicitor#1  ;align file when solicitor code filled in
  96.                ENDIF
  97.                REPLACE solicitor with solicitor#3
  98.                @ 23,0
  99.             ELSE
  100.                @ 23,0 say cen('Invalid Donor number...please re-enter.',80)
  101.             ENDIF
  102.          ENDIF
  103.       ENDIF
  104.    FIELD date
  105.       IF date=' ' .or. date<>date(ymd,date)
  106.          :field=field(date)
  107.          @ 23,0 say cen('Date must be filled in with legal date in form YY/MM/DD',80)
  108.          RING
  109.       ELSE
  110.          @ 23,0
  111.       ENDIF
  112.    ENDON
  113. ENDPROC inputscrn
  114. *
  115. *                     *** end of program ENTRY.prg ***
  116.