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 / CPMUG089.ARK / VPRPT.BAS < prev    next >
BASIC Source File  |  1984-04-29  |  4KB  |  124 lines
  1.      rem This is the Aged Accounts Payable Statement Printer
  2.  
  3. %INCLUDE ALL.BAS
  4.      RESTORE
  5.      dim n(2,20),k$(3,20),h(9),s(9),t(4,9)
  6. 1009 PRINT clear$:PRINT
  7. 1020 N(1,3)=24:N(1,4)=24:N(1,5)=24:N(1,6)=17:N(1,7)=2:N(1,8)=5
  8. 1025 N(1,9)=14:N(1,10)=24:N(1,11)=24:N(1,12)=24:N(1,13)=17:N(1,14)=2
  9. 1030 N(1,15)=5:N(1,16)=14:N(1,17)=8
  10. 1080 Q$="A G E D  A C C O U N T S  P A Y A B L E  R E P O R T"
  11. 1090 U$="#,###,###.##":u1$="##########":u2$="###,###.##"
  12. 1100 REM GET DATES ROUTINE
  13. 1145 Z9=0
  14. 1200 REM READ TAB VALUES ROUTINE
  15.      for z=1 to t%(1):del$=del$+"*":del1$=del1$+"=":del2$=del2$+"-":next z
  16. 3000 REM READ NAME FILE SUBROUTINE
  17. 3005 a5=T%(12)
  18. 3080 Z=24:Z9=1
  19. 3090 FOR Z0=1 TO 4
  20. 3100 K$(0,Z0)=MID$(N$,Z9,Z)
  21. 3110 Z9=Z9+Z
  22. 3120 NEXT Z0
  23. 3125 REM ROUTINE TO ELIMINATE TRAILING BLANKS
  24.      l8=1
  25. 3130 FOR I=1 TO 4
  26.      l9=len(k$(0,i))
  27. 3140 for z=l9 to l8 step -1
  28. 3150 IF MID$(K$(0,I),Z,1)<>" " THEN 3170
  29. 3160 NEXT Z
  30. 3170 Z$=""
  31. 3180 FOR Z0=1 TO Z
  32. 3190 Z$=Z$+MID$(K$(0,I),Z0,1)
  33. 3200 NEXT Z0
  34. 3210 K$(0,I)="":K$(0,I)=Z$
  35. 3220 NEXT I
  36. 6000 REM PRINT AGED ACCOUNTS PAYABLE REPORT
  37. 6005 PRINT clear$:PRINT
  38. 6010 PRINT "PRINTING AGED ACCOUNTS PAYABLE REPORT"
  39. 6015 FOR Z=0 TO 9
  40. 6020 H(Z)=0:S(Z)=0:T(0,Z)=0:T(1,Z)=0:T(2,Z)=0:T(3,Z)=0:A(Z)=0
  41. 6025 NEXT Z
  42. 6030 T1=0:T2=0:T3=0:T4=0:P0=1
  43. 6035 X=1
  44. 6100 P9=0
  45. 6200 open "b:vp" recl 384 as 1
  46. 6205 z3=(size("b:vp")*block.size)/384
  47. 6210 FOR Z2=1 TO Z3
  48. 6215 read #1,z2;n(2,1),n(2,2),n$
  49. 6220 IF N(2,2)=0 THEN 6230
  50. 6225 NEXT Z2
  51. 6230 close 1
  52. 6235 Z2=Z2-1
  53. 6240 PRINT:PRINT "RECORDS TO BE PRINTED ";Z2
  54. 6245 PRINT:INPUT "TO DO PRINT REPORT, TYPE RETURN.";line temp$
  55.     lprinter
  56. 6300 open "b:vp" recl 384 as 1
  57. 6310 J=1
  58. 6320 FOR K=1 TO (Z2/10)+1
  59. 6330 GOSUB 9600
  60. 6340 FOR I=J TO J+9
  61. 6350 GOSUB 15000
  62. 6360 NEXT I
  63. 6370 GOSUB 9700:J=J+10
  64. 6380 NEXT K
  65. 6390 GOSUB 15600
  66. 6400 GOSUB 9800
  67. 6410 GOTO 20000
  68. 9600 REM PRINT PAGE HEADING SUBROUTINE
  69. 9610 print del$:P9=P9+1
  70. 9615 print:P9=P9+1
  71. 9616 print TAB((T%(1)-LEN(Q$))/2);Q$:P9=P9+1
  72. 9617 print:P9=P9+1
  73. 9620 FOR Z=2 TO 4
  74. 9625 print TAB((T%(1)-LEN(K$(0,Z)))/2);K$(0,Z):P9=P9+1
  75. 9630 NEXT Z
  76. 9635 print:P9=P9+1
  77. 9640 print TAB(T%(10));"DATE ";D$(X);TAB(T%(11));"PAGE #";P0
  78. 9642 P9=P9+1
  79. 9645 print del1$:P9=P9+1
  80. 9650 print " REC# - NAME";TAB(36);"DATE OF LAST PAYMENT - AMOUNT";
  81. 9655 print TAB(67);"YTD PAYMENTS"
  82. 9660 print "ACCT# - PHONE#";TAB(29);"CUR-CHGS";"    30-60/CHGS";
  83. 9665 print "    60-90/CHGS      90+/CHGS"
  84. 9670 print del1$:P9=P9+1
  85. 9695 RETURN
  86. 9700 REM REPORT CONTINUED SUBROUTINE
  87. 9705 print del1$
  88. 9710 print "Report continues on next page"
  89. 9715 print del1$
  90. 9720 print chr$(12):P9=0
  91. 9725 P0=P0+1
  92. 9740 RETURN
  93. 9800 REM End of report ROUTINE
  94. 9810 print del1$
  95. 9820 print "End of report"
  96. 9830 print del$
  97. 9840 print chr$(12)
  98. 9845 FOR Z=1 TO 100:NEXT Z:print chr$(12)
  99. 9850 RETURN
  100. 15000 IF I>Z2 THEN 15595
  101. 15005 read #1,i;n(2,1),n(2,2),n$,c1,c2,c3,c4,c5,c6
  102. 15020 Z9=1:FOR Z=3 TO 17:K$(3,Z)=MID$(N$,Z9,N(1,Z)):Z9=Z9+N(1,Z):NEXT Z
  103. 15030 print I;" - ";K$(3,4);TAB(43);K$(3,17);TAB(53);
  104.       print using u$;c1;tab(68);c2
  105. 15050 print using u1$;n(2,2);:print "  ";k$(3,9);:print using u2$;c3;
  106.       print using u$;tab(38);c4;tab(53);c5;tab(68);c6
  107. 15070 IF C3+C4+C5+C6>=0 THEN 15090
  108. 15080 print TAB(57);"*** CREDIT BALANCE ***"
  109. 15090 T1=T1+C3:T2=T2+C4:T3=T3+C5:T4=T4+C6
  110. 15550 print:print
  111. 15595 RETURN
  112. 15600 print :print 
  113. 15700 print del1$
  114. 15710 T5=T4+T3+T2+T1
  115. 15720 print "TOTALS:";TAB(27);:print using u2$;t1;tab(38);
  116.       print using u$;t2;tab(53);t3;tab(68);t4
  117. 15730 print "REPORT TOTAL:";TAB(68);:print using u$;t5
  118. 15740 print del1$
  119. 15795 RETURN
  120. 20000 REM ROUTINE TO CLOSE FILES AND RETURN TO master3
  121. 20005 close 1
  122. 20040 console
  123. 20050 CHAIN "master3"
  124.