rem This is the Comparative Income Statement Printer

%INCLUDE ALL.BAS
     dim TC%(11),n(2,12),k$(2,10),h(9),s(9),t(4,9)
     RESTORE
	P0=1
	HEAD2$="MONTH TO DATE"
	HEAD3$="QUARTER T/DATE"
	HEAD4$="YEAR TO DATE"
1009 PRINT clear$:PRINT
	HEAD=0
1010	PRINT "IS THIS INCOME STATEMENT TO BE FOR THE :"
	PRINT
	PRINT "MONTH TO DATE"
	PRINT:PRINT "QUARTER TO DATE"
	PRINT:PRINT "YEAR TO DATE"
	PRINT
	INPUT "  (M, Q, OR Y) ";LINE LA$
	IF UCASE$(LA$)="M" THEN X=4:GOTO 1020
	IF UCASE$(LA$)="Q" THEN X=5:GOTO 1020
	IF UCASE$(LA$)="Y" THEN X=6:GOTO 1020
	GOTO 1009
1020	REM NOW FOR THE COMPARATIVE SIDE
	IF X=4 THEN HEAD$=HEAD2$
	IF X=5 THEN HEAD$=HEAD3$
	IF X=6 THEN HEAD$=HEAD4$
	PRINT CLEAR$
	PRINT "WHAT KIND OF COMPARATIVE STATEMENT WILL THIS BE :"
	PRINT:PRINT "MONTH TO DATE"
	PRINT:PRINT "QUARTER TO DATE"
	PRINT:PRINT "YEAR TO DATE"
	PRINT:PRINT "PREVIOUS MONTH TO DATE"
	PRINT:PRINT "PREVIOUS QUARTER TO DATE"
	PRINT:PRINT "PREVIOUS YEAR TO DATE"
	PRINT
	INPUT "  (M, Q, Y, PM, PQ, OR PY) ";LINE LA1$
	IF UCASE$(LA1$)="M" THEN LA=4:GOTO 1030
	IF UCASE$(LA1$)="Q" THEN LA=5:GOTO 1030
	IF UCASE$(LA1$)="Y" THEN LA=6:GOTO 1030
	IF UCASE$(LA1$)="PM" THEN LA=7:GOTO 1030
	IF UCASE$(LA1$)="PQ" THEN LA=8:GOTO 1030
	IF UCASE$(LA1$)="PY" THEN LA=9:GOTO 1030
	GOTO 1020
1030	HEAD=0
	IF LEFT$(LA1$,1)="P" OR LEFT$(LA1$,1)="p" THEN HEAD=1
	IF LA=4 OR LA=7 THEN HEAD1$=HEAD2$:GOTO 1035
	IF LA=5 OR LA=8 THEN HEAD1$=HEAD3$:GOTO 1035
	IF LA=6 OR LA=9 THEN HEAD1$=HEAD4$
1035	REM
1075 Q$="COMPARATIVE INCOME STATEMENT"
1200 REM READ TAB VALUES ROUTINE
	for z=1 to 11:read TC%(z):next z
	data 72,2,10,22,2,4,36,6,36,2,57
1300 REM READ FORMAT STRINGS FOR % AND $ VALUES
	l$="##,###,###":p$="###.#"
3000 REM READ NAME FILE SUBROUTINE
3005 a5=t%(12)
3080 Z=24:Z9=1
3090 FOR Z0=1 TO 4
3100 K$(0,Z0)=MID$(N$,Z9,Z)
3110 Z9=Z9+Z
3120 NEXT Z0
3125 REM ROUTINE TO ELIMINATE TRAILING BLANKS
     l8=1
3130 FOR I=1 TO 4
     l9=len(k$(0,i))
3140 for z=l9 to l8 step -1
3150 IF MID$(K$(0,I),Z,1)<>" " THEN 3170
3160 NEXT Z
3170 Z$=""
3180 FOR Z0=1 TO Z
3190 Z$=Z$+MID$(K$(0,I),Z0,1)
3200 NEXT Z0
3210 K$(0,I)="":K$(0,I)=Z$
3220 NEXT I
4000 REM GET TOTAL SALES AND COST OF GOODS SOLD AS P1/P3 AND P2/P4
4001 REM GET TOTAL OPERATING EXPENSES AS P7/P8
4002 P1=0:P2=0:P3=0:P4=0:P5=0:P6=0:P7=0:P8=0
4005 open "b:glh" recl 150 as 1
4010 FOR Z=1 TO 30
4015 read #1,z;n(2,1),n(2,2),h$,h(0),h(1),h(2),h(3),h(4),h(5),h(6),h(7)
4020 IF LEFT$(H$,2)="HS" THEN 4030
4025 NEXT Z
4030 close 1
4035 open "b:gl" recl 138 as 1
4040 A(9)=A(9)+1
4045 read #1,a(9);N(2,1),N(2,2),K$,N(2,4),\
          N(2,5),N(2,6),N(2,7),N(2,8),N(2,9),N(2,10)
