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