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 / CRJOLIST.BAS < prev    next >
BASIC Source File  |  1984-04-29  |  8KB  |  224 lines
  1.      rem This is the Invoice Register Printing Program
  2.  
  3. %INCLUDE ALL.BAS
  4.      RESTORE
  5.      dim n(5,20),k$(5,20),h(9),s(9),t(4,9),g(10),q(10)
  6.      for z=4 to 11:read n(0,z):next z
  7.      for z=3 to 17:read n(1,z):next z
  8.      for z=3 to 9:read n(2,z):next z
  9.      data 14,10,8,8,10,10,1,4
  10.      data 24,24,24,17,2,5,14,24,24,24,17,2,5,14,8
  11.      data 7,12,24,24,8,8,10
  12.      z5$="a:ir":z6$="b:cr":z7$="b:fg"
  13.      for z=1 to 80:del$=del$+"*":del1$=del1$+"=":del2$=del2$+"-":next z
  14. fmt1$ ="           /...5...10...15...20.../"
  15. fmt2$ ="           /...5...10...15...20.../"
  16. fmt3$ ="           /...5...10...15...20.../           Invoice No.  ####"
  17. fmt4$ ="                                              Invoice Date Salesman"
  18. fmt5$ ="                                              /....../     /........./"
  19. fmt6$ ="      /...5...10...15...20.../          /...5...10...15...20.../"
  20. fmt7$ ="      /....................../          /....................../"
  21. fmt8$ ="      /....................../          /....................../"
  22. fmt9$ ="      /.............../, //  /.../      /.............../, //  /.../"
  23. fmt10$="   Your Ord No. Shipped   Via           FOB Point      Terms"
  24. fmt11$="   /........../ /....../  /........../  /......./      /.........../"
  25. fmt12$="   Quan   Quan B.O.   Description            Unit                    "
  26. fmt12$=fmt12$+"Total"
  27. fmt13$="   ###### ######      /...5...10...15...2/   $$#,###.##              "
  28. fmt13$=fmt13$+"$$##,###.##"
  29.      u$="$$##,###.##"
  30.      print clear$:print
  31. 1080 Q$="I N V O I C E   R E G I S T E R"
  32. 1100 REM GET DATES ROUTINE
  33. 1145 Z9=0
  34. 1200 REM READ TAB VALUES ROUTINE
  35. 3000 REM READ NAME FILE SUBROUTINE
  36. 3005 a5=T%(12)
  37. 3080 Z=24:Z9=1
  38. 3090 FOR Z0=1 TO 4
  39. 3100 K$(0,Z0)=MID$(N$,Z9,Z)
  40. 3110 Z9=Z9+Z
  41. 3120 NEXT Z0
  42. 3125 REM ROUTINE TO ELIMINATE TRAILING BLANKS
  43.      l8=1
  44. 3130 FOR I=1 TO 4
  45.      l9=len(k$(0,i))
  46. 3140 for z=l9 to l8 step -1
  47. 3150 IF MID$(K$(0,I),Z,1)<>" " THEN 3170
  48. 3160 NEXT Z
  49. 3170 Z$=""
  50. 3180 FOR Z0=1 TO Z
  51. 3190 Z$=Z$+MID$(K$(0,I),Z0,1)
  52. 3200 NEXT Z0
  53. 3210 K$(0,I)="":K$(0,I)=Z$
  54. 3220 NEXT I
  55. 6000 REM PRINT INVOICE REGISTER
  56. 6005 PRINT clear$:PRINT
  57. 6010 PRINT "PRINTING INVOICE REGISTER"
  58. 6015 FOR Z=0 TO 9
  59. 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
  60. 6025 NEXT Z
  61. 6030 T1=0:T2=0:T3=0:T4=0:T5=0:T6=0:P0=1
  62. 6035 X=1
  63. 6040 PRINT:PRINT "INSTALL INVOICE REGISTER DISK IN DRIVE A"
  64. 6045 PRINT:PRINT "INSTALL A CUSTOMER DISK IN DRIVE B":PRINT
  65. 6046 PRINT chr$(07)
  66. 6050 INPUT "TYPE RETURN TO CONTINUE ";line temp$
  67.      initialize
  68. 6100 p9=0
  69. 6200 open z5$ recl 384 as 1
  70. 6205 z3=(size(z5$)*block.size)/384
  71. 6210 FOR Z2=1 TO Z3
  72.      read #1,z2;z5,z6,n$
  73. 6220 IF Z6=0 THEN 6230
  74. 6225 NEXT Z2
  75. 6230 close 1
  76. 6235 Z2=Z2-1
  77. 6240 PRINT clear$:PRINT
  78. 6245 PRINT:PRINT "RECORDS TO BE PRINTED ";Z2
  79. 6246 PRINT chr$(07)
  80. 6250 PRINT:INPUT "TO PRINT REGISTER, TYPE RETURN.";line temp$
  81.     lprinter
  82. 6300 open z5$ recl 384 as 1
  83. 6310 open z6$ recl 384 as 2
  84. 6320 FOR I=1 TO Z2
  85. 6330 GOSUB 9600
  86. 6350 GOSUB 15000
  87. 6370 GOSUB 9700
  88. 6380 NEXT I
  89. 6390 GOSUB 15600
  90. 6400 GOSUB 9800
  91. 6410 GOTO 20000
  92. 9600 REM PRINT PAGE HEADING SUBROUTINE
  93. 9610 print del$:P9=P9+1
  94. 9615 print:P9=P9+1
  95. 9616 print TAB((T%(1)-LEN(Q$))/2);Q$:P9=P9+1
  96. 9617 print:P9=P9+1
  97. 9620 FOR Z=2 TO 4
  98. 9625 print TAB((T%(1)-LEN(K$(0,Z)))/2);K$(0,Z):P9=P9+1
  99. 9630 NEXT Z
  100. 9635 print:P9=P9+1
  101. 9640 print TAB(T%(10));"DATE ";D$(X);TAB(T%(11));"PAGE #";P0
  102. 9642 P9=P9+1
  103. 9645 print del1$:P9=P9+1
  104. 9695 RETURN
  105. 9700 REM REPORT CONTINUED SUBROUTINE
  106. 9705 print del1$
  107.      print "Report continues on next page"
  108. 9715 print del1$
  109. 9720 print chr$(12):P9=0
  110. 9725 P0=P0+1
  111. 9740 RETURN
  112. 9800 REM End of report ROUTINE
  113. 9810 print del1$
  114. 9820 print "End of report"
  115. 9830 print del$
  116. 9840 print chr$(12)
  117. 9845 FOR Z=1 TO 100:NEXT Z:print chr$(12)
  118. 9850 RETURN
  119. 15000 IF I>Z2 THEN 15595
  120.       read #1,i;N(3,1),N(3,2),N(3,3),N$,A1,D4,\
  121.            G(1),Q(1),G(2),Q(2),G(3),Q(3),G(4),Q(4),G(5),Q(5),\
  122.            G(6),Q(6),G(7),Q(7),G(8),Q(8),G(9),Q(9),G(10),Q(10)
  123. 15060 Z9=1:FOR Z=4 TO 11:K$(3,Z)=MID$(N$,Z9,N(0,Z)):Z9=Z9+N(0,Z):NEXT Z
  124. 15070 IF MID$(K$(3,11),3,1)="R" THEN 15595
  125. 15080 IF VAL(K$(3,9))=1 THEN K$(3,11)="P RP":GOTO 15105
  126. 15085 K$(3,11)="P R "
  127. 15105 read #2,a1;n(4,1),n(4,2),o$,c1,c2,c3,c4,c5,c6
  128. 15115 close 2
  129. 15120 Z9=1:FOR Z=3 TO 17:K$(4,Z)=MID$(O$,Z9,N(1,Z)):Z9=Z9+N(1,Z):NEXT Z
  130. 15200 print using fmt1$;k$(0,2)
  131.       print using fmt2$;k$(0,3)
  132.       print using fmt3$;k$(0,4),n(3,3)
  133.       print fmt4$
  134.       print using fmt5$;d$(1),k$(3,4)
  135.       print using fmt6$;k$(4,3),k$(4,10)
  136.       print using fmt7$;k$(4,4),k$(4,11)
  137.       print using fmt8$;k$(4,5),k$(4,12)
  138.       print using fmt9$;k$(4,6),k$(4,7),k$(4,8),k$(4,13),k$(4,14),k$(4,15)
  139. 15240 FOR Z=1 TO 2:print:NEXT Z:print del1$
  140. 15270 IF VAL(K$(3,9))=1 THEN terms$= "PREPAID"
  141. 15275 IF VAL(K$(3,9))=2 THEN terms$= "COD"
  142. 15280 IF VAL(K$(3,9))=3 THEN terms$= "1% 10, NET 30"
  143. 15285 Z$=K$(3,9)
  144. 15286 IF VAL(Z$)<>1 AND VAL(Z$)<>2 AND VAL(Z$)<>3 THEN terms$= K$(3,9)
  145.       print fmt10$
  146.       print using fmt11$;k$(3,5),k$(3,6),k$(3,7),k$(3,8),terms$
  147. 15290 print del1$
  148.       print fmt12$
  149. 15310 print del2$
  150. 15315 print
  151.     console
  152. 15350 PRINT clear$:PRINT
  153. 15352 PRINT "INSTALL THE APPROPRIATE FINISHED GOODS DISK IN DRIVE B"
  154. 15353 PRINT chr$(07)
  155. 15354 PRINT:INPUT "TYPE RETURN TO CONTINUE ";line temp$
  156.     lprinter
  157.       initialize
  158.       open z7$ recl 256 as 3
  159. 15358 FOR J=1 TO 10
  160. 15360 IF G(J)=0 THEN 15500
  161. 15365 read #3,g(j);Z,Z,F$,F0,F1,F2,F3,F4,F5,F6,F7,F8,F9
  162. 15370 IF Q(J)<=F3 THEN quan=q(j)
  163.       if q(j)>f3 then quan=f3:b.o.=q(j)-f3
  164. 15380 Z9=1:FOR Z=3 TO 9:K$(5,Z)=MID$(F$,Z9,N(2,Z)):Z9=Z9+N(2,Z):NEXT Z
  165.       print using fmt13$;quan,b.o.,k$(5,5),f2,f2*q(j)
  166.      quan=0:b.o.=0
  167. 15395 D3=D3+(Q(J)*F2):T2=T2+(Q(J)*F1)
  168. 15400 IF ucase$(k$(3,10))<>"T" AND ucase$(k$(3,10))<>"Y" then 15410
  169. 15405 D5=D5+((q(j)*f2)*.06)
  170. 15410 IF VAL(K$(3,9))=1 THEN S1=S1+(q(j)*f2):GOTO 15500
  171. 15415 S2=S2+(q(j)*f2)
  172. 15500 NEXT J
  173. 15505 T4=T4+D4:T5=T5+D5
  174. 15510 print TAB(70);"-----------"
  175. 15512 print:print TAB(58);"TOTAL";TAB(70);:print using u$;d3
  176. 15514 print:print TAB(58);"SALES TAX";TAB(70);:print using u$;d5
  177. 15516 print:print TAB(58);"SHIPPING";TAB(70);:print using u$;d4
  178. 15518 print TAB(70);"==========="
  179. 15520 print TAB(70);:print using u$;d3+d4+d5
  180. 15540 N$="":FOR Z=4 TO 11:N$=N$+K$(3,Z):NEXT Z
  181. 15545 print #1,i;N(3,1),N(3,2),N(3,3),n$,A1,D4,\
  182.            G(1),Q(1),G(2),Q(2),G(3),Q(3),G(4),Q(4),G(5),Q(5),\
  183.            G(6),Q(6),G(7),Q(7),G(8),Q(8),G(9),Q(9),G(10),Q(10)
  184. 15560 D3=0:D4=0:D5=0
  185. 15565 O$="":FOR Z=3 TO 17:O$=O$+K$(4,Z):NEXT Z
  186. 15570 close 3
  187.     console
  188. 15575 PRINT clear$:PRINT:PRINT "INSTALL CUSTOMER DISK IN DRIVE B"
  189. 15576 PRINT chr$(07)
  190. 15580 PRINT:INPUT "TYPE RETURN TO CONTINUE ";line temp$
  191.     lprinter
  192.       initialize
  193. 15582 open z6$ recl 384 as 2
  194.       print #2,a1;n(4,1),n(4,2),o$,c1,c2,c3,c4,c5,c6
  195. 15595 RETURN
  196. 15600 print :print 
  197. 15610 print del1$
  198. 15620 print "TOTAL REVENUES (SALES) ";TAB(40);:print using u$;s1+s2
  199. 15630 print "TOTAL COST OF GOODS ";TAB(40);:print using u$;t2
  200. 15640 print TAB(40);"------------"
  201. 15650 print:print "GROSS PROFIT MARGIN ";TAB(40);
  202.     print using u$;(s1+s2)-t2
  203. 15660 print:print "SHIPPING CHARGES";TAB(40);:print using u$;t4
  204. 15670 print "SALES TAX";TAB(40);:print using u$;t5
  205. 15680 print TAB(40);"============"
  206. 15690 print "TOTAL SALES,TAX AND SHIPPING";TAB(40);:print using u$;s1+s2+t4+t5
  207.       if end #4 then 15800
  208. 15700 open "b:ar" as 4
  209. 15710 print #4;s1,s2,t2,t4,t5
  210.       close 4
  211. 15795 return
  212. 15800 create "b:ar" as 4
  213.       goto 15710
  214. 20000 REM ROUTINE TO CLOSE FILES AND RETURN TO master2
  215. 20005 close 1
  216. 20010 close 2
  217. 20015 console
  218. 20020 PRINT clear$:PRINT
  219. 20025 PRINT "INSTALL PROGRAM DISK IN DRIVE A":PRINT
  220. 20026 PRINT chr$(07)
  221. 20030 INPUT "TYPE RETURN TO CONTINUE ";line temp$
  222.       initialize
  223. 20050 CHAIN "master2"
  224.