4070 IF N(2,2)=0 THEN 4100
4075 IF N(2,2)>=H(0) AND N(2,2)<=H(1) THEN P1=P1+N(2,X):P3=P3+N(2,LA)
4080 IF N(2,2)>=A(15) AND N(2,2)<=A(16) THEN P2=P2+N(2,X):P4=P4+N(2,LA)
4085 IF N(2,2)>A(16) THEN P7=P7+N(2,X):P8=P8+N(2,LA)
4090 GOTO 4040
4100 IF P1<>0 THEN P1=P1*(-1)
4105 IF P1=0 THEN P1=999999999999
4110 IF P2=0 THEN P2=999999999999
4115 IF P3<>0 THEN P3=P3*(-1)
4120 IF P3=0 THEN P3=999999999999
4130 IF P4=0 THEN P4=999999999999
4140 IF P5=0 THEN P5=999999999999
4150 IF P6=0 THEN P6=999999999999
4160 IF P7=0 THEN P7=999999999999
4170 IF P8=0 THEN P8=999999999999
4990 A(9)=1
4995 close 1
6000 REM PRINT INCOME STATEMENT
6005 PRINT clear$:PRINT
6010 PRINT "PRINTING INCOME STATEMENT"
6015 FOR Z=0 TO 9
6020 H(Z)=0:S(Z)=0:T(0,Z)=0:T(1,Z)=0:T(2,Z)=0:T(3,Z)=0:A(Z)=0
6025 NEXT Z
6030 T1=0:T2=0:T3=0:T4=0
6100 lprinter:P9=0
     open "b:gl" recl 138 as 1
     open "b:glh" recl 150 as 2
     open "b:gls" recl 150 as 3
6200 GOSUB 9600
6250 GOSUB 10000
6255 IF N(2,2)=0 THEN 6400
6300 GOSUB 11000
6350 GOSUB 15000
6355 IF LEFT$(S$,2)<>"SS" AND LEFT$(S$,2)<>"SX" THEN 6980
6400 REM DO PARTIAL TOTALS OR TOTALS AND TEST


6403 IF N(2,2)=0 THEN GOSUB 14500
6404 IF N(2,2)=0 THEN FOR Z=1 TO 51-P9:print:NEXT Z:GOSUB 9800
6405 IF N(2,2)=0 THEN 20000
6410 GOSUB 13000
	IF S(1)=H(1) THEN GOSUB 12000
6415 IF S(1)=A(16) THEN GOSUB 14000
6980 IF P9>56 THEN GOSUB 9700
	IF S(1)< H(1) THEN 6300
6995 GOTO 6250
9600 REM PRINT PAGE HEADING SUBROUTINE
9610 print:P9=P9+1
	REM 9615 print:P9=P9+1
9616 print TAB((TC%(1)-LEN(Q$))/2);Q$:P9=P9+1
9617 print:P9=P9+1
9620 FOR Z=2 TO 4
9625 print TAB((TC%(1)-LEN(K$(0,Z)))/2);K$(0,Z):P9=P9+1
9630 NEXT Z
9635 print:P9=P9+1
9640 print TAB(TC%(10));"FOR PERIOD ENDING ";D$(X);TAB(TC%(11));"PAGE #";P0
9642 P9=P9+1
	PRINT
	IF HEAD=1 THEN PRINT TAB(62);"PREVIOUS"
	IF HEAD=0 THEN PRINT
	PRINT
	PRINT TAB(40);HEAD$;TAB(60);HEAD1$:P9=P9+1
     print tab(40);"-------------";tab(60);"-------------"
     print tab(40);"Amount";tab(50);"Pct";tab(60);"Amount";tab(70);"Pct"
     p9=p9+2
9645 print:P9=P9+1
9670 RETURN
9700 REM REPORT CONTINUED SUBROUTINE
     print
     print "report continues on next page"
     print
9720 print chr$(12):P9=0
9725 P0=P0+1
	GOSUB 9600
9740 RETURN
9800 REM END OF REPORT ROUTINE
     print
     print "end of report"
     print
9840 print chr$(12)
9845 REM
9850 RETURN
10000 REM GET HEADING LINE AND PRINT
10005 H(9)=H(9)+1
     read #2,h(9);n(2,1),n(2,2),h$,h(0),h(1),h(2),h(3),h(4),h(5),h(6),h(7)
