1 '************************************************************************* 2 ' HomExpense Manager by Sayre & Erickson 3 '************************************************************************* 4 ' 5 ' Home accounting program for the Radio Shack Model 100. 6 ' From a forthcoming book by Osborne/McGraw-Hill. 7 ' Copyright (C) 1984 by McGraw-Hill, Inc. All rights reserved. 8 ' Permission granted to copy for noncommercial use only. Not for resale. 9 ' Credit to the original author and publisher should remain in the 10 ' program listing. Please submit revised versions to the publisher. 11 ' 12 ' Technical Director 13 ' Osborne/McGraw-Hill 14 ' 2600 Tenth Street Source: ST5072 15 ' Berkeley, CA 94710 17 ' 18 ' ** HomExpense Manager ** Copyright (C) 1983 by Sayre & Erickson. 19 ' 20 'Module 1 -- Main Driver 30 CLEAR 500 40 MAXFILES=2:DEFINT A-Z 50 CR$=CHR$(13):RV$=CHR$(27)+"p":NV$=CHR$(27)+"q" 60 KEY1,"N":KEY2,"S":KEY3,"": KEY4,"":KEY5,"":KEY6,"": KEY7,"":KEY8,"M" 70 CLS:PRINT NV$; 80 PRINT@5, "Welcome to HomExpense Manager" 90 PRINT@280,"Next Select"; 100 PRINT@315,"Menu"; 110 OP$(0)=" Enter Home Expenses ":PP(0)=90 120 OP$(1)=" Print Home Expenses ":PP(1)=130 130 R=0 140 FOR I=0 TO 1:PRINT@PP(I),NV$;OP$(I);:NEXT I 150 PRINT@PP(R),RV$;OP$(R);NV$; 160 A$=INKEY$:IF A$="" THEN160 170 IF A$="N" THEN R=(R+1)MOD2: GOTO140 180 IF A$="M" THEN CALL 23164,0,23366:CALL 27795:MENU 190 IF A$<>"S" THEN BEEP:GOTO140 200 ON R+1 GOSUB 220,650 210 GOTO60 220 'Module 2 -- Enter a home expense 230 ON ERROR GOTO 610 240 CLS:PRINT NV$; 250 PRINT "Bill Category #:____"; 260 PRINT@25,"Date: __/__/__"; 270 PRINT@40,"Amount: $_____.__"; 280 PRINT@62,"Paid With: ______"; 290 PRINT @80,"Check #:______"; 300 PRINT@120,"Notes: "+STRING$(33,"_"); 310 PRINT@280,"Rcrd Cncl"; 320 BF$=STRING$(62," ") 330 PP(0)=16:CC(0)=3 340 PP(1)=31:CC(1)=1 350 PP(2)=34:CC(2)=1 360 PP(3)=37:CC(3)=1 370 PP(4)=49:CC(4)=4 380 PP(5)=55:CC(5)=1 390 PP(6)=73:CC(6)=5 400 PP(7)=88:CC(7)=5 410 PP(8)=127:CC(8)=32 420 CH=0:WD=0:BP=0:MW=8:MB=61 430 GOSUB 1880 440 IF C$=CHR$(2) THEN PRINT@295,NV$;"Operation cancelled!";:GOTO 590 450 OPEN "HOMEXP" FOR INPUT AS 1 460 OPEN "TMPEXP" FOR OUTPUT AS 2 470 S1$=MID$(BF$,9,2)+MID$(BF$,5,4)+MID$(BF$,1,4) 480 IF EOF(1) THEN PRINT#2,BF$;:GOTO560 490 IP$=INPUT$(62,1) 500 S2$=MID$(IP$,9,2)+MID$(IP$,5,4)+MID$(IP$,1,4) 510 IFS1$52 THEN PRINT @240,"Error #";ERR;" in line #";ERL:STOP 620 OPEN "HOMEXP" FOR OUTPUT AS 1 630 CLOSE 1 640 RESUME 650 'Module 3 -- Display or print home expenses 660 ON ERROR GOTO610 670 CLS:PRINT NV$; 680 PRINT@0,"Starting with Bill Category # ____"; 690 PRINT@40,"Ending with Bill Category # ____"; 700 PRINT@80,"Starting Date: __/__/__"; 710 PRINT@120,"Ending Date: __/__/__"; 720 PRINT@160,"Specific Topic(s): "+STRING$(21,"_") 730 PRINT@200,"Print to Screen or Printer (S/P): _"; 740 PRINT@280,"Print Cncl"; 750 PP(0)=30:CC(0)=3 760 PP(1)=68:CC(1)=3 770 PP(2)=95:CC(2)=1 780 PP(3)=98:CC(3)=1 790 PP(4)=101:CC(4)=1 800 PP(5)=133:CC(5)=1 810 PP(6)=136:CC(6)=1 820 PP(7)=139:CC(7)=1 830 PP(8)=179:CC(8)=20 840 PP(9)=234:CC(10)=0 850 CH=0:WD=0:BP=0:MW=9:MB=41 860 BF$=STRING$(42," ") 870 GOSUB 1880 880 IF C$=CHR$(2) THEN PRINT@300,"Operation cancelled!";:GOTO 1180 890 SD$=MID$(BF$,13,2)+MID$(BF$,9,4) 900 ED$=MID$(BF$,19,2)+MID$(BF$,15,4) 910 IF ED$=" " THEN ED$="991231" 920 SA$=MID$(BF$,1,4) 930 EA$=MID$(BF$,5,4) 940 IF EA$=" " THEN EA$="ZZZZ" 950 TC=0 960 TP$(1)="":TP$(2)="" 970 PT=INSTR(13,BF$,CHR$(255)) 980 IF PT=0 THEN 1130 990 TP$(1)=MID$(BF$,21,PT-21) 1000 FOR I=1 TO LEN(TP$(1)) 1010 IF MID$(TP$(1),I,1)<"a" OR MID$(TP$(1),I,1)>"z" THEN 1030 1020 MID$(TP$(1),I,1)=CHR$(ASC(MID$(TP$(1),I,1))-32) 1030 NEXT I 1040 NP=PT+1:TC=1 1050 PT=INSTR(NP,BF$,CHR$(255)) 1060 IF PT=0 THEN 1130 1070 TP$(2)=MID$(BF$,NP,PT-NP) 1080 FOR I=1 TO LEN(TP$(2)) 1090 IF MID$(TP$(2),I,1)<"a" OR MID$(TP$(2),I,1)>"z" THEN 1110 1100 MID$(TP$(2),I,1)=CHR$(ASC(MID$(TP$(2),I,1))-32) 1110 NEXT I 1120 TC=2 1130 OPEN "HOMEXP" FOR INPUT AS 1 1140 IF MID$(BF$,42,1)="P" OR MID$(BF$,42,1)="p" THEN GOSUB 1470ELSE GOSUB 1190 1150 PRINT@300,NV$;"End of file"; 1160 FOR I=1 TO 1000:NEXT I 1170 CLOSE 1180 RETURN 1190 'Module 3-A -- Display home expenses on the screen 1200 KEY1,"N":KEY2,"Q":KEY8,"" 1210 CLS:PRINT NV$; 1220 PRINT@0,"Bill Category #"; 1230 PRINT@25,"Date:"; 1240 PRINT@40,"Amount:$"; 1250 PRINT@62,"Paid With:"; 1260 PRINT@80,"Check #:"; 1270 PRINT@120,"Notes: "; 1280 PRINT@200,"Running Total:$" 1290 PRINT@280,"Next Quit"; 1300 TT!=0 1310 GOSUB 1710 1320 IF PF=0 GOTO1450 1330 PRINT@16,MID$(BF$,1,4); 1340 PRINT@31,MID$(BF$,5,2)+"/"+MID$(BF$,7,2)+"/"+MID$(BF$,9,2); 1350 AM!=VAL(MID$(BF$,11,7))/100 1360 TT!=TT!+AM! 1370 PRINT@49,USING"#####.##";AM!; 1380 PRINT@73,MID$(BF$,18,6); 1390 PRINT@87,MID$(BF$,24,6); 1400 PRINT@127,MID$(BF$,30,33); 1410 PRINT@215,USING"######.##";TT! 1420 A$=INKEY$ 1430 IF A$="N" THEN 1310 1440 IF A$<>"Q" THEN 1420 1450 CLOSE 1 1460 RETURN 1470 'Module 3-B -- Display home expenses on the printer 1480 OPEN "LPT:" FOR OUTPUT AS 2 1490 TT!=0:OD$="" 1500 PRINT#2,CR$;CR$;TAB(30);"Home Expense Report";CR$;CR$;CR$; 1510 PRINT:PRINT#2,TAB(10);"Bill Paid" 1520 PRINT#2," Date Category With Check# Notes ";TAB(29);"Amount Total" 1530 LC=7 1540 GOSUB 1710 1550 IF PF=0 GOTO 1700 1560 ND$=MID$(BF$,5,2)+"/"+MID$(BF$,7,2)+"/"+MID$(BF$,9,2) 1570 IF ND$=OD$ THEN ND$=" " ELSEOD$=ND$:LC=LC+1:PRINT#2,"" 1580 PRINT#2,ND$+" "; 1590 PRINT#2,MID$(BF$,1,4)+" "; 1600 PRINT#2,MID$(BF$,18,6);" "; 1610 PRINT#2,MID$(BF$,24,6);" "; 1620 PRINT#2,MID$(BF$,30,33); 1630 AM!=VAL(MID$(BF$,11,7))/100 1640 TT!=TT!+AM! 1650 PRINT#2,USING"#####.##";AM!; 1660 PRINT#2," "; 1670 PRINT#2,USING"######.##";TT! 1680 LC=LC+1 1690 IF LC<60 GOTO1540ELSE GOTO1500 1700 RETURN 1710 'Module 3-C -- Validate input 1720 IF EOF(1) THEN PF=0:GOTO 1870 1730 BF$=INPUT$(62,1):PF=1 1740 IF MID$(BF$,1,4)EA$ GOTO 1710 1750 ID$=MID$(BF$,9,2)+MID$(BF$,5,4) 1760 IF ID$ED$ GOTO 1710 1770 IF TC=0 GOTO 1870 1780 TB$=BF$ 1790 FOR I=11 TO 55 1800 LC$=MID$(TB$,I,1) 1810 IF LC$<"a" OR TC$>"z" THEN 1830 1820 MID$(TB$,I,1)=CHR$(ASC(LC$)-32) 1830 NEXT I 1840 FOR I=1 TO TC 1850 IF INSTR(1,TB$,TP$(I))=0 THEN GOTO 1710 1860 NEXT I 1870 RETURN 1880 'Module 4 -- Keyboard input routine 1890 KEY1,CHR$(1):KEY2,CHR$(2):KEY8,"" 1900 AS$=MID$(BF$,BP+1,1) 1910 IF AS$=" " THEN AS$="_" 1920 PRINT@PP(WD)+CH, RV$;AS$; 1930 C$=INKEY$:IF C$="" THEN 1930 1940 IF C$=CHR$(28) THEN GOSUB 2100 1950 IF C$=CHR$(29) THEN GOSUB 2020 1960 IF C$>CHR$(31) THEN GOSUB 2300 1970 IF C$=CHR$(8) THEN GOSUB 2410 1980 IF C$=CHR$(27) THEN GOSUB 2180 1990 IF C$=CHR$(13) THEN GOSUB 2240 2000 IF C$=CHR$(1) OR C$=CHR$(2) THENRETURN 2010 GOTO 1900 2020 'Module 4-A -- Left arrow processing 2030 PRINT@PP(WD)+CH,NV$;AS$; 2040 CH=CH-1:BP=BP-1 2050 IF CH>=0 THEN GOTO 2090 2060 WD=WD-1 2070 IF WD<0 THEN WD=MW:BP=MB 2080 CH=CC(WD) 2090 RETURN 2100 'Module 4-B -- Right arrow processing 2110 PRINT@PP(WD)+CH,NV$;AS$; 2120 CH=CH+1:BP=BP+1 2130 IF CH<=CC(WD) GOTO 2170 2140 WD=WD+1 2150 IF WD>MW THEN WD=0:BP=0 2160 CH=0 2170 RETURN 2180 'Module 4-C -- Escape key processing 2190 BP=BP-CH 2200 CH=0 2210 MID$(BF$,BP+1,CC(WD)+1)= STRING$(CC(WD)+1," ") 2220 PRINT@PP(WD)+CH,NV$; STRING$(CC(WD)+1,"_") 2230 RETURN 2240 'Module 4-D -- Enter key processing 2250 PRINT@PP(WD)+CH,NV$;AS$; 2260 BP=BP+(CC(WD)-CH)+1:WD=WD+1 2270 IF WD>MW THEN WD=0:BP=0 2280 CH=0 2290 RETURN 2300 'Module 4-E -- Printable letter processing 2310 MID$(BF$,BP+1,1)=C$ 2320 BP=BP+1 2330 IF C$=" " THEN C$="_ 2340 PRINT@PP(WD)+CH,NV$;C$; 2350 CH=CH+1 2360 IF CH<=CC(WD) GOTO 2400 2370 WD=WD+1 2380 IF WD>MW THEN WD=0:BP=0 2390 CH=0 2400 RETURN 2410 'Module 4-F -- Backspace processing 2420 PRINT@PP(WD)+CH,NV$;AS$; 2430 BP=BP-1 2440 CH=CH-1 2450 IF CH>=0 GOTO 2490 2460 WD=WD-1 2470 IF WD<0 THEN WD=MW:BP=MB 2480 CH=CC(WD) 2490 MID$(BF$,BP+1,1)=" " 2500 RETURN