home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Nibble Magazine
/
nib30a.dsk
/
FEBRUARY.1987
/
PRINT.BILLS.bas
< prev
next >
Wrap
BASIC Source File
|
2023-02-26
|
11KB
|
195 lines
1 REM **********************
2 REM * DATE.POKER *
3 REM * BY S. KARATSORIDIS *
4 REM * KAPYRITE [K] 2013 *
5 REM * BY STAVSOFT, INC. *
6 REM **********************
10 REM **********************
20 REM * PRINT.BILLS *
30 REM * BY A.R. CLAYTON *
40 REM * COPYRIGHT (C) 1987 *
50 REM * BY MICROSPARC, INC *
60 REM * CONCORD, MA 01742 *
70 REM **********************
80 LOMEM: 15104: DIM DA$(30):FL$ = ""
90 REM DECLARE DA$ ARRAY TO HOLD ONE FIELD FROM APPLEWORKS
100 REM DECLARE FL$ AS OUR FIRST STRING VARIABLE USED BY ASSEMBLY ROUTINE
110 GOSUB 1850: GOSUB 1750: GOSUB 830: GOSUB 1630: CALL 12288
120 REM INITIAL DISPLAY / DEFINE VARS / SELECT THE FILE / GET DATE / OPEN THE FILE FROM ASSEMBLY ROUTINE
130 IF PEEK(252) >ZZ THEN PRINT PEEK(252): END
140 REM LOCATION 252 IS WHERE ERR NUMBERS ARE STORED FROM ASSEMBLY ROUTINE
150 CALL 12291: REM READ A LINE OF APPLEWORKS DATA
160 REM THE ARRAY DA$ NOW HOLDS UP TO 30 FIELDS OF APPLEWORKS DATA
170 IF PEEK(252) = Z1 THEN R = R +Z1: GOSUB 330: GOTO 1380: REM END
180 REM END THE PROGRAM IF ERR = 1 FILE END REACHED
190 GOSUB 210: GOSUB 270: GOTO 150
200 REM CONVERT AW DATE
210 YR$ = MID$ (DA$(6),2,2):MU = ASC( MID$ (DA$(6),4)) -64:DA$ = MID$ (DA$(6),5)
220 DA = VAL(DA$):YR = VAL(YR$) +1900
230 IF MU <3 THEN DX = FN F1(X)
240 IF MU >2 THEN DX = FN F2(X)
250 MU$ = MID$ (M1$,MU *3 +Z1,3)
260 DA$(6) = MU$ +"/" +DA$ +"/" +YR$: RETURN
270 R = R +Z1: IF R = Z1 THEN GOTO 300: REM NEW FILE
280 PRINT D$"READ/RAM/BILL,R"R -Z1: FOR Y = ZZ TO 5: INPUT XX$(Y): NEXT
290 IF XX$(5) < >DA$(5) THEN GOSUB 330: GOTO 270: REM PRINT BILL
300 PRINT D$"WRITE/RAM/BILL,R"ZZ: PRINT R: PRINT D$"WRITE/RAM/BILL,R"R
310 FOR Y = ZZ TO CA: PRINT DA$(Y): NEXT : PRINT DX: REM DAYS
320 TT = TT +( VAL(DA$(9)) - VAL(DA$(8))): RETURN
330 IF INT(TT *100 +.5)/100 < = ZZ THEN GOTO 350
340 GOSUB 370
350 PRINT D$"CLOSE/RAM/BILL": PRINT D$"DELETE/RAM/BILL": PRINT D$"OPEN/RAM/BILL,L200"
360 R = ZZ:TT = ZZ: RETURN
370 PRINT D$"PR#"PS: PRINT PW$:TT = ZZ:PASTDUE = ZZ:PT = ZZ
380 REM TURN ON PRINTER & SEND STRING TO INHIBIT SCREEN OUTPUT AND CR'S
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
400 PRINT SPC( 31);EX$;"INVOICE";EZ$: REM PRINT EXPANDED HEADING
410 PRINT SPC( 35);"A B COMPANY"
420 PRINT SPC( 35);"123 SOUTH ROAD"
430 PRINT SPC( 35);"SALISBURY NC"
440 PRINT SPC( 35);"Tel. 1-555-555-5555
450 PRINT : PRINT : PRINT
460 PRINT SPC( 6);NF$ +" " +NL$: PRINT SPC( 6);AD$: PRINT SPC( 6);CT$: PRINT SPC( 53);"Account Number :";AC$
470 PRINT SPC( 53);"Invoice Date: ";TD$
480 PRINT : PRINT : PRINT
490 GOSUB 770
500 PRINT D$"READ/RAM/BILL,R"ZZ: INPUT RR:D9 = ZZ
510 FOR R = Z1 TO RR
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
530 FOR Y = ZZ TO CA: INPUT XX$(Y): NEXT : INPUT D2: REM DAYS
540 TT = TT +( VAL(XX$(9)) - VAL(XX$(8)))
550 TT = INT(TT *100 +.5)/100
560 IF TT = <ZZ THEN PASTDUE = ZZ:D9 = Z1: REM D9 SET MEANS BALANCE ONCE WAS ZERO
570 IF D1 -D2 >30 AND TT >ZZ THEN PASTDUE = Z1:PT = TT:D3 = D1 -D2
580 IF D1 -D2 <31 AND PASTDUE = Z1 THEN PT = PT - VAL(XX$(8)):PT = INT(PT *100 +.5)/100
590 IF PT < = ZZ THEN PASTDUE = ZZ
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
610 XX$(6) = XX$(6) +BS$
620 XX$(7) = XX$(7) +BS$ +BS$ +BS$ +BS$
630 XX$(8) = BS$ +XX$(8)
640 XX$(9) = BS$ +XX$(9)
650 TT$ = BS$ +TT$
660 PRINT LEFT$(XX$(6),10);
670 PRINT LEFT$(XX$(7),40);
680 PRINT RIGHT$(XX$(8),10);
690 PRINT RIGHT$(XX$(9),10);
700 PRINT RIGHT$(TT$,10): NEXT
710 IF PASTDUE THEN V = PT *.015: GOSUB 780:V$ = BS$ +V$: PRINT SPC( 22)"NEW CARRYING CHARGES.................." RIGHT$(V$,10);: REM 18 PERIODS
720 REM FINANCE CHARGE OF 1 1/2% =.015 TIMES THE PAST DUE AMOUNT
730 IF PASTDUE THEN GOSUB 1350:V = TT +V: GOSUB 780:V$ = BS$ +V$: PRINT RIGHT$(V$,10)
740 PRINT : PRINT "...............................Please pay last amount in this column........^^^": REM 31/8 PERIODS
750 PRINT CHR$(12);: PRINT : PRINT D$"PR#A$C307": RETURN
760 REM SEND A FORM FEED CONTROL L & TURN OFF THE PRINTER
770 PRINT "..Date..............Item..............................Credit.....Debit...Balance": PRINT : RETURN : REM 2/14/30/5/3 PERIODS
780 V = INT(V *100 +.5)/100
790 V$ = STR$(V): IF INT(V) = V THEN V$ = V$ +".00": RETURN
800 DE = INT((V - INT(V)) *100 +.5)/100:DE$ = STR$(DE)
810 IF LEN(DE$) = 3 THEN V$ = STR$( INT(V)) +DE$: RETURN
820 V$ = STR$( INT(V)) +DE$ +"0": RETURN : REM ZERO IN QUOTES
830 DIM FI$(50):H = Z1
840 REM DIM AN ARRAY OF 50 FOR FILES FROM THE DATA DIRECTORY
850 ONERR GOTO 1840
860 HOME : PRINT "Return = default drive 2"
870 INPUT "Enter the pathname for data disk ";PRE$: IF PRE$ = "" THEN PRINT D$"PREFIX,D2": GOTO 890
880 PRINT D$"PREFIX"PRE$
890 PRINT D$"PREFIX": INPUT PRE$
900 HOME : PRINT "Working": GOSUB 1260
910 HT = Z1:SN = 10:HL = 3
920 BEG = Z1
930 IF BEG >H THEN BEG = H -10
940 IF BEG <Z1 THEN BEG = Z1
950 AA = Z1:SN = 10: IF H -BEG <10 THEN SN = H -BEG +Z1
960 FOR X = BEG TO BEG +9:SI$(AA) = FI$(X):AA = AA +Z1: NEXT
970 HOME
980 PRINT "_______________________________________________________________________________": REM 79 DASHES
990 PRINT "| PRINT.BILLS by A.R. Clayton -- Copyright 1987 by MicroSPARC, Inc. |": REM 7/5 SPACES
1000 PRINT "| Press Escape to restart |": REM 7/47 SPACES
1010 PRINT "|_____________________________________________________________________________|": REM 77 DASHES
1020 PRINT L$(2)
1030 CS = Z1
1040 FOR X = Z1 TO SN: IF X = CS THEN INVERSE
1050 VTAB HL +2 +X: HTAB HT: PRINT SI$(X): NORMAL : NEXT
1060 VTAB 19: PRINT "File Group ";BEG;" on"
1070 VTAB 21: PRINT LEFT$(L$(5),64);"TOTAL FILES ";H
1080 VTAB 23: PRINT "^ v To move : > Page Forward : < Page Back Return to select"
1090 VTAB HL +2 +CS: POKE -16368,0
1100 WAIT -16384,128:K = PEEK( -16384) -128: POKE -16368,0: IF K = 27 THEN H = Z1: GOTO 860
1110 IF K = 21 OR K = 32 OR K = 42 THEN BEG = BEG +10: GOTO 930
1120 IF K = 8 THEN BEG = BEG -10: GOTO 930
1130 IF K < >10 AND K < >11 AND K < >13 THEN 1090
1140 LS = CS
1150 IF K = 11 THEN CS = CS -Z1:CS = CS *(CS >ZZ) +SN *(CS = ZZ): GOSUB 1230: GOTO 1090
1160 IF K = 10 THEN CS = CS +Z1:CS = CS *(CS < = SN) +(CS = SN +Z1): GOSUB 1230: GOTO 1090
1170 REM GOT A SELECTION
1180 FL$ = MID$ (SI$(CS),2,15)
1190 IF RIGHT$(FL$,1) < >" " THEN 1220
1200 FL$ = LEFT$(FL$, LEN(FL$) -Z1): GOTO 1190
1210 FOR X = 1 TO 50:FI$(X) = "": NEXT
1220 GOTO 1320: REM ACT ON THE SELECTION
1230 VTAB HL +2 +LS: HTAB HT: PRINT SI$(LS)
1240 VTAB HL +2 +CS: INVERSE : HTAB HT: PRINT SI$(CS): NORMAL
1250 RETURN
1260 PRINT D$;"OPEN";PRE$;",TDIR": PRINT D$;"READ";PRE$
1270 FOR I = Z1 TO 3: INPUT L$(I): NEXT
1280 INPUT FI$(H)
1290 IF FI$(H) < >"" THEN H = H +Z1: GOTO 1280
1300 H = H -Z1: INPUT L$(5)
1310 PRINT D$;"CLOSE"PRE$: RETURN
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
1330 REM FILTER THE FILE SELECTION
1340 HOME : PRINT "Working on "FL$: RETURN
1350 PRINT D$"OPEN/RAM/PDFILE": PRINT D$"APPEND/RAM/PDFILE"
1360 PRINT AC$: PRINT NF$ +" " +NL$: PRINT V$: PRINT D3: REM 1 BLANK SPACE
1370 PRINT D$"CLOSE/RAM/PDFILE": RETURN
1380 ONERR GOTO 1560
1390 I = ZZ: PRINT D$"PR#"PS: PRINT PW$
1400 REM TURN ON THE PRINTER AND SEND STRING TO INHIBIT SCREEN OUTPUT AND CR'S
1410 GOSUB 1420: GOTO 1450
1420 PRINT "PAST DUE REPORT": REM SEND A FORM FEED TO THE PRINTER
1430 PRINT "THESE CHARGES MUST BE POSTED TO EACH ACCOUNT SHOWN": PRINT : PRINT
1440 PRINT "Acc........Name.........................Days........Charges": RETURN : REM 8/25/8PERIODS
1450 PRINT D$"OPEN/RAM/PDFILE": PRINT D$"READ/RAM/PDFILE"
1460 INPUT AC$: INPUT NF$: INPUT V$: INPUT D3
1470 PRINT AC$" ";: REM 6 SPACES
1480 NF$ = NF$ +BS$ +BS$ +BS$
1490 PRINT LEFT$(NF$,30);
1500 D3$ = STR$(D3) +BS$
1510 PRINT LEFT$(D3$,10);
1520 V = VAL(V$): GOSUB 780: PRINT " $"V$: REM 4 SPACES THEN $
1530 I = I +Z1: IF I = 50 THEN GOSUB 1420:I = ZZ
1540 REM PRINT 50 LINES THEN GOTO NEXT PAGE
1550 GOTO 1460
1560 POKE 222,0: PRINT D$"CLOSE": REM RESET ERR HANDLING & CLOSE ALL FILES
1570 PRINT D$"PR#A$C307": REM TURN OFF THE PRINTER & 80-COL SCREEN ON
1580 ONERR GOTO 1580: POKE 222,0
1590 HOME : PRINT "Return = default STARTUP on drive 1": POKE -16368,0
1600 INPUT "Enter the pathname for next program ";PRE$: IF PRE$ = "" THEN PRINT D$"PREFIX,D1": PRINT : PRINT D$"-STARTUP"
1610 PRINT D$"-";PRE$
1620 REM LEAVE THIS PROGRAM
1630 DA = PEEK(49040) - INT( PEEK(49040)/32) *32
1640 YR = INT( PEEK(49041)/2)
1650 MU = ( PEEK(49041) -YR *2) *8 + INT( PEEK(49040)/32)
1660 TD$ = STR$(MU) +"-" + STR$(DA) +"-" + STR$(YR): REM HOLD TODAY'S DATE IN TD$
1670 YR = YR +1900
1680 IF MU <3 THEN D1 = FN F1(X)
1690 IF MU >2 THEN D1 = FN F2(X)
1700 VTAB 5: PRINT "Current date is: ";TD$: PRINT "Press Return to accept."
1710 VTAB 7: HTAB 1: INPUT "Enter today's date (MM-DD-YY): ";A$: IF A$ = "" GOTO 1740
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)
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
1730 TD$ = A$:MU = M:DA = D:YR = Y +1900
1735 IF MU <3 THEN D1 = FN F1(X)
1736 IF MU >2 THEN D1 = FN F2(X)
1740 RETURN
1750 M1$ = "???JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC"
1760 Z1 = 1:ZZ = 0:CA = 9: REM CATEGORY QTY
1770 D$ = CHR$(4):PS = 1:PW$ = CHR$(9) +"0N":EX$ = CHR$(14):EZ$ = CHR$(20):BS$ = " ": REM 10 SPACES
1780 PRINT D$"OPEN/RAM/BILL,L200": PRINT D$"CLOSE": PRINT D$"DELETE/RAM/BILL"
1790 PRINT D$"OPEN/RAM/PDFILE": PRINT D$"CLOSE": PRINT D$"DELETE/RAM/PDFILE"
1800 PRINT CHR$(4)"BLOAD AWRD": PRINT D$"OPEN/RAM/BILL,L200"
1810 DEF FN F1(X) = 365 *YR +DA +31 *(MU -1) + INT((YR -1)/4) - INT(.75 *( INT(((YR -1)/100) +1)))
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))
1830 RETURN
1840 HOME : PRINT " Please enter a valid prefix beginning with / ": PRINT "Press Return to continue ";: GET FL$: POKE 222,0: GOTO 860
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."
1860 VTAB 22: HTAB 28: PRINT "Press Return to Continue";: GET Z$: PRINT : PRINT : RETURN