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 / CPMUG088.ARK / EPDPOSIT.BAS < prev    next >
BASIC Source File  |  1984-04-29  |  8KB  |  240 lines
  1.      rem This is the Federal Tax Deposit Entry Program
  2.  
  3. %INCLUDE ALL.BAS
  4.      dim n(2,20),k$(6,20)
  5.      z5$="b:edep":z6$=z5$+"back":z7$=z5$+"size"
  6.      repeat$="-------------------------------"
  7.      fill$="                               "
  8.      l$="$#,###,###.##"
  9.      RESTORE
  10. 540 K$(6,1)="1 - NEW ENTRY":K$(6,2)="2 - EXAMINE EXISTING ENTRY"
  11. 550 K$(6,3)="3 - MODIFY EXISTING ENTRY"
  12. 560 K$(6,4)="4 - NOT USED"
  13. 570 K$(6,5)="5 - CREATE NEW FILE":K$(6,6)="6 - CLEAR EXISTING FILE"
  14. 580 K$(6,7)="7 - NOT USED":K$(6,8)="8 - LIST FILE"
  15. 590 K$(6,9)="9 - FINISHED"
  16. 1075 K$(1,1)="QUARTER (1,2,3 OR 4)":K$(1,2)="MONTH (1,2 OR 3)"
  17. 1080 K$(1,3)="PERIOD (1,2,3 OR 4)":K$(1,4)="TAX LIABILITY"
  18. 1085 K$(1,5)="AMOUNT OF ANY DEPOSIT":K$(1,6)="CHECK NO."
  19. 1090 K$(1,7)="DATE OF DEPOSIT"
  20. 1095 K$(2,1)="1 - QUARTER (1,2,3 OR 4)":K$(2,2)="2 - MONTH (1,2 OR 3)"
  21. 1100 K$(2,3)="3 - PERIOD (1,2,3 OR 4)":K$(2,4)="4 - TAX LIABILITY"
  22. 1110 K$(2,5)="5 - AMOUNT OF ANY DEPOSIT":K$(2,6)="6 - CHECK NO."
  23. 1115 K$(2,7)="7 - DATE OF DEPOSIT":K$(2,8)="8 - NONE"
  24. 1135 N(1,1)=1:N(1,2)=1:N(1,3)=1:N(1,4)=12:N(1,5)=12:N(1,6)=8:N(1,7)=8
  25.     print clear$:print
  26.  
  27. 1500    if end #1 then 6000
  28.     if end #2 then 15000
  29.         open z5$ recl 64 as 1
  30.         close 1
  31.         open z7$ as 2
  32.         read #2;z2,z3
  33.         close 2
  34.  
  35. 1600    REM
  36. 1620    PRINT CLEAR$
  37.     if z2>z3 then print "*** OUT OF RECORD SPACE ***"
  38.     PRINT "FEDERAL PAYROLL DEPOSIT ENTRY PROGRAM"
  39.         PRINT      "-------------------------------------"
  40.     PRINT:PRINT "THERE ARE ";Z3;" AVAILABLE RECORDS"
  41.     PRINT "OF THESE THERE ARE:";TAB(30);(Z3-Z2)+1;" RECORDS OPEN"
  42.     PRINT                      ;TAB(30);Z2-1;" RECORDS USED"
  43.     PRINT
  44.  
  45. 1650 PRINT "THIS IS A LIST OF OPERATIONS."
  46. 1655 PRINT
  47. 1660 FOR Z=1 TO 9:PRINT K$(6,Z):NEXT Z:PRINT
  48. 1665 PRINT "INDICATE WHAT YOU WOULD LIKE TO DO BY TYPING"
  49. 1670 PRINT "THE CORRESPONDING NUMBER."
  50. 1675 PRINT
  51. 1680 INPUT Z
  52.     IF Z<1 OR Z>9 then 1620
  53. 1682 IF Z=1 THEN new$="N"
  54. 1685 ON Z GOSUB 2000,3000,4000,5000,6000,7000,8000,9000,10000
  55. 1690 FOR Z=1 TO 20:N(2,Z)=0:NEXT Z:N$=" "
  56. 1700 FOR Z=1 TO 20:K$(3,Z)=" ":NEXT Z
  57. 1702 new$=""
  58. 1705 GOTO 1600
  59. 2000 PRINT clear$:PRINT
  60. 2005 PRINT "RECORD NUMBER";Z2:PRINT
  61. 2015 FOR Z=1 TO 5
  62.     PRINT CUR$
  63. 2020 PRINT TAB(30);left$(repeat$,n(1,z))
  64.     PRINT UP$;
  65. 2025 PRINT K$(1,Z);TAB(30);
  66. 2030 INPUT N(2,Z):PRINT chr$(13)
  67.     PRINT CLEAR$
  68. 2035 NEXT Z
  69. 2040 FOR Z=6 TO 7
  70.     PRINT CUR$
  71. 2045 PRINT TAB(30);left$(repeat$,n(1,z))
  72.     PRINT UP$;
  73. 2050 PRINT K$(1,Z);TAB(30);
  74. 2055 INPUT line K$(3,Z):PRINT chr$(13)
  75.     if len(k$(3,z))>n(1,z) then k$(3,z)=left$(k$(3,z),n(1,z))
  76. 2060 I=(N(1,Z)-LEN(K$(3,Z))):K$(3,Z)=K$(3,Z)+left$(fill$,i)
  77.     PRINT CLEAR$
  78. 2065 NEXT Z
  79. 2090 N$=""
  80. 2095 FOR Z=6 TO 7:N$=N$+K$(3,Z):NEXT Z
  81. 2100 Z1=Z2
  82. 2105 PRINT clear$:PRINT
  83. 2110 PRINT "RECORD NUMBER";Z1:PRINT
  84. 2115 FOR Z=1 TO 5
  85. 2120 PRINT K$(2,Z);TAB(30);N(2,Z)
  86. 2125 NEXT Z
  87. 2130 FOR Z=6 TO 7
  88. 2135 PRINT K$(2,Z);TAB(30);K$(3,Z)
  89. 2140 NEXT Z
  90. 2142 PRINT K$(2,8)
  91. 2145 PRINT
  92. 2150 PRINT "IF AN ITEM IS TO BE CHANGED, TYPE THE APPROPRIATE NUMBER."
  93. 2155 PRINT:INPUT Z
  94. 2160 PRINT
  95. 2165 IF Z>7 THEN 2216
  96. 2170 IF Z<1 THEN 2105
  97. 2175 IF Z>5 THEN 2200
  98. 2180 PRINT TAB(30);left$(repeat$,n(1,z))
  99.     PRINT UP$;
  100. 2185 PRINT K$(1,Z);TAB(30);
  101. 2190 INPUT N(2,Z)
  102. 2195 GOTO 2225
  103. 2200 PRINT TAB(30);left$(repeat$,n(1,z))
  104.     PRINT UP$;
  105. 2205 PRINT K$(1,Z);TAB(30);
  106. 2210 INPUT line K$(3,Z)
  107.     if len(k$(3,z))>n(1,z) then k$(3,z)=left$(k$(3,z),n(1,z))
  108. 2215 I=(N(1,Z)-LEN(K$(3,Z))):K$(3,Z)=K$(3,Z)+left$(fill$,i)
  109. 2216 N$=""
  110. 2220 FOR Z=6 TO 7:N$=N$+K$(3,Z):NEXT Z
  111. 2225 INPUT "ANY MORE CHANGES";line temp$
  112. 2230 IF left$(temp$,1)="y" OR left$(temp$,1)="Y" THEN 2105
  113. 2235 PRINT
  114. 2240 INPUT "IS RECORD TO BE ENTERED";line temp$
  115. 2245 PRINT
  116. 2250 IF left$(temp$,1)="y" OR left$(temp$,1)="Y" THEN 2280
  117. 2255 IF left$(temp$,1)<>"n" AND left$(temp$,1)<>"N" THEN 2235
  118. 2260 PRINT clear$:PRINT
  119. 2270 PRINT "*** RECORD NOT ENTERED ***":PRINT:PRINT
  120. 2275 FOR Z=1 TO 200:NEXT Z:RETURN
  121. 2280 open z5$ recl 64 as 1
  122.      print #1,z1;n(2,1),n(2,2),n(2,3),n(2,4),n(2,5),n$
  123.      close 1
  124. 2295 IF new$="N" THEN Z2=Z2+1:open z7$ as 1:print #1;z2,z3:close 1
  125. 2300 RETURN
  126. 3000 PRINT clear$:PRINT
  127. 3005 INPUT "RECORD NUMBER";Z1
  128. 3010 IF Z1>=Z2 THEN 3000
  129. 3012 IF Z1<1 THEN RETURN
  130. 3020 open z5$ recl 64 as 1
  131.      read #1,z1;n(2,1),n(2,2),n(2,3),n(2,4),n(2,5),n$
  132.      close 1
  133. 3026 Z9=1:FOR Z=6 TO 7:K$(3,Z)=MID$(N$,Z9,N(1,Z)):Z9=Z9+N(1,Z):NEXT Z
  134. 3030 PRINT
  135. 3035 FOR Z=1 TO 5
  136. 3040 PRINT K$(1,Z);TAB(30);N(2,Z)
  137. 3045 NEXT Z
  138. 3050 FOR Z=6 TO 7
  139. 3055 PRINT K$(1,Z);TAB(30);K$(3,Z)
  140. 3060 NEXT Z
  141. 3070 PRINT
  142. 3075 PRINT "FOR A NEW RECORD NUMBER, TYPE N - RETURN.":PRINT
  143. 3080 PRINT "IF FINISHED, TYPE F - RETURN.":PRINT
  144. 3085 INPUT line temp$
  145. 3090 IF ucase$(temp$)="N" THEN 3000
  146. 3095 RETURN
  147. 4000 PRINT clear$:PRINT
  148. 4005 N$=""
  149. 4010 INPUT "RECORD NUMBER";Z1
  150. 4015 IF Z1<1 THEN PRINT "*** NO SUCH RECORD ***":GOTO 1620
  151. 4020 IF Z1>Z3 THEN PRINT "*** OUT OF RANGE ***":GOTO 1620
  152. 4025 IF Z1>=Z2 THEN PRINT "NO RECORD NUMBER";Z1:GOTO 1620
  153. 4030 open z5$ recl 64 as 1
  154.      read #1,z1;n(2,1),n(2,2),n(2,3),n(2,4),n(2,5),n$
  155.      close 1
  156. 4045 IF N(2,1)=0 THEN PRINT "*** DELETED RECORD ***":GOTO 1620
  157. 4050 Z9=1:FOR Z=6 TO 7:K$(3,Z)=MID$(N$,Z9,N(1,Z)):Z9=Z9+N(1,Z):NEXT Z
  158. 4075 GOTO 2105
  159. 5000 RETURN
  160. 6000 PRINT clear$:PRINT
  161. 6005 PRINT "IF YOU HAVE ARRIVED HERE, AND HAVE A FED DEPOSIT FILE"
  162. 6010 PRINT "ALREADY ON A DISK, YOU SHOULD INSTALL THAT DISK THEN"
  163. 6015 PRINT "TYPE THE LETTER C FOLLOWED BY A RETURN TO CONTINUE."
  164. 6020 PRINT
  165. 6025 PRINT "IF YOU WISH TO CREATE A NEW FILE, TYPE THE LETTER N"
  166. 6030 PRINT "FOLLOWED BY RETURN.":PRINT
  167. 6035 INPUT line temp$
  168. 6040 IF ucase$(temp$)="C" THEN initialize:GOTO 1500
  169. 6045 PRINT clear$:PRINT
  170.     z3=48
  171. 6055 PRINT
  172.      n$="":for z=1 to 30:n$=n$+" ":next z
  173.      for z=1 to 10:n(2,z)=0:next z
  174. 6065 create z5$ recl 64 as 1
  175. 6070 FOR Z1=1 TO z3+2
  176.      print #1,z1;n(2,1),n(2,2),n(2,3),n(2,4),n(2,5),n$
  177. 6085 NEXT Z1
  178. 6090 close 1
  179. 6095 PRINT clear$:PRINT
  180. 6100 PRINT "FED DEPOSIT FILE CREATED AND CLEARED.":PRINT
  181. 6105 PRINT z3;"RECORDS CREATED.":PRINT
  182. 6110 PRINT "TO CONTINUE, TYPE RETURN.":INPUT line temp$
  183.     Z2=1
  184.     create z7$ as 1:print #1;Z2,Z3:close 1
  185. 6115 GOTO 1500
  186. 7000 n$="":for z=1 to 30:n$=n$+" ":next z
  187.      for z=1 to 10:n(2,z)=0:next z
  188. 7006 INPUT "ARE YOU SURE !!! (YES OR NO)";line temp$
  189. 7007 IF ucase$(temp$)<>"YES" THEN RETURN
  190.      open z5$ recl 64 as 1
  191. 7010 FOR Z1=1 TO z3+2
  192.      print #1,z1;n(2,1),n(2,2),n(2,3),n(2,4),n(2,5),n$
  193. 7025 NEXT Z1
  194. 7030 close 1
  195. 7035 PRINT clear$:PRINT
  196. 7040 PRINT "FED DEPOSIT FILE CLEARED!":PRINT
  197. 7045 PRINT "TO CONTINUE, TYPE RETURN."
  198. 7050 INPUT line temp$
  199.     Z2=1
  200.     open z7$ as 1:print #1;Z2,Z3:close 1
  201. 7060 RETURN
  202. 8000 RETURN
  203. 9000 PRINT clear$:PRINT:PRINT "LISTING"
  204. 9010 P1=1:P2=1:P3=12
  205. 9020 lprinter
  206. 9030 open z5$ recl 64 as 1
  207. 9040 print chr$(12)
  208. 9045 print "FEDERAL DEPOSIT RECORD LISTING"
  209. 9050 print
  210. 9055 print "QUARTER";TAB(10);"MONTH";TAB(20);"PERIOD";TAB(30);
  211. 9060 print "TAX LIABILITY";TAB(50);"AMOUNT OF DEPOSIT";TAB(70);
  212. 9065 print "CHECK #";TAB(80);"DATE OF DEPOSIT"
  213. 9070 print
  214. 9075 FOR Z1=1 TO Z2-1
  215.      read #1,z1;n(2,1),n(2,2),n(2,3),n(2,4),n(2,5),n$
  216. 9085 Z9=1:FOR Z=6 TO 7:K$(3,Z)=MID$(N$,Z9,N(1,Z)):Z9=Z9+N(1,Z):NEXT Z
  217. 9090 print N(2,1);TAB(10);N(2,2);TAB(20);N(2,3);TAB(30);
  218.      print using l$;n(2,4);tab(50);n(2,5);
  219. 9095 print TAB(70);K$(3,6);TAB(80);K$(3,7)
  220. 9100 NEXT Z1
  221. 9110 print chr$(12):FOR Z=1 TO 100:NEXT Z:print chr$(12)
  222. 9115 close 1
  223.     console
  224.     return
  225. 10000 chain "master5"
  226. 15000    print clear$:print:print "CHECKING FILE LENGTH"
  227.     PRINT:PRINT "*** PLEASE WAIT ***"
  228.     open z5$ recl 64 as 1
  229.     z3=(size(z5$)*block.size)/64
  230.     for z2=1 to z3
  231.     read #1,z2;n(2,1),n(2,2)
  232.     if n(2,2)=0 then 15300
  233.     next z2
  234. 15300    z3=48
  235.     close 1
  236.     create z7$ as 1
  237.     print #1;z2,z3
  238.     close 1
  239.     GOTO 1500
  240.