start tok64 d64-kInY6S
5 PRINT"{clear}{down*6}"
10 PRINT "journal - jim butterfield"
11 PRINT "v1 - 1987 may 20"
15 d=19870503
20 DATA receipts,expenses,*
30 READ f$
40 IF f$<>"*" THEN j=j+1:PRINT j;f$:GOTO 30
50 PRINT "your choice (1 to";j;")"
60 INPUT x:IF x<1 OR x>j GOTO 60
70 RESTORE:FOR j=1 TO x:READ f$:NEXT j
80 PRINT "data file <";f$;".d>"
100 m$="{space*2}janfebmaraprmayjunjulaugsepoctnovdec"
110 m=300:DIM d(m),a$(m),v(m),n$(m),k(30),b(30)
120 OPEN 15,8,15
130 t9=0:OPEN 1,8,3,f$+".d"
140 INPUT#15,e,e$
150 IF e=62 GOTO 260
160 n=n+1:INPUT#1,d(n),a$(n),v(n),n$(n)
165 t9=t9+ABS(v(n)):IF t9=0 THEN n9=n9+1
170 IF st=0 GOTO 160
180 INPUT#15,e,e$,e1,e2
190 CLOSE 1
200 IF e<>0 THEN PRINT "*** error ***";e$;e1;e2:END
210 PRINT n;"items found on file"
215 IF n9>0 THEN PRINT "(including";n9;"dummies)"
250 d=d(n):GOTO 300
260 CLOSE 1
270 PRINT "i don't find a current journal file"
280 INPUT "should i start a new one";x$
290 IF x$<>"y" AND x$<>"yes" THEN END
300 CLOSE 15
310 n0=n:IF n=0 GOTO 390
320 PRINT "1. enter new data"
330 PRINT "2. print data"
340 INPUT "your choice (1 or 2){space*2}1{left*3}";x
350 IF x=1 GOTO 390
360 IF x=2 GOTO 4000
370 GOTO 320
390 d0=d:PRINT
400 y$=MID$(STR$(d),2,4)
410 PRINT "year{space*2}";y$;"{left*6}";
420 INPUT y:IF y<1980 OR y>2079 GOTO 410
430 IF n=0 OR y=VAL(y$) GOTO 440
435 d0=y*1e4+100:PRINT"<< maybe start a new disk ?? >>"
440 m0$=MID$(m$,3*VAL(MID$(STR$(d0),6,2)),3)
450 PRINT "month{space*2}";m0$;"{left*5}";
460 INPUT m1$:m1$=LEFT$(m1$+"..",3)
470 FOR m1=1 TO 12
480 IF m1$=MID$(m$,m1*3,3) GOTO 510
490 NEXT m1
500 GOTO 450
510 INPUT "day";d1
520 IF d1<1 OR d1>31 OR d1<>INT(d1) GOTO 510
530 d0=y*10000+m1*100+d1
540 IF d0<d THEN PRINT "(out of chronological order??)"
550 d=d0:d(n+1)=d
560 IF n=0 GOTO 750
570 IF k0>0 GOTO 660
580 k0=1:k(1)=1:IF n=1 GOTO 660
590 FOR j=2 TO n
600 FOR k1=1 TO k0
610 IF a$(j)=a$(k(k1)) GOTO 650
620 NEXT k1
630 k0=k0+1
640 k(k0)=j
650 NEXT j
660 PRINT "existing accounts":
670 j0=k0:IF k0<30 THEN j0=k0+1
672 FOR j=1 TO j0/2+.9
675 PRINT j;a$(k(j));TAB(19);
680 k=j+INT(j0/2+.9)
682 IF k<k0+1 THEN PRINT k;a$(k(k));
683 IF k=k0+1 THEN PRINT k;"<< new account >>";
684 PRINT
690 NEXT j
710 PRINT "which of the above (1 to";j0;")";
720 INPUT x
730 IF x<1 OR x>j0 GOTO 710
740 IF x<k0+1 THEN a$(n+1)=a$(k(x)):GOTO 770
750 INPUT "account name";a$(n+1)
760 k0=0
770 INPUT"amount";v
780 v(n+1)=INT(v*100+.5)
790 n$(n+1)="/"
800 IF n=0 GOTO 930
810 b=0
815 FOR j=1 TO n
820 IF a$(j)<>a$(n+1) AND k0>0 THEN GOTO 839
822 IF b=0 GOTO 838
824 FOR k=1 TO b:IF n$(b(k))=n$(j) GOTO 839
826 NEXT k
830 IF a$(j)<>a$(n+1) AND k0>0 THEN GOTO 880
838 b=b+1:b(b)=j:IF b=30 GOTO 840
839 NEXT j
840 j0=b+1
845 FOR j=1 TO j0/2+.9
850 PRINT j;n$(b(j));TAB(19);
852 k=j+INT(j0/2+.9)
855 IF k<b+1 THEN PRINT k;n$(b(k));
860 IF k=b+1 THEN PRINT k;"<< other >>";
865 PRINT
880 NEXT j
900 INPUT "comment/category above";x
910 IF x<0 OR x>b+1 OR x<>INT(x) GOTO 900
920 IF x<b+1 THEN n$(n+1)=n$(b(x)):GOTO 940
930 INPUT "comment/category{space*2}/{left*3}";n$(n+1)
940 PRINT
950 j=n+1
960 OPEN 4,3:GOSUB 5000:CLOSE 4
970 INPUT "is above ok";x$
980 IF x$<>"y" AND x$<>"yes" THEN PRINT"{<*5}{space*3}cancelled{space*4}{>*5}":GOTO 1010
990 n=j:PRINT "ok":f=1
1000 IF m-n<10 THEN PRINT "data file almost full {!*4}"
1010 PRINT
1020 INPUT "more";x$
1030 IF x$="y" OR x$="yes" GOTO 440
1040 IF f=0 THEN END
1050 INPUT "want a summary of entries";x$
1060 IF x$<>"y" AND x$<>"yes" GOTO 1120
1070 PRINT:OPEN 4,3
1080 FOR j=n0+1 TO n
1090 GOSUB 5000
1100 NEXT j
1110 CLOSE 4
1120 PRINT
1130 GOSUB 2000
1140 IF f=0 THEN END
1210 INPUT "ready to write output file";x$
1220 IF x$<>"y" AND x$<>"yes" THEN STOP
1230 OPEN 15,8,15
1240 PRINT#15,"s0:"+f$+".x"
1250 INPUT#15,e,e$,e1
1260 PRINT e$,e1
1270 PRINT#15,"r0:"+f$+".x=0:"+f$+".d"
1280 INPUT#15,e,e$,e1
1290 OPEN 1,8,3,"0:"+f$+".d,s,w"
1300 INPUT#15,e,e$
1310 IF e<>0 THEN PRINT ">> disk >>";e$
1320 FOR j=1 TO n
1322 IF j>n9 GOTO 1330
1324 IF j=n GOTO 1330
1325 FOR k=j+1 TO n
1326 IF a$(j)=a$(k) AND n$(j)=n$(k) GOTO 1340
1327 NEXT k
1330 PRINT#1,d(j):PRINT#1,a$(j):PRINT#1,v(j):PRINT#1,n$(j)
1340 NEXT j
1350 INPUT#15,e,e$,e1,e2
1360 CLOSE 1
1370 IF e<>0 THEN PRINT "{>*3} error {>*3}";e$;e1;e2
1380 IF e=0 THEN PRINT "< file written >"
1390 END
2000 PRINT "want a summary by ";
2010 INPUT "account or item";x$
2020 x=ASC(x$)
2030 IF x=78 THEN RETURN
2040 IF x=65 OR x=73 GOTO 2060
2050 GOTO 2010
2060 INPUT "detail(d) or summary(s)";x$
2070 IF x$<>"d" AND x$<>"s" GOTO 2060
2080 l=1
2090 h=1
2100 FOR j=2 TO n
2110 IF x=65 THEN IF a$(j)<a$(l) THEN l=j
2120 IF x=73 THEN IF n$(j)<n$(l) THEN l=j
2130 IF x=65 THEN IF a$(j)>a$(h) THEN h=j
2140 IF x=73 THEN IF n$(j)>n$(h) THEN h=j
2150 NEXT j
2170 INPUT "output to printer{space*2}n{left*3}";p$
2180 p=3:IF p$="y" OR p$="yes" THEN p=4
2190 OPEN 4,p
2195 t9=0:s9=0
2200 t=0:s=0:l1=h
2210 FOR j=1 TO n
2220 IF x=65 THEN GOSUB 3000:IF f0 GOTO 2260
2230 IF x=73 THEN GOSUB 3100:IF f0 GOTO 2260
2240 j0=j:IF j>n9 THEN t=t+v(j):s=s+1
2250 IF x$="d" THEN GOSUB 5000
2260 NEXT j
2270 p$=" items{space*6}":GOSUB 6000
2275 t9=t9+t:s9=s9+s
2280 IF l<>h THEN l=l1:GOTO 2200
2290 GOSUB 4700
2300 CLOSE 4
2310 RETURN
3000 f0=a$(j)<a$(l):IF f0 GOTO 3090
3010 f0=a$(j)>a$(l)
3020 IF f0 THEN IF a$(j)<a$(l1) THEN l1=j
3090 RETURN
3100 f0=n$(j)<n$(l):IF f0 GOTO 3090
3110 f0=n$(j)>n$(l)
3120 IF f0 THEN IF n$(j)<n$(l1) THEN l1=j
3190 RETURN
4000 IF k0>0 GOTO 4090
4010 k0=1:k(1)=1:IF n=1 GOTO 4090
4020 FOR j=2 TO n
4030 FOR k1=1 TO k0
4040 IF a$(j)=a$(k(k1)) GOTO 4080
4050 NEXT k1
4060 k0=k0+1
4070 k(k0)=j
4080 NEXT j
4090 PRINT "accounts":
4100 FOR j=1 TO k0
4110 PRINT j;a$(k(j))
4120 NEXT j
4130 j0=k0+1
4140 PRINT j0;" << all >>"
4150 PRINT "which of the above (1 to";j0;")";
4160 INPUT x
4170 IF x<1 OR x>j0 GOTO 4150
4180 INPUT "want monthly totals";x$
4190 x$=LEFT$(x$,1)
4200 k=k(x)
4210 INPUT "output to printer{space*2}n{left*3}";p$
4220 p=3:IF p$="y" OR p$="yes" THEN p=4
4230 OPEN 4,p
4235 s9=0:t9=0
4240 p=INT(d(1)/100):t=0:s=0
4300 FOR j=1 TO n
4310 IF x<>j0 THEN IF a$(j)<>a$(k) GOTO 4350
4320 p1=INT(d(j)/100):IF p1<>p THEN GOSUB 4800
4340 IF j>n9 THEN GOSUB 5000:s=s+1:t=t+v(j)
4350 NEXT j
4360 GOSUB 4800
4370 GOSUB 4700
4380 CLOSE 4
4390 GOTO 1120
4700 PRINT#4,"{space*3}**";s9;" items total{space*2}";
4710 v$=RIGHT$("{space*7}"+STR$(t9),9)
4720 v5=8:v6=1:IF ASC(MID$(v$,8))<48 THEN v5=9:v6=2
4730 PRINT#4,MID$(v$,v6,7);LEFT$(".0",v6);MID$(v$,v5);" **"
4740 RETURN
4800 IF x$<>"y" GOTO 4830
4810 p2=INT(p/100)*100:p3=p-p2:p$="{space*2}"+MID$(m$,3*p3,3)+"{space*3}"
4820 GOSUB 6000
4830 t9=t9+t:s9=s9+s
4840 p=p1:t=0:s=0
4850 RETURN
5000 IF v(j)=0 GOTO 5080
5010 d1=d(j):d2=INT(d1/10000):d1=d1-d2*10000:d3=INT(d1/100):d1=d1-d3*100
5020 PRINT#4,STR$(d2);" ";MID$(m$,d3*3,3);RIGHT$(" "+STR$(d1),3);"{space*2}";
5030 PRINT#4,LEFT$(a$(j)+"{space*11}",12);
5040 v$=RIGHT$("{space*7}"+STR$(v(j)),9)
5050 v5=8:v6=1:IF ASC(MID$(v$,8))<48 THEN v5=9:v6=2
5060 PRINT#4,MID$(v$,v6,7);LEFT$(".0",v6);MID$(v$,v5);
5070 PRINT#4," ";n$(j)
5080 RETURN
6000 PRINT#4,RIGHT$("{space*4}"+STR$(s),6);p$;
6010 IF x=65 THEN PRINT#4,LEFT$(a$(j0)+"{space*11}",12);
6020 IF x=73 THEN PRINT#4,"{space*12}";
6030 v$=RIGHT$("{space*7}"+STR$(t),9)
6040 v5=8:v6=1:IF ASC(MID$(v$,8))<48 THEN v5=9:v6=2
6050 PRINT#4,MID$(v$,v6,7);LEFT$(".0",v6);MID$(v$,v5);
6060 IF x=73 THEN PRINT#4," ";n$(j0);
6070 PRINT#4
6080 RETURN
stop tok64
(bastext 1.0)