home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / cpmug / cpmug087.ark / GLHENTRY.BAS < prev    next >
Encoding:
BASIC Source File  |  1986-10-20  |  10.9 KB  |  336 lines
  1.      rem This is the General Ledger Heading Entry Program
  2.  
  3. %INCLUDE ALL.BAS
  4.      RESTORE
  5. 505 z5$="b:glh"
  6. 506 z6$="b:glhback"
  7.     z7$="b:glhsize"
  8. 515 repeat$="-------------------------------"
  9. 516 fill$="                               "
  10. 520 dim z$(5,5),n(2,20),k$(6,20)
  11.     for z=1 to 80:delim$=delim$+"*":next z
  12.     for z=1 to 80:delim1$=delim1$+"=":next z
  13. 540 K$(6,1)="1 - NEW ENTRY":K$(6,2)="2 - EXAMINE EXISTING ENTRY"
  14. 550 K$(6,3)="3 - MODIFY EXISTING ENTRY"
  15. 560 K$(6,4)="4 - DELETE EXISTING ENTRY"
  16. 570 K$(6,5)="5 - CREATE NEW FILE":K$(6,6)="6 - CLEAR EXISTING FILE"
  17. 580 K$(6,7)="7 - BACK-UP AND SORT FILE":K$(6,8)="8 - LIST FILE"
  18. 590 K$(6,9)="9 - FINISHED"
  19. 1000 rem THIS IS THE GENERAL LEDGER HEADINGS ENTRY PROGRAM
  20. 1005 PRINT clear$
  21. 1010 PRINT
  22. 1075 K$(1,1)="TAG":K$(1,2)="LEDGER ACCOUNT NUMBER":K$(1,3)="DESCRIPTION"
  23. 1080 K$(1,4)="FIRST ACCOUNT NUMBER":K$(1,5)="LAST ACCOUNT NUMBER"
  24. 1085 K$(1,6)="M-T-D TOTAL":K$(1,7)="Q-T-D TOTAL"
  25. 1090 K$(1,8)="Y-T-D TOTAL":K$(1,9)="M-T-D PERCENTAGE"
  26. 1095 K$(1,10)="Q-T-D PERCENTAGE":K$(1,11)="Y-T-D PERCENTAGE"
  27. 1105 K$(2,1)="1 - TAG":K$(2,2)="2 - LEDGER ACCOUNT NUMBER"
  28. 1106 K$(2,3)="3 - DESCRIPTION"
  29. 1110 K$(2,4)="4 - FIRST ACCOUNT NUMBER":K$(2,5)="5 - LAST ACCOUNT NUMBER"
  30. 1115 K$(2,6)="6 - M-T-D TOTAL":K$(2,7)="7 - Q-T-D TOTAL"
  31. 1120 K$(2,8)="8 - Y-T-D TOTAL":K$(2,9)="9 - M-T-D PERCENTAGE"
  32. 1125 K$(2,10)="10- Q-T-D PERCENTAGE":K$(2,11)="11- Y-T-D PERCENTAGE"
  33. 1130 K$(2,12)="12- NONE"
  34. 1135 N(1,1)=4:N(1,2)=10:N(1,3)=30:N(1,4)=10:N(1,5)=10:N(1,6)=12
  35. 1140 N(1,7)=12:N(1,8)=12:N(1,9)=12:N(1,10)=12:N(1,11)=12
  36.     print clear$:print
  37.  
  38. 1500    if end #1 then 6000
  39.     if end #2 then 15000
  40.         open z5$ recl 150 as 1
  41.         close 1
  42.         open z7$ as 2
  43.         read #2;z2,z3
  44.         close 2
  45.  
  46. 1600    PRINT CLEAR$
  47. 1620    REM
  48.     if z2>z3 then print "*** OUT OF RECORD SPACE ***"
  49.     PRINT "GENERAL LEDGER HEADING ENTRY PROGRAM"
  50.         PRINT      "------------------------------------"
  51.     PRINT:PRINT "THERE ARE ";Z3;" AVAILABLE RECORDS"
  52.     PRINT "OF THESE THERE ARE:";TAB(30);(Z3-Z2)+1;" RECORDS OPEN"
  53.     PRINT                      ;TAB(30);Z2-1;" RECORDS USED"
  54.     PRINT
  55.  
  56. 1650 PRINT "THIS IS A LIST OF OPERATIONS."
  57. 1655 PRINT
  58. 1660 FOR Z=1 TO 9:PRINT K$(6,Z):NEXT Z:PRINT
  59. 1665 PRINT "INDICATE WHAT YOU WOULD LIKE TO DO BY TYPING"
  60. 1670 PRINT "THE CORRESPONDING NUMBER."
  61. 1675 PRINT
  62. 1680 INPUT Z
  63.     IF Z<1 OR Z>9 then 1600
  64. 1682 IF Z=1 THEN new$="N"
  65. 1685 ON Z GOSUB 2000,3000,4000,5000,6000,7000,8000,9000,10000
  66. 1690 FOR Z=1 TO 20:N(2,Z)=0:NEXT Z:n$=""
  67. 1700 FOR Z=1 TO 20:K$(3,Z)="":NEXT Z
  68. 1702 new$="":H$=""
  69. 1705 GOTO 1600
  70. 2000 IF Z2>Z3 THEN RETURN
  71. 2001 PRINT CLEAR$:PRINT
  72. 2005 PRINT "RECORD NUMBER";Z2:PRINT
  73. 2010 PRINT "TYPE OF HEADING - A=ASSETS, L=LIABILITIES,"
  74. 2012 PRINT "E=EQUITY, S=SALES, OR X=EXPENSES."
  75. 2013 input line H$:H$="H"+H$
  76.      if h$<>"HA" and h$<>"HL" and h$<>"HE" and h$<>"HS" and\
  77.      h$<>"HX" then 2010
  78. 2015 FOR Z=1 TO 2
  79.     PRINT CUR$
  80. 2020 PRINT TAB(30);left$(repeat$,n(1,z))
  81.     PRINT UP$;
  82. 2025 PRINT K$(1,Z);TAB(30);
  83. 2030 INPUT N(2,Z):PRINT chr$(13)
  84.     PRINT CLEAR$
  85. 2035 NEXT Z
  86. 2040 Z=3
  87.     PRINT CUR$
  88. 2045 PRINT TAB(30);left$(repeat$,n(1,z))
  89.     PRINT UP$;
  90. 2050 PRINT K$(1,Z);TAB(30);
  91. 2055 input line k$(3,Z):PRINT chr$(13)
  92.     if len(k$(3,z))>n(1,z) then k$(3,z)=left$(k$(3,z),n(1,z))
  93. 2060 I=(N(1,Z)-LEN(K$(3,Z))):K$(3,Z)=H$+K$(3,Z)+left$(fill$,I)
  94.     PRINT CLEAR$
  95. 2065 FOR Z=4 TO 11
  96.     PRINT CUR$
  97. 2070 PRINT TAB(30);left$(repeat$,n(1,z))
  98.     PRINT UP$;
  99. 2075 PRINT K$(1,Z);TAB(30);
  100. 2080 INPUT N(2,Z):PRINT chr$(13)
  101.     PRINT CLEAR$
  102. 2085 NEXT Z
  103. 2090 N$=""
  104. 2095 N$=K$(3,3)
  105. 2100 Z1=Z2
  106. 2105 PRINT clear$:PRINT
  107. 2110 PRINT "RECORD NUMBER";Z1:PRINT
  108. 2115 FOR Z=1 TO 2
  109. 2120 PRINT K$(2,Z);TAB(30);N(2,Z)
  110. 2125 NEXT Z
  111. 2135 PRINT K$(2,3);TAB(30);K$(3,3)
  112. 2140 FOR Z=4 TO 5:PRINT K$(2,Z);TAB(30);N(2,Z):NEXT Z
  113. 2141 FOR Z=6 TO 8:PRINT K$(2,Z);TAB(30);
  114.      print using "##,###,###.##";n(2,z):NEXT Z
  115. 2142 FOR Z=9 TO 11:PRINT K$(2,Z);TAB(30);"% ";N(2,Z):NEXT Z
  116. 2145 Z=12:PRINT K$(2,Z):PRINT
  117. 2150 PRINT "IF AN ITEM IS TO BE CHANGED, TYPE THE APPROPRIATE NUMBER."
  118. 2155 PRINT:INPUT Z
  119. 2160 PRINT
  120. 2165 IF Z>11 THEN 2216
  121. 2170 IF Z<1 THEN 2105
  122. 2175 IF Z=3 THEN 2200
  123. 2180 PRINT TAB(30);left$(repeat$,n(1,z))
  124.     PRINT UP$;
  125. 2185 PRINT K$(1,Z);TAB(30);
  126. 2190 INPUT N(2,Z)
  127. 2195 GOTO 2225
  128. 2200 PRINT "TYPE OF HEADING - A=ASSETS, L=LIABILITIES,"
  129. 2201 PRINT "E=EQUITY, S=SALES, OR X=EXPENSES."
  130. 2202 input line H$:H$="H"+H$
  131.      if h$<>"HA" and h$<>"HL" and h$<>"HE" and h$<>"HS" and\
  132.      h$<>"HX" then 2200
  133. 2204 PRINT TAB(30);left$(repeat$,n(1,z))
  134.     PRINT UP$;
  135. 2205 PRINT K$(1,Z);TAB(30);
  136. 2210 input line K$(3,Z)
  137.     if len(k$(3,z))>n(1,z) then k$(3,z)=left$(k$(3,z),n(1,z))
  138. 2215 I=(N(1,Z)-LEN(K$(3,Z))):K$(3,Z)=H$+K$(3,Z)+left$(fill$,I)
  139. 2216 N$=""
  140. 2220 N$=K$(3,3)
  141. 2225 INPUT "ANY MORE CHANGES";line temp$
  142. 2230 if left$(temp$,1)="y" or left$(temp$,1)="Y" then 2105
  143. 2235 PRINT
  144. 2240 INPUT "IS RECORD TO BE ENTERED";line temp$
  145. 2245 PRINT
  146.      if left$(temp$,1)="y" or left$(temp$,1)="Y" then 2280
  147.      if left$(temp$,1)<>"n" and left$(temp$,1)<>"N" then 2235
  148. 2260 PRINT clear$:PRINT
  149. 2270 PRINT "*** RECORD NOT ENTERED ***":PRINT:PRINT
  150. 2275 FOR Z=1 TO 200:NEXT Z:RETURN
  151. 2280 open z5$ recl 150 as 1
  152.      print #1,z1;n(2,1),n(2,2),n$,n(2,4),n(2,5),n(2,6),\
  153.           n(2,7),n(2,8),n(2,9),n(2,10),n(2,11)
  154.      close 1
  155. 2295 IF new$="N" THEN Z2=Z2+1:open z7$ as 1:print #1;z2,z3:close 1
  156. 2300 RETURN
  157. 3000 PRINT clear$:PRINT
  158. 3005 INPUT "RECORD NUMBER";Z1
  159. 3010 IF Z1>=Z2 THEN 3000
  160. 3012 IF Z1<1 THEN RETURN
  161.      open z5$ recl 150 as 1
  162.       read #1,z1;n(2,1),n(2,2),n$,n(2,4),n(2,5),n(2,6),\
  163.          n(2,7),n(2,8),n(2,9),n(2,10),n(2,11)
  164.      close 1
  165. 3030 PRINT
  166. 3035 FOR Z=1 TO 2
  167. 3040 PRINT K$(1,Z);TAB(30);N(2,Z)
  168. 3045 NEXT Z
  169. 3055 PRINT K$(1,3);TAB(30);N$
  170. 3060 FOR Z=4 TO 5:PRINT K$(1,Z);TAB(30);N(2,Z):NEXT Z
  171. 3065 FOR Z=6 TO 8:PRINT K$(2,Z);TAB(30);
  172.       print using "##,###,###.##";N(2,Z):NEXT Z
  173. 3070 FOR Z=9 TO 11:PRINT K$(2,Z);TAB(30);"% ";N(2,Z):NEXT Z:PRINT
  174. 3075 PRINT "FOR A NEW RECORD NUMBER, TYPE N - RETURN.":PRINT
  175. 3080 PRINT "IF FINISHED, TYPE F - RETURN.":PRINT
  176.       input line temp$
  177.       if left$(temp$,1)="n" or left$(temp$,1)="N" then 3000
  178. 3095 RETURN
  179. 4000 PRINT clear$:PRINT
  180. 4005 N$=""
  181. 4010 INPUT "RECORD NUMBER";Z1
  182. 4015 IF Z1<1 THEN PRINT "*** NO SUCH RECORD ***":GOTO 1620
  183. 4020 IF Z1>Z3 THEN PRINT "*** OUT OF RANGE ***":GOTO 1620
  184. 4025 IF Z1>=Z2 THEN PRINT "NO RECORD NUMBER";Z1:GOTO 1620
  185.      open z5$ recl 150 as 1
  186.       read #1,z1;n(2,1),n(2,2),n$,n(2,4),n(2,5),n(2,6),\
  187.          n(2,7),n(2,8),n(2,9),n(2,10),n(2,11)
  188.      close 1
  189. 4045 IF N(2,1)=0 THEN PRINT "*** DELETED RECORD ***":GOTO 1620
  190. 4060 K$(3,3)=N$
  191. 4075 GOTO 2105
  192. 5000 PRINT clear$:PRINT
  193. 5010 INPUT "RECORD NUMBER";Z1
  194. 5015 IF Z1<1 THEN PRINT "*** NO SUCH RECORD ***":GOTO 1620
  195. 5020 IF Z1>Z3 THEN PRINT "*** OUT OF RANGE ***":GOTO 1620
  196. 5025 IF Z1>=Z2 THEN PRINT "NO RECORD NUMBER";Z1:GOTO 1620
  197.      open z5$ recl 150 as 1
  198.       read #1,z1;n(2,1),n(2,2),n$,n(2,4),n(2,5),n(2,6),\
  199.          n(2,7),n(2,8),n(2,9),n(2,10),n(2,11)
  200.      close 1
  201. 5045 PRINT "RECORD NUMBER";Z1
  202. 5050 PRINT
  203. 5055 FOR Z=1 TO 2
  204. 5060 PRINT K$(1,Z);TAB(30);N(2,Z)
  205. 5065 NEXT Z
  206. 5070 Z=3
  207. 5075 PRINT K$(1,Z);TAB(30);N$
  208. 5080 FOR Z=4 TO 5:PRINT K$(1,Z);TAB(30);N(2,Z):NEXT Z
  209. 5085 FOR Z=6 TO 8:PRINT K$(1,Z);TAB(30);
  210.      print using "##,###,###.##";n(2,Z):NEXT Z
  211. 5090 FOR Z=9 TO 11:PRINT K$(1,Z);TAB(30);"%";N(2,Z):NEXT Z
  212. 5095 PRINT
  213. 5100 INPUT "IS RECORD TO BE DELETED (MUST BE YES TO DELETE)";line temp$
  214.      if left$(temp$,1)="n" or left$(temp$,1)="N" then return
  215.      if temp$<>"YES" then 5095
  216. 5115 N(2,1)=0
  217.      open z5$ recl 150 as 1
  218.       print #1,z1;n(2,1),n(2,2),n$,n(2,4),n(2,5),n(2,6),\
  219.          n(2,7),n(2,8),n(2,9),n(2,10),n(2,11)
  220.      close 1
  221. 5135 RETURN
  222. 6000 PRINT clear$:PRINT
  223. 6005 PRINT "IF YOU HAVE ARRIVED HERE, AND HAVE A GENERAL LEDGER HEADING FILE"
  224. 6010 PRINT "ALREADY ON A DISK, YOU SHOULD INSTALL THAT DISK THEN"
  225. 6015 PRINT "TYPE THE letter c FOLLOWED BY A RETURN TO CONTINUE."
  226. 6020 PRINT
  227. 6025 PRINT "IF YOU WISH TO CREATE A NEW FILE, TYPE THE letter n"
  228. 6030 PRINT "FOLLOWED BY RETURN.":PRINT
  229.      input line temp$
  230.      if left$(temp$,1)="c" or left$(temp$,1)="C" then initialize:GOTO 1500
  231. 6045 PRINT clear$:PRINT
  232. 6050 INPUT "NUMBER OF RECORDS DESIRED";Z3
  233. 6055 PRINT
  234.     n$=""
  235.      for z=1 to 30:n$=n$+" ":next z
  236.      for z=1 to 20:n(2,z)=0:next z
  237.      create z5$ recl 150 as 1
  238. 6070 FOR Z1=1 TO Z3+2
  239.      print #1,z1;n(2,1),n(2,2),n$,n(2,4),n(2,5),n(2,6),\
  240.           n(2,7),n(2,8),n(2,9),n(2,10),n(2,11)
  241. 6085 NEXT Z1
  242. 6090 close 1
  243. 6095 PRINT clear$:PRINT
  244. 6100 PRINT "GENERAL LEDGER HEADING FILE CREATED AND CLEARED.":PRINT
  245. 6105 PRINT Z3;"RECORDS CREATED.":PRINT
  246. 6110 PRINT "TO CONTINUE, TYPE RETURN.":INPUT line temp$
  247.     Z2=1
  248.     create z7$ as 1:print #1;Z2,Z3:close 1
  249. 6115 GOTO 1500
  250. 7000 input "ARE YOU SURE !!! (YES or no) ";line temp$
  251. 7007 if temp$<>"YES" then return
  252.      for z=1 to 20:n(2,z)=0:next z
  253.     n$=""
  254.      for z=1 to 30:n$=n$+" ":next z
  255.      open z5$ recl 150 as 1
  256.      for z1=1 to z3+2
  257.      print #1,z1;n(2,1),n(2,2),n$,n(2,4),n(2,5),n(2,6),\
  258.            n(2,7),n(2,8),n(2,9),n(2,10),n(2,11)
  259.      next z1
  260.      close 1
  261. 7035 PRINT clear$:PRINT
  262. 7040 PRINT "GENERAL LEDGER HEADING FILE CLEARED!":PRINT
  263. 7045 input "TO CONTINUE, TYPE RETURN ";line temp$
  264.     z2=1
  265.     open z7$ as 1:print #1;z2,z3:close 1
  266. 7060 RETURN
  267. 8000 chain "GLHSORT"
  268. 9000 PRINT clear$:PRINT:PRINT "LISTING"
  269. 9010 P1=1:P2=1:P3=12
  270. 9020 lprinter
  271. 9030 open z5$ recl 150 as 1
  272. 9040 FOR Z0=1 TO Z2/12
  273. 9050 GOSUB 9500
  274. 9060 GOSUB 9100
  275. 9065 IF P3>Z2 THEN GOSUB 9800:RETURN
  276. 9070 GOSUB 9300
  277. 9080 NEXT Z0
  278. 9085 print chr$(12)
  279. 9090 RETURN
  280. 9100 FOR Z1=P2 TO P3
  281.      read #1,z1;n(2,1),n(2,2),n$,n(2,4),n(2,5),n(2,6),\
  282.           n(2,7),n(2,8),n(2,9),n(2,10),n(2,11)
  283. 9115 if n(2,2)=0 then return
  284. 9120 print
  285. 9130 print N(2,1);TAB(7);N(2,2);TAB(21);mid$(n$,3,30);
  286. 9135 print TAB(53);N(2,4);TAB(65);N(2,5)
  287. 9140 print using "##,###,###.##";n(2,6);tab(21);n(2,7);tab(41);n(2,8)
  288. 9145 print N(2,9);TAB(21);N(2,10);TAB(41);N(2,11)
  289. 9160 NEXT Z1
  290. 9165 P2=P2+12:P3=P3+12
  291. 9170 RETURN
  292. 9300 print
  293.      print
  294.      print "report continues on next page"
  295.      print
  296. 9340 print chr$(12)
  297. 9350 RETURN
  298. 9500 print delim$
  299. 9510 print
  300. 9520 print "TAG";TAB(7);"ACCOUNT NUMBER";TAB(21);"DESCRIPTION";
  301. 9525 print TAB(53);"1ST ACCT #";TAB(65);"2ND ACCT #"
  302. 9530 print "M-T-D TOTAL";TAB(21);"Q-T-D TOTAL";TAB(41);"Y-T-D TOTAL"
  303. 9540 print "M-T-D PERCENT";TAB(21);"Q-T-D PERCENT";TAB(41);"Y-T-D PERCENT"
  304. 9570 print TAB(66);"PAGE NUMBER ";P1:P1=P1+1
  305. 9580 print delim1$
  306. 9590 print
  307. 9600 RETURN
  308. 9800 print
  309.      print
  310.      print "end of report"
  311.      print
  312. 9840    REM
  313. 9845 print chr$(12)
  314. 9850 CLOSE 1
  315.      console
  316. 9870 RETURN
  317. 10000 print clear$:print:print "Replace disk #5 in drive A."
  318.       print "Type return to continue."
  319.       input line temp$
  320.       initialize
  321.       chain "bizmii"
  322. 15000    print clear$:print:print "CHECKING FILE LENGTH"
  323.     PRINT:PRINT "*** PLEASE WAIT ***"
  324.     open z5$ recl 150 as 1
  325.     z3=(size(z5$)*block.size)/150
  326.     for z2=1 to z3
  327.     read #1,z2;n(2,1),n(2,2)
  328.     if n(2,2)=0 then 15300
  329.     next z2
  330. 15300    z3=int(z3)-2
  331.     close 1
  332.     create z7$ as 1
  333.     print #1;z2,z3
  334.     close 1
  335.     GOTO 1500
  336.