home *** CD-ROM | disk | FTP | other *** search
/ Nibble Magazine / nib30a.dsk / FEBRUARY.1987 / PRINT.BILLS.bas < prev    next >
BASIC Source File  |  2023-02-26  |  11KB  |  195 lines
  1. 1  REM  **********************
  2. 2  REM  * DATE.POKER         *
  3. 3  REM  * BY S. KARATSORIDIS *
  4. 4  REM  * KAPYRITE [K] 2013  *
  5. 5  REM  * BY STAVSOFT, INC.  *
  6. 6  REM  **********************
  7. 10  REM  **********************
  8. 20  REM  *    PRINT.BILLS     *
  9. 30  REM  *  BY A.R. CLAYTON   *
  10. 40  REM  * COPYRIGHT (C) 1987 *
  11. 50  REM  * BY MICROSPARC, INC *
  12. 60  REM  * CONCORD, MA  01742 *
  13. 70  REM  **********************
  14. 80  LOMEM: 15104: DIM DA$(30):FL$ = ""
  15. 90  REM  DECLARE DA$ ARRAY TO HOLD ONE FIELD FROM APPLEWORKS
  16. 100  REM  DECLARE FL$ AS OUR FIRST STRING VARIABLE USED BY ASSEMBLY ROUTINE
  17. 110  GOSUB 1850: GOSUB 1750: GOSUB 830: GOSUB 1630: CALL 12288
  18. 120  REM  INITIAL DISPLAY / DEFINE VARS / SELECT THE FILE / GET DATE / OPEN THE FILE FROM ASSEMBLY ROUTINE
  19. 130  IF  PEEK(252) >ZZ  THEN  PRINT  PEEK(252): END 
  20. 140  REM  LOCATION 252 IS WHERE ERR NUMBERS ARE STORED FROM ASSEMBLY ROUTINE
  21. 150  CALL 12291: REM  READ A LINE OF APPLEWORKS DATA
  22. 160  REM  THE ARRAY DA$ NOW HOLDS UP TO 30 FIELDS OF APPLEWORKS DATA
  23. 170  IF  PEEK(252) = Z1  THEN R = R +Z1: GOSUB 330: GOTO 1380: REM  END
  24. 180  REM  END THE PROGRAM IF ERR = 1 FILE END REACHED
  25. 190  GOSUB 210: GOSUB 270: GOTO 150
  26. 200  REM  CONVERT AW DATE
  27. 210 YR$ =  MID$ (DA$(6),2,2):MU =  ASC( MID$ (DA$(6),4)) -64:DA$ =  MID$ (DA$(6),5)
  28. 220 DA =  VAL(DA$):YR =  VAL(YR$) +1900
  29. 230  IF MU <3  THEN DX =  FN F1(X)
  30. 240  IF MU >2  THEN DX =  FN F2(X)
  31. 250 MU$ =  MID$ (M1$,MU *3 +Z1,3)
  32. 260 DA$(6) = MU$ +"/" +DA$ +"/" +YR$: RETURN 
  33. 270 R = R +Z1: IF R = Z1  THEN  GOTO 300: REM  NEW FILE
  34. 280  PRINT D$"READ/RAM/BILL,R"R -Z1: FOR Y = ZZ TO 5: INPUT XX$(Y): NEXT 
  35. 290  IF XX$(5) < >DA$(5)  THEN  GOSUB 330: GOTO 270: REM  PRINT BILL
  36. 300  PRINT D$"WRITE/RAM/BILL,R"ZZ: PRINT R: PRINT D$"WRITE/RAM/BILL,R"R
  37. 310  FOR Y = ZZ TO CA: PRINT DA$(Y): NEXT : PRINT DX: REM  DAYS
  38. 320 TT = TT +( VAL(DA$(9)) - VAL(DA$(8))): RETURN 
  39. 330  IF  INT(TT *100 +.5)/100 < = ZZ  THEN  GOTO 350
  40. 340  GOSUB 370
  41. 350  PRINT D$"CLOSE/RAM/BILL": PRINT D$"DELETE/RAM/BILL": PRINT D$"OPEN/RAM/BILL,L200"
  42. 360 R = ZZ:TT = ZZ: RETURN 
  43. 370  PRINT D$"PR#"PS: PRINT PW$:TT = ZZ:PASTDUE = ZZ:PT = ZZ
  44. 380  REM  TURN ON PRINTER & SEND STRING TO INHIBIT SCREEN OUTPUT AND CR'S
  45. 390  PRINT D$"READ/RAM/BILL,R1": INPUT NL$: INPUT NF$: INPUT AD$: INPUT CT$: INPUT TE$: INPUT AC$: IF AC$ = "-"  THEN  PRINT "ERR NO ACCOUNT NUMBER": END 
  46. 400  PRINT  SPC( 31);EX$;"INVOICE";EZ$: REM  PRINT EXPANDED HEADING
  47. 410  PRINT  SPC( 35);"A B COMPANY"
  48. 420  PRINT  SPC( 35);"123 SOUTH ROAD"
  49. 430  PRINT  SPC( 35);"SALISBURY NC"
  50. 440  PRINT  SPC( 35);"Tel. 1-555-555-5555
  51. 450  PRINT : PRINT : PRINT 
  52. 460  PRINT  SPC( 6);NF$ +" " +NL$: PRINT  SPC( 6);AD$: PRINT  SPC( 6);CT$: PRINT  SPC( 53);"Account Number :";AC$
  53. 470  PRINT  SPC( 53);"Invoice Date: ";TD$
  54. 480  PRINT : PRINT : PRINT 
  55. 490  GOSUB 770
  56. 500  PRINT D$"READ/RAM/BILL,R"ZZ: INPUT RR:D9 = ZZ
  57. 510  FOR R = Z1 TO RR
  58. 520  IF R/40 =  INT(R/40)  THEN  PRINT "CONTINUED :": PRINT  CHR$(12);: FOR Y = Z1 TO 15: PRINT : NEXT : PRINT "PAGE :"R/40 +Z1: PRINT : GOSUB 770
  59. 530  FOR Y = ZZ TO CA: INPUT XX$(Y): NEXT : INPUT D2: REM  DAYS
  60. 540 TT = TT +( VAL(XX$(9)) - VAL(XX$(8)))
  61. 550 TT =  INT(TT *100 +.5)/100
  62. 560  IF TT =  <ZZ  THEN PASTDUE = ZZ:D9 = Z1: REM  D9 SET MEANS BALANCE ONCE WAS ZERO
  63. 570  IF D1 -D2 >30  AND TT >ZZ  THEN PASTDUE = Z1:PT = TT:D3 = D1 -D2
  64. 580  IF D1 -D2 <31  AND PASTDUE = Z1  THEN PT = PT - VAL(XX$(8)):PT =  INT(PT *100 +.5)/100
  65. 590  IF PT < = ZZ  THEN PASTDUE = ZZ
  66. 600 V = TT: GOSUB 780:TT$ = V$: IF D9  AND  VAL(XX$(9)) >ZZ  THEN D3 = D1 -D2:D9 = ZZ: REM  FIX QUANTITY OF PAST DUE DAYS
  67. 610 XX$(6) = XX$(6) +BS$
  68. 620 XX$(7) = XX$(7) +BS$ +BS$ +BS$ +BS$
  69. 630 XX$(8) = BS$ +XX$(8)
  70. 640 XX$(9) = BS$ +XX$(9)
  71. 650 TT$ = BS$ +TT$
  72. 660  PRINT  LEFT$(XX$(6),10);
  73. 670  PRINT  LEFT$(XX$(7),40);
  74. 680  PRINT  RIGHT$(XX$(8),10);
  75. 690  PRINT  RIGHT$(XX$(9),10);
  76. 700  PRINT  RIGHT$(TT$,10): NEXT 
  77. 710  IF PASTDUE  THEN V = PT *.015: GOSUB 780:V$ = BS$ +V$: PRINT  SPC( 22)"NEW CARRYING CHARGES.................." RIGHT$(V$,10);: REM  18 PERIODS
  78. 720  REM  FINANCE CHARGE OF 1 1/2% =.015 TIMES THE PAST DUE AMOUNT
  79. 730  IF PASTDUE  THEN  GOSUB 1350:V = TT +V: GOSUB 780:V$ = BS$ +V$: PRINT  RIGHT$(V$,10)
  80. 740  PRINT : PRINT "...............................Please pay last amount in this column........^^^": REM  31/8 PERIODS
  81. 750  PRINT  CHR$(12);: PRINT : PRINT D$"PR#A$C307": RETURN 
  82. 760  REM  SEND A FORM FEED CONTROL L & TURN OFF THE PRINTER
  83. 770  PRINT "..Date..............Item..............................Credit.....Debit...Balance": PRINT : RETURN : REM  2/14/30/5/3 PERIODS
  84. 780 V =  INT(V *100 +.5)/100
  85. 790 V$ =  STR$(V): IF  INT(V) = V  THEN V$ = V$ +".00": RETURN 
  86. 800 DE =  INT((V - INT(V)) *100 +.5)/100:DE$ =  STR$(DE)
  87. 810  IF  LEN(DE$) = 3  THEN V$ =  STR$( INT(V)) +DE$: RETURN 
  88. 820 V$ =  STR$( INT(V)) +DE$ +"0": RETURN : REM  ZERO IN QUOTES
  89. 830  DIM FI$(50):H = Z1
  90. 840  REM  DIM AN ARRAY OF 50 FOR FILES FROM THE DATA DIRECTORY
  91. 850  ONERR  GOTO 1840
  92. 860  HOME : PRINT "Return = default drive 2"
  93. 870  INPUT "Enter the pathname for data disk ";PRE$: IF PRE$ = ""  THEN  PRINT D$"PREFIX,D2": GOTO 890
  94. 880  PRINT D$"PREFIX"PRE$
  95. 890  PRINT D$"PREFIX": INPUT PRE$
  96. 900  HOME : PRINT "Working": GOSUB 1260
  97. 910 HT = Z1:SN = 10:HL = 3
  98. 920 BEG = Z1
  99. 930  IF BEG >H  THEN BEG = H -10
  100. 940  IF BEG <Z1  THEN BEG = Z1
  101. 950 AA = Z1:SN = 10: IF H -BEG <10  THEN SN = H -BEG +Z1
  102. 960  FOR X = BEG TO BEG +9:SI$(AA) = FI$(X):AA = AA +Z1: NEXT 
  103. 970  HOME 
  104. 980  PRINT "_______________________________________________________________________________": REM  79 DASHES
  105. 990  PRINT "|       PRINT.BILLS by A.R. Clayton -- Copyright 1987 by MicroSPARC, Inc.     |": REM  7/5 SPACES
  106. 1000  PRINT "|       Press Escape to restart                                               |": REM  7/47 SPACES
  107. 1010  PRINT "|_____________________________________________________________________________|": REM  77 DASHES
  108. 1020  PRINT L$(2)
  109. 1030 CS = Z1
  110. 1040  FOR X = Z1 TO SN: IF X = CS  THEN  INVERSE 
  111. 1050  VTAB HL +2 +X: HTAB HT: PRINT SI$(X): NORMAL : NEXT 
  112. 1060  VTAB 19: PRINT "File Group ";BEG;" on"
  113. 1070  VTAB 21: PRINT  LEFT$(L$(5),64);"TOTAL FILES ";H
  114. 1080  VTAB 23: PRINT "^ v To move   : > Page Forward : < Page Back     Return to select"
  115. 1090  VTAB HL +2 +CS: POKE  -16368,0
  116. 1100  WAIT  -16384,128:K =  PEEK( -16384) -128: POKE  -16368,0: IF K = 27  THEN H = Z1: GOTO 860
  117. 1110  IF K = 21  OR K = 32  OR K = 42  THEN BEG = BEG +10: GOTO 930
  118. 1120  IF K = 8  THEN BEG = BEG -10: GOTO 930
  119. 1130  IF K < >10  AND K < >11  AND K < >13  THEN 1090
  120. 1140 LS = CS
  121. 1150  IF K = 11  THEN CS = CS -Z1:CS = CS *(CS >ZZ) +SN *(CS = ZZ): GOSUB 1230: GOTO 1090
  122. 1160  IF K = 10  THEN CS = CS +Z1:CS = CS *(CS < = SN) +(CS = SN +Z1): GOSUB 1230: GOTO 1090
  123. 1170  REM  GOT A SELECTION
  124. 1180 FL$ =  MID$ (SI$(CS),2,15)
  125. 1190  IF  RIGHT$(FL$,1) < >" "  THEN 1220
  126. 1200 FL$ =  LEFT$(FL$, LEN(FL$) -Z1): GOTO 1190
  127. 1210  FOR X = 1 TO 50:FI$(X) = "": NEXT 
  128. 1220  GOTO 1320: REM  ACT ON THE SELECTION
  129. 1230  VTAB HL +2 +LS: HTAB HT: PRINT SI$(LS)
  130. 1240  VTAB HL +2 +CS: INVERSE : HTAB HT: PRINT SI$(CS): NORMAL 
  131. 1250  RETURN 
  132. 1260  PRINT D$;"OPEN";PRE$;",TDIR": PRINT D$;"READ";PRE$
  133. 1270  FOR I = Z1 TO 3: INPUT L$(I): NEXT 
  134. 1280  INPUT FI$(H)
  135. 1290  IF FI$(H) < >""  THEN H = H +Z1: GOTO 1280
  136. 1300 H = H -Z1: INPUT L$(5)
  137. 1310  PRINT D$;"CLOSE"PRE$: RETURN 
  138. 1320  IF  MID$ (SI$(CS),18,3) < >"ADB"  THEN  HOME : PRINT "NON-APPLEWORKS DATABASE FILE. Please reselect": PRINT "Press Return to continue ";: GET FL$: HOME : GOTO 910
  139. 1330  REM  FILTER THE FILE SELECTION
  140. 1340  HOME : PRINT "Working on "FL$: RETURN 
  141. 1350  PRINT D$"OPEN/RAM/PDFILE": PRINT D$"APPEND/RAM/PDFILE"
  142. 1360  PRINT AC$: PRINT NF$ +" " +NL$: PRINT V$: PRINT D3: REM  1 BLANK SPACE
  143. 1370  PRINT D$"CLOSE/RAM/PDFILE": RETURN 
  144. 1380  ONERR  GOTO 1560
  145. 1390 I = ZZ: PRINT D$"PR#"PS: PRINT PW$
  146. 1400  REM  TURN ON THE PRINTER AND SEND STRING TO INHIBIT SCREEN OUTPUT AND CR'S
  147. 1410  GOSUB 1420: GOTO 1450
  148. 1420  PRINT "PAST DUE REPORT": REM  SEND A FORM FEED TO THE PRINTER
  149. 1430  PRINT "THESE CHARGES MUST BE POSTED TO EACH ACCOUNT SHOWN": PRINT : PRINT 
  150. 1440  PRINT "Acc........Name.........................Days........Charges": RETURN : REM 8/25/8PERIODS
  151. 1450  PRINT D$"OPEN/RAM/PDFILE": PRINT D$"READ/RAM/PDFILE"
  152. 1460  INPUT AC$: INPUT NF$: INPUT V$: INPUT D3
  153. 1470  PRINT AC$"      ";: REM  6 SPACES
  154. 1480 NF$ = NF$ +BS$ +BS$ +BS$
  155. 1490  PRINT  LEFT$(NF$,30);
  156. 1500 D3$ =  STR$(D3) +BS$
  157. 1510  PRINT  LEFT$(D3$,10);
  158. 1520 V =  VAL(V$): GOSUB 780: PRINT "    $"V$: REM  4 SPACES THEN $
  159. 1530 I = I +Z1: IF I = 50  THEN  GOSUB 1420:I = ZZ
  160. 1540  REM  PRINT 50 LINES THEN GOTO NEXT PAGE
  161. 1550  GOTO 1460
  162. 1560  POKE 222,0: PRINT D$"CLOSE": REM  RESET ERR HANDLING & CLOSE ALL FILES
  163. 1570  PRINT D$"PR#A$C307": REM  TURN OFF THE PRINTER & 80-COL SCREEN ON
  164. 1580  ONERR  GOTO 1580: POKE 222,0
  165. 1590  HOME : PRINT "Return = default STARTUP on drive 1": POKE  -16368,0
  166. 1600  INPUT "Enter the pathname for next program ";PRE$: IF PRE$ = ""  THEN  PRINT D$"PREFIX,D1": PRINT : PRINT D$"-STARTUP"
  167. 1610  PRINT D$"-";PRE$
  168. 1620  REM  LEAVE THIS PROGRAM
  169. 1630 DA =  PEEK(49040) - INT( PEEK(49040)/32) *32
  170. 1640 YR =  INT( PEEK(49041)/2)
  171. 1650 MU = ( PEEK(49041) -YR *2) *8 + INT( PEEK(49040)/32)
  172. 1660 TD$ =  STR$(MU) +"-" + STR$(DA) +"-" + STR$(YR): REM  HOLD TODAY'S DATE IN TD$
  173. 1670 YR = YR +1900
  174. 1680  IF MU <3  THEN D1 =  FN F1(X)
  175. 1690  IF MU >2  THEN D1 =  FN F2(X)
  176. 1700  VTAB 5: PRINT "Current date is: ";TD$: PRINT "Press Return to accept."
  177. 1710  VTAB 7: HTAB 1: INPUT "Enter today's date (MM-DD-YY): ";A$: IF A$ = "" GOTO 1740
  178. 1720 J = 0:T = 1: FOR I = 1 TO  LEN(A$):A(J) =  INT( VAL( MID$ (A$,I))):J = J +T *(J <3):T = ( MID$ (A$,I,1) = "-"): NEXT :M = A(0):D = A(1):Y = A(2)
  179. 1725  IF (M <1) +(M >12) +(D <1) +(D >31) +(Y >99) +(M = 2) *(D >28 +(Y/4 - INT(Y/4) = 0)) +(D >30) *((M = 4) +(M = 6) +(M = 9) +(M = 11))  THEN  GOTO 1710
  180. 1730 TD$ = A$:MU = M:DA = D:YR = Y +1900
  181. 1735  IF MU <3  THEN D1 =  FN F1(X)
  182. 1736  IF MU >2  THEN D1 =  FN F2(X)
  183. 1740  RETURN 
  184. 1750 M1$ = "???JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC"
  185. 1760 Z1 = 1:ZZ = 0:CA = 9: REM  CATEGORY QTY
  186. 1770 D$ =  CHR$(4):PS = 1:PW$ =  CHR$(9) +"0N":EX$ =  CHR$(14):EZ$ =  CHR$(20):BS$ = "          ": REM  10 SPACES
  187. 1780  PRINT D$"OPEN/RAM/BILL,L200": PRINT D$"CLOSE": PRINT D$"DELETE/RAM/BILL"
  188. 1790  PRINT D$"OPEN/RAM/PDFILE": PRINT D$"CLOSE": PRINT D$"DELETE/RAM/PDFILE"
  189. 1800  PRINT  CHR$(4)"BLOAD AWRD": PRINT D$"OPEN/RAM/BILL,L200"
  190. 1810  DEF  FN F1(X) = 365 *YR +DA +31 *(MU -1) + INT((YR -1)/4) - INT(.75 *( INT(((YR -1)/100) +1)))
  191. 1820  DEF  FN F2(X) = 365 *YR +DA +31 *(MU -1) - INT(.4 *MU +2.3) + INT(YR/4) - INT(.75 *( INT(YR/100) +1))
  192. 1830  RETURN 
  193. 1840  HOME : PRINT " Please enter a valid prefix beginning with / ": PRINT "Press Return to continue ";: GET FL$: POKE 222,0: GOTO 860
  194. 1850  PRINT  CHR$(4)"PR#3": PRINT : VTAB 10: HTAB 27: PRINT "PRINT.BILLS by A.R. Clayton": VTAB 12: HTAB 21: PRINT "Copyright (C) 1987 by MicroSPARC, Inc."
  195. 1860  VTAB 22: HTAB 28: PRINT "Press Return to Continue";: GET Z$: PRINT : PRINT : RETURN