home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
ftp.barnyard.co.uk
/
2015.02.ftp.barnyard.co.uk.tar
/
ftp.barnyard.co.uk
/
cpm
/
walnut-creek-CDROM
/
SIMTEL
/
CPMUG
/
CPMUG044.ARK
/
BUDGET1.BAS
< prev
next >
Wrap
BASIC Source File
|
1984-04-29
|
12KB
|
297 lines
REM BUDGET1.BAS
REM Copyright 1980 W. Patrick Cunningham, 235 Sharon Drive,
REM San Antonio, TX 78216. Commercial distribution of this
REM program is prohibited without permission of the author.
REM
REM This program will perform various functions for household
REM bookkeeping, including recording expenses and prorating
REM them among various categories. It will create monthly
REM files of data and monthly ledgers, which may be balanced and
REM totalled by the companion programs, LEDGER1, BUDGETCH, & ANNTOT1.
REM
REM This is a source program written in CBASIC2 on a 48K machine,
REM but will work with as little as 32K if a restricted number of
REM records are to be processed.
REM
REM Declaration of various dimensions and initialization of constants.
DIM DATE%(20) REM The program is structured for no more than 20
REM records.
DIM PAYEE$(20)
DIM TAMOUNT(20)
DIM ANS$(20)
DIM AMOUNT(20,4) REM This is the register for storing data
DIM CAT$(20,4) REM This is the category of each datum.
DIM CATVAL$(17) REM This is the identity of each category.
DIM VALID.MO$(12)
PRIFLAG%=0 REM When = 1, data will print before storage on disc.
05 DEF FN.CHECK$(VAL$)
FN.CHECK$=""
WHILE LEN(VAL$)>1
PRINT "Your category code must be only 1 character long."
5.5 PRINT "Re-enter your category code";
INPUT LINE RSS$
IF RSS$="" THEN GOTO 5.5
VAL$=RSS$
WEND
FOR I%=1 TO 19
READ OKVALUE$
IF VAL$=OKVALUE$ THEN GOTO 06
NEXT I%
RESTORE
5.6 PRINT "Your category code is improper: enter one of these:"
FOR I%=1 TO 19
READ OKVALUE$
PRINT OKVALUE$;" ";
NEXT I%
RESTORE
INPUT "What code is proper"; LINE RSS$
IF RSS$="" THEN GOTO 5.5
FOR I%=1 TO 19
READ OKVALUE$
IF RSS$=OKVALUE$ THEN VAL$=RSS$ : GOTO 06
NEXT I%
GOTO 5.5
06 RESTORE
FN.CHECK$=VAL$
DATA "C","G","F","H","I","J","M","N","P","B","R","S","U","E","X","W","T","D","Y"
RETURN
FEND
PRINT TAB(15);"B U D G E T P R O G R A M."
FOR I%=1 TO 15 REM here we go!!
PRINT
NEXT I%
10 PRINT "This program will input expenses and store them on disc."
FOR I%=1 TO 4
PRINT
NEXT I%
10.01 PRINT "What month and year is this?"
INPUT "MONTH:"; LINE RESP$
INPUT "YEAR:";LINE YR$
IF LEN(YR$)<>4 THEN GOTO 10.01
OLDNEW$="OLD"
IF RESP$="" OR YR$="" THEN 10.01
IF UCASE$(RESP$)="SAME" THEN 10.02
MO$=UCASE$(LEFT$(RESP$,3))
VALID.MO$(1)="JAN"
VALID.MO$(2)="FEB"
VALID.MO$(3)="MAR"
VALID.MO$(4)="APR"
VALID.MO$(5)="MAY"
VALID.MO$(6)="JUN"
VALID.MO$(7)="JUL"
VALID.MO$(8)="AUG"
VALID.MO$(9)="SEP"
VALID.MO$(10)="OCT"
VALID.MO$(11)="NOV"
VALID.MO$(12)="DEC"
FOR K%=1 TO 12
IF MO$=VALID.MO$(K%) THEN GOTO 10.019
NEXT K%
RESTORE
PRINT "YOUR MONTH IS NOT RECOGNIZEABLE!":GOTO 10.01
10.019 FILN$="EXPENS"+RIGHT$(YR$,2)+"."+MO$
INPUT "Is this file NEW or OLD"; LINE OLDNEW$
IF OLDNEW$="NEW" THEN CREATE FILN$ RECL 64 AS 1 BUFF 1 RECS 128 :GOTO 11.5
10.02 IF OLDNEW$="OLD" THEN OPEN FILN$ RECL 64 AS 1 BUFF 1 RECS 128 : GOTO 11.5
PRINT "Your response is not recognizeable"
GOTO 10.01
11.5 POSN%=0
TRUE%=-1
DEF FN.GET.TO.END%(FILE.NAME$,REC.SIZE%,FILE.NUM%,POSITION%)
FN.GET.TO.END%=0
FILE.SIZE%=SIZE(FILE.NAME$)
IF FILE.SIZE%=0 THEN \ REM FALSE IF NO FILE
RETURN \
ELSE FN.GET.TO.END%=TRUE%
IF END # FILE.NUM% THEN 11.8
POSITION%=INT%(FLOAT(FILE.SIZE% * 128.0)/REC.SIZE%)
PRINT "positioning file at end"
READ # FILE.NUM%,POSITION%;
WHILE TRUE%
READ # FILE.NUM%; LINE DUMMY$
POSITION% = POSITION%+ 1
WEND
11.8 PRINT FILE.SIZE%,POSITION%
RETURN
FEND
CHECK%=FN.GET.TO.END%(FILN$,64,1,POSN%)
IF END # 1 THEN 4400
INPUT "Do you wish data displayed as it is stored (Y/N)"; RESP$
IF RESP$="Y" THEN PRIFLAG%=1
20 TOT=0.0
PRINT "How many payees are you entering [maximum of 20]";
INPUT N% REM no more than 20 allowed
WHILE N%>20
N%=0
PRINT "Sorry, your batch is too big; break it into smaller pieces."
GOTO 20
WEND
FOR J%=1 TO N%
22 PRINT "Date of payment # ";J%;
INPUT DATE%(J%)
IF DATE%(J%)<=0 THEN 22
IF DATE%(J%)>31 THEN 22
23 INPUT "Name of PAYEE:"; LINE PAYEE$(J%)
IF LEN(PAYEE$(J%))<3 THEN 23
WHILE LEN(PAYEE$(J%))>18
PRINT "Name is too long (18); abbreviate where possible."
GOTO 23
WEND
INPUT "Total amount of payment, omitting $:"; TAMOUNT(J%)
TOT = TOT+TAMOUNT(J%)
NEXT J%
REM
REM Amounts are now in the file memory
REM
PRINT "The total spent in this batch of payments is $";TOT
REM
FOR J%=1 TO N%
PRINT "<cr> if ";PAYEE$(J%); " payment is to one category; ";
PRINT "If not, type an N."
INPUT LINE RES$
ANS$(J%)=UCASE$(RES$)
WHILE ANS$(J%)=""
ANS$(J%)="*" REM flag to indicate no subcategories
AMOUNT(J%,1)=TAMOUNT(J%)
FOR K%=2 TO 4
AMOUNT (J%,K%)=0
CAT$(J%,K%)=""
NEXT K%
PRINT "MENU is displayed when you type \? as response."
35 INPUT "Category of this payment"; LINE RESP$
WHILE RESP$="\?"
RESP$=""
GOSUB 200
WEND
IF RESP$ ="" THEN GOTO 35
CAT$(J%,1)=FN.CHECK$(RESP$)
RESP$=""
WEND
WHILE ANS$(J%)="N"
PRINT "Do you need a menu of budget categories (Y/N)";
INPUT LINE RESP$
IF RESP$="Y" THEN GOSUB 200
ANS$(J%)="C"
40 PRINT "How many different categories for ";PAYEE$(J%);
INPUT RSP%
WHILE RSP%>4
PRINT "Too many categories; maximum is 4,incl.tax"
GOTO 40
WEND
SUBTOT=0.0
FOR K%=1 TO RSP%
PRINT "TYPE <category code>,<amount/no$ sign>"; K%; "FOR "; PAYEE$(J%);
50 INPUT RESP$, AMOUNT (J%,K%)
CAT$(J%,K%)= FN.CHECK$(RESP$)
SUBTOT=SUBTOT+AMOUNT(J%,K%)
NEXT K%
IF SUBTOT<>TAMOUNT(J%) THEN GOSUB 300
WEND
PRINT "Information on payee "; PAYEE$(J%);" is entered."
NEXT J%
REM
REM Data entry routine is complete.
REM
REM Data is now transferred to the disc.
REM
WHILE PRIFLAG%=1
FOR J%=1 TO N%
PRINT DATE%(J%);" ";PAYEE$(J%);" ";
FOR K%=1 TO 4
PRINT CAT$(J%,K%);" $";AMOUNT(J%,K%)
NEXT K%
PRINT " "
NEXT J%
PRIFLAG%=0
WEND
120 REM disc transfer routine
FOR J%=1 TO N%
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)
PRINT PAYEE$(J%);" data on disc."
NEXT J%
122 CLOSE 1
125 PRINT "Do you have more data to process [D];or do you want to quit now";
PRINT " [Q] ";
INPUT LINE RSP$
IF RSP$="D" THEN GOTO 10
IF RSP$="Q" THEN GOTO 2000
PRINT "Your response is not recognizeable."
GOTO 125
200 REM subroutine to display menu
PRINT "******************************************"
PRINT "Here are the budget categories and codes:"
PRINT
PRINT " : CATEGORY : CODE "
PRINT " Charity C "
PRINT " Drugs and Pharmacy D "
PRINT " Clothing/garments G "
PRINT " Food F "
PRINT " Household goods/hardware H "
PRINT " Inventoried Items (mortgage) I "
PRINT " Insurance J "
PRINT " Medical (doctors,hospital) Y "
PRINT " Miscellaneous taxable M "
PRINT " Miscellaneous non-taxable N "
PRINT " Telephone (personal) P "
PRINT " Telephone (business) B "
PRINT " Telephone (other) R "
PRINT " Savings (e.g. credit union) S "
PRINT " Utility (Power,H2O) U "
PRINT " Gasoline, personal E "
PRINT " Auto parts, personal car X "
PRINT " Auto repair, personal car W "
PRINT " **** SALES TAX ON THE TOTAL ***** T "
PRINT "REMEMBER:separate category from amount with a comma; no $"
RETURN
REM
300 REM HERE WE INSERT SUBROUTINE TO ENABLE OPERATOR TO CORRECT MISTAKES
REM
305 PRINT "** Your entries do not add up to the total you have entered. ***"
PRINT
PRINT " They add up to $";SUBTOT;" ;the entry for ";PAYEE$(J%);" was ";
PRINT "$";TAMOUNT(J%);"."
PRINT "<cr> if the original total was correct; otherwise type N."
INPUT LINE WHAT$
IF WHAT$=""THEN 307
WHILE WHAT$="N"
WHAT$=""
PRINT "The correct total for ";PAYEE$(J%);" is:";
INPUT TAMOUNT(J%)
PRINT "The correct total is verified as $"; TAMOUNT(J%)
IF SUBTOT<>TAMOUNT(J%) THEN 305
RETURN
WEND
307 PRINT "Re-enter the values for the several categories of ";PAYEE$(J%);"."
INPUT "How many different categories for this payment"; CATS%
SAMOUNT = 0.0
FOR K%=1 TO CATS%
PRINT "For category ";CAT$(J%,K%); " enter correct amount";
INPUT AMOUNT(J%,K%)
SAMOUNT=SAMOUNT +AMOUNT(J%,K%)
NEXT K%
SUBTOT = SAMOUNT
IF SAMOUNT<>TAMOUNT(J%) THEN 305
RETURN
2000 PRINT "Your response indicates we are through for the day":GOTO 4500
4400 PRINT "END OF FILE CONDITION SENSED FOR DATA FILE"+FILN$
PRINT "SUMMON HELP! COPY SCREEN ON PAPER AND RESTART..."
CLOSE 1
4500 END
EOF