home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / cpmug / cpmug090.ark / GCINCOME.BAS < prev    next >
BASIC Source File  |  1984-04-29  |  11KB  |  323 lines
  1.      rem This is the Comparative Income Statement Printer
  2.  
  3. %INCLUDE ALL.BAS
  4.      dim TC%(11),n(2,12),k$(2,10),h(9),s(9),t(4,9)
  5.      RESTORE
  6.     P0=1
  7.     HEAD2$="MONTH TO DATE"
  8.     HEAD3$="QUARTER T/DATE"
  9.     HEAD4$="YEAR TO DATE"
  10. 1009 PRINT clear$:PRINT
  11.     HEAD=0
  12. 1010    PRINT "IS THIS INCOME STATEMENT TO BE FOR THE :"
  13.     PRINT
  14.     PRINT "MONTH TO DATE"
  15.     PRINT:PRINT "QUARTER TO DATE"
  16.     PRINT:PRINT "YEAR TO DATE"
  17.     PRINT
  18.     INPUT "  (M, Q, OR Y) ";LINE LA$
  19.     IF UCASE$(LA$)="M" THEN X=4:GOTO 1020
  20.     IF UCASE$(LA$)="Q" THEN X=5:GOTO 1020
  21.     IF UCASE$(LA$)="Y" THEN X=6:GOTO 1020
  22.     GOTO 1009
  23. 1020    REM NOW FOR THE COMPARATIVE SIDE
  24.     IF X=4 THEN HEAD$=HEAD2$
  25.     IF X=5 THEN HEAD$=HEAD3$
  26.     IF X=6 THEN HEAD$=HEAD4$
  27.     PRINT CLEAR$
  28.     PRINT "WHAT KIND OF COMPARATIVE STATEMENT WILL THIS BE :"
  29.     PRINT:PRINT "MONTH TO DATE"
  30.     PRINT:PRINT "QUARTER TO DATE"
  31.     PRINT:PRINT "YEAR TO DATE"
  32.     PRINT:PRINT "PREVIOUS MONTH TO DATE"
  33.     PRINT:PRINT "PREVIOUS QUARTER TO DATE"
  34.     PRINT:PRINT "PREVIOUS YEAR TO DATE"
  35.     PRINT
  36.     INPUT "  (M, Q, Y, PM, PQ, OR PY) ";LINE LA1$
  37.     IF UCASE$(LA1$)="M" THEN LA=4:GOTO 1030
  38.     IF UCASE$(LA1$)="Q" THEN LA=5:GOTO 1030
  39.     IF UCASE$(LA1$)="Y" THEN LA=6:GOTO 1030
  40.     IF UCASE$(LA1$)="PM" THEN LA=7:GOTO 1030
  41.     IF UCASE$(LA1$)="PQ" THEN LA=8:GOTO 1030
  42.     IF UCASE$(LA1$)="PY" THEN LA=9:GOTO 1030
  43.     GOTO 1020
  44. 1030    HEAD=0
  45.     IF LEFT$(LA1$,1)="P" OR LEFT$(LA1$,1)="p" THEN HEAD=1
  46.     IF LA=4 OR LA=7 THEN HEAD1$=HEAD2$:GOTO 1035
  47.     IF LA=5 OR LA=8 THEN HEAD1$=HEAD3$:GOTO 1035
  48.     IF LA=6 OR LA=9 THEN HEAD1$=HEAD4$
  49. 1035    REM
  50. 1075 Q$="COMPARATIVE INCOME STATEMENT"
  51. 1200 REM READ TAB VALUES ROUTINE
  52.     for z=1 to 11:read TC%(z):next z
  53.     data 72,2,10,22,2,4,36,6,36,2,57
  54. 1300 REM READ FORMAT STRINGS FOR % AND $ VALUES
  55.     l$="##,###,###":p$="###.#"
  56. 3000 REM READ NAME FILE SUBROUTINE
  57. 3005 a5=t%(12)
  58. 3080 Z=24:Z9=1
  59. 3090 FOR Z0=1 TO 4
  60. 3100 K$(0,Z0)=MID$(N$,Z9,Z)
  61. 3110 Z9=Z9+Z
  62. 3120 NEXT Z0
  63. 3125 REM ROUTINE TO ELIMINATE TRAILING BLANKS
  64.      l8=1
  65. 3130 FOR I=1 TO 4
  66.      l9=len(k$(0,i))
  67. 3140 for z=l9 to l8 step -1
  68. 3150 IF MID$(K$(0,I),Z,1)<>" " THEN 3170
  69. 3160 NEXT Z
  70. 3170 Z$=""
  71. 3180 FOR Z0=1 TO Z
  72. 3190 Z$=Z$+MID$(K$(0,I),Z0,1)
  73. 3200 NEXT Z0
  74. 3210 K$(0,I)="":K$(0,I)=Z$
  75. 3220 NEXT I
  76. 4000 REM GET TOTAL SALES AND COST OF GOODS SOLD AS P1/P3 AND P2/P4
  77. 4001 REM GET TOTAL OPERATING EXPENSES AS P7/P8
  78. 4002 P1=0:P2=0:P3=0:P4=0:P5=0:P6=0:P7=0:P8=0
  79. 4005 open "b:glh" recl 150 as 1
  80. 4010 FOR Z=1 TO 30
  81. 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)
  82. 4020 IF LEFT$(H$,2)="HS" THEN 4030
  83. 4025 NEXT Z
  84. 4030 close 1
  85. 4035 open "b:gl" recl 138 as 1
  86. 4040 A(9)=A(9)+1
  87. 4045 read #1,a(9);N(2,1),N(2,2),K$,N(2,4),\
  88.           N(2,5),N(2,6),N(2,7),N(2,8),N(2,9),N(2,10)
  89. 4070 IF N(2,2)=0 THEN 4100
  90. 4075 IF N(2,2)>=H(0) AND N(2,2)<=H(1) THEN P1=P1+N(2,X):P3=P3+N(2,LA)
  91. 4080 IF N(2,2)>=A(15) AND N(2,2)<=A(16) THEN P2=P2+N(2,X):P4=P4+N(2,LA)
  92. 4085 IF N(2,2)>A(16) THEN P7=P7+N(2,X):P8=P8+N(2,LA)
  93. 4090 GOTO 4040
  94. 4100 IF P1<>0 THEN P1=P1*(-1)
  95. 4105 IF P1=0 THEN P1=999999999999
  96. 4110 IF P2=0 THEN P2=999999999999
  97. 4115 IF P3<>0 THEN P3=P3*(-1)
  98. 4120 IF P3=0 THEN P3=999999999999
  99. 4130 IF P4=0 THEN P4=999999999999
  100. 4140 IF P5=0 THEN P5=999999999999
  101. 4150 IF P6=0 THEN P6=999999999999
  102. 4160 IF P7=0 THEN P7=999999999999
  103. 4170 IF P8=0 THEN P8=999999999999
  104. 4990 A(9)=1
  105. 4995 close 1
  106. 6000 REM PRINT INCOME STATEMENT
  107. 6005 PRINT clear$:PRINT
  108. 6010 PRINT "PRINTING INCOME STATEMENT"
  109. 6015 FOR Z=0 TO 9
  110. 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
  111. 6025 NEXT Z
  112. 6030 T1=0:T2=0:T3=0:T4=0
  113. 6100 lprinter:P9=0
  114.      open "b:gl" recl 138 as 1
  115.      open "b:glh" recl 150 as 2
  116.      open "b:gls" recl 150 as 3
  117. 6200 GOSUB 9600
  118. 6250 GOSUB 10000
  119. 6255 IF N(2,2)=0 THEN 6400
  120. 6300 GOSUB 11000
  121. 6350 GOSUB 15000
  122. 6355 IF LEFT$(S$,2)<>"SS" AND LEFT$(S$,2)<>"SX" THEN 6980
  123. 6400 REM DO PARTIAL TOTALS OR TOTALS AND TEST
  124.  
  125.  
  126. 6403 IF N(2,2)=0 THEN GOSUB 14500
  127. 6404 IF N(2,2)=0 THEN FOR Z=1 TO 51-P9:print:NEXT Z:GOSUB 9800
  128. 6405 IF N(2,2)=0 THEN 20000
  129. 6410 GOSUB 13000
  130.     IF S(1)=H(1) THEN GOSUB 12000
  131. 6415 IF S(1)=A(16) THEN GOSUB 14000
  132. 6980 IF P9>56 THEN GOSUB 9700
  133.     IF S(1)< H(1) THEN 6300
  134. 6995 GOTO 6250
  135. 9600 REM PRINT PAGE HEADING SUBROUTINE
  136. 9610 print:P9=P9+1
  137.     REM 9615 print:P9=P9+1
  138. 9616 print TAB((TC%(1)-LEN(Q$))/2);Q$:P9=P9+1
  139. 9617 print:P9=P9+1
  140. 9620 FOR Z=2 TO 4
  141. 9625 print TAB((TC%(1)-LEN(K$(0,Z)))/2);K$(0,Z):P9=P9+1
  142. 9630 NEXT Z
  143. 9635 print:P9=P9+1
  144. 9640 print TAB(TC%(10));"FOR PERIOD ENDING ";D$(X);TAB(TC%(11));"PAGE #";P0
  145. 9642 P9=P9+1
  146.     PRINT
  147.     IF HEAD=1 THEN PRINT TAB(62);"PREVIOUS"
  148.     IF HEAD=0 THEN PRINT
  149.     PRINT
  150.     PRINT TAB(40);HEAD$;TAB(60);HEAD1$:P9=P9+1
  151.      print tab(40);"-------------";tab(60);"-------------"
  152.      print tab(40);"Amount";tab(50);"Pct";tab(60);"Amount";tab(70);"Pct"
  153.      p9=p9+2
  154. 9645 print:P9=P9+1
  155. 9670 RETURN
  156. 9700 REM REPORT CONTINUED SUBROUTINE
  157.      print
  158.      print "report continues on next page"
  159.      print
  160. 9720 print chr$(12):P9=0
  161. 9725 P0=P0+1
  162.     GOSUB 9600
  163. 9740 RETURN
  164. 9800 REM END OF REPORT ROUTINE
  165.      print
  166.      print "end of report"
  167.      print
  168. 9840 print chr$(12)
  169. 9845 REM
  170. 9850 RETURN
  171. 10000 REM GET HEADING LINE AND PRINT
  172. 10005 H(9)=H(9)+1
  173.      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)
  174. 10015 IF LEFT$(H$,2)<>"HS" AND LEFT$(H$,2)<>"HX" THEN 10995
  175. 10020 print:print:print TAB(TC%(4));RIGHT$(H$,30):P9=P9+1
  176. 10995 RETURN
  177. 11000 REM GET SUBHEADING LINE AND PRINT
  178. 11005 S(9)=S(9)+1
  179.      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)
  180. 11012 IF LEFT$(S$,2)<>"SS" AND LEFT$(S$,2)<>"SX" THEN 11995
  181. 11015 print TAB(TC%(5));RIGHT$(S$,30):P9=P9+1
  182. 11995 RETURN
  183. 12000 REM PRINT FINAL TOTAL LINE
  184. 12005 IF LEFT$(H$,2)<>"HS" AND LEFT$(H$,2)<>"HX" THEN 12995
  185. 12010 print:P9=P9+1
  186. 12015 GOSUB 32000
  187. 12020 print TAB(TC%(8));"TOTAL "+MID$(H$,3,20);TAB(TC%(9));:print using l$;t2;
  188. 12025 print TAB(TC%(9)+12);:print using p$;p5;
  189. 12035 print TAB(TC%(9)+20);:print using l$;t4;
  190. 12040 print TAB(TC%(9)+32);:print using p$;p6:P9=P9+1
  191.     print tab(TC%(9));"----------";tab(TC%(9)+12);"-----";
  192.     print tab(TC%(9)+20);"----------";tab(TC%(9)+32);"-----":p9=p9+1
  193. 12990 T1=0:T2=0:T3=0:T4=0
  194. 12995 RETURN
  195. 13000 REM PRINT SUBTOTAL LINE
  196. 13005 GOSUB 31000
  197. 13010 print TAB(TC%(6));"TOTAL "+MID$(S$,3,20);TAB(TC%(7));:print using l$;t1;
  198. 13015 print TAB(TC%(7)+12);:print using p$;p5;
  199. 13025 print TAB(TC%(7)+20);:print using l$;t3;
  200. 13030 print TAB(TC%(7)+32);:print using p$;p6:T3=0:T1=0:P9=P9+1
  201. 13995 RETURN
  202. 14000 REM PRINT GROSS PROFIT (LOSS) LINE
  203. 14005 print:P9=P9+1
  204. 14010 GOSUB 33000
  205. 14015 IF P1-(P2)<0 THEN 14035
  206. 14020 print TAB(TC%(8));"GROSS PROFIT (LOSS)";TAB(TC%(9));
  207.       print using l$;p1-(p2);
  208. 14025 print TAB(TC%(9)+12);:print using p$;p5;
  209. 14030 GOTO 14050
  210. 14035 print TAB(TC%(8));"GROSS PROFIT (LOSS)";TAB(TC%(9)-1);"(";
  211.       print using l$;p1-(p2);:PRINT ")";
  212. 14040 print TAB(TC%(9)+11);"(";:print using p$;p5;:PRINT ")";
  213. 14050 IF P3-(P4)<0 THEN 14135
  214. 14120 print TAB(TC%(9)+20);:print using l$;p3-(p4);
  215. 14125 print TAB(TC%(9)+32);:print using p$;p6:P9=P9+1
  216. 14130 GOTO 14490
  217. 14135 print TAB(TC%(9)+19);"(";:print using l$;p3-(p4);:PRINT ")";
  218. 14140 print TAB(TC%(9)+31);"(";:print using p$;p6;:PRINT ")":P9=P9+1
  219. 14490    print tab(TC%(9));"==========";tab(TC%(9)+12);"=====";
  220.     print tab(TC%(9)+20);"==========";tab(TC%(9)+32);"=====":p9=p9+1
  221. 14495 RETURN
  222. 14500 REM PRINT NET PROFIT (LOSS) LINE
  223. 14505 print:P9=P9+1
  224. 14510 GOSUB 34000
  225. 14515 IF P1-(P2+P7)<0 THEN 14535
  226. 14520 print TAB(TC%(8));"NET PROFIT (LOSS)";TAB(TC%(9));
  227.           print using l$;p1-(p2+p7);
  228. 14525 print TAB(TC%(9)+12);:print using p$;p5;
  229. 14530 GOTO 14550
  230. 14535 print TAB(TC%(8));"NET PROFIT (LOSS)";TAB(TC%(9)-1);
  231. 14540 print "(";:print using l$;p1-(p2+p7);
  232.       print ")";TAB(TC%(9)+12);:print using p$;p5;
  233. 14550 IF P3-(P4+P8)<0 THEN 14635
  234. 14620 print TAB(TC%(9)+20);:print using l$;p3-(p4+p8);
  235. 14625 print TAB(TC%(9)+32);:print using p$;p6:P9=P9+1
  236. 14630 GOTO 14995
  237. 14635 print TAB(TC%(9)+19);"(";
  238.       print using l$;p3-(p4+p8);:PRINT ")";
  239. 14640 print TAB(TC%(9)+31);"(";:print using p$;p6;:PRINT ")":P9=P9+1
  240. 14995    print tab(TC%(9));"**********";tab(TC%(9)+12);"*****";
  241.     print tab(TC%(9)+20);"**********";tab(TC%(9)+32);"*****":p9=p9+1
  242.     return
  243. 15000 REM GET ACCOUNTS IN SUBHEAD RANGE AND PRINT
  244. 15005 A(9)=A(9)+1
  245. 15006 IF P9>51 THEN GOSUB 9700
  246.      read #1,a(9);n(2,1),n(2,2),k$(1,3),n(2,4),n(2,5),n(2,6),\
  247.           n(2,7),n(2,8),n(2,9),n(2,10)
  248. 15105 IF N(2,2)=0 THEN 15995
  249.      if n(2,x)=0 then 15990
  250. 15110 IF LEFT$(S$,2)<>"SS" AND LEFT$(S$,2)<>"SX" THEN 15990
  251. 15112 IF LEFT$(S$,2)="SS" THEN GOSUB 16000
  252. 15115 GOSUB 30000
  253. 15200 print TAB(TC%(5)+2);K$(1,3);TAB(TC%(5)+34);:print using l$;n(2,x);
  254. 15202 print TAB(TC%(5)+46);:print using p$;p5;
  255. 15215 print TAB(TC%(5)+54);:print using l$;n(2,(LA));
  256. 15220 print TAB(TC%(5)+66);:print using p$;p6:P9=P9+1
  257. 15230 T1=T1+N(2,X):T2=T2+N(2,X):T3=T3+N(2,(LA)):T4=T4+N(2,(LA))
  258. 15990 IF N(2,2)< S(1) THEN 15005
  259. 15995 RETURN
  260. 16000 FOR Z=4 TO 10:N(2,Z)=N(2,Z)*(-1):NEXT Z
  261. 16995 RETURN
  262. 20000 REM ROUTINE TO CLOSE FILES AND RETURN TO MASTER1
  263. 20010 CLOSE 1
  264. 20015 CLOSE 2
  265. 20040 CLOSE 3
  266. 20041 CONSOLE 
  267. 20050 CHAIN "master1"
  268. 30000 REM THESE ROUTINES CALCULATE PERCENTAGES AND ROUND TO ONE
  269. 30001 REM DECIMAL PLACE FOR INDIVIDUAL ACCOUNTS
  270. 30005 P5=0:P6=0
  271. 30010 P5=((N(2,X)/P1)*1000):P6=((N(2,LA)/P3)*1000)
  272. 30015 Z=P5-INT(P5)
  273. 30020 IF Z<.5 THEN P5=P5/10
  274. 30025 IF Z>=.5 THEN P5=(P5+1)/10
  275. 30115 Z=P6-INT(P6)
  276. 30120 IF Z<.5 THEN P6=P6/10
  277. 30125 IF Z>=.5 THEN P6=(P6+1)/10
  278. 30995 RETURN
  279. 31000 REM THESE ROUTINES CALCULATE PERCENTAGES AND ROUND TO ONE
  280. 31001 REM DECIMAL PLACE FOR SUBTOTALS
  281. 31005 P5=0:P6=0
  282. 31010 P5=((T1/P1)*1000):P6=((T3/P3)*1000)
  283. 31015 Z=P5-INT(P5)
  284. 31020 IF Z<.5 THEN P5=P5/10
  285. 31025 IF Z>=.5 THEN P5=(P5+1)/10
  286. 31115 Z=P6-INT(P6)
  287. 31120 IF Z<.5 THEN P6=P6/10
  288. 31125 IF Z>=.5 THEN P6=(P6+1)/10
  289. 31995 RETURN
  290. 32000 REM THESE ROUTINES CALCULATE PERCENTAGES AND ROUND TO ONE
  291. 32001 REM DECIMAL PLACE FOR FINAL TOTALS
  292. 32005 P5=0:P6=0
  293. 32010 P5=((T2/P1)*1000):P6=((T4/P3)*1000)
  294. 32015 Z=P5-INT(P5)
  295. 32020 IF Z<.5 THEN P5=P5/10
  296. 32025 IF Z>=.5 THEN P5=(P5+1)/10
  297. 32115 Z=P6-INT(P6)
  298. 32120 IF Z<.5 THEN P6=P6/10
  299. 32125 IF Z>=.5 THEN P6=(P6+1)/10
  300. 32995 RETURN
  301. 33000 REM THESE ROUTINES CALCULATE PERCENTAGES AND ROUND TO ONE
  302. 33001 REM DECIMAL PLACE FOR GROSS PROFIT
  303. 33005 P5=0:P6=0
  304. 33010 P5=(((P1-P2)/P1)*1000):P6=(((P3-P4)/P3)*1000)
  305. 33015 Z=P5-INT(P5)
  306. 33020 IF Z<.5 THEN P5=P5/10
  307. 33025 IF Z>=.5 THEN P5=(P5+1)/10
  308. 33115 Z=P6-INT(P6)
  309. 33120 IF Z<.5 THEN P6=P6/10
  310. 33125 IF Z>=.5 THEN P6=(P6+1)/10
  311. 33995 RETURN
  312. 34000 REM THESE ROUTINES CALCULATE PERCENTAGES AND ROUND TO ONE
  313. 34001 REM DECIMAL PLACE FOR NET PROFIT
  314. 34005 P5=0:P6=0
  315. 34010 P5=(((P1-P2-P7)/P1)*1000):P6=(((P3-P4-P8)/P3)*1000)
  316. 34015 Z=P5-INT(P5)
  317. 34020 IF Z<.5 THEN P5=P5/10
  318. 34025 IF Z>=.5 THEN P5=(P5+1)/10
  319. 34115 Z=P6-INT(P6)
  320. 34120 IF Z<.5 THEN P6=P6/10
  321. 34125 IF Z>=.5 THEN P6=(P6+1)/10
  322. 34995 RETURN
  323.