home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / cpmug / cpmug087.ark / CGENTRY.BAS < prev    next >
Encoding:
BASIC Source File  |  1986-10-20  |  10.6 KB  |  313 lines
  1.      rem This is the Capital Goods (Fixed Asset) Entry Program
  2.  
  3. %INCLUDE ALL.BAS
  4.      dim k$(6,20),n(2,20)
  5.      repeat$="-------------------------------"
  6.      fill$="                               "
  7.      z5$="b:cg"
  8.      z6$=z5$+"back":z7$=z5$+"size"
  9.      RESTORE
  10.      U$="##########"
  11.      L$="##,###,###.##"
  12. 540 K$(6,1)="1 - NEW ENTRY":K$(6,2)="2 - EXAMINE EXISTING ENTRY"
  13. 550 K$(6,3)="3 - MODIFY EXISTING ENTRY"
  14. 560 K$(6,4)="4 - DELETE EXISTING ENTRY"
  15. 570 K$(6,5)="5 - CREATE NEW FILE":K$(6,6)="6 - CLEAR EXISTING FILE"
  16. 580 K$(6,7)="7 - BACK-UP AND SORT FILE":K$(6,8)="8 - LIST FILE"
  17. 590 K$(6,9)="9 - FINISHED"
  18. 1000 print clear$:print
  19. 1075 K$(1,1)="TAG":K$(1,2)="FIXED ASSET ACCT #"
  20. 1076 K$(1,3)="DEPRECIATION ACCT #"
  21. 1080 K$(1,4)="DESCRIPTION":K$(1,5)="LOCATION"
  22. 1085 K$(1,6)="NEW OR USED":K$(1,7)="DATE ACQUIRED"
  23. 1090 K$(1,8)="DEPRECIATION METHOD":K$(1,9)="COST OR BASIS"
  24. 1095 K$(1,10)="DEPRECIABLE BASIS":K$(1,11)="PRIOR YEARS DEP."
  25. 1100 K$(1,12)="USEFUL LIFE":K$(1,13)="REMAINING LIFE"
  26. 1105 K$(1,14)="M-T-D DEPRECIATION":K$(1,15)="Q-T-D DEPRECIATION"
  27. 1110 K$(1,16)="Y-T-D DEPRECIATION":K$(1,17)="SALVAGE VALUE"
  28. 1200 K$(2,1)="1 - TAG":K$(2,2)="2 - FIXED ASSET ACCT #"
  29. 1201 K$(2,3)="3 - DEPRECIATION ACCT #"
  30. 1205 K$(2,4)="4 - DESCRIPTION":K$(2,5)="5 - LOCATION"
  31. 1210 K$(2,6)="6 - NEW OR USED":K$(2,7)="7 - DATE ACQUIRED"
  32. 1215 K$(2,8)="8 - DEPRECIATION METHOD":K$(2,9)="9 - COST OR BASIS"
  33. 1220 K$(2,10)="10- DEPRECIABLE BASIS":K$(2,11)="11- PRIOR YEARS DEP."
  34. 1225 K$(2,12)="12- USEFUL LIFE":K$(2,13)="13- REMAINING LIFE"
  35. 1230 K$(2,14)="14- M-T-D DEPRECIATION":K$(2,15)="15- Q-T-D DEPRECIATION"
  36. 1235 K$(2,16)="16- Y-T-D DEPRECIATION":K$(2,17)="17- SALVAGE VALUE"
  37. 1280 K$(2,18)="18- NONE"
  38.      for z=1 to 17:read n(1,z):next z
  39.      data 4,10,10,24,24,1,8,2,12,12,12,4,4,12,12,12,12
  40.     print clear$:print
  41.  
  42. 1500    if end #1 then 6000
  43.     if end #2 then 15000
  44.         open z5$ recl 256 as 1
  45.         close 1
  46.         open z7$ as 2
  47.         read #2;z2,z3
  48.         close 2
  49.  
  50. 1600    REM
  51. 1620    PRINT CLEAR$
  52.     if z2>z3 then print "*** OUT OF RECORD SPACE ***"
  53.     PRINT "CAPITAL GOODS ENTRY PROGRAM"
  54.         PRINT      "---------------------------"
  55.     PRINT:PRINT "THERE ARE ";Z3;" AVAILABLE RECORDS"
  56.     PRINT "OF THESE THERE ARE:";TAB(30);(Z3-Z2)+1;" RECORDS OPEN"
  57.     PRINT                      ;TAB(30);Z2-1;" RECORDS USED"
  58.     PRINT
  59.  
  60. 1650 PRINT "THIS IS A LIST OF OPERATIONS."
  61. 1655 PRINT
  62. 1660 FOR Z=1 TO 9:PRINT K$(6,Z):NEXT Z:PRINT
  63. 1665 PRINT "INDICATE WHAT YOU WOULD LIKE TO DO BY TYPING"
  64. 1670 PRINT "THE CORRESPONDING NUMBER."
  65. 1675 PRINT
  66. 1680 INPUT Z
  67.     IF Z<1 OR Z>9 then 1620
  68. 1682 IF Z=1 THEN new$="N"
  69. 1685 ON Z GOSUB 2000,3000,4000,5000,6000,7000,8000,9000,10000
  70. 1690 FOR Z=1 TO 20:N(2,Z)=0:NEXT Z:N$=""
  71. 1700 FOR Z=1 TO 20:K$(3,Z)="":NEXT Z
  72. 1702 new$=""
  73. 1705 GOTO 1600
  74. 2000 IF Z2>Z3 THEN RETURN 
  75. 2001 PRINT CLEAR$:PRINT
  76. 2005 PRINT "RECORD NUMBER";Z2:PRINT
  77. 2015 FOR Z=1 TO 3
  78.     PRINT CUR$
  79. 2020 PRINT TAB(30);left$(repeat$,n(1,z))
  80.     PRINT UP$;
  81. 2025 PRINT K$(1,Z);TAB(30);
  82. 2030 INPUT N(2,Z):PRINT chr$(13)
  83.     PRINT CLEAR$
  84. 2035 NEXT Z
  85. 2036 FOR Z=4 TO 8
  86.     PRINT CUR$
  87. 2037 PRINT TAB(30);left$(repeat$,n(1,z))
  88.     PRINT UP$;
  89. 2038 PRINT K$(1,Z);TAB(30);
  90. 2039 INPUT line K$(3,Z):PRINT chr$(13)
  91.     if len(k$(3,z))>n(1,z) then k$(3,z)=left$(k$(3,z),n(1,z))
  92. 2040 I=(N(1,Z)-LEN(K$(3,Z))):K$(3,Z)=K$(3,Z)+left$(fill$,i)
  93.     PRINT CLEAR$
  94. 2045 NEXT Z
  95. 2065 FOR Z=9 TO 17
  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 FOR Z=4 TO 8:N$=N$+K$(3,Z):NEXT Z
  105. 2100 Z1=Z2
  106. 2105 PRINT clear$;
  107. 2110 PRINT "RECORD NUMBER";Z1;TAB(31);"CAPITAL GOODS ENTRY"
  108. 2115 FOR Z=1 TO 3
  109. 2116 PRINT K$(2,Z);TAB(30);:print using u$;n(2,z)
  110. 2118 NEXT Z
  111. 2120 FOR Z=4 TO 8
  112. 2122 PRINT K$(2,Z);TAB(30);K$(3,Z)
  113. 2124 NEXT Z
  114. 2125 FOR Z=9 TO 11
  115. 2126 PRINT K$(2,Z);TAB(30);:print using l$;n(2,z)
  116. 2127 NEXT Z
  117. 2128 FOR Z=12 TO 13
  118. 2130 PRINT K$(2,Z);TAB(30);:print using u$;n(2,z)
  119. 2132 NEXT Z
  120. 2134 FOR Z=14 TO 17
  121. 2136 PRINT K$(2,Z);TAB(30);:print using l$;n(2,z)
  122. 2138 NEXT Z
  123. 2140 PRINT K$(2,18)
  124. 2163 PRINT"TO MAKE A CHANGE, TYPE THE APPROPRIATE #."
  125. 2164 INPUT Z
  126. 2165 IF Z>17 THEN 2216
  127. 2170 IF Z<1 THEN 2105
  128. 2175 IF Z>3 AND Z<9 THEN 2200
  129.     CL=10:CC=50:GOSUB 50:PRINT CUR2$;
  130. 2180 PRINT left$(repeat$,n(1,z))
  131.     CL=12:GOSUB 50:PRINT CUR2$;
  132. 2185 PRINT K$(1,Z)
  133.     CL=10:CC=48:GOSUB 50:PRINT CUR2$;
  134. 2190 INPUT N(2,Z)
  135. 2195 GOTO 2225
  136. 2200 CL=10:CC=50:GOSUB 50:PRINT CUR2$; :PRINT left$(repeat$,n(1,z))
  137.     CL=12:GOSUB 50:PRINT CUR2$;
  138. 2205 PRINT K$(1,Z)
  139.     CL=10:CC=48:GOSUB 50:PRINT CUR2$;
  140. 2210 INPUT line K$(3,Z)
  141.     if len(k$(3,z))>n(1,z) then k$(3,z)=left$(k$(3,z),n(1,z))
  142. 2215 I=(N(1,Z)-LEN(K$(3,Z))):K$(3,Z)=K$(3,Z)+left$(fill$,i)
  143. 2216 N$=""
  144. 2220 FOR Z=4 TO 8:N$=N$+K$(3,Z):NEXT Z
  145. 2225 CL=14:CC=50:GOSUB 50:PRINT CUR2$;
  146.     INPUT "ANY MORE CHANGES";line temp$
  147. 2230 IF left$(temp$,1)="y" OR left$(temp$,1)="Y" THEN 2105
  148. 2235    PRINT CUR2$;
  149. 2240 INPUT "IS RECORD TO BE ENTERED";line temp$
  150. 2245 PRINT
  151. 2250 IF left$(temp$,1)="y" OR left$(temp$,1)="Y" THEN 2280
  152. 2255 IF left$(temp$,1)<>"n" AND left$(temp$,1)<>"N" THEN 2235
  153. 2260 PRINT clear$:PRINT
  154. 2270 PRINT "*** RECORD NOT ENTERED ***":PRINT:PRINT
  155. 2275 FOR Z=1 TO 200:NEXT Z:RETURN
  156. 2280 open z5$ recl 256 as 1
  157.      print #1,z1;n(2,1),n(2,2),n(2,3),n$,n(2,9),n(2,10),n(2,11),\
  158.           n(2,12),n(2,13),n(2,14),n(2,15),n(2,16),n(2,17)
  159.      close 1
  160. 2295 IF new$="N" THEN Z2=Z2+1:open z7$ as 1:print #1;z2,z3:close 1
  161. 2300 RETURN
  162. 3000 PRINT clear$:PRINT
  163. 3005 INPUT "RECORD NUMBER";Z1
  164. 3010 IF Z1>=Z2 THEN 3000
  165. 3012 IF Z1<1 THEN RETURN
  166.      open z5$ recl 256 as 1
  167.      read #1,z1;n(2,1),n(2,2),n(2,3),n$,n(2,9),n(2,10),n(2,11),\
  168.           n(2,12),n(2,13),n(2,14),n(2,15),n(2,16),n(2,17)
  169. 3022 Z9=1:FOR Z=4 TO 8:K$(3,Z)=MID$(N$,Z9,N(1,Z)):Z9=Z9+N(1,Z):next z
  170. 3025 close 1
  171. 3105 GOSUB 11000
  172. 3170 PRINT"FOR A NEW RECORD, TYPE N - TYPE F IF FINISHED.":input line temp$
  173. 3190 IF left$(temp$,1)="n" or left$(temp$,1)="N" THEN 3000
  174. 3195 RETURN
  175. 4000 PRINT clear$:PRINT
  176. 4005 N$=""
  177. 4010 INPUT "RECORD NUMBER";Z1
  178. 4015 IF Z1<1 THEN PRINT "*** NO SUCH RECORD ***":GOTO 1620
  179. 4020 IF Z1>Z3 THEN PRINT "*** OUT OF RANGE ***":GOTO 1620
  180. 4025 IF Z1>=Z2 THEN PRINT "NO RECORD NUMBER";Z1:GOTO 1620
  181.      open z5$ recl 256 as 1
  182.      read #1,z1;n(2,1),n(2,2),n(2,3),n$,n(2,9),n(2,10),n(2,11),\
  183.           n(2,12),n(2,13),n(2,14),n(2,15),n(2,16),n(2,17)
  184. 4036 Z9=1:FOR Z=4 TO 8:K$(3,Z)=MID$(N$,Z9,N(1,Z)):Z9=Z9+N(1,Z):NEXT Z
  185. 4040 close 1
  186. 4045 IF N(2,1)=0 THEN PRINT "*** DELETED RECORD ***":GOTO 1620
  187. 4075 GOTO 2105
  188. 5000 PRINT clear$:PRINT
  189. 5010 INPUT "RECORD NUMBER";Z1
  190. 5015 IF Z1<1 THEN PRINT "*** NO SUCH RECORD ***":GOTO 1620
  191. 5020 IF Z1>Z3 THEN PRINT "*** OUT OF RANGE ***":GOTO 1620
  192. 5025 IF Z1>=Z2 THEN PRINT "NO RECORD NUMBER";Z1:GOTO 1620
  193.      open z5$ recl 256 as 1
  194.      read #1,z1;n(2,1),n(2,2),n(2,3),n$,n(2,9),n(2,10),n(2,11),\
  195.           n(2,12),n(2,13),n(2,14),n(2,15),n(2,16),n(2,17)
  196. 5036 Z9=1:FOR Z=4 TO 8:K$(3,Z)=MID$(N$,Z9,N(1,Z)):Z9=Z9+N(1,Z):NEXT Z
  197. 5040 close 1
  198. 5105 GOSUB 11000
  199. 5200 INPUT "IS RECORD TO BE DELETED (MUST BE YES TO DELETE)";line temp$
  200. 5205 IF left$(temp$,1)="n" OR left$(temp$,1)="N" THEN RETURN
  201. 5210 IF ucase$(temp$) <> "YES" THEN 5200
  202. 5215 N(2,1)=0
  203.      open z5$ recl 256 as 1
  204.      print #1,z1;n(2,1),n(2,2),n(2,3),n$,n(2,9),n(2,10),n(2,11),\
  205.           n(2,12),n(2,13),n(2,14),n(2,15),n(2,16),n(2,17)
  206.      close 1
  207. 5235 RETURN
  208. 6000 PRINT clear$:PRINT
  209. 6005 PRINT "IF YOU HAVE ARRIVED HERE, AND HAVE A CAPITAL GOODS FILE"
  210. 6010 PRINT "ALREADY ON A DISK, YOU SHOULD INSTALL THAT DISK THEN"
  211. 6015 PRINT "TYPE THE LETTER C FOLLOWED BY A RETURN TO CONTINUE."
  212. 6020 PRINT
  213. 6025 PRINT "IF YOU WISH TO CREATE A NEW FILE, TYPE THE LETTER N"
  214. 6030 PRINT "FOLLOWED BY RETURN.":PRINT
  215. 6035 INPUT line temp$
  216. 6040 IF left$(temp$,1)="c" or left$(temp$,1)="C" THEN initialize:GOTO 1500
  217. 6045 PRINT clear$:PRINT
  218. 6050 INPUT "NUMBER OF RECORDS DESIRED";z3
  219. 6055 PRINT
  220. 6060 n$="":for z=1 to 70:n$=n$+" ":next z:FOR Z=1 TO 20:N(2,Z)=0:NEXT Z
  221. 6065 create z5$ recl 256 as 1
  222. 6070 FOR Z1=1 TO z3+2
  223.      print #1,z1;n(2,1),n(2,2),n(2,3),n$,n(2,9),n(2,10),n(2,11),\
  224.           n(2,12),n(2,13),n(2,14),n(2,15),n(2,16),n(2,17)
  225. 6085 NEXT Z1
  226. 6090 close 1
  227. 6095 PRINT clear$:PRINT
  228. 6100 PRINT "CAPITAL GOODS FILE CREATED AND CLEARED.":PRINT
  229. 6105 PRINT z3;"RECORDS CREATED.":PRINT
  230. 6110 PRINT "TO CONTINUE, TYPE RETURN.":INPUT line temp$
  231.     Z2=1
  232.     create z7$ as 1:print #1;Z2,Z3:close 1
  233. 6115 GOTO 1500
  234. 7000 z2=(size(z5$)*block.size)/256:for z=1 to 20:n(2,z)=0:next z
  235.      n$="":for z=1 to 70:n$=n$+" ":next z
  236. 7006 INPUT "ARE YOU SURE !!! (YES OR NO)";line temp$
  237. 7007 IF ucase$(temp$)<>"YES" THEN RETURN
  238.      open z5$ recl 256 as 1
  239. 7010 FOR Z1=1 TO z3+2
  240.      print #1,z1;n(2,1),n(2,2),n(2,3),n$,n(2,9),n(2,10),n(2,11),\
  241.           n(2,12),n(2,13),n(2,14),n(2,15),n(2,16),n(2,17)
  242. 7025 NEXT Z1
  243. 7030 close 1
  244. 7035 PRINT clear$:PRINT
  245. 7040 PRINT "CAPITAL GOODS FILE CLEARED!":PRINT
  246. 7045 PRINT "TO CONTINUE, TYPE RETURN."
  247. 7050 INPUT line temp$
  248.     Z2=1
  249.     open z7$ as 1:print #1;Z2,Z3:close 1
  250. 7060 RETURN
  251. 8000 chain "cgsort"
  252. 9000 lprinter
  253. 9005 PRINT clear$:PRINT
  254. 9010 open z5$ recl 256 as 1
  255. 9015 FOR I=1 TO Z2-1
  256.      read #1,i;n(2,1),n(2,2),n(2,3),n$,n(2,9),n(2,10),n(2,11),\
  257.           n(2,12),n(2,13),n(2,14),n(2,15),n(2,16),n(2,17)
  258. 9035 Z9=1:FOR Z=4 TO 8:K$(3,Z)=MID$(N$,Z9,N(1,Z)):Z9=Z9+N(1,Z):NEXT Z
  259. 9110 print "RECORD NUMBER";i;TAB(31);"CAPITAL GOODS ENTRY"
  260. 9115 FOR Z=1 TO 3
  261. 9116 print K$(2,Z);TAB(30);:print using u$;n(2,z)
  262. 9118 NEXT Z
  263. 9120 FOR Z=4 TO 8
  264. 9122 print K$(2,Z);TAB(30);K$(3,Z)
  265. 9124 NEXT Z
  266. 9125 FOR Z=9 TO 11
  267. 9126 print K$(2,Z);TAB(30);:print using l$;n(2,z)
  268. 9127 NEXT Z
  269. 9128 FOR Z=12 TO 13
  270. 9130 print K$(2,Z);TAB(30);:print using u$;n(2,z)
  271. 9132 NEXT Z
  272. 9134 FOR Z=14 TO 17
  273. 9136 print K$(2,Z);TAB(30);:print using l$;n(2,z)
  274. 9138 NEXT Z
  275. 9145 print chr$(12)
  276. 9150 NEXT I
  277. 9155 close 1
  278.      console
  279. 9900 RETURN
  280. 10000 CHAIN "master16"
  281. 11000 PRINT clear$:PRINT
  282. 11110 PRINT "RECORD NUMBER";Z1;TAB(31);"CAPITAL GOODS ENTRY"
  283. 11115 FOR Z=1 TO 3
  284. 11116 PRINT K$(2,Z);TAB(30);:print using u$;n(2,z)
  285. 11118 NEXT Z
  286. 11120 FOR Z=4 TO 8
  287. 11122 PRINT K$(2,Z);TAB(30);K$(3,Z)
  288. 11124 NEXT Z
  289. 11125 FOR Z=9 TO 11
  290. 11126 PRINT K$(2,Z);TAB(30);:print using l$;n(2,z)
  291. 11127 NEXT Z
  292. 11128 FOR Z=12 TO 13
  293. 11130 PRINT K$(2,Z);TAB(30);:print using u$;n(2,z)
  294. 11132 NEXT Z
  295. 11134 FOR Z=14 TO 17
  296. 11136 PRINT K$(2,Z);TAB(30);:print using l$;n(2,z)
  297. 11138 NEXT Z
  298. 11140 RETURN
  299. 15000    print clear$:print:print "CHECKING FILE LENGTH"
  300.     PRINT:PRINT "*** PLEASE WAIT ***"
  301.     open z5$ recl 256 as 1
  302.     z3=(size(z5$)*block.size)/256
  303.     for z2=1 to z3
  304.     read #1,z2;n(2,1),n(2,2)
  305.     if n(2,2)=0 then 15300
  306.     next z2
  307. 15300    z3=int(z3)-2
  308.     close 1
  309.     create z7$ as 1
  310.     print #1;z2,z3
  311.     close 1
  312.     GOTO 1500
  313.