home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / cpmug / cpmug044.ark / BUDGET1.BAS < prev    next >
Encoding:
BASIC Source File  |  1984-04-29  |  11.2 KB  |  297 lines
  1. REM                      BUDGET1.BAS
  2. REM   Copyright 1980 W. Patrick Cunningham, 235 Sharon Drive,
  3. REM   San Antonio, TX  78216.  Commercial distribution of this
  4. REM   program is prohibited without permission of the author.
  5. REM
  6. REM   This program will perform various functions for household
  7. REM   bookkeeping, including recording expenses and prorating 
  8. REM   them among various categories.  It will create monthly
  9. REM   files of data and monthly ledgers, which may be balanced and
  10. REM   totalled by the companion programs, LEDGER1, BUDGETCH, & ANNTOT1.
  11. REM
  12. REM   This is a source program written in CBASIC2 on a 48K machine,
  13. REM   but will work with as little as 32K if a restricted number of
  14. REM   records are to be processed.
  15. REM
  16. REM   Declaration of various dimensions and initialization of constants.
  17.      DIM DATE%(20)   REM The program is structured for no more than 20
  18.                      REM records.
  19.      DIM PAYEE$(20)
  20.      DIM TAMOUNT(20)
  21.      DIM ANS$(20)
  22.      DIM AMOUNT(20,4)  REM This is the register for storing data
  23.      DIM CAT$(20,4)    REM This is the category of each datum.
  24.      DIM CATVAL$(17)   REM This is the identity of each category.
  25.      DIM VALID.MO$(12)
  26.      PRIFLAG%=0        REM When = 1, data will print before storage on disc.
  27. 05   DEF FN.CHECK$(VAL$)
  28.          FN.CHECK$=""
  29.          WHILE LEN(VAL$)>1
  30.               PRINT "Your category code must be only 1 character long."
  31. 5.5           PRINT "Re-enter your category code";
  32.               INPUT LINE RSS$
  33.               IF RSS$="" THEN GOTO 5.5
  34.               VAL$=RSS$
  35.               WEND 
  36.          FOR I%=1 TO 19
  37.               READ OKVALUE$
  38.               IF VAL$=OKVALUE$ THEN GOTO 06
  39.               NEXT I%
  40.          RESTORE
  41. 5.6      PRINT "Your category code is improper: enter one of these:"
  42.          FOR I%=1 TO 19
  43.               READ OKVALUE$
  44.               PRINT OKVALUE$;" ";
  45.               NEXT I%
  46.          RESTORE
  47.          INPUT "What code is proper"; LINE RSS$
  48.          IF RSS$="" THEN GOTO 5.5
  49.          FOR I%=1 TO 19
  50.               READ OKVALUE$
  51.               IF RSS$=OKVALUE$ THEN VAL$=RSS$ : GOTO 06
  52.               NEXT I%
  53.          GOTO 5.5 
  54. 06       RESTORE
  55.          FN.CHECK$=VAL$
  56.          DATA "C","G","F","H","I","J","M","N","P","B","R","S","U","E","X","W","T","D","Y"
  57.          RETURN
  58.      FEND
  59.      PRINT TAB(15);"B U D G E T    P R O G R A M."
  60.      FOR I%=1 TO 15  REM here we go!!
  61.           PRINT
  62.           NEXT I%
  63. 10   PRINT "This program will input expenses and store them on disc."
  64.      FOR I%=1 TO 4
  65.           PRINT
  66.           NEXT I%
  67. 10.01 PRINT "What month and year is this?"
  68.      INPUT "MONTH:"; LINE RESP$
  69.      INPUT "YEAR:";LINE YR$
  70.      IF LEN(YR$)<>4 THEN GOTO 10.01
  71.      OLDNEW$="OLD"
  72.      IF RESP$="" OR YR$="" THEN 10.01
  73.      IF UCASE$(RESP$)="SAME" THEN 10.02
  74.      MO$=UCASE$(LEFT$(RESP$,3))
  75.      VALID.MO$(1)="JAN"
  76.      VALID.MO$(2)="FEB"
  77.      VALID.MO$(3)="MAR"
  78.      VALID.MO$(4)="APR"
  79.      VALID.MO$(5)="MAY"
  80.      VALID.MO$(6)="JUN"
  81.      VALID.MO$(7)="JUL"
  82.      VALID.MO$(8)="AUG"
  83.      VALID.MO$(9)="SEP"
  84.      VALID.MO$(10)="OCT"
  85.      VALID.MO$(11)="NOV"
  86.      VALID.MO$(12)="DEC"
  87.      FOR K%=1 TO 12
  88.           IF MO$=VALID.MO$(K%) THEN GOTO 10.019
  89.           NEXT K%
  90.      RESTORE
  91.      PRINT "YOUR MONTH IS NOT RECOGNIZEABLE!":GOTO 10.01
  92. 10.019 FILN$="EXPENS"+RIGHT$(YR$,2)+"."+MO$
  93.      INPUT "Is this file NEW or OLD"; LINE OLDNEW$
  94.      IF OLDNEW$="NEW" THEN CREATE FILN$ RECL 64 AS 1 BUFF 1 RECS 128 :GOTO 11.5
  95. 10.02 IF OLDNEW$="OLD" THEN OPEN FILN$ RECL 64 AS 1 BUFF 1 RECS 128 : GOTO 11.5
  96.      PRINT "Your response is not recognizeable"
  97.      GOTO 10.01
  98. 11.5 POSN%=0
  99.       TRUE%=-1
  100.       DEF FN.GET.TO.END%(FILE.NAME$,REC.SIZE%,FILE.NUM%,POSITION%)
  101.            FN.GET.TO.END%=0
  102.            FILE.SIZE%=SIZE(FILE.NAME$)
  103.            IF FILE.SIZE%=0 THEN \ REM FALSE IF NO FILE
  104.                 RETURN \
  105.                 ELSE FN.GET.TO.END%=TRUE%
  106.            IF END # FILE.NUM% THEN 11.8
  107.            POSITION%=INT%(FLOAT(FILE.SIZE% * 128.0)/REC.SIZE%)
  108.            PRINT "positioning file at end"
  109.            READ # FILE.NUM%,POSITION%;
  110.            WHILE TRUE%
  111.                 READ # FILE.NUM%; LINE DUMMY$
  112.                 POSITION% = POSITION%+ 1
  113.                 WEND
  114. 11.8       PRINT FILE.SIZE%,POSITION%
  115.            RETURN
  116.       FEND 
  117.       CHECK%=FN.GET.TO.END%(FILN$,64,1,POSN%)
  118.       IF END # 1 THEN 4400
  119.       INPUT "Do you wish data displayed as it is stored (Y/N)"; RESP$
  120.       IF RESP$="Y" THEN PRIFLAG%=1
  121. 20    TOT=0.0
  122.       PRINT "How many payees are you entering [maximum of 20]";
  123.       INPUT N%   REM no more than 20 allowed
  124.       WHILE N%>20 
  125.           N%=0
  126.           PRINT "Sorry, your batch is too big; break it into smaller pieces."
  127.           GOTO 20
  128.           WEND
  129.      FOR J%=1 TO N%
  130. 22        PRINT "Date of payment # ";J%; 
  131.           INPUT DATE%(J%)
  132.                IF DATE%(J%)<=0 THEN 22
  133.                IF DATE%(J%)>31 THEN 22
  134. 23        INPUT "Name of PAYEE:"; LINE PAYEE$(J%)
  135.                IF LEN(PAYEE$(J%))<3 THEN 23
  136.                WHILE LEN(PAYEE$(J%))>18
  137.                     PRINT "Name is too long (18); abbreviate where possible."
  138.                     GOTO 23
  139.                     WEND
  140.           INPUT "Total amount of payment, omitting $:"; TAMOUNT(J%)
  141.           TOT = TOT+TAMOUNT(J%)
  142.           NEXT J%
  143. REM
  144. REM  Amounts are now in the file memory
  145. REM
  146.      PRINT "The total spent in this batch of payments is $";TOT
  147.      REM
  148.           FOR J%=1 TO N%
  149.                PRINT "<cr> if ";PAYEE$(J%); " payment is to one category; ";
  150.                PRINT "If not, type an N."
  151.                INPUT LINE RES$
  152.                ANS$(J%)=UCASE$(RES$)
  153.                WHILE ANS$(J%)=""
  154.                     ANS$(J%)="*"    REM flag to indicate no subcategories
  155.                     AMOUNT(J%,1)=TAMOUNT(J%)
  156.                     FOR K%=2 TO 4
  157.                          AMOUNT (J%,K%)=0
  158.                          CAT$(J%,K%)=""
  159.                          NEXT K%
  160.                     PRINT "MENU is displayed when you type \? as response."
  161. 35                  INPUT "Category of this payment"; LINE RESP$
  162.                     WHILE RESP$="\?"
  163.                          RESP$=""
  164.                          GOSUB 200
  165.                          WEND    
  166.                     IF RESP$ ="" THEN GOTO 35
  167.                     CAT$(J%,1)=FN.CHECK$(RESP$)
  168.                     RESP$=""
  169.                     WEND
  170.                WHILE ANS$(J%)="N"
  171.                     PRINT "Do you need a menu of budget categories (Y/N)";
  172.                     INPUT LINE RESP$
  173.                     IF RESP$="Y" THEN GOSUB 200
  174.                     ANS$(J%)="C"
  175. 40                  PRINT "How many different categories for ";PAYEE$(J%);     
  176.                     INPUT RSP%
  177.                     WHILE RSP%>4
  178.                          PRINT "Too many categories; maximum is 4,incl.tax"
  179.                          GOTO 40
  180.                          WEND
  181.                     SUBTOT=0.0
  182.                     FOR K%=1 TO RSP%
  183.                          PRINT "TYPE <category code>,<amount/no$ sign>"; K%; "FOR "; PAYEE$(J%);
  184. 50                       INPUT RESP$, AMOUNT (J%,K%)
  185.                          CAT$(J%,K%)= FN.CHECK$(RESP$)
  186.                          SUBTOT=SUBTOT+AMOUNT(J%,K%)
  187.                          NEXT K%
  188.                     IF SUBTOT<>TAMOUNT(J%) THEN GOSUB 300 
  189.                     WEND
  190.                PRINT "Information on payee "; PAYEE$(J%);" is entered."
  191.                NEXT J%
  192. REM
  193. REM   Data entry routine is complete.
  194. REM
  195. REM   Data is now transferred to the disc.
  196. REM   
  197.       WHILE PRIFLAG%=1
  198.            FOR J%=1 TO N%  
  199.                PRINT DATE%(J%);" ";PAYEE$(J%);" ";
  200.                    FOR K%=1 TO 4
  201.                         PRINT CAT$(J%,K%);" $";AMOUNT(J%,K%)
  202.                         NEXT K%
  203.                    PRINT " "
  204.                NEXT J%
  205.            PRIFLAG%=0
  206.            WEND
  207. 120   REM disc transfer routine
  208.       FOR J%=1 TO N%
  209.            PRINT #1;DATE%(J%),PAYEE$(J%),CAT$(J%,1),AMOUNT(J%,1),CAT$(J%,2),AMOUNT(J%,2),CAT$(J%,3),AMOUNT(J%,3),CAT$(J%,4),AMOUNT(J%,4)
  210.            PRINT PAYEE$(J%);" data on disc."
  211.            NEXT J%
  212. 122   CLOSE 1
  213. 125   PRINT "Do you have more data to process [D];or do you want to quit now";
  214.       PRINT " [Q] ";
  215.       INPUT LINE RSP$
  216.       IF RSP$="D" THEN GOTO 10
  217.       IF RSP$="Q" THEN GOTO 2000
  218.       PRINT "Your response is not recognizeable."
  219.       GOTO 125
  220. 200   REM subroutine to display menu
  221.       PRINT "******************************************"
  222.       PRINT "Here are the budget categories and codes:"
  223.       PRINT
  224.       PRINT "           : CATEGORY :                CODE          "
  225.       PRINT "          Charity                        C           "
  226.       PRINT "          Drugs and Pharmacy             D           "
  227.       PRINT "          Clothing/garments              G           "
  228.       PRINT "          Food                           F           "
  229.       PRINT "          Household goods/hardware       H           "
  230.       PRINT "          Inventoried Items (mortgage)   I           "
  231.       PRINT "          Insurance                      J           "
  232.       PRINT "          Medical (doctors,hospital)     Y           "
  233.       PRINT "          Miscellaneous taxable          M           "
  234.       PRINT "          Miscellaneous non-taxable      N           "
  235.       PRINT "          Telephone (personal)           P           "
  236.       PRINT "          Telephone (business)           B           "
  237.       PRINT "          Telephone (other)              R           "
  238.       PRINT "          Savings (e.g. credit union)    S           "
  239.       PRINT "          Utility (Power,H2O)            U           "
  240.       PRINT "          Gasoline, personal             E           "
  241.       PRINT "          Auto parts, personal car       X           "
  242.       PRINT "          Auto repair, personal car      W           "
  243.       PRINT "     **** SALES TAX ON THE TOTAL *****   T           "
  244.       PRINT "REMEMBER:separate category from amount with a comma; no $"
  245.       RETURN
  246. REM
  247. 300  REM HERE WE INSERT SUBROUTINE TO ENABLE OPERATOR TO CORRECT MISTAKES
  248. REM
  249. 305  PRINT "** Your entries do not add up to the total you have entered. ***"
  250.      PRINT
  251.      PRINT "   They add up to $";SUBTOT;" ;the entry for ";PAYEE$(J%);" was ";
  252.      PRINT "$";TAMOUNT(J%);"."
  253.      PRINT "<cr> if the original total was correct; otherwise type N."
  254.      INPUT LINE WHAT$
  255.      IF WHAT$=""THEN 307
  256.      WHILE WHAT$="N"
  257.           WHAT$=""
  258.           PRINT "The correct total for ";PAYEE$(J%);" is:";
  259.           INPUT TAMOUNT(J%)
  260.           PRINT "The correct total is verified as $"; TAMOUNT(J%)
  261.           IF SUBTOT<>TAMOUNT(J%) THEN 305
  262.           RETURN
  263.           WEND
  264. 307  PRINT "Re-enter the values for the several categories of ";PAYEE$(J%);"."
  265.      INPUT "How many different categories for this payment"; CATS%
  266.      SAMOUNT = 0.0
  267.      FOR K%=1 TO CATS%
  268.           PRINT "For category ";CAT$(J%,K%); " enter correct amount";
  269.           INPUT AMOUNT(J%,K%)
  270.           SAMOUNT=SAMOUNT +AMOUNT(J%,K%)
  271.           NEXT K%
  272.      SUBTOT = SAMOUNT
  273.      IF SAMOUNT<>TAMOUNT(J%) THEN 305
  274.      RETURN 
  275. 2000 PRINT "Your response indicates we are through for the day":GOTO 4500
  276. 4400 PRINT "END OF FILE CONDITION SENSED FOR DATA FILE"+FILN$
  277.      PRINT "SUMMON HELP!  COPY SCREEN ON PAPER AND RESTART..."
  278.      CLOSE 1
  279. 4500 END
  280. EOF
  281.  
  282.  
  283.  
  284.  
  285.  
  286.  
  287.  
  288.  
  289.  
  290.  
  291.  
  292.  
  293.  
  294.  
  295.  
  296.  
  297.