10015 IF LEFT$(H$,2)<>"HS" AND LEFT$(H$,2)<>"HX" THEN 10995
10020 print:print:print TAB(TC%(4));RIGHT$(H$,30):P9=P9+1
10995 RETURN
11000 REM GET SUBHEADING LINE AND PRINT
11005 S(9)=S(9)+1
     read #3,s(9);n(2,1),n(2,2),s$,s(0),s(1),s(2),s(3),s(4),s(5),s(6),s(7)
11012 IF LEFT$(S$,2)<>"SS" AND LEFT$(S$,2)<>"SX" THEN 11995
11015 print TAB(TC%(5));RIGHT$(S$,30):P9=P9+1
11995 RETURN
12000 REM PRINT FINAL TOTAL LINE
12005 IF LEFT$(H$,2)<>"HS" AND LEFT$(H$,2)<>"HX" THEN 12995
12010 print:P9=P9+1
12015 GOSUB 32000
12020 print TAB(TC%(8));"TOTAL "+MID$(H$,3,20);TAB(TC%(9));:print using l$;t2;
12025 print TAB(TC%(9)+12);:print using p$;p5;
12035 print TAB(TC%(9)+20);:print using l$;t4;
12040 print TAB(TC%(9)+32);:print using p$;p6:P9=P9+1
	print tab(TC%(9));"----------";tab(TC%(9)+12);"-----";
	print tab(TC%(9)+20);"----------";tab(TC%(9)+32);"-----":p9=p9+1
12990 T1=0:T2=0:T3=0:T4=0
12995 RETURN
13000 REM PRINT SUBTOTAL LINE
13005 GOSUB 31000
13010 print TAB(TC%(6));"TOTAL "+MID$(S$,3,20);TAB(TC%(7));:print using l$;t1;
13015 print TAB(TC%(7)+12);:print using p$;p5;
13025 print TAB(TC%(7)+20);:print using l$;t3;
13030 print TAB(TC%(7)+32);:print using p$;p6:T3=0:T1=0:P9=P9+1
13995 RETURN
14000 REM PRINT GROSS PROFIT (LOSS) LINE
14005 print:P9=P9+1
14010 GOSUB 33000
14015 IF P1-(P2)<0 THEN 14035
14020 print TAB(TC%(8));"GROSS PROFIT (LOSS)";TAB(TC%(9));
      print using l$;p1-(p2);
14025 print TAB(TC%(9)+12);:print using p$;p5;
14030 GOTO 14050
14035 print TAB(TC%(8));"GROSS PROFIT (LOSS)";TAB(TC%(9)-1);"(";
      print using l$;p1-(p2);:PRINT ")";
14040 print TAB(TC%(9)+11);"(";:print using p$;p5;:PRINT ")";
14050 IF P3-(P4)<0 THEN 14135
14120 print TAB(TC%(9)+20);:print using l$;p3-(p4);
14125 print TAB(TC%(9)+32);:print using p$;p6:P9=P9+1
14130 GOTO 14490
14135 print TAB(TC%(9)+19);"(";:print using l$;p3-(p4);:PRINT ")";
14140 print TAB(TC%(9)+31);"(";:print using p$;p6;:PRINT ")":P9=P9+1
14490	print tab(TC%(9));"==========";tab(TC%(9)+12);"=====";
	print tab(TC%(9)+20);"==========";tab(TC%(9)+32);"=====":p9=p9+1
14495 RETURN
14500 REM PRINT NET PROFIT (LOSS) LINE
14505 print:P9=P9+1
14510 GOSUB 34000
14515 IF P1-(P2+P7)<0 THEN 14535
14520 print TAB(TC%(8));"NET PROFIT (LOSS)";TAB(TC%(9));
          print using l$;p1-(p2+p7);
14525 print TAB(TC%(9)+12);:print using p$;p5;
14530 GOTO 14550
14535 print TAB(TC%(8));"NET PROFIT (LOSS)";TAB(TC%(9)-1);
14540 print "(";:print using l$;p1-(p2+p7);
      print ")";TAB(TC%(9)+12);:print using p$;p5;
14550 IF P3-(P4+P8)<0 THEN 14635
14620 print TAB(TC%(9)+20);:print using l$;p3-(p4+p8);
14625 print TAB(TC%(9)+32);:print using p$;p6:P9=P9+1
14630 GOTO 14995
14635 print TAB(TC%(9)+19);"(";
      print using l$;p3-(p4+p8);:PRINT ")";
14640 print TAB(TC%(9)+31);"(";:print using p$;p6;:PRINT ")":P9=P9+1
14995	print tab(TC%(9));"**********";tab(TC%(9)+12);"*****";
	print tab(TC%(9)+20);"**********";tab(TC%(9)+32);"*****":p9=p9+1
	return
