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 / CRPPINV.BAS < prev    next >
BASIC Source File  |  1984-04-29  |  6KB  |  207 lines
  1.      rem This is the Preprinted Invoice 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.  
  14.     for z=1 to 49:fmttemp$=fmttemp$+" ":next z
  15.  
  16.     fmt5$=fmttemp$+"##########"
  17.     fmt8$=fmttemp$+"/...5...10...15/  /...5../"
  18.  
  19.     fmt10$="      /...5...10...15...20.../                    "
  20.     fmt10$=fmt10$+"/...5...10...15...20.../"
  21.  
  22.     fmt11$=fmt10$
  23.     fmt12$=fmt10$
  24.  
  25.     fmt13$="      /...5...10...15./, //  /.../                "
  26.     fmt13$=fmt13$+"/...5...10...15./, //  /.../"
  27.  
  28.     fmt18$="########## /...5../ /...5../            /...5...1/  "
  29.     fmt18$=fmt18$+"/...5...1/   /...5...10.../"
  30.  
  31.     fmt21$="##########  ##########    /...5...10...15...20.../"
  32.     fmt21$=fmt21$+"              ##,###.## ###,###.##"
  33.  
  34.     fmttemp$="":for z=1 to 74:fmttemp$=fmttemp$+" ":next z
  35.     fmt39$=fmttemp$+"###,###.##"
  36.  
  37.      u$="###,###.##"
  38.      print clear$:print
  39. 1100 REM GET DATES ROUTINE
  40. 1145 Z9=0
  41. 1200 REM READ TAB VALUES ROUTINE
  42. 3000 REM READ NAME FILE SUBROUTINE
  43. 3005 a5=T%(12)
  44. 3080 Z=24:Z9=1
  45. 3090 FOR Z0=1 TO 4
  46. 3100 K$(0,Z0)=MID$(N$,Z9,Z)
  47. 3110 Z9=Z9+Z
  48. 3120 NEXT Z0
  49. 3125 REM ROUTINE TO ELIMINATE TRAILING BLANKS
  50.      l8=1
  51. 3130 FOR I=1 TO 4
  52.      l9=len(k$(0,i))
  53. 3140 for z=l9 to l8 step -1
  54. 3150 IF MID$(K$(0,I),Z,1)<>" " THEN 3170
  55. 3160 NEXT Z
  56. 3170 Z$=""
  57. 3180 FOR Z0=1 TO Z
  58. 3190 Z$=Z$+MID$(K$(0,I),Z0,1)
  59. 3200 NEXT Z0
  60. 3210 K$(0,I)="":K$(0,I)=Z$
  61. 3220 NEXT I
  62. 6000 REM PRINT INVOICES
  63. 6005 PRINT clear$:PRINT
  64. 6010 PRINT "PRINTING INVOICES"
  65. 6015 FOR Z=0 TO 9
  66. 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
  67. 6025 NEXT Z
  68. 6030 T1=0:T2=0:T3=0:T4=0:T5=0:T6=0:P0=1
  69. 6035 X=1
  70. 6040 PRINT:PRINT "INSTALL INVOICE REGISTER DISK IN DRIVE A"
  71. 6045 PRINT:PRINT "INSTALL A CUSTOMER DISK IN DRIVE B":PRINT
  72. 6046 PRINT chr$(07)
  73. 6050 INPUT "TYPE RETURN TO CONTINUE ";line temp$
  74.      initialize
  75. 6100 p9=0
  76.  
  77.     open "a:irsize" as 1
  78.         read #1;z2,z3
  79.         close 1
  80.         z2=z2-1
  81.  
  82. 6240 PRINT clear$:PRINT
  83. 6245 PRINT:PRINT "INVOICES TO BE PRINTED ";Z2
  84. 6246 PRINT chr$(07)
  85. 6250 PRINT:INPUT "TO PRINT INVOICES, TYPE RETURN.";line temp$
  86.     lprinter
  87. 6300 open z5$ recl 384 as 1
  88. 6310 open z6$ recl 384 as 2
  89. 6320 FOR I=1 TO Z2
  90. 6350 GOSUB 15000
  91. 6380 NEXT I
  92. 6410 GOTO 20000
  93. 15000 IF I>Z2 THEN 15595
  94.       read #1,i;N(3,1),N(3,2),N(3,3),N$,A1,D4,\
  95.            G(1),Q(1),G(2),Q(2),G(3),Q(3),G(4),Q(4),G(5),Q(5),\
  96.            G(6),Q(6),G(7),Q(7),G(8),Q(8),G(9),Q(9),G(10),Q(10)
  97. 15060 Z9=1:FOR Z=4 TO 11:K$(3,Z)=MID$(N$,Z9,N(0,Z)):Z9=Z9+N(0,Z):NEXT Z
  98. 15065 if mid$(k$(3,11),2,1)="I" then 15595
  99. 15070 z$="":z$=left$(k$(3,11),1)+"I"+right$(k$(3,11),2):k$(3,11)=z$
  100. 15105 read #2,a1;n(4,1),n(4,2),o$,c1,c2,c3,c4,c5,c6
  101. 15115 close 2
  102. 15120 Z9=1:FOR Z=3 TO 17:K$(4,Z)=MID$(O$,Z9,N(1,Z)):Z9=Z9+N(1,Z):NEXT Z
  103. 15200 for z=1 to 4:print:next z
  104.  
  105.       print using fmt5$;n(3,3)
  106.       print:print
  107.       print using fmt8$;k$(3,4),d$(1)
  108.  
  109.     print
  110.       print using fmt10$;k$(4,3),k$(4,10)
  111.       print using fmt11$;k$(4,4),k$(4,11)
  112.       print using fmt12$;k$(4,5),k$(4,12)
  113.       print using fmt13$;k$(4,6),k$(4,7),k$(4,8),k$(4,13),k$(4,14),k$(4,15)
  114.  
  115. 15240 FOR Z=1 TO 4:print:NEXT Z
  116.  
  117. 15270 IF VAL(K$(3,9))=1 THEN terms$= "PREPAID"
  118. 15275 IF VAL(K$(3,9))=2 THEN terms$= "COD"
  119. 15280 IF VAL(K$(3,9))=3 THEN terms$= "1% 10, NET 30"
  120. 15285 Z$=K$(3,9)
  121. 15286 IF VAL(Z$)<>1 AND VAL(Z$)<>2 AND VAL(Z$)<>3 THEN terms$= K$(3,9)
  122.  
  123.       print using fmt18$;n(4,2),k$(3,6),k$(3,7),k$(3,8),terms$,k$(3,5)
  124. 15290 print:print
  125.  
  126.     console
  127.  
  128. 15350 PRINT clear$:PRINT
  129. 15352 PRINT "INSTALL THE APPROPRIATE FINISHED GOODS DISK IN DRIVE B"
  130. 15353 PRINT chr$(07)
  131. 15354 PRINT:INPUT "TYPE RETURN TO CONTINUE ";line temp$
  132.     lprinter
  133.     initialize
  134.     open z7$ recl 256 as 3
  135.  
  136.     lines=20
  137.  
  138. 15358 FOR J=1 TO 10
  139. 15360 IF G(J)=0 THEN 15500
  140. 15365 read #3,g(j);Z,Z,F$,F0,F1,F2,F3,F4,F5,F6,F7,F8,F9
  141. 15370 IF Q(J)<=F3 THEN quan=q(j):F3=F3-q(j)
  142.       if q(j)>f3 then quan=f3:b.o.=q(j)-f3:F3=0
  143. 15380 Z9=1:FOR Z=3 TO 9:K$(5,Z)=MID$(F$,Z9,N(2,Z)):Z9=Z9+N(2,Z):NEXT Z
  144.  
  145.     print using fmt21$;quan,b.o.,k$(5,5),f2,f2*q(j):lines=lines+1
  146.  
  147.     print #3,g(j);Z,Z,F$,F0,F1,F2,F3,F4,F5,F6,F7,F8,F9
  148.  
  149.         quan=0:b.o.=0
  150.  
  151. 15395 D3=D3+(Q(J)*F2):T2=T2+(Q(J)*F1)
  152. 15400 IF ucase$(k$(3,10))<>"T" AND ucase$(k$(3,10))<>"Y" then 15410
  153. 15405 D5=D5+(D3*.06)
  154. 15410 IF VAL(K$(3,9))=1 THEN S1=S1+D3:GOTO 15500
  155. 15415 S2=S2+D3
  156. 15500 NEXT J
  157. 15505 T4=T4+D4:T5=T5+D5
  158. 15510 print TAB(75);"-----------":lines=lines+1
  159. 15512 print TAB(45);"Total Goods";TAB(75);:print using u$;d3:lines=lines+1
  160.  
  161.     if d5=0 then 15515
  162.  
  163. 15514 print:print TAB(50);"Sales Tax";TAB(75);:print using u$;d5:lines=lines+2
  164.  
  165. 15515    if d4=0 then 15518
  166.  
  167. 15516 print TAB(50);"Shipping";TAB(75);:print using u$;d4:lines=lines+1
  168. 15518 print TAB(75);"===========":lines=lines+1
  169.  
  170.     for z=1 to 38-lines:print:next z
  171.  
  172. 15520 print using fmt39$;d3+d4+d5
  173.  
  174.     for z=1 to 4:print:next z
  175.  
  176. 15540 N$="":FOR Z=4 TO 11:N$=N$+K$(3,Z):NEXT Z
  177. 15545 print #1,i;N(3,1),N(3,2),N(3,3),n$,A1,D4,\
  178.            G(1),Q(1),G(2),Q(2),G(3),Q(3),G(4),Q(4),G(5),Q(5),\
  179.            G(6),Q(6),G(7),Q(7),G(8),Q(8),G(9),Q(9),G(10),Q(10)
  180. 15550 IF VAL(K$(3,9))=1 THEN K$(4,17)=D$(1):C1=D3+D4+D5:C2=C2+D3+D4+D5
  181.       if val(k$(3,9))=1 then 15560
  182. 15555 C3=C3+D3+D4+D5
  183. 15560 D3=0:D4=0:D5=0
  184. 15565 O$="":FOR Z=3 TO 17:O$=O$+K$(4,Z):NEXT Z
  185. 15570 close 3
  186.     console
  187. 15575 PRINT clear$:PRINT:PRINT "INSTALL CUSTOMER DISK IN DRIVE B"
  188. 15576 PRINT chr$(07)
  189. 15580 PRINT:INPUT "TYPE RETURN TO CONTINUE ";line temp$
  190.     lprinter
  191.  
  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. 20000 REM ROUTINE TO CLOSE FILES AND RETURN TO master2
  197. 20005 close 1
  198. 20010 close 2
  199.     print chr$(12):for z=1 to 100:next z:print chr$(12)
  200. 20015 console
  201. 20020 PRINT clear$:PRINT
  202. 20025 PRINT "INSTALL PROGRAM DISK IN DRIVE A":PRINT
  203. 20026 PRINT chr$(07)
  204. 20030 INPUT "TYPE RETURN TO CONTINUE ";line temp$
  205.       initialize
  206. 20050 CHAIN "master2"
  207.