home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / cpmug / cpmug090.ark / GLBALSHT.BAS < prev    next >
Encoding:
BASIC Source File  |  1984-04-29  |  4.5 KB  |  146 lines
  1.      rem This is the General Ledger Balance Sheet Printer
  2.  
  3. %INCLUDE ALL.BAS
  4.      dim n(2,12),k$(2,10),h(9),s(9),t(4,9)
  5.      RESTORE
  6. 1009 PRINT clear$:PRINT
  7.     A(9)=0
  8. 1010 PRINT "IS THIS BALANCE SHEET TO BE FOR THE MONTH TO DATE,"
  9. 1011 PRINT "QUARTER TO DATE, OR YEAR TO DATE (M, Q, OR Y)?"
  10. 1015 INPUT Z$
  11. 1017 IF ucase$(Z$)="M" THEN X=4:GOTO 1025
  12. 1020 IF ucase$(Z$)="Q" THEN X=5:GOTO 1025
  13. 1021 IF ucase$(Z$)="Y" THEN X=6:GOTO 1025
  14. 1023 GOTO 1010
  15. 1025 PRINT:PRINT"DO YOU WANT AN ORDINARY OR A COMPARATIVE"
  16. 1028 PRINT"BALANCE SHEET (O OR C) ?"
  17. 1030 INPUT U$
  18. 1050 PRINT clear$:PRINT
  19. 1075 IF ucase$(U$)="C" THEN Q$="COMPARATIVE BALANCE SHEET"
  20. 1076 IF ucase$(U$)="C" THEN GOTO 1100
  21. 1080 Q$="B A L A N C E  S H E E T"
  22. 1100 REM
  23. 3000 rem READ NAME FILE SUBROUTINE
  24. 3005 a5=t%(12)
  25. 3080 Z=24:Z9=1
  26. 3090 FOR Z0=1 TO 4
  27. 3100 K$(0,Z0)=MID$(N$,Z9,Z)
  28. 3110 Z9=Z9+Z
  29. 3120 NEXT Z0
  30. 3125 rem ROUTINE TO ELIMINATE TRAILING BLANKS
  31.      l8=1
  32. 3130 FOR I=1 TO 4
  33.      l9=len(k$(0,i))
  34. 3140 for z=l9 to l8 step -1
  35. 3150 IF MID$(K$(0,I),Z,1)<>" " THEN 3170
  36. 3160 NEXT Z
  37. 3170 Z$=""
  38. 3180 FOR Z0=1 TO Z
  39. 3190 Z$=Z$+MID$(K$(0,I),Z0,1)
  40. 3200 NEXT Z0
  41. 3210 K$(0,I)="":K$(0,I)=Z$
  42. 3220 NEXT I
  43. 6000 rem PRINT BALANCE SHEET
  44. 6005 PRINT clear$:PRINT
  45. 6010 PRINT "PRINTING BALANCE SHEET"
  46. 6015 FOR Z=0 TO 9
  47. 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
  48. 6025 NEXT Z
  49. 6030 T1=0:T2=0:T3=0:T4=0
  50.      lprinter
  51.      open "b:gl" recl 138 as 1
  52.      open "b:glh" recl 150 as 2
  53.      open "b:gls" recl 150 as 3
  54. 6200 GOSUB 9600
  55. 6250 GOSUB 10000
  56. 6255 IF N(2,2)=0 THEN 6403
  57. 6300 GOSUB 11000
  58. 6350 GOSUB 15000
  59. 6400 rem DO PARTIAL TOTALS OR TOTALS AND TEST
  60. 6403 IF N(2,2)=0 THEN FOR Z=1 TO 51-P9:print:NEXT Z:GOSUB 9800
  61. 6405 IF N(2,2)=0 THEN 20000
  62. 6410 print:print TAB(t%(6));"TOTAL "+MID$(S$,3,20);TAB(t%(7));
  63.           print using l$;abs(t1):T1=0:P9=P9+1
  64.         print tab(t%(7));"-------------":p9=p9+1
  65. 6415 IF ucase$(U$)<>"C" THEN 6980
  66. 6420 print TAB(t%(6));"PREVIOUS";TAB(t%(7));
  67.           print using l$;abs(t3):T3=0:P9=P9+1
  68.         print tab(t%(7));"-------------":p9=p9+1
  69. 6980 IF P9>51 THEN GOSUB 9700
  70. 6985 IF S(1)< H(1) THEN 6300
  71. 6990 IF S(1)=H(1) THEN GOSUB 12000
  72. 6995 GOTO 6250
  73. 9600 rem PRINT PAGE HEADING SUBROUTINE
  74. 9605 P0=1
  75.     GOSUB 9610
  76.     RETURN
  77. 9610 print:P9=P9+1
  78. 9615 print:P9=P9+1
  79. 9616 print TAB((t%(1)-LEN(Q$))/2);Q$:P9=P9+1
  80. 9617 print:P9=P9+1
  81. 9620 FOR Z=2 TO 4
  82. 9625 print TAB((t%(1)-LEN(K$(0,Z)))/2);K$(0,Z):P9=P9+1
  83. 9630 NEXT Z
  84. 9635 print:P9=P9+1
  85. 9640 print TAB(t%(10));"AS OF ";D$(X);TAB(t%(11));"PAGE #";P0:P9=P9+1
  86. 9645 print:P9=P9+1
  87. 9670 RETURN
  88. 9700 rem REPORT CONTINUED SUBROUTINE
  89.     print:print
  90. 9710 print "report continues on next page"
  91. 9720 print chr$(12):P9=0
  92. 9725 P0=P0+1
  93.     GOSUB 9610
  94. 9740 RETURN
  95. 9800 rem end of report ROUTINE
  96. 9820 print "end of report"
  97. 9840 print chr$(12)
  98. 9850 RETURN
  99. 10000 rem GET HEADING LINE AND PRINT
  100. 10005 H(9)=H(9)+1
  101. 10006 if p9>51 then gosub 9700
  102.       read #2,h(9);n(2,1),n(2,2),h$,h(0),h(1),h(2),h(3),\
  103.            h(4),h(5),h(6),h(7)
  104. 10015 IF LEFT$(H$,2)="HS" OR LEFT$(H$,2)="HX" THEN N(2,2)=0:GOTO 10995
  105. 10020 print TAB(t%(4));mid$(h$,3,28):print:P9=P9+2
  106. 10995 RETURN
  107. 11000 rem GET SUBHEADING LINE AND PRINT
  108. 11005 S(9)=S(9)+1
  109. 11006 if p9>51 then gosub 9700
  110.       read #3,s(9);n(2,1),n(2,2),s$,s(0),s(1),s(2),s(3),\
  111.            s(4),s(5),s(6),s(7)
  112. 11015 print:print TAB(t%(5));mid$(s$,3,28):print:P9=P9+3
  113. 11995 RETURN
  114. 12000 rem PRINT FINAL TOTAL LINE
  115. 12010 print:P9=P9+1
  116. 12020 print TAB(t%(8));"TOTAL "+MID$(H$,3,20);TAB(t%(9));
  117.           print using l$;abs(t2):P9=P9+1
  118.         print tab(t%(9));"=============":p9=p9+1
  119. 12025 IF ucase$(U$)<>"C" THEN 12990
  120. 12030 print TAB(t%(8));"PREVIOUS";TAB(t%(9));
  121.           print using l$;abs(t4):P9=P9+1
  122.         print tab(t%(9));"=============":p9=p9+1
  123. 12990 print:print:p9=p9+2:T1=0:T2=0:T3=0:T4=0
  124. 12995 RETURN
  125. 15000 rem GET ACCOUNTS IN SUBHEAD RANGE AND PRINT
  126. 15005 A(9)=A(9)+1
  127. 15006 IF P9>51 THEN GOSUB 9700
  128.       read #1,a(9);n(2,1),n(2,2),k$(1,3),n(2,4),n(2,5),n(2,6),\
  129.            n(2,7),n(2,8),n(2,9),n(2,10)
  130.       if n(2,2)=0 then 15995
  131.     if n(2,x)=0 AND n(2,(x+3))=0 then 15990
  132. 15200 print TAB(t%(5)+2);K$(1,3);TAB(t%(5)+34);
  133.           print using l$;abs(n(2,x)):P9=P9+1
  134. 15205 T1=T1+N(2,X):T2=T2+N(2,X):T3=T3+N(2,(X+3)):T4=T4+N(2,(X+3))
  135. 15210 IF ucase$(U$)<>"C" THEN 15990
  136. 15215 print TAB(t%(5)+2);"PREVIOUS";TAB(t%(5)+34);
  137.           print using l$;abs(n(2,(x+3))):P9=P9+1
  138. 15990 IF N(2,2)< S(1) THEN 15005
  139. 15995 RETURN
  140. 20000 rem ROUTINE TO CLOSE FILES AND RETURN TO MASTER1
  141.         close 1
  142.         close 2
  143.         close 3
  144.         console
  145. 20050 CHAIN "master1"
  146.