15000 REM GET ACCOUNTS IN SUBHEAD RANGE AND PRINT
15005 A(9)=A(9)+1
15006 IF P9>51 THEN GOSUB 9700
     read #1,a(9);n(2,1),n(2,2),k$(1,3),n(2,4),n(2,5),n(2,6),\
          n(2,7),n(2,8),n(2,9),n(2,10)
15105 IF N(2,2)=0 THEN 15995
     if n(2,x)=0 then 15990
15110 IF LEFT$(S$,2)<>"SS" AND LEFT$(S$,2)<>"SX" THEN 15990
15112 IF LEFT$(S$,2)="SS" THEN GOSUB 16000
15115 GOSUB 30000
15200 print TAB(TC%(5)+2);K$(1,3);TAB(TC%(5)+34);:print using l$;n(2,x);
15202 print TAB(TC%(5)+46);:print using p$;p5;
15215 print TAB(TC%(5)+54);:print using l$;n(2,(LA));
15220 print TAB(TC%(5)+66);:print using p$;p6:P9=P9+1
15230 T1=T1+N(2,X):T2=T2+N(2,X):T3=T3+N(2,(LA)):T4=T4+N(2,(LA))
15990 IF N(2,2)< S(1) THEN 15005
15995 RETURN
16000 FOR Z=4 TO 10:N(2,Z)=N(2,Z)*(-1):NEXT Z
16995 RETURN
20000 REM ROUTINE TO CLOSE FILES AND RETURN TO MASTER1
20010 CLOSE 1
20015 CLOSE 2
20040 CLOSE 3
20041 CONSOLE 
20050 CHAIN "master1"
30000 REM THESE ROUTINES CALCULATE PERCENTAGES AND ROUND TO ONE
30001 REM DECIMAL PLACE FOR INDIVIDUAL ACCOUNTS
30005 P5=0:P6=0
30010 P5=((N(2,X)/P1)*1000):P6=((N(2,LA)/P3)*1000)
30015 Z=P5-INT(P5)
30020 IF Z<.5 THEN P5=P5/10
30025 IF Z>=.5 THEN P5=(P5+1)/10
30115 Z=P6-INT(P6)
30120 IF Z<.5 THEN P6=P6/10
30125 IF Z>=.5 THEN P6=(P6+1)/10
30995 RETURN
31000 REM THESE ROUTINES CALCULATE PERCENTAGES AND ROUND TO ONE
31001 REM DECIMAL PLACE FOR SUBTOTALS
31005 P5=0:P6=0
31010 P5=((T1/P1)*1000):P6=((T3/P3)*1000)
31015 Z=P5-INT(P5)
31020 IF Z<.5 THEN P5=P5/10
31025 IF Z>=.5 THEN P5=(P5+1)/10
31115 Z=P6-INT(P6)
31120 IF Z<.5 THEN P6=P6/10
31125 IF Z>=.5 THEN P6=(P6+1)/10
31995 RETURN
32000 REM THESE ROUTINES CALCULATE PERCENTAGES AND ROUND TO ONE
32001 REM DECIMAL PLACE FOR FINAL TOTALS
32005 P5=0:P6=0
32010 P5=((T2/P1)*1000):P6=((T4/P3)*1000)
32015 Z=P5-INT(P5)
32020 IF Z<.5 THEN P5=P5/10
32025 IF Z>=.5 THEN P5=(P5+1)/10
32115 Z=P6-INT(P6)
32120 IF Z<.5 THEN P6=P6/10
32125 IF Z>=.5 THEN P6=(P6+1)/10
32995 RETURN
33000 REM THESE ROUTINES CALCULATE PERCENTAGES AND ROUND TO ONE
33001 REM DECIMAL PLACE FOR GROSS PROFIT
33005 P5=0:P6=0
33010 P5=(((P1-P2)/P1)*1000):P6=(((P3-P4)/P3)*1000)
33015 Z=P5-INT(P5)
33020 IF Z<.5 THEN P5=P5/10
33025 IF Z>=.5 THEN P5=(P5+1)/10
33115 Z=P6-INT(P6)
33120 IF Z<.5 THEN P6=P6/10
33125 IF Z>=.5 THEN P6=(P6+1)/10
33995 RETURN
34000 REM THESE ROUTINES CALCULATE PERCENTAGES AND ROUND TO ONE
34001 REM DECIMAL PLACE FOR NET PROFIT
34005 P5=0:P6=0
34010 P5=(((P1-P2-P7)/P1)*1000):P6=(((P3-P4-P8)/P3)*1000)
34015 Z=P5-INT(P5)
34020 IF Z<.5 THEN P5=P5/10
34025 IF Z>=.5 THEN P5=(P5+1)/10
34115 Z=P6-INT(P6)
34120 IF Z<.5 THEN P6=P6/10
34125 IF Z>=.5 THEN P6=(P6+1)/10
34995 RETURN