home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / cpmug / cpmug090.ark / GLCHART.BAS < prev    next >
Encoding:
BASIC Source File  |  1984-04-29  |  3.3 KB  |  119 lines
  1.      rem This is the General Ledger Chart of Accounts Printer
  2.  
  3. %INCLUDE ALL.BAS
  4.      dim n(2,12),k$(2,10),h(9),s(9),t(4,9)
  5.      RESTORE
  6. 1025 PRINT clear$:PRINT
  7. 1045 Q$="G E N E R A L  L E D G E R  C H A R T  O F  A C C O U N T S"
  8. 3005 a5=t%(12)
  9. 3080 Z=24:Z9=1
  10. 3090 FOR Z0=1 TO 4
  11. 3100 K$(0,Z0)=MID$(N$,Z9,Z)
  12. 3110 Z9=Z9+Z
  13. 3120 NEXT Z0
  14. 3125 rem ROUTINE TO ELIMINATE TRAILING BLANKS
  15.      l8=1
  16. 3130 FOR I=1 TO 4
  17.      l9=len(k$(0,i))
  18. 3140 FOR Z=l9 TO l8 STEP -1
  19. 3150 IF MID$(K$(0,I),Z,1)<>" " THEN 3170
  20. 3160 NEXT Z
  21. 3170 Z$=""
  22. 3180 FOR Z0=1 TO Z
  23. 3190 Z$=Z$+MID$(K$(0,I),Z0,1)
  24. 3200 NEXT Z0
  25. 3210 K$(0,I)="":K$(0,I)=Z$
  26. 3220 NEXT I
  27. 6000 rem PRINT CHART OF ACCOUNTS
  28. 6005 PRINT clear$:PRINT
  29. 6010 PRINT "PRINTING CHART OF ACCOUNTS"
  30. 6015 FOR Z=0 TO 9
  31. 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
  32. 6025 NEXT Z
  33.      lprinter
  34.      open "b:gl" recl 138 as 1
  35.      open "b:glh" recl 150 as 2
  36.      open "b:gls" recl 150 as 3
  37.      p9=0
  38. 6200 GOSUB 9600
  39. 6250 GOSUB 10000
  40. 6300 GOSUB 11000
  41. 6350 GOSUB 15000
  42. 6400 rem DO PARTIAL TOTALS OR TOTALS AND TEST
  43. 6410 print TAB(t%(6));"TOTAL "+mid$(s$,3,28):P9=P9+1
  44. 6415 IF P9>51 THEN GOSUB 9700
  45. 6420 IF S(1)< H(1) THEN 6300
  46. 6430 IF S(1)=H(1) THEN GOSUB 12000
  47. 6435 IF N(2,2)=0 THEN FOR Z=1 TO 51-P9:print:next z:GOSUB 9800 
  48. 6440 IF N(2,2)=0 THEN 20000
  49. 6450 GOTO 6250
  50. 9600 rem PRINT PAGE HEADING SUBROUTINE
  51. 9605 P0=1
  52. 9610 print
  53. 9615 print:P9=P9+2
  54. 9616 print TAB((t%(1)-LEN(Q$))/2);Q$:print:P9=P9+2
  55. 9620 FOR Z=2 TO 3
  56. 9625 print TAB((t%(1)-LEN(K$(0,Z)))/2);K$(0,Z):P9=P9+1
  57. 9630 NEXT Z
  58. 9631 PRINT TAB((T%(1)-LEN(K$(0,4)))/2);LEFT$(K$(0,4),17);
  59. 9632 PRINT MID$(K$(0,4),18,2);"  ";MID$(K$(0,4),20,5)
  60. 9635 print:P9=P9+1
  61. 9640 print TAB(t%(10));D$(1);TAB(t%(11));"PAGE #";P0:P9=P9+1
  62. 9645 print
  63. 9650 print:P9=P9+2
  64. 9655 RETURN
  65. 9700 rem REPORT CONTINUED SUBROUTINE
  66.      print
  67.      print "report continues on next page"
  68.      print
  69. 9720 print chr$(12):P9=0
  70. 9725 P0=P0+1
  71. 9730 FOR Z=1 TO 3:print:P9=P9+1:next z:print TAB(t%(11));"PAGE #";P0:P9=P9+1
  72. 9735 print:P9=P9+1
  73. 9740 RETURN
  74. 9800 rem END OF REPORT ROUTINE
  75.      print
  76.      print "end of report"
  77.      print
  78. 9840 print chr$(12)
  79. 9845 FOR Z=1 TO 100:NEXT Z:print chr$(12)
  80. 9850 RETURN
  81. 10000 rem GET HEADING LINE AND PRINT
  82. 10005 H(9)=H(9)+1
  83. 10006 IF P9>51 THEN GOSUB 9700
  84.      read #2,h(9);n(2,1),n(2,2),h$,h(0),h(1),h(2),h(3),\
  85.           h(4),h(5),h(6),h(7)
  86. 10015 print TAB(t%(4));mid$(h$,3,28):P9=P9+1
  87. 10995 RETURN
  88. 11000 rem GET SUBHEADING LINE AND PRINT
  89. 11005 S(9)=S(9)+1
  90. 11006 IF P9>51 THEN GOSUB 9700
  91.       read #3,s(9);n(2,1),n(2,2),s$,s(0),s(1),s(2),s(3),\
  92.            s(4),s(5),s(6),s(7)
  93. 11015 print TAB(t%(5));mid$(s$,3,28):P9=P9+1
  94. 11995 RETURN
  95. 12000 rem PRINT FINAL TOTAL LINE
  96. 12010 print:P9=P9+1
  97. 12020 print TAB(t%(8));"TOTAL "+mid$(h$,3,28):P9=P9+1
  98. 12025 IF P9>51 THEN GOSUB 9700
  99. 12030 print :P9=P9+1
  100. 12040 RETURN
  101. 15000 rem GET ACCOUNTS IN SUBHEAD RANGE AND PRINT
  102. 15005 A(9)=A(9)+1
  103. 15010 IF P9>51 THEN GOSUB 9700
  104.       read #1,a(9);n(2,1),n(2,2),k$(0,3),n(2,4),n(2,5),n(2,6),\
  105.            n(2,7),n(2,8),n(2,9),n(2,10)
  106. 15105 IF N(2,2)=0 THEN 15995
  107. 15106 IF N(2,2)<=S(1) THEN 15110  
  108. 15107 A(9)=A(9)-1 
  109. 15108 GOTO 15995 
  110. 15110 print A(9);TAB(6);N(2,2);K$(0,3):P9=P9+1
  111. 15111 GOTO 15005
  112. 15995 RETURN
  113. 20000 rem ROUTINE TO CLOSE FILES AND RETURN TO BIZMII
  114. 20010 CLOSE 1
  115. 20015 CLOSE 2
  116. 20040 CLOSE 3
  117.      console
  118. 20050 chain "master1"
  119.