home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / SIMTEL / CPMUG / CPMUG090.ARK / GLENTRY.BAS < prev    next >
BASIC Source File  |  1984-04-29  |  11KB  |  341 lines
  1.      rem This is the General Ledger Entry Program
  2.  
  3. %INCLUDE ALL.BAS
  4.     RESTORE
  5. 505 z5$="b:gl"
  6. 506 z6$="b:glback"
  7.     z7$="b:glsize"
  8. 515 repeat$="------------------------------"
  9. 516 fill$="                               "
  10. 520 dim 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 ENTRY PROGRAM
  20. 1005 PRINT clear$:PRINT
  21. 1075 K$(1,1)="TAG":K$(1,2)="LEDGER ACCOUNT NUMBER":K$(1,3)="DESCRIPTION"
  22. 1080 K$(1,4)="MONTH TO DATE AMOUNT":K$(1,5)="QUARTER TO DATE AMOUNT"
  23. 1085 K$(1,6)="YEAR TO DATE AMOUNT":K$(1,7)="PREV MONTH TO DATE AMOUNT"
  24. 1090 K$(1,8)="PREV QUARTER TO DATE AMOUNT"
  25. 1095 K$(1,9)="PREV YEAR TO DATE AMOUNT"
  26. 1100 K$(1,10)="BUDGETED AMOUNT"
  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 - MONTH TO DATE AMOUNT":K$(2,5)="5 - QUARTER TO DATE AMOUNT"
  30. 1115 K$(2,6)="6 - YEAR TO DATE AMOUNT":K$(2,7)="7 - PREV MONTH TO DATE AMT"
  31. 1120 K$(2,8)="8 - PREV QUARTER TO DATE AMT"
  32. 1125 K$(2,9)="9 - PREV YEAR TO DATE AMT"
  33. 1130 K$(2,10)="10 - BUDGETED AMOUNT":K$(2,11)="11 - NONE"
  34. 1135 N(1,1)=4:N(1,2)=10:N(1,3)=30:N(1,4)=12:N(1,5)=12:N(1,6)=12
  35. 1140 N(1,7)=12:N(1,8)=12:N(1,9)=12:N(1,10)=12
  36.     print clear$:print
  37.  
  38. 1500    if end #1 then 6000
  39.     if end #2 then 30000
  40.         open z5$ recl 138 as 1
  41.         close 1
  42.         open z7$ as 2
  43.         read #2;z2,z3
  44.         close 2
  45.  
  46. 1600    REM
  47. 1620    PRINT CLEAR$
  48.     if z2>z3 then print "*** OUT OF RECORD SPACE ***"
  49.     PRINT "GENERAL LEDGER 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 1620
  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$=""
  69. 1705 GOTO 1600
  70. 2000 IF Z2>Z3 THEN RETURN
  71. 2001 PRINT CLEAR$:PRINT
  72. 2005 PRINT "RECORD NUMBER";Z2:PRINT
  73. 2015 FOR Z=1 TO 2
  74.     PRINT CUR$
  75. 2020 PRINT TAB(30);left$(repeat$,n(1,z))
  76.     PRINT UP$;
  77. 2025 PRINT K$(1,Z);TAB(30);
  78. 2030 INPUT N(2,Z):PRINT chr$(13)
  79.     PRINT CLEAR$
  80. 2035 NEXT Z
  81. 2040 Z=3
  82.     PRINT CUR$
  83. 2045 PRINT TAB(30);left$(repeat$,n(1,z))
  84.     PRINT UP$;
  85. 2050 PRINT K$(1,Z);TAB(30);
  86. 2055 INPUT line K$(3,Z):PRINT chr$(13)
  87.     if len(k$(3,z))>n(1,z) then k$(3,z)=left$(k$(3,z),n(1,z))
  88. 2060 I=(N(1,Z)-LEN(K$(3,Z))):K$(3,Z)=K$(3,Z)+left$(fill$,i)
  89. 2090 N$=""
  90. 2095 N$=K$(3,3)
  91. 2100 Z1=Z2
  92. 2105 PRINT clear$;
  93. 2110 PRINT "RECORD NUMBER";Z1:PRINT
  94. 2115 FOR Z=1 TO 2
  95. 2120 PRINT K$(2,Z);TAB(30);N(2,Z)
  96. 2125 NEXT Z
  97. 2135 PRINT K$(2,3);TAB(30);K$(3,3)
  98. 2140 FOR Z=4 TO 10
  99. 2141 PRINT K$(2,Z);TAB(30);:print using "##,###,###.##";n(2,z)
  100. 2142 NEXT Z
  101.      print k$(2,11)
  102. 2145 PRINT
  103. 2150 PRINT "IF AN ITEM IS TO BE CHANGED, TYPE THE APPROPRIATE NUMBER."
  104. 2155 PRINT:INPUT Z
  105. 2160 PRINT
  106. 2165 IF Z>10 THEN 2216
  107. 2170 IF Z<1 THEN 2105
  108. 2175 IF Z=3 THEN 2200
  109. 2180 PRINT TAB(30);left$(repeat$,n(1,z))
  110.     PRINT UP$;
  111. 2185 PRINT K$(1,Z);TAB(30);
  112. 2190 INPUT N(2,Z)
  113. 2195 GOTO 2225
  114. 2200 PRINT TAB(30);left$(repeat$,n(1,z))
  115.     PRINT UP$;
  116. 2205 PRINT K$(1,Z);TAB(30);
  117. 2210 INPUT line K$(3,Z)
  118.     if len(k$(3,z))>n(1,z) then k$(3,z)=left$(k$(3,z),n(1,z))
  119. 2215 I=(N(1,Z)-LEN(K$(3,Z))):K$(3,Z)=K$(3,Z)+left$(fill$,i)
  120. 2216 N$=""
  121. 2220 N$=K$(3,3)
  122. 2225 INPUT "ANY MORE CHANGES";line temp$
  123. 2230 if left$(temp$,1)="y" or left$(temp$,1)="Y" then 2105
  124. 2235 PRINT
  125. 2240 INPUT "IS RECORD TO BE ENTERED";line temp$
  126. 2245 PRINT
  127. 2250 if left$(temp$,1)="y" or left$(temp$,1)="Y" then 2280
  128. 2255 if left$(temp$,1)<>"n" and left$(temp$,1)<>"N" then 2235
  129. 2260 PRINT clear$:PRINT
  130. 2270 PRINT "*** RECORD NOT ENTERED ***":PRINT:PRINT
  131. 2275 FOR Z=1 TO 200:NEXT Z:RETURN
  132. 2280 open z5$ recl 138 as 1
  133.      print #1,z1;n(2,1),n(2,2),n$,n(2,4),n(2,5),n(2,6),n(2,7),\
  134.            n(2,8),n(2,9),n(2,10)
  135.      close 1
  136. 2295 IF new$="N" THEN Z2=Z2+1:open z7$ as 1:print #1;z2,z3:close 1
  137. 2300 RETURN
  138. 3000 PRINT clear$:PRINT
  139. 3005 INPUT "RECORD NUMBER";Z1
  140. 3010 IF Z1>=Z2 THEN 3000
  141. 3012 IF Z1<1 THEN RETURN
  142. open z5$ recl 138 as 1
  143.      read #1,z1;n(2,1),n(2,2),n$,n(2,4),n(2,5),n(2,6),n(2,7),\
  144.            n(2,8),n(2,9),n(2,10)
  145.      close 1
  146. 3030 PRINT
  147. 3035 FOR Z=1 TO 2
  148. 3040 PRINT K$(1,Z);TAB(30);N(2,Z)
  149. 3045 NEXT Z
  150. 3055 PRINT K$(1,3);TAB(30);N$
  151. 3060 FOR Z=4 TO 10
  152. 3062 PRINT K$(1,Z);TAB(30);:print using "##,###,###.##";n(2,z)
  153. 3065 NEXT Z
  154. 3070 PRINT
  155. 3075 PRINT "FOR A NEW RECORD NUMBER, TYPE N - RETURN.":PRINT
  156. 3080 PRINT "IF FINISHED, TYPE F - RETURN.":PRINT
  157. 3085 input line temp$
  158. 3090 if left$(temp$,1)="n" or left$(temp$,1)="N" then 3000
  159. 3095 RETURN
  160. 4000 PRINT clear$:PRINT
  161. 4005 N$=""
  162. 4010 INPUT "RECORD NUMBER";Z1
  163. 4015 IF Z1<1 THEN PRINT "*** NO SUCH RECORD ***":GOTO 1620
  164. 4020 IF Z1>Z3 THEN PRINT "*** OUT OF RANGE ***":GOTO 1620
  165. 4025 IF Z1>=Z2 THEN PRINT "NO RECORD NUMBER";Z1:GOTO 1620
  166. open z5$ recl 138 as 1
  167.      read #1,z1;n(2,1),n(2,2),n$,n(2,4),n(2,5),n(2,6),n(2,7),\
  168.            n(2,8),n(2,9),n(2,10)
  169.      close 1
  170. 4045 IF N(2,1)=0 THEN PRINT "*** DELETED RECORD ***":GOTO 1620
  171. 4060 K$(3,3)=N$
  172. 4075 GOTO 2105
  173. 5000 PRINT clear$:PRINT
  174. 5010 INPUT "RECORD NUMBER";Z1
  175. 5015 IF Z1<1 THEN PRINT "*** NO SUCH RECORD ***":GOTO 1620
  176. 5020 IF Z1>Z3 THEN PRINT "*** OUT OF RANGE ***":GOTO 1620
  177. 5025 IF Z1>=Z2 THEN PRINT "NO RECORD NUMBER";Z1:GOTO 1620
  178. open z5$ recl 138 as 1
  179.      read #1,z1;n(2,1),n(2,2),n$,n(2,4),n(2,5),n(2,6),n(2,7),\
  180.            n(2,8),n(2,9),n(2,10)
  181.      close 1
  182. 5045 PRINT "RECORD NUMBER";Z1
  183. 5050 PRINT
  184. 5055 FOR Z=1 TO 2
  185. 5060 PRINT K$(1,Z);TAB(30);N(2,Z)
  186. 5065 NEXT Z
  187. 5070 Z=3
  188. 5075 PRINT K$(1,Z);TAB(30);N$
  189. 5080 FOR Z=4 TO 10
  190. 5085 PRINT K$(1,Z);TAB(30);:print using "##,###,###.##";n(2,z)
  191. 5090 NEXT Z
  192. 5095 PRINT
  193. 5100 INPUT "IS RECORD TO BE DELETED (MUST BE YES TO DELETE)";line temp$
  194. 5105 if left$(temp$,1)="n" or left$(temp$,1)="N" then return
  195. 5110 if left$(temp$,1)<>"y" and left$(temp$,1)<>"Y" then 5095
  196. 5115 N(2,1)=0
  197.      open z5$ recl 138 as 1
  198.      print #1,z1;n(2,1),n(2,2),n$,n(2,4),n(2,5),n(2,6),n(2,7),\
  199.            n(2,8),n(2,9),n(2,10)
  200.      close 1
  201. 5135 RETURN
  202. 6000 PRINT clear$:PRINT
  203. 6005 PRINT "IF YOU HAVE ARRIVED HERE, AND HAVE A GENERAL LEDGER FILE"
  204. 6010 PRINT "ALREADY ON A DISK, YOU SHOULD INSTALL THAT DISK THEN"
  205. 6015 PRINT "TYPE THE letter c FOLLOWED BY A RETURN TO CONTINUE."
  206. 6020 PRINT
  207. 6025 PRINT "IF YOU WISH TO CREATE A NEW FILE, TYPE THE letter n"
  208. 6030 PRINT "FOLLOWED BY RETURN.":PRINT
  209. 6035 INPUT line temp$
  210. 6040 IF temp$="c" OR temp$="C" THEN INITIALIZE:GOTO 1500
  211. 6045 PRINT clear$:PRINT
  212. 6050 INPUT "NUMBER OF RECORDS DESIRED";Z3
  213. 6055 PRINT
  214. 6060 for z=1 to 20:n(2,z)=0: next z
  215.     N$=""
  216.      for z=1 to 30:n$=n$+" ":next z
  217.      create z5$ recl 138 as 1
  218. 6070 for z1=1 to z3+2
  219.      print #1,z1;n(2,1),n(2,2),n$,n(2,4),n(2,5),n(2,6),\
  220.            n(2,7),n(2,8),n(2,9),n(2,10)
  221.      next z1
  222.      close 1
  223. 6095 PRINT clear$:PRINT
  224. 6100 PRINT "GENERAL LEDGER FILE CREATED AND CLEARED.":PRINT
  225. 6105 print z3;" RECORDS CREATED":print
  226. 6110 input "TO CONTINUE, TYPE RETURN ";line temp$
  227.     Z2=1
  228.     create z7$ as 1:print #1;Z2,Z3:close 1
  229. 6115 GOTO 1500
  230. 7000 input "ARE YOU SURE !!! (yes or no) ";line temp$
  231. 7007 if temp$<>"yes" AND temp$<>"YES" then return
  232.      for z=1 to 20:n(2,z)=0:next z
  233.     N$=""
  234.      for z=1 to 30:n$=n$+" ":next z
  235.      open z5$ recl 138 as 1
  236.      for z1=1 to z3+2
  237.      print #1,z1;n(2,1),n(2,2),n$,n(2,4),n(2,5),n(2,6),\
  238.            n(2,7),n(2,8),n(2,9),n(2,10)
  239.      next z1
  240.      close 1
  241. 7035 PRINT clear$:PRINT
  242. 7040 PRINT "GENERAL LEDGER FILE CLEARED!":PRINT
  243. 7045 input "TO CONTINUE, TYPE RETURN ";line temp$
  244.     Z2=1
  245.     open z7$ as 1:print #1;Z2,Z3:close 1
  246. 7060 RETURN
  247. 8000 CHAIN "GLSORT"
  248. 9000 PRINT clear$:PRINT:PRINT "LISTING"
  249. 9010 P1=1:P2=1:P3=16
  250. 9020 lprinter
  251. 9030 open z5$ recl 138 as 1
  252. 9040 FOR Z0=1 TO (Z2/16)+1
  253. 9050 GOSUB 9500
  254. 9060 GOSUB 9100
  255. 9065 IF N(2,2)=0 THEN GOSUB 9800:RETURN
  256. 9070 GOSUB 9300
  257. 9080 NEXT Z0
  258. 9085 print chr$(12)
  259. 9090 RETURN
  260. 9100 FOR Z1=P2 TO P3
  261. 9110 read #1,z1;n(2,1),n(2,2),n$,n(2,4),n(2,5),n(2,6),\
  262.          n(2,7),n(2,8),n(2,9),n(2,10)
  263. 9115 IF N(2,2)=0 THEN RETURN
  264. 9120 print
  265. 9130 print Z1;TAB(8);N(2,1);TAB(14);N(2,2);
  266. 9140 print using "##,###,###.##";tab(35);n(2,4);tab(50);n(2,5);tab(65);n(2,6)
  267.     print n$;
  268. 9150 print using "##,###,###.##";tab(35);n(2,7);tab(50);n(2,8);tab(65);n(2,9)
  269. 9160 NEXT Z1
  270. 9165 P2=P2+16:P3=P3+16
  271. 9170 RETURN
  272. 9300 print
  273. 9310 print
  274. 9320 print "report continues on next page"
  275. 9330 print
  276. 9340 print chr$(12)
  277. 9350 RETURN
  278. 9500 print delim$
  279. 9510 print
  280.     print "Rec #";tab(8);"Tag";tab(14);"Acct No.";tab(35);
  281.     print "Month to Date";tab(50);"Quart to Date";tab(65);"Year to Date"
  282.     print "Description";tab(35);"Previous MTD";tab(50);"Previous QTD";
  283.     print tab(65);"Previous YTD"
  284. 9570 print TAB(66);"PAGE NUMBER ";P1:P1=P1+1
  285. 9585 print delim1$
  286. 9590 print
  287. 9600 RETURN
  288. 9800 print
  289. 9810 print
  290. 9820 print "END OF REPORT"
  291. 9830 print
  292. 9840 print chr$(12)
  293. 9845 print chr$(12)
  294. 9850 CLOSE 1
  295.      console
  296. 9870 RETURN
  297. 10000 GOSUB 20000
  298. 10040 chain "master1"
  299. 20000 PRINT clear$:PRINT
  300. 20005 PRINT "A NEW GENERAL LEDGER REFERENCE FILE IS BEING"
  301. 20010 PRINT "CREATED.":PRINT
  302. 20015 PRINT "*** PLEASE WAIT ***"
  303. 20025 open z5$ recl 138 as 1
  304. 20035 FOR Z2=1 TO Z3+2
  305. 20040 read #1,z2;i,j
  306. 20045 IF j=0 THEN 20055
  307. 20050 NEXT Z2
  308. 20055 close 1
  309. 20060 Z2=Z2-1
  310. 20065 DIM U(Z2)
  311. 20070 open z5$ recl 138 as 1
  312. 20075 FOR Z=1 TO Z2
  313. 20080 read #1,z;i,u(z)
  314. 20085 print i,u(z)
  315. 20090 NEXT Z
  316. 20095 close 1
  317.      if end #2 then 25000
  318. 20100 open "b:glref" as 2
  319.       print #2;z2
  320. 20105 for z=1 to z2
  321. 20110 print #2;u(z)
  322. 20115 next z
  323. 20120 close 2
  324. 20505 return
  325. 25000 create "b:glref" as 2
  326.       goto 20105
  327. 30000    print clear$:print:print "CHECKING FILE LENGTH"
  328.     PRINT:PRINT "*** PLEASE WAIT ***"
  329.     open z5$ recl 138 as 1
  330.     z3=(size(z5$)*block.size)/138
  331.     for z2=1 to z3
  332.     read #1,z2;n(2,1),n(2,2)
  333.     if n(2,2)=0 then 30300
  334.     next z2
  335. 30300    z3=int(z3)-2
  336.     close 1
  337.     create z7$ as 1
  338.     print #1;z2,z3
  339.     close 1
  340.     GOTO 1500
  341.