home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / cpmug / cpmug087.ark / CGFM4562.BAS < prev    next >
Encoding:
BASIC Source File  |  1986-10-20  |  2.8 KB  |  87 lines
  1.      rem This is the IRS Form 4652 - Depreciation Printer
  2.  
  3. %INCLUDE ALL.BAS
  4.      dim n(2,20),k$(3,20)
  5.      z5$="b:cg"
  6.      RESTORE
  7. 1008 DIM H(9),S(9),T(4,9)
  8. 1009 PRINT clear$:PRINT
  9. 1090 U$="##,###,###"
  10. 1095 FOR Z=1 TO 104:A$=A$+"-":NEXT Z
  11. 1100 REM GET DATES ROUTINE
  12. 1145 Z9=0
  13. 1200 REM READ TAB VALUES ROUTINE
  14. 3000 REM READ NAME FILE SUBROUTINE
  15. 3005 a5=T%(12)
  16.      for z=3 to 11:read n(1,z):next z
  17.      data 24,24,24,17,2,5,14,20,20
  18. 3085 Z9=1:FOR Z=3 TO 11:K$(0,Z)=MID$(N$,Z9,N(1,Z)):Z9=Z9+N(1,Z):NEXT Z
  19. 3090 N$="":FOR Z=1 TO 20:N(1,Z)=0:NEXT Z
  20. 3125 REM ROUTINE TO ELIMINATE TRAILING BLANKS
  21.      l8=1
  22. 3130 for I=3 TO 6
  23.      l9=len(k$(0,i))
  24. 3140 FOR Z=l9 to l8 step -1
  25. 3150 IF MID$(K$(0,I),Z,1)<>" " THEN 3170
  26. 3160 NEXT Z
  27. 3170 Z$=""
  28. 3180 FOR Z0=1 TO Z
  29. 3190 Z$=Z$+MID$(K$(0,I),Z0,1)
  30. 3200 NEXT Z0
  31. 3210 K$(0,I)="":K$(0,I)=Z$
  32. 3220 NEXT I
  33. 6000 REM PROGRAM TO PRINT DEPRECIATION REPORT
  34. 6005 PRINT clear$:PRINT
  35. 6010 PRINT "PRINTING DEPRECIATION REPORT"
  36. 6030 T1=0:T2=0:T3=0:T4=0:P0=1
  37. 6035 X=1
  38. 6040 for z=4 to 8:read n(1,z):next z
  39.      data 24,24,1,8,2
  40. 6200 open z5$ recl 256 as 1
  41. 6205 z3=(size(z5$)*block.size)/256
  42. 6210 FOR Z2=1 TO Z3
  43. 6215 read #1,z2;n(2,1),n(2,2),n(2,3),n$
  44. 6220 IF N(2,2)=0 THEN 6230
  45. 6225 NEXT Z2
  46. 6230 close 1
  47. 6235 Z2=Z2-1
  48. 6240 PRINT:PRINT "RECORDS TO BE PRINTED ";Z2
  49. 6245 PRINT:INPUT "TO PRINT REPORT, TYPE RETURN.";line temp$
  50.      lprinter:P9=0
  51. 6300 open z5$ recl 256 as 1
  52. 6310 FOR Z1=1 TO Z2
  53. 6320 read #1,z1;N(2,1),N(2,2),N(2,3),N$,D1,D2,D3,D4,D5,D6,D7,D8,D9
  54. 6330 Z9=1:FOR Z=4 TO 8:K$(3,Z)=MID$(N$,Z9,N(1,Z)):Z9=Z9+N(1,Z):NEXT Z
  55. 6340 IF RIGHT$(K$(3,7),2)=RIGHT$(D$(6),2) AND D3>D8 THEN T3=T3+D3-D8
  56. 6350 NEXT Z1
  57. 6360 print TAB(7);K$(0,4);TAB(61);K$(0,10):P9=P9+1
  58. 6370 FOR Z=1 TO 5:print:NEXT Z:P9=P9+5
  59. 6380 print TAB(67);:print using u$;t3:P9=P9+1
  60.      console
  61. 6390 PRINT clear$:PRINT
  62. 6395 PRINT "ENTER DEPRECIATION FROM ANY FORM 4832 (CLADR)."
  63. 6400 INPUT T9
  64.      lprinter
  65. 6405 print TAB(67);:print using u$;t9:P9=P9+1
  66. 6410 FOR Z=1 TO 6:print:NEXT Z:P9=P9+6:T3=T3+T9
  67. 6500 FOR Z1=1 TO Z2
  68. 6510 read #1,z1;N(2,1),N(2,2),N(2,3),N$,D1,D2,D3,D4,D5,D6,D7,D8,D9
  69. 6520 Z9=1:FOR Z=4 TO 8:K$(3,Z)=MID$(N$,Z9,N(1,Z)):Z9=Z9+N(1,Z):NEXT Z
  70. 6530 print TAB(7);LEFT$(K$(3,4),15);TAB(24);K$(3,7);TAB(33);
  71. 6540 print using u$;d1;tab(44);d3;tab(56);:print k$(3,8);tab(61);
  72. 6550 print using "####";d4;tab(67);:print using u$;d8
  73. 6560 T1=T1+D1:T2=T2+D8:P9=P9+1
  74.      console
  75. 6570 IF P9>38 THEN PRINT "INSERT ANOTHER SHEET AND ADVANCE TO FIRST DESC LINE"
  76. 6575 IF P9>38 THEN INPUT "TYPE RETURN TO CONTINUE ";line temp$
  77.      lprinter
  78. 6580 NEXT Z1
  79. 6590 FOR Z=P9 TO 39:print:NEXT Z
  80. 6600 print using u$;tab(33);t1;tab(67);t2+t3
  81. 6995 GOTO 20000
  82. 20000 REM ROUTINE TO CLOSE FILES AND RETURN TO master16
  83.      print chr$(12)
  84. 20005 close 1
  85. 20040 console
  86. 20050 CHAIN "master16"
  87.