PCjs Machines
Home of the original IBM PC emulator for browsers.
PC-SIG Diskette Library (Disk #472)
[PCjs Machine "ibm5160"]
Waiting for machine "ibm5160" to load....
Information about “SIMPLIFIED BUSINESS”
All of the programs on this disk are menu driven and written in BASIC.
However, simplified doesn't mean simple; its powers and features are
quite substantial and we urge a careful reading of the documentation.
The Simplified Bookkeeping System offers you the following programs:
Expenses, Income, Bank Account, Payroll, Accounts Receivable,and
Summary of Operations. A quite powerful collection for financial
management.
System Requirements: 128K, two disk drives, monochrome display and
a printer
How to Start: Consult the BKG.DOC file for documentation. To run the
BASIC programs, consult the directions in GETTING STARTED for your
configuration.
Suggested Registration: $35.00
File Descriptions:
ACCTREC BAS Processes Accounts Receivables
A EXE Information on how to use to backup your data
AUTOEXEC BAT Request the DATE then loads BASICA BKPG /F:5
C BAT COPY PAYEE.FIL, CATEGORY.FIL, INCOME.FIL to B:
BKPG BAK Backup file of bookkeeping
BKPG DOC Author supplied documentation file
BKPG BAS This is the bookkeeping program
EXPENSE BAS Keeps track of expenses
CHECKING BAS Maintains the checking account
L BAT Copies checking.acc to new backup bookkeeping disk.
INCOME BAS Keeps track of income
G BAT Copies totals to new backup bookkeeping disk.
F BAT Creates and formats two new disks.
X BAT Makes new backup copy of PAYROLL FILE DISK on drive B:
STARTUP BAT Author supplied User startup procedure batch file
SHELLSRT BAS This is a shell sort program for sorting files
S BAT Format 6 disks by responding "Y" first 5 times.
N BAT Creates two disks then loads BASICA & runs Payroll program
R BAT Creates two disks then loads BASICA & runs A/R program
PAYROLL BAS Processes the payroll
ACCTREC.BAS
10 CLS:ON ERROR GOTO 7000
20 KEY 8, "@":COLOR 0,7:PRINT TAB(10)"REMOVE PROGRAM DISK FROM DRIVE A AND INSERT ACCOUNTS RECEIVABLE FILE DISK.":PRINT:PRINT TAB(10)"READY PRINTER.":PRINT:PRINT TAB(10) "PRESS F8 WHEN READY.":COLOR 7,0
40 X$=INKEY$:IF X$<>"@" THEN 40
50 CLS:CLEAR,,1536:PRINT TAB(5) "CHOOSE":PRINT:ON ERROR GOTO 7000
70 FOR N=1 TO 10:KEY N,"":NEXT:KEY 8, "@":ON KEY(7) GOSUB 3910:SP$=" ":SPP$=" ":DL$="$$######.##":MODE$=CHR$(27)+CHR$(45)+CHR$(1)+CHR$(27)+CHR$(71)+CHR$(27)+CHR$(78)+CHR$(6):DEFDBL A-Z:DEFINT N,I,J:WIDTH "LPT1:",80
160 XMOD$=CHR$(27)+CHR$(45)+CHR$(0)+CHR$(27)+CHR$(72):OPEN "A:ACCT.CNT" AS 2:FIELD 2, 35 AS AA$, 15 AS BB$, 2 AS CC$, 9 AS DD$, 67 AS EE$
200 PRINT TAB(10) "E=ADD OR DELELETE ACCOUNT, READ OR REVISE ACCOUNT DATA":PRINT:PRINT TAB(10) "C=CHARGE OR CREDIT FILE":PRINT:PRINT TAB(10) "R=READ ACCOUNT FILE":PRINT:PRINT TAB(10)"I=BILL INDIVIDUAL":PRINT:PRINT TAB(10)"A=AUTOMATIC MONTHLY BILLING"
210 PRINT:PRINT TAB(10) "L=READ OR PRINT LIST OF ACCOUNTS":PRINT:PRINT TAB(10) "U=PRINT LIST OF ACCOUNT NUMBERS IN USE":PRINT:PRINT TAB(10) "F=CREATE NEW FILE DISK":PRINT:PRINT TAB(10) "B=ALPHABETIZE ACCOUNT LIST":PRINT:PRINT TAB(10) "M=RETURN TO MENU"
220 X$=INKEY$:DEF SEG=64:POKE 23, (PEEK(23) OR 64)
240 IF X$="A" OR X$="I" THEN 2100 ELSE IF X$="C" THEN 3320 ELSE IF X$="M" THEN 30000 ELSE IF X$="E" THEN 280 ELSE IF X$="L" THEN 3650 ELSE IF X$="U" OR X$="B" THEN 5800 ELSE IF X$="F" THEN 7090 ELSE IF X$="R" THEN 3100 ELSE 220
280 CLS:PRINT:PRINT TAB(10) "N=NEW ACCOUNT":PRINT:PRINT TAB(10) "R=READ, REVISE OR DELETE ACCOUNT"
300 EMD$=INKEY$:DEF SEG=64:POKE 23, (PEEK(23) OR 64):IF EMD$="N" THEN GOSUB 330:GOTO 430 ELSE IF EMD$="R" THEN 960 ELSE IF EMD$=CHR$(27) THEN 50 ELSE 300
330 CLS
340 PRINT "ENTER CUSTOMER'S LAST NAME ";:INLN%=35:GOSUB 20050:NAM2$=INPT$:IF LEN(NAM2$)=35 THEN NAM1$="":MDL$="":GOTO 420
370 PRINT "ENTER CUSTOMER'S FIRST NAME ";:INLN%=35-LEN(NAM2$):GOSUB 20050:NAM1$=INPT$:IF LEN(NAM2$)+LEN(NAM1$)>33 THEN MDL$="":GOTO 420
400 PRINT "ENTER CUSTOMER'S MIDDLE INITIAL ";:INLN%=2:GOSUB 20050:MDL$=LEFT$(INPT$,1)+"."
420 RETURN
430 PRINT "ENTER STREET ADDRESS OR BOX NO. ";:INLN%=35:GOSUB 20050:ADR$=INPT$:IF REC1 THEN RETURN
460 PRINT "ENTER CITY,STATE,ZIP ";:INLN%=35:GOSUB 20050:CITY$=INPT$:IF REC1 THEN RETURN
490 PRINT "ENTER PHONE NUMBER ";:INLN%=13:GOSUB 20050:PHN$=INPT$:IF REC3 THEN RETURN
520 PRINT:PRINT TAB(10) "ENTER ACCOUNT NUMBER ";:INLN%=7:GOSUB 20050:ES$=INPT$:FOR N=1 TO LOF(2)/128:GET 2,N:IF ES$+SP$=LEFT$(DD$,INSTR(DD$,SP$)) THEN PRINT:PRINT TAB(10) "THIS NUMBER IS ALREADY IN USE, PLEASE CHOOSE ANOTHER":PRINT:GOTO 520
570 NEXT:IF REC1 THEN RETURN
590 PRINT " ENTER MESSAGE TO APPEAR ON THIS CUSTOMER'S BILLS (JUST PRESS ENTER IF NONE).
600 INLN%=80:GOSUB 20050:MSG$=INPT$+STRING$(80-LEN(MSG$),32):IF REC2 THEN RETURN
620 FL$="A:"+ES$:OPEN FL$ AS 3:FIELD 3, 8 AS A$, 35 AS B$, 15 AS C$, 2 AS CA$, 35 AS D$, 33 AS E$:LSET A$=ES$:LSET B$=NAM2$:RSET C$=NAM1$:RSET CA$=MDL$:LSET D$=ADR$:LSET E$=CITY$:PUT 3,1:GOSUB 30200:FIELD 3, 13 AS F$, 115 AS G$:LSET F$=PHN$
740 LSET G$="":PUT 3,2
760 FIELD 3, 40 AS H$, 40 AS I$, 48 AS J$:LSET H$=LEFT$(MSG$,40):LSET I$=MID$(MSG$,41,40):LSET J$="":PUT 3,3:IF REC2 THEN GET 2,LOC(2):LSET EE$=MSG$:PUT 2,LOC(2):GOTO 50
820 PRINT "IF CUSTOMER ALREADY HAS A PREVIOUS BALANCE, ENTER BALANCE OR ENTER 0 IF NONE ":NBR=1:GOSUB 20050:PB=VAL(INPT$):NBR=0:FIELD 3, 8 AS R$, 12 AS S$, 12 AS T$, 12 AS U$, 12 AS V$, 12 AS W$, 12 AS Y$
850 LSET R$="":LSET S$=MKD$(PB):LSET T$="":LSET U$="":LSET V$="":LSET W$="":LSET Y$="":PUT 3,4:CLOSE 3:FIELD 2, 35 AS AA$, 15 AS BB$, 2 AS CC$, 9 AS DD$, 67 AS EE$:LSET AA$=NAM2$:LSET BB$=NAM1$:LSET CC$=MDL$:LSET DD$=ES$:LSET EE$=MSG$
930 PUT 2, LOF(2)/128+1:FL$="ACCT.CNT":GOSUB 30200:IF REC1 THEN RETURN
950 GOTO 50
960 CLS:PRINT:PRINT TAB(10) "L=LIST ALL ACCOUNTS (NOT FOR REVISING)":PRINT:PRINT TAB(10)"S=LIST ONE"
980 LS$=INKEY$:IF LS$="L" THEN 1040 ELSE IF LS$="S" THEN 1000 ELSE IF LS$=CHR$(27) THEN 50 ELSE 980
1000 PRINT:PRINT TAB(10) "ENTER ACCT. NO. (JUST PRESS ENTER TO ENTER NAME INSTEAD).":INLN%=7:GOSUB 20050:ES$=INPT$:IF ES$<>"" THEN 1040
1030 GOSUB 340
1040 FOR N=1 TO LOF(2)/128:GET 2,N:IF ES$<>"" THEN IF ES$=LEFT$(DD$,-1+INSTR(DD$,SP$)) THEN 1170 ELSE 1090
1070 IF LS$="L" THEN GOSUB 1170:GOTO 1090
1080 IF NAM2$=LEFT$(AA$,LEN(NAM2$)) AND NAM1$=LEFT$(BB$,LEN(NAM1$)) THEN IF LEFT$(MDL$,1)="." OR LEFT$(MDL$,1)=LEFT$(CC$,1) THEN 1170 ELSE 1090
1090 NEXT:IF LS$="L" THEN PRINT:PRINT TAB(10) "PRESS F8 TO RETURN TO OPTIONS" ELSE 1130
1110 IF PRT THEN LPRINT CHR$(27)CHR$(79)
1120 O$=INKEY$:IF O$="@" THEN 50 ELSE 1120
1130 PRINT " NUMBER OR NAME NOT FOUND. PRESS R TO REENTER PRESS O TO RETURN TO OPTIONS"
1140 XX$=INKEY$:DEF SEG=64:POKE 23, (PEEK(23) OR 64):IF XX$="R" AND ES$="" THEN 1030 ELSE IF XX$="R" THEN 1000 ELSE IF XX$="O" THEN 50 ELSE 1140
1170 FL$="A:"+DD$:NAM2$="":OPEN FL$ AS 3:FIELD 3, 8 AS A$, 35 AS B$, 15 AS C$, 2 AS CA$, 35 AS D$, 33 AS E$:IF LS$="L" AND N>1 THEN 1270
1220 IF BIL=1 THEN 3340 ELSE IF X$="I" THEN GOSUB 30200:BN$="A":NB=1:GOTO 2270
1230 CLS:PRINT TAB(10) "R=READ ONLY":PRINT:PRINT TAB(10)"P=READ AND PRINT(TURN ON PRINTER)
1240 PRT$=INKEY$:DEF SEG=64:POKE 23, (PEEK(23) OR 64):IF PRT$<>"P" AND PRT$<>"R" THEN 1240
1270 IF LS$<>"L" THEN CLS ELSE IF PRT$="P" THEN LPRINT CHR$(27)CHR$(78)CHR$(6)
1280 GET 3,1:IF PRT$="P" THEN PRT=1
1300 IF RIGHT$(C$,1)=" " THEN NOM$="":GOTO 1320
1310 FOR NS=1 TO LEN(C$):IF MID$(C$,NS,1)<>CHR$(32) THEN NOM$=MID$(C$,NS)+SP$ ELSE NEXT
1320 PRINT "1. NAME " SPC(14) NOM$;:IF LEFT$(CA$,1)=" " THEN PRINT B$ ELSE PRINT CA$+" "+B$
1330 IF PRT THEN LPRINT "NAME " SPC(14) NOM$+" ";:IF LEFT$(CA$,1)=" " THEN LPRINT B$ ELSE LPRINT CA$+" "+B$
1340 PRINT "2. ACCOUNT NUMBER ";:IF PRT THEN LPRINT "ACCOUNT NUMBER ";
1360 PRINT SPC(5) A$:IF PRT THEN LPRINT SPC(5) A$
1380 PRINT "3. ADDRESS" SPC(15) D$:IF PRT THEN LPRINT "ADDRESS" SPC(15) D$
1400 PRINT "4. CITY,STATE,ZIP" SPC(8) E$:IF PRT THEN LPRINT "CITY,STATE,ZIP" SPC(8) E$
1420 FIELD 3, 13 AS F$, 115 AS G$:GET 3,2:PRINT "5. PHONE NUMBER" SPC(10) F$:IF PRT THEN LPRINT "PHONE NUMBER" SPC(10)F$
1460 PRINT "6. MESSAGE TO BE PRINTED ON BILLS":IF PRT THEN LPRINT " MESSAGE TO BE PRINTED ON BILLS"
1480 FIELD 3, 40 AS H$, 40 AS I$, 48 AS J$:GET 3,3:PRINT TAB(10) H$:IF PRT THEN LPRINT TAB(10) H$
1500 PRINT TAB(10) I$:IF PRT THEN LPRINT TAB(10) I$
1510 IF X$="R" THEN 3120
1520 IF LS$="L" THEN CLOSE 3:RETURN
1530 IF PRT THEN LPRINT:LPRINT
1540 PRINT:PRINT TAB(2) "A=READ ANOTHER R=REVISE FILE D=DELETE ACCOUNT O=RETURN TO OPTIONS"
1550 X$=INKEY$:DEF SEG=64:POKE 23, (PEEK(23) OR 64):IF X$="A" THEN CLOSE 3:GOTO 960 ELSE IF X$="R" THEN 1780 ELSE IF X$="D" THEN 1580 ELSE IF X$="O" THEN CLOSE:GOTO 50 ELSE 1550
1580 CLS:FIELD 3, 8 AS A$, 35 AS B$, 12 AS C$, 4 AS D$, 12 AS E$, 5 AS F$, 46 AS G$:GET 3,LOF(3)/128:IF ABS(CVD(E$))>0.05 THEN PRINT "THIS ACCOUNT HAS A BALANCE OF ";:PRINT USING DL$;CVD(E$);:PRINT " DO YOU STILL WANT TO DELETE ACCOUNT? Y/N" ELSE 1650
1610 DEL$=INKEY$:DEF SEG=64:POKE 23, (PEEK(23) OR 64):IF DEL$="Y" THEN 1640 ELSE IF DEL$="N" THEN X$="":GOTO 1540 ELSE 1610
1640 FIELD 3, 8 AS A$, 35 AS B$, 15 AS C$, 2 AS CA$, 35 AS D$, 33 AS E$
1650 PRINT "ENTER DATE ACCOUNT CLOSED ";:INLN%=8:GOSUB 20050:CLSD$=INPT$:GET 3,1:FIELD 3, 8 AS A$:LSET A$="*"+LEFT$(A$,7):PUT 3,1:GOSUB 30200:FIELD 3, 13 AS F$, 115 AS G$:GET 3,2:LSET G$="CLOSED "+CLSD$:PUT 3,2
1750 GET 2, LOC(2):LSET DD$="*"+LEFT$(DD$,8):PUT 2, LOC(2):FL$="ACCT.CNT":GOSUB 30200:CLOSE:GOTO 50
1780 GOSUB 30200
1790 LOCATE 21,1:PRINT STRING$(239,32):LOCATE 21,1:PRINT "ENTER NUMBER OF DATA TO BE CHANGED (ENTER 0 IF FINISHED) ";:INLN%=2:NBR=1:GOSUB 20050:I=VAL(INPT$):NBR=0:IF I=0 THEN 1870 ELSE IF I=6 THEN REC2=1 ELSE IF I=5 THEN REC3=1 ELSE REC1=1
1830 IF I=2 THEN ES=1
1840 LOCATE 21,1:PRINT STRING$(79,32):LOCATE 21,1:ON I GOSUB 340,520,430,460,490,590:GOTO 1790
1870 IF REC1 THEN 1880 ELSE IF REC3 THEN 1970 ELSE IF REC2 THEN 760 ELSE 2010
1880 GET 3,1:FIELD 3, 8 AS A$, 35 AS B$, 15 AS C$, 2 AS CA$, 35 AS D$, 33 AS E$:IF ES=1 THEN LSET A$=ES$:GET 2, LOC(2):LSET DD$=ES$:PUT 2, LOC(2)
1910 IF ES=1 THEN IF FL$<>"A:"+ES$ THEN NAME FL$ AS "A:"+ES$
1915 IF REC2=1 THEN GET 2,LOC(2):LSET EE$=MSG$:PUT 2, LOC(2)
1920 IF NAM2$<>"" THEN GOSUB 2020:LSET B$=NAM2$:RSET C$=NAM1$:RSET CA$=MDL$
1930 IF ADR$<>"" THEN LSET D$=ADR$
1940 IF CITY$<>"" THEN LSET E$=CITY$
1950 PUT 3,1:IF REC3=0 THEN 2010
1970 FIELD 3, 13 AS F$, 115 AS G$:GET 3,2:LSET F$=PHN$:PUT 3,2
2010 IF REC2 THEN 760 ELSE 50
2020 GET 2,LOC(2):LSET AA$=NAM2$:LSET BB$=NAM1$:LSET CC$=MDL$:PUT 2, LOC(2):FL$="ACCT.CNT":GOSUB 30200:RETURN
2100 CLS:PRINT " REGULAR BILLING (LAST BILLING DATE TO END OF FILE? Y/N. ";:INLN%=1:GOSUB 20050:REGBIL$=INPT$:PRINT:IF REGBIL$="Y" THEN 2140
2110 PRINT TAB(10) "ENTER START DATE FOR BILLING ";
2120 INLN%=8:GOSUB 20050:STD$=INPT$:IF LEN(STD$)<>8 THEN PRINT "MUST BE xx-xx-xx ";:GOTO 2120 ELSE IF MID$(STD$,3,1)<>"-" OR MID$(STD$,6,1)<>"-" THEN PRINT "MUST BE xx-xx-xx ";:GOTO 2120
2135 IF X$="R" THEN PRINT:PRINT TAB(10) "ENTER STOP DATE":GOTO 2150
2140 PRINT:PRINT TAB(5) "TURN ON PRINTER AND SET TOP OF BILL ":PRINT:PRINT "ENTER BILLING DATE (CHARGES WILL BE TO END OF FILE IF REGULAR BILLING) ";
2150 INLN%=8:GOSUB 20050:PD$=INPT$:IF LEN(PD$)<>8 THEN PRINT "MUST BE xx-xx-xx ";:GOTO 2150 ELSE IF MID$(PD$,3,1)<>"-" OR MID$(PD$,6,1)<>"-" THEN PRINT "MUST BE xx-xx-xx ";:GOTO 2150
2165 IF X$="R" THEN 3110 ELSE LPRINT CHR$(27)CHR$(67)CHR$(42):LPRINT:LPRINT
2170 IF X$="I" THEN 1000
2172 LIM%=LOF(2)/128:DIM OM3(LIM%), M3(LIM%), M2(LIM%), M1(LIM%), CB(LIM%):CLOSE 4:KILL "BACKUP.FIL":FL$="*.*":GOSUB 30200:PRINT:PRINT TAB(10) "A=PRINT ALL BILLS":PRINT:PRINT TAB(10) "P=PRINT ONLY BILLS WITH BALANCE NOT EQUAL TO 0"
2190 DEF SEG=64:POKE 23, (PEEK(23) OR 64)
2200 BN$=INKEY$:IF BN$=CHR$(27) THEN 50
2210 IF BN$<>"A" AND BN$<>"P" THEN 2200
2220 FOR NB=1 TO LOF(2)/128:GET 2,NB:IF LEFT$(DD$,1)="*" THEN 2300
2222 NPRINT=0
2250 FL$="A:"+DD$:OPEN FL$ AS 3
2270 NM=1:AN$=DD$:IF LEFT$(BB$,1)=SP$ THEN NAM$=AA$ ELSE IF RIGHT$(BB$,2)=SPP$ THEN NAM$=LEFT$(BB$,INSTR(BB$,SPP$))+AA$ ELSE IF RIGHT$(BB$,1)=SP$ THEN NAM$=BB$+AA$ ELSE NAM$=BB$+SP$+AA$
2290 GOSUB 2323
2300 NEXT:GOTO 2790
2323 FIELD 3, 8 AS R$, 12 AS S$, 12 AS T$, 12 AS U$, 12 AS V$, 12 AS W$, 12 AS Y$:GET 3,4:TAMT=CVD(S$):OAMT=CVD(S$):FIELD 3, 8 AS A$, 35 AS B$, 12 AS C$, 4 AS D$, 12 AS E$, 5 AS F$, 46 AS G$:FOR IT=LOF(3)/128 TO 5 STEP -1:GET 3,IT
2328 IF F$="BILLD" THEN OAMT=CVD(E$):IIT=IT:GOTO 2330
2329 NEXT
2330 IF REGBIL$="Y" THEN IT=IT+1:GOTO 2336
2331 FOR IT= 5 TO LOF(3)/128:GET 3,IT
2332 IF VAL(RIGHT$(A$,2))<VAL(RIGHT$(STD$,2)) THEN 2335 ELSE IF VAL(LEFT$(A$,2))<VAL(LEFT$(STD$,2)) AND VAL(RIGHT$(A$,2))=VAL(RIGHT$(STD$,2)) THEN 2335 ELSE IF VAL(MID$(A$,4,2))<VAL(MID$(STD$,4,2)) AND VAL(LEFT$(A$,2))=VAL(LEFT$(STD$,2)) THEN 2335
2333 IF IT=5 THEN 2336
2334 GET 3,LOC(3)-1:OAMT=CVD(E$):GOTO 2336
2335 NEXT
2336 FIELD 3, 8 AS A$, 35 AS B$, 12 AS C$, 4 AS D$, 12 AS E$, 5 AS F$, 46 AS G$:IF LOF(3)/128<>4 THEN GET 3, LOF(3)/128:TAMT=CVD(E$)
2338 IF BN$="A" THEN 2340 ELSE IF REGBIL$="N" AND LOF(3)/128>4 THEN 2340
2339 IF TAMT<0.1 AND TAMT>-0.1 THEN NPRINT=1 ELSE NPRINT=0
2340 FIELD 3, 8 AS A$, 35 AS B$, 15 AS C$, 2 AS CA$, 35 AS D$, 33 AS E$:GET 3,1:IF NPRINT THEN 2465
2360 LPRINT TAB(43) PD$:LPRINT:LPRINT TAB(43) AN$:LPRINT:LPRINT:LPRINT:LPRINT:LPRINT TAB(6) NAM$:LPRINT TAB(6) D$:LPRINT TAB(6) E$:FOR N=1 TO 8:LPRINT:NEXT:FIELD 3, 40 AS H$, 40 AS I$, 48 AS J$
2420 GET 3,3:IF LEFT$(H$,1)<>" " THEN LPRINT TAB(11) H$:LIN%=LIN%+1 ELSE 2440
2430 IF LEFT$(I$,1)<>" " THEN LPRINT TAB(11) I$:LIN%=LIN%+1
2440 LPRINT TAB(20)"PREVIOUS BALANCE ";
2465 IF NPRINT THEN TB=0:TCR=0:GOTO 2475
2470 LPRINT USING DL$;OAMT:TB=0:TCR=0
2475 IF LOF(3)/128=4 THEN CB=TAMT:GOTO 2610
2480 FIELD 3, 8 AS A$, 35 AS B$, 12 AS C$, 4 AS D$, 12 AS E$, 5 AS F$, 46 AS G$
2485 IF IIT=LOF(3)/128 THEN CB=TAMT:GOTO 2595
2490 FOR I=IT TO LOF(3)/128:GET 3,I:IF REGBIL$="Y" THEN 2522
2520 IF VAL(RIGHT$(A$,2))>VAL(RIGHT$(PD$,2)) THEN 2580 ELSE IF VAL(LEFT$(A$,2))>VAL(LEFT$(PD$,2)) AND VAL(RIGHT$(A$,2))=VAL(RIGHT$(PD$,2)) THEN 2580 ELSE IF VAL(MID$(A$,4,2))>VAL(MID$(PD$,4,2)) AND VAL(LEFT$(A$,2))=VAL(LEFT$(PD$,2)) THEN 2580
2522 NIT=I
2525 CB=CVD(E$):IF NPRINT THEN 2540
2530 LPRINT A$+" "+B$+" ";:LPRINT USING DL$;CVD(C$)
2540 IF LEFT$(D$,1)="P" OR LEFT$(D$,2)="CR" THEN TCR=TCR+CVD(C$):GOTO 2555
2550 TB=TB+CVD(C$):CB=CVD(E$)
2555 IF NPRINT THEN 2571
2560 LIN%=LIN%+1
2570 IF LIN%=12 THEN LPRINT TAB(50) "CONTINUED":LPRINT CHR$(140):LPRINT:LPRINT:LPRINT TAB(43) PD$:LPRINT:LPRINT TAB(43) AN$:LPRINT:LPRINT:LPRINT:LPRINT:LPRINT:LPRINT TAB(6) NAM$:FOR J=1 TO 9:LPRINT:NEXT:LPRINT " CONTINUED":LIN%=1
2571 IF I<>LOF(3)/128 THEN 2580
2573 IF REGBIL$="Y" THEN LSET F$="BILLD":PUT 3,LOC(3):GOTO 2595
2580 NEXT I:IF NIT>IIT THEN GET 3,NIT:CB=CVD(E$):LSET F$="BILLD":PUT 3,NIT ELSE IF IIT<>0 THEN GET 3, IIT:CB=CVD(E$)
2595 IF NPRINT THEN 2625
2600 LPRINT TAB(49) "_______________"
2610 IF NPRINT THEN 2625 ELSE IF CB<=0 THEN LPRINT TAB(11) "NO PAYMENT DUE AT THIS TIME**BALANCE IS "; ELSE LPRINT TAB(32) "BALANCE DUE ";
2620 LPRINT USING DL$;CB
2625 IF IIT>NIT THEN GET 3,IIT:CB=CVD(E$)
2630 NT=NT+1:TTAMT=TTAMT+CB:FIELD 3, 8 AS R$, 12 AS S$, 12 AS T$, 12 AS U$, 12 AS V$, 12 AS W$, 12 AS Y$:GET 3,4:IF CB<0.01 THEN M1(NB)=0:M2(NB)=0:M3(NB)=0:OM3(NB)=0:CB(NB)=CB:GOTO 2750
2670 M1(NB)=CVD(S$)+TCR:M2(NB)=CVD(T$)+TCR:M3(NB)=CVD(U$)+TCR:OM3(NB)=CVD(V$)+TCR:CB(NB)=CB
2750 IF X$="I" THEN LPRINT CHR$(140);:GOTO 3020
2755 IF NPRINT THEN 2770
2760 LPRINT CHR$(140);:LIN%=0:IF NB<>LOF(2)/128 THEN LPRINT:LPRINT:LPRINT
2770 TCB=TCB+CB:TTB=TTB+TB:IF NPRINT AND NBB=0 THEN NBB=0 ELSE NBB=NBB+1
2777 IF NBB=1 THEN CLS:PRINT:PRINT TAB(10) "CHECK PRINTING AND ADJUST IF NECESSARY":PRINT:PRINT TAB(10) "ENTER C TO CONTINUE":PRINT:PRINT TAB(10) "PRESS ESCAPE TO RETURN TO OPTIONS AND RESTART" ELSE 2780
2778 INLN%=1:GOSUB 20050:OK$=INPT$:IF INPT$="C" THEN 2780 ELSE 2778
2780 NIT=0:IIT=0:CLOSE 3:RETURN
2790 OPEN "ACCTREC.TOT" AS 1:CLS:PRINT:PRINT TAB(10) "ENTER C TO CONTINUE":PRINT:PRINT TAB(10)"PRESS ESCAPE TO RETURN TO OPTIONS AND RESTART"
2806 INLN%=1:GOSUB 20050:OK$=INPT$:IF INPT$="C" THEN 2890 ELSE 2806
2890 PRINT:PRINT TAB(10) "REMOVE BILL HEADS AND INSERT REGULAR PAPER":PRINT:PRINT TAB(10) "SET TOP OF PAGE AND TURN ON PRINTER":PRINT:PRINT TAB(10) "PRESS F8 WHEN READY"
2900 Z$=INKEY$:IF Z$<>"@" THEN 2900
2915 LPRINT CHR$(27)CHR$(67)CHR$(66):LPRINT CHR$(27)CHR$(78)CHR$(6)+CHR$(15):WIDTH "LPT1:",132:LPRINT CHR$(27)CHR$(71);:LPRINT " ACCOUNTS RECEIVABLE REPORT "+PD$:LPRINT
2940 LPRINT "ACCT.NO. NAME BALANCE DUE 1 MONTH 2 MONTHS 3 MONTHS OVER 3 MONTHS":LPRINT CHR$(27)CHR$(72):IF X$="I" THEN 3030 ELSE SM=1
2970 FOR NB=1 TO LOF(2)/128:GET 2,NB:IF LEFT$(DD$,1)="*" THEN 3055 ELSE ES$=DD$
2990 FL$="A:"+DD$:OPEN FL$ AS 3:IF LEFT$(BB$,1)=SP$ THEN NAM$=AA$ ELSE IF RIGHT$(BB$,2)=SPP$ THEN NAM$=LEFT$(BB$,INSTR(BB$,SPP$))+AA$ ELSE IF RIGHT$(BB$,1)=SP$ THEN NAM$=BB$+AA$ ELSE NAM$=BB$+SP$+AA$
3020 FIELD 3, 8 AS R$, 12 AS S$, 12 AS T$, 12 AS U$, 12 AS V$, 12 AS W$, 12 AS Y$:IF X$="I" THEN IF REGBIL$="N" AND IIT=>NIT THEN 50
3026 IF REGBIL$="N" AND IIT>NIT THEN 3038
3030 GET 3,4:LSET R$=PD$:IF OM3(NB)>0.01 THEN TOM3=TOM3+OM3(NB):LSET W$=MKD$(OM3(NB)) ELSE LSET W$=MKD$(0)
3033 IF M3(NB)>0.01 THEN TM3=TM3+M3(NB):LSET V$=MKD$(M3(NB)) ELSE LSET V$=MKD$(0)
3034 IF M2(NB)>0.01 THEN TM2=TM2+M2(NB):LSET U$=MKD$(M2(NB)) ELSE LSET U$=MKD$(0)
3035 IF M1(NB)>0.01 THEN TM1=TM1+M1(NB):LSET T$=MKD$(M1(NB)) ELSE LSET T$=MKD$(0)
3036 LSET S$=MKD$(CB(NB)):LSET Y$=MKD$(0):PUT 3,4
3038 IF X$="I" THEN 50 ELSE GET 3,4
3040 LPRINT ES$+" "+NAM$ SPC(50-LEN(NAM$));:LPRINT USING DL$;CVD(S$);CVD(T$);CVD(U$);CVD(V$);CVD(W$):LPRINT:CLOSE 3:NIT=0:IIT=0:IT=0
3055 NEXT:LPRINT:LPRINT:LPRINT PD$+" TOTALS FOR THIS BILLING PERIOD ";:LPRINT USING DL$;TCB;TM1;TM2;TM3;TOM3:LPRINT:LPRINT " TOTAL NEW BILLINGS THIS PERIOD ";:LPRINT USING DL$;TTB
3081 FIELD 1, 8 AS R$, 12 AS S$, 12 AS T$, 12 AS U$, 12 AS V$, 12 AS W$, 12 AS Y$:LSET R$=PD$:LSET S$=MKD$(TCB):LSET T$=MKD$(TM1):LSET U$=MKD$(TM2):LSET U$=MKD$(TOM3):LSET Y$=MKD$(TTB):PUT 1,1:LPRINT CHR$(140):LPRINT CHR$(27)CHR$(64):GOTO 50
3100 CLS:PRINT:PRINT TAB(10) "ENTER START DATE":GOTO 2120
3110 GOTO 1000
3120 PRINT:PRINT TAB(10) "PRESS F8 TO START":PRINT TAB(10)"PRESS F7 TO STOP AT ANY POINT":PRINT TAB(10) "PRESS F8 AGAIN TO CONTINUE"
3130 ST$=INKEY$:IF ST$<>"@" THEN 3130 ELSE CLS
3160 PRINT:PRINT " DATE FOR AMOUNT BALANCE":PRINT:IF PRT THEN LPRINT:LPRINT CHR$(27)CHR$(69)+CHR$(27)CHR$(71); ELSE 3210
3190 LPRINT " DATE FOR AMOUNT BALANCE":LPRINT CHR$(27)CHR$(70)+CHR$(27)CHR$(72)
3210 FOR I=5 TO LOF(3)/128:FIELD 3, 8 AS A$, 35 AS B$, 12 AS C$, 4 AS D$, 12 AS E$, 5 AS F$, 46 AS G$:GET 3,I:KEY (7) ON
3242 IF VAL(RIGHT$(A$,2))<VAL(RIGHT$(STD$,2)) THEN 3270 ELSE IF VAL(LEFT$(A$,2))<VAL(LEFT$(STD$,2)) AND VAL(RIGHT$(A$,2))=VAL(RIGHT$(STD$,2)) THEN 3270 ELSE IF VAL(MID$(A$,4,2))<VAL(MID$(STD$,4,2)) AND VAL(LEFT$(A$,2))=VAL(LEFT$(STD$,2)) THEN 3270
3244 IF VAL(RIGHT$(A$,2))>VAL(RIGHT$(PD$,2)) THEN 3270 ELSE IF VAL(LEFT$(A$,2))>VAL(LEFT$(PD$,2)) AND VAL(RIGHT$(A$,2))=VAL(RIGHT$(PD$,2)) THEN 3270 ELSE IF VAL(MID$(A$,4,2))>VAL(MID$(PD$,4,2)) AND VAL(LEFT$(A$,2))=VAL(LEFT$(PD$,2)) THEN 3270
3250 PRBAL=1:PRINT A$+" "+B$;:PRINT USING DL$;CVD(C$);CVD(E$):IF PRT THEN LPRINT A$+" "B$;:LPRINT USING DL$;CVD(C$);CVD(E$)
3270 NEXT:IF PRBAL=0 OR LOF(3)/128=4 THEN GET 3,4 ELSE 3280
3272 FIELD 3, 8 AS R$, 12 AS S$, 12 AS T$, 12 AS U$, 12 AS V$, 12 AS W$, 12 AS Y$:PRINT R$;:PRINT TAB(59) USING DL$;CVD(S$):IF PRT THEN LPRINT R$;:LPRINT TAB(59) USING DL$;CVD(S$)
3280 PRINT:PRINT TAB(10) "A=READ ANOTHER":PRINT:PRINT TAB(10) "O=RETURN TO OPTIONS"
3290 AN$=INKEY$:DEF SEG=64:POKE 23, (PEEK(23) OR 64):IF AN$="A" THEN CLOSE 3:GOTO 3100 ELSE IF AN$="O" THEN 50 ELSE 3290
3320 CLS:IF BIL=1 THEN 3330
3322 PRINT TAB(5) "ENTER MONTH AND YEAR OF CURRENT BILLING PERIOD AS xx/xx ";:INLN%=5:GOSUB 20050:CURM$=LEFT$(INPT$,2):CURY$=RIGHT$(INPT$,2)
3330 BIL=1:GOTO 1000
3335 IF LEFT$(BB$,1)=SP$ THEN NAM$=AA$ ELSE IF RIGHT$(BB$,2)=SPP$ THEN NAM$=LEFT$(BB$,INSTR(BB$,SPP$))+AA$ ELSE IF RIGHT$(BB$,1)=SP$ THEN NAM$=BB$+AA$ ELSE NAM$=BB$+SP$+AA$
3340 IF LEFT$(BB$,1)=SP$ THEN NAM$=AA$ ELSE IF RIGHT$(BB$,2)=SPP$ THEN NAM$=LEFT$(BB$,INSTR(BB$,SPP$))+AA$ ELSE IF RIGHT$(BB$,1)=SP$ THEN NAM$=BB$+AA$ ELSE NAM$=BB$+SP$+AA$
3342 PRINT TAB(5) NAM$:PRINT EE$
3346 PRINT:PRINT TAB(10) "ENTER DATE OF CHARGE OR CREDIT ";
3350 INLN%=8:GOSUB 20050:IF INPT$<>"" THEN PD$=INPT$
3355 IF MID$(PD$,2,1)="-" THEN PD$="0"+PD$
3360 IF LEN(PD$)<>8 THEN PRINT "MUST BE xx-xx-xx ";:GOTO 3350 ELSE IF MID$(PD$,3,1)<>"-" OR MID$(PD$,6,1)<>"-" THEN PRINT "MUST BE xx-xx-xx ";:GOTO 3350
3361 IF LEFT$(PD$,2)=CURM$ AND RIGHT$(PD$,2)=CURY$ THEN 3370
3362 PRINT TAB(10)"DATE IS NOT IN CURRENT BILLING PERIOD":PRINT:PRINT TAB(10) "C = CONTINUE":PRINT TAB(10) "R = REENTER DATE ";
3363 RDT$=INKEY$:DEF SEG=64:POKE 23, (PEEK(23) OR 64):IF RDT$<>"C" AND RDT$<>"R" THEN 3363
3365 IF RDT$="R" THEN LOCATE CSRLIN-4,1:PRINT STRING$(160,32):PRINT STRING$(239,32):LOCATE CSRLIN-5,1:GOTO 3346
3370 IF X$="I" THEN 2250
3380 PRINT:PRINT TAB(10) "C=CHARGE":PRINT:PRINT TAB(10) "CR=CREDIT":PRINT:PRINT TAB(10)"P=PAYMENT ";:INLN%=2:GOSUB 20050:TYP$=INPT$:IF TYP$<>"P" AND TYP$<>"C" THEN IF TYP$<>"CR" THEN 3380
3410 PRINT:PRINT TAB(10) "AMOUNT ";:NBR=1:GOSUB 20050:AMT=VAL(INPT$):NBR=0:IF TYP$="CR" OR TYP$="P" THEN IF AMT>0 THEN AMT=-1*AMT
3435 IF TYP$="P" THEN 3460
3440 PRINT:PRINT TAB(10) "FOR (JUST PRESS ENTER IF NOT NEEDED) ";:IF TYP$="CR" THEN INLN%=28:GOSUB 20050:FR$=INPT$ ELSE INLN%=35:GOSUB 20050:FR$=INPT$
3460 IF TYP$="P" THEN FR$="PAYMENT-THANK YOU" ELSE IF TYP$="CR" THEN FR$=FR$+"-CREDIT"
3470 IF LOF(3)/128<>4 THEN 3510
3480 FIELD 3, 8 AS R$, 12 AS S$, 12 AS T$, 12 AS U$, 12 AS V$, 12 AS W$, 12 AS Y$:GET 3,4:PB=CVD(S$)
3510 FIELD 3, 8 AS A$, 35 AS B$, 12 AS C$, 4 AS D$, 12 AS E$, 5 AS F$, 46 AS G$:IF LOF(3)/128>4 THEN GET 3, LOF(3)/128:PB=CVD(E$)
3530 LSET A$=PD$:LSET B$=FR$:LSET C$=MKD$(AMT):LSET D$=TYP$:LSET E$=MKD$(PB+AMT):LSET F$="":LSET G$="":PUT 3, LOF(3)/128+1:GOSUB 30200
3610 PRINT:PRINT TAB(10) "A=ENTER ANOTHER FOR SAME ACCOUNT":PRINT:PRINT TAB(10) "B=ENTER ANOTHER FOR DIFFERENT ACCOUNT":PRINT:PRINT TAB(10) "O=RETURN TO OPTIONS"
3620 AN$=INKEY$:DEF SEG=64:POKE 23, (PEEK(23) OR 64):IF AN$="A" THEN 3340 ELSE IF AN$="B" THEN CLOSE 3:GOTO 3320 ELSE IF AN$="O" THEN 50 ELSE 3620
3650 CLS:CLS:PRINT TAB(10) "R=READ ONLY":PRINT:PRINT TAB(10)"P=READ AND PRINT(TURN ON PRINTER)
3670 PRT$=INKEY$:DEF SEG=64:POKE 23, (PEEK(23) OR 64):IF PRT$<>"P" AND PRT$<>"R" THEN 3670
3700 IF PRT$="P" THEN PRT=1:LPRINT CHR$(27)CHR$(78)CHR$(6)
3710 PRINT:PRINT TAB(10) "PRESS F8 TO START":PRINT TAB(10)"PRESS F7 TO STOP AT ANY POINT":PRINT TAB(10) "PRESS F8 AGAIN TO CONTINUE"
3720 ST$=INKEY$:IF ST$<>"@" THEN 3720
3740 CLS:PRINT "ACCT. NO. NAME":IF PRT THEN LPRINT CHR$(27)CHR$(69)+CHR$(27)CHR$(71):LPRINT "ACCT. NO. NAME"
3760 IF PRT THEN LPRINT CHR$(27)CHR$(70)+CHR$(27)CHR$(72)+CHR$(27)CHR$(78)CHR$(6)
3765 KEY(7) ON:FOR N=1 TO LOF(2)/128:ON KEY(7) GOSUB 3910:GET 2,N:FIELD 2, 35 AS AA$, 15 AS BB$, 2 AS CC$, 9 AS DD$, 67 AS EE$:SP2$=" ":IF LEFT$(DD$,1)="*" THEN 3870
3820 NAM$=LEFT$(AA$,-1+INSTR(AA$,SP2$)):IF LEFT$(BB$,2)<>" " THEN NAM$=NAM$+", "+LEFT$(BB$,INSTR(BB$,SP2$))
3840 IF LEFT$(CC$,1)<>"." THEN NAM$=NAM$+CC$
3850 PRINT DD$+" "+NAM$:PRINT TAB(13) EE$:IF PRT THEN LPRINT DD$+" "+NAM$ ELSE 3870
3865 LPRINT TAB(13) EE$
3870 NEXT:IF PRT THEN LPRINT CHR$(140)
3880 PRINT:PRINT TAB(10) "PRESS F8 TO RETURN TO OPTIONS"
3890 X$=INKEY$:IF X$<>"@" THEN 3890 ELSE 50
3910 ST$=INKEY$:IF ST$=CHR$(27) THEN 50
3920 IF ST$<>"@" THEN 3910 ELSE RETURN
5800 CLS:GOTO 60000
5802 IF SHELLD%=1 THEN 5807
5803 DEF SEG=LD.ADDR:BLOAD "SHELLSRT",0:SHELLSRT=0:SHELLD%=1
5807 SEQ$="A":CLOSE 2:OPEN "ACCT.CNT" AS 2:IF X$="U" THEN FIELD 2, 35 AS AA$, 15 AS BB$, 2 AS CC$, 9 AS DD$, 67 AS EE$ ELSE FIELD 2, 128 AS AA$
5815 COUNT%=LOF(2)/128:DIM DIRLST$(COUNT%):FOR N=1 TO COUNT%:GET 2,N:IF X$="U" THEN DIRLST$(N-1)=DD$ ELSE DIRLST$(N-1)=AA$
5840 NEXT:DEF SEG=LD.ADDR:CALL SHELLSRT(SEQ$,COUNT%,DIRLST$(0)):IF X$="B" THEN FL$="ACCT.CNT":GOSUB 30200:GOTO 5863
5855 FOR N=0 TO COUNT%-1:IF COUNT% MOD 8=0 THEN PRINT DIRLST$(N) ELSE PRINT DIRLST$(N);
5862 NEXT:GOTO 5865
5863 FOR N=0 TO COUNT%-1:PRINT DIRLST$(N):LSET AA$=DIRLST$(N):PUT 2, N+1:NEXT
5865 PRINT:PRINT TAB(10) "PRESS F8 TO RETURN TO OPTIONS"
5870 MU$=INKEY$:IF MU$<>"@" THEN 5870 ELSE 50
5880 '
7000 CLS:IF ERR=71 THEN COLOR 0,7:PRINT " CORRECT DISK NOT IN DRIVE B OR CORRECT DISK NOT IN DRIVE A OR DOOR IS OPEN.":PRINT:PRINT"CORRECT PROBLEM AND PRESS F8 WHEN READY. ":GOTO 7070
7020 IF ERR=24 OR ERR=27 THEN COLOR 0,7:PRINT " PRINTER NOT ON OR OUT OF PAPER. SET TOP OF PAGE AND TURN ON PRINTER. PRESS F8 WHEN READY. ":GOTO 7070
7030 IF ERR=53 THEN COLOR 0,7:PRINT " FILE NOT FOUND ":PRINT:PRINT " INSERT DISK CONTAINING FILE AND PRESS F8 WHEN READY. ":GOTO 7070
7040 PRINT " AN UNDEFINED ERROR HAS OCCURRED":PRINT:PRINT "PRESS F8 TO RETURN TO MENU"
7050 ER$=INKEY$:IF ER$<>"@" THEN 7050 ELSE COLOR 7,0:GOTO 50
7070 ER$=INKEY$:IF ER$<>"@" THEN 7070 ELSE COLOR 7,0:CLS:RESUME
7090 CLS:PRINT "TOTALS FOR EACH ACCOUNT WILL ONLY BE TRANSFERRED THROUGH LAST DATE BILLED":PRINT
7093 PRINT "IF ENTRIES HAVE BEEN MADE TO FILES SINCE LAST BILLING THEY WILL HAVE TO BE REENTERED FOR NEW FILE DISK - OR - DO REGULAR BILLING BEFORE PREPARING NEW DISK.":PRINT:PRINT TAB(10) "C = CONTINUE":PRINT:PRINT TAB(10) "R = RETURN TO MENU"
7095 FR$=INKEY$:DEF SEG=64:POKE 23, (PEEK(23) OR 64):IF FR$<>"C" AND FR$<> "R" THEN 7095 ELSE IF FR$="R" THEN 50
7098 CLS:PRINT:PRINT "DO YOU HAVE TWO BLANK DISKS AVAILABLE WHICH HAVE BEEN FORMATTED WITH THE R PROCEDURE FROM THE PROGRAM DISK Y/N ?"
7110 FR$=INKEY$:DEF SEG=64:POKE 23, (PEEK(23) OR 64):IF FR$="Y" THEN 7190 ELSE IF FR$="N" THEN 7140 ELSE 7110
7140 CLS:PRINT:PRINT TAB(10)"REMOVE BOTH DISKS AND INSERT PROGRAM DISK IN DRIVE A":PRINT:PRINT TAB(10)"PRESS F8 WHEN READY"
7150 RD$=INKEY$:IF RD$="@" THEN 7170 ELSE 7150
7170 PRINT:PRINT:PRINT TAB(10) "YOU WILL BE RETURNED TO ACCOUNT RECEIVABLE PROGRAM AFTER DISKS HAVE BEEN FORMATTED AND YOU WILL HAVE TO SELECT F OPTION AGAIN.":PRINT:PRINT TAB(10) "ENTER R WHEN A> PROMPT APPEARS.":SYSTEM
7190 PRINT:PRINT TAB(10) "MOST RECENT ACCT.REC. FILE DISK MUST BE IN DRIVE A":PRINT:PRINT TAB(10) "IS THIS FOR A NEW YEAR Y/N ?"
7200 NY$=INKEY$:DEF SEG=64:POKE 23, (PEEK(23) OR 64):IF NY$="" THEN 7200
7230 PRINT:PRINT TAB(10) "INSERT NEW ACCT.REC. FILE DISK IN DRIVE B":PRINT:PRINT TAB(10) "PRESS F8 WHEN READY."
7240 CP$=INKEY$:IF CP$="@" THEN 7260 ELSE 7240
7260 CLS:LOCATE 12,22:PRINT "COPYING FILES *** PLEASE WAIT"
7270 OPEN "B:ACCT.CNT" AS 1:FOR N=1 TO LOF(2)/128:FIELD 2, 35 AS AA$, 15 AS BB$, 2 AS CC$, 9 AS DD$, 67 AS EE$:GET 2,N:FL$="A:"+DD$:NFL$="B:"+DD$:IF NY$="Y" THEN IF LEFT$(DD$,1)="*" THEN 7650
7340 A$=AA$:B$=BB$:C$=CC$:D$=DD$:FIELD 1, 20 AS AA$, 15 AS BB$, 2 AS CC$, 9 AS DD$:LSET AA$=A$:LSET BB$=B$:LSET CC$=C$:LSET DD$=D$:PUT 1,LOF(1)/128+1:OPEN FL$ AS 3:OPEN NFL$ AS 4:FIELD 3, 8 AS A$, 35 AS B$, 15 AS C$, 2 AS CA$, 35 AS D$, 33 AS E$
7410 GET 3,1:G$=A$:H$=B$:I$=C$:J$=CA$:K$=D$:L$=E$:FIELD 3, 8 AS A$, 35 AS B$, 15 AS C$, 2 AS CA$, 35 AS D$, 33 AS E$:LSET A$=G$:LSET B$=H$:LSET C$=I$:LSET CA$=J$:LSET D$=K$:LSET E$=L$:PUT 4,1:FIELD 3, 13 AS F$, 115 AS G$:GET 3,2:FF$=F$:GG$=G$
7490 FIELD 4, 13 AS F$, 115 AS G$:LSET F$=FF$:LSET G$=GG$:PUT 4,2:FIELD 3, 40 AS H$, 40 AS I$, 48 AS J$:GET 3,3:HH$=H$:II$=I$:JJ$=J$:FIELD 4, 40 AS H$, 40 AS I$, 48 AS J$:LSET H$=HH$:LSET I$=II$:LSET J$=JJ$:PUT 4,3:FIELD 4,40 AS H$
7590 FIELD 3, 8 AS R$, 12 AS S$, 12 AS T$, 12 AS U$, 12 AS V$, 12 AS W$, 12 AS Y$:GET 3,4:A$=R$:A=CVD(S$):B=CVD(T$):C=CVD(U$):D=CVD(V$):E=CVD(W$):F=CVD(Y$):FIELD 4, 8 AS R$, 12 AS S$, 12 AS T$, 12 AS U$, 12 AS V$, 12 AS W$, 12 AS Y$
7630 LSET R$=A$:LSET S$=MKD$(A):LSET T$=MKD$(B):LSET U$=MKD$(C):LSET V$=MKD$(D):LSET W$=MKD$(E):LSET Y$=MKD$(F):PUT 4,4
7650 CLOSE 3:CLOSE 4:NEXT N:OPEN "A:ACCTREC.TOT" AS 3:OPEN "B:ACCTREC.TOT" AS 4:FIELD 3, 8 AS R$, 12 AS S$, 12 AS T$, 12 AS U$, 12 AS V$, 12 AS W$, 12 AS Y$:GET 3,1:A$=R$:A=CVD(S$):B=CVD(T$):C=CVD(U$):D=CVD(V$):E=CVD(W$):F=CVD(Y$)
7720 FIELD 4, 8 AS R$, 12 AS S$, 12 AS T$, 12 AS U$, 12 AS V$, 12 AS W$, 12 AS Y$:LSET R$=A$:LSET S$=MKD$(A):LSET T$=MKD$(B):LSET U$=MKD$(C):LSET V$=MKD$(D):LSET W$=MKD$(E):LSET Y$=MKD$(F):PUT 4,1:CLOSE 1:CLOSE 3:CLOSE 4:IF SECOND THEN 7800
7770 CLS:PRINT:PRINT TAB(10)"REMOVE NEW FILE DISK FROM DRIVE B AND INSERT NEW BACKUP FILE DISK.":PRINT:PRINT TAB(10)"PRESS F8 WHEN READY."
7780 SD$=INKEY$:IF SD$="@" THEN SECOND=1:GOTO 7270 ELSE 7780
7800 PRINT:PRINT TAB(10) "REMOVE BOTH DISKS":PRINT:PRINT TAB(10)"INSERT BOOKKEEPING FILE DISK IN DRIVE B":PRINT:PRINT TAB(10)"INSERT NEW ACCT.REC. FILE DISK IN DRIVE A":PRINT:PRINT TAB(10) "PRESS F8 WHEN READY"
7810 ES$=INKEY$:IF ES$<>"@" THEN 7810 ELSE 50
20050 INPT$="":INPOS%=POS(0):DEF SEG=64:POKE 23, (PEEK(23) OR 64):POKE 23, (PEEK(23) OR 32):LOCATE,,1,6,7:IF INLN%=0 THEN INLN%=10
20110 IP$=INKEY$:IF IP$="" THEN 20110
20130 IF NBR THEN IF ASC(IP$)>57 THEN BEEP:GOTO 20110
20140 IF NBR THEN IF ASC(IP$)<48 AND ASC(IP$)<>46 THEN IF ASC(IP$)<>8 AND ASC(IP$)<>13 THEN BEEP:GOTO 20110
20150 IF ASC(IP$)=29 THEN BEEP:GOTO 20110
20155 IF ASC(IP$)=27 THEN 50
20160 IP$=CHR$(ASC(IP$)+32*(IP$>="a" AND IP$<="z")):IF LEN(INPT$)=INLN% THEN IF ASC(IP$)<>13 AND ASC(IP$)<>8 THEN 20110
20180 IF ASC(IP$)=13 THEN PRINT:GOTO 20240
20190 IF ASC(IP$)=8 AND POS(0)=INPOS% THEN 20110
20200 IF ASC(IP$)=8 THEN GOSUB 20250:GOTO 20110
20210 INPT$=INPT$+IP$:PRINT IP$;:GOTO 20110
20240 INLN%=0:RETURN
20250 IF INPT$="" THEN 20110
20260 INPT$=LEFT$(INPT$,LEN(INPT$)-1):LOCATE CSRLIN,POS(0)-1:PRINT " ";:LOCATE CSRLIN,POS(0)-1:RETURN
30000 OPEN "BACKUP.FIL" AS 4:IF LOF(4)/128=0 THEN 30020 ELSE GOSUB 30070
30020 CLS:PRINT:PRINT TAB(10) "REMOVE DISK FROM DRIVE A.":PRINT:PRINT TAB(10) "INSERT PROGRAM DISK IN DRIVE A.":PRINT:PRINT TAB(10) "PRESS F8 WHEN READY."
30030 X$=INKEY$:IF X$<>"@" THEN 30030
30050 RUN "BKPG.BAS"
30070 OPEN "Q.BAT" FOR OUTPUT AS 3:FOR N=1 TO LOF(4)/128:FIELD 4, 14 AS A$:GET 4,N:IF LEFT$(A$,3)="*.*" THEN CHKDSC=1:GOTO 30151
30140 PRINT #3, "COPY "+A$+" "+"B:":NEXT
30151 IF CHKDSC THEN PRINT #3, "COPY "+"*. "+" "+"B:":PRINT #3, "COPY "+"ACCT.CNT"+" "+"B:":PRINT #3, "COPY "+"ACCTREC.TOT"+" "+"B:"
30152 IF CHKDSC THEN PRINT #3, "CHKDSK A:":PRINT #3, "CHKDSK B:"
30155 PRINT #3, "REM REMOVE BOTH DISKS":PRINT #3, "REM INSERT PROGRAM DISK IN DRIVE A":PRINT #3, "REM ENTER A WHEN READY":CLOSE 3:CLOSE 4:KILL "BACKUP.FIL":RETURN
30200 IF BKUP THEN 30220 ELSE OPEN "BACKUP.FIL" AS 4:BKUP=1
30220 FIELD 4, 14 AS A$:IF LOF(4)/128=0 THEN 30280
30240 FOR N=1 TO LOF(4)/128:GET 4,N:IF FL$+STRING$(14-LEN(FL$),32)=A$ OR LEFT$(A$,3)="*.*" THEN 30300
30270 NEXT
30280 LSET A$=FL$:PUT 4, LOF(4)/128+1
30300 RETURN
60000 TRUE%=-1:FALSE%=0:LDOUT%=FALSE%:GOSUB 60180:GOSUB 60230:GOSUB 60270:IF NOT LDOUT% THEN 60130
60030 GOSUB 60340:GOTO 60160
60050 '
60130 GOSUB 60380:CLEAR ,CLR.ADDR:GOSUB 60180:GOSUB 60430
60160 GOTO 5802
60170 END
60180 SUBR.SIZE=400:RETURN
60230 DEF SEG=0:SYS.MEMORY=PEEK(&H413)+PEEK(&H414)*256:RETURN
60270 DEF SEG=0:BASIC.DS=(PEEK(&H510)+PEEK(&H511)*256):OUTSIDE.BASIC.DS=BASIC.DS+4104+(SUBR.SIZE/16):IF OUTSIDE.BASIC.DS*16<SYS.MEMORY*1024 THEN LDOUT%=TRUE%
60330 RETURN
60340 LD.ADDR=OUTSIDE.BASIC.DS-(SUBR.SIZE/16):RETURN
60380 DEF SEG:TOP.STACK=PEEK(&H2C)+PEEK(&H2D)*256:CLR.ADDR=(TOP.STACK-SUBR.SIZE)-128:RETURN
60430 DEF SEG=0:BASIC.DS=16*(PEEK(&H510)+PEEK(&H511)*256):DEF SEG:TOP.STACK=PEEK(&H2C)+PEEK(&H2D)*256:LD.ADDR=(BASIC.DS+TOP.STACK)/16:LD.ADDR=INT(LD.ADDR+0.5):RETURN
BKPG.BAS
1 DEF SEG
2 IF PEEK(0)=1 THEN 10
3 POKE 0,1
4 '*************** SIMPLIFIED BUSINESS BOOKKEEPING *****************************
5 '************** COPYRIGHT 1985 DONALD I. PARITZ *****************************
6 CLS:FOR N=1 TO 10:PRINT:NEXT:PRINT STRING$(79,42):PRINT:PRINT TAB(25)"SIMPLIFIED BUSINESS BOOKKEEPING":PRINT:PRINT TAB(24) "COPYRIGHT 1985 DONALD I. PARITZ":PRINT STRING$(79,42)
7 WHILE N<1000:N=N+1:WEND
10 '
20 COLOR 7,0:CLS:CLEAR:KEY 7, "":KEY 8, "@":ON ERROR GOTO 300
50 PRINT:PRINT: COLOR 0,7:PRINT" BOOKKEEPING FILE DISK MUST BE IN DRIVE B ":COLOR 7,0:PRINT:DEFDBL A-Z:DEFINT N,I,J:PRINT "CHOOSE PROGRAM":PRINT:PRINT TAB(10) "E=EXPENSES":PRINT:PRINT TAB(10) "I=INCOME"
120 PRINT:PRINT TAB(10) "B=BANK-CHECKING ACCOUNT --- DO FIRST IF INITIATING SYSTEM":PRINT:PRINT TAB(10) "A=ACCOUNTS RECEIVABLE":PRINT:PRINT TAB(10) "F=SUMMARY OF OPERATIONS (CLOSE OUT INCOME AND EXPENSE FILES FIRST)"
140 PRINT:PRINT TAB(10) "C=CLOSE FILES AND END - BOOKKEEPING FILE DISK MUST BE IN DRIVE B
160 PRINT:PRINT " P=PREPARE NEW BOOKKEEPING FILE DISKS (PAYROLL DISKS MUST BE PREPARED FROM PAYROLL PROGRAM)
170 PRINT:PRINT " S=INITIALIZE SYSTEM - PREPARES NEW BOOKKEEPING, PAYROLL AND ACCOUNT RECEIVABLE FILE DISKS FOR FIRST TIME SYSTEM IS USED"
180 X$=INKEY$:DEF SEG=64:POKE 23, (PEEK(23) OR 64)
200 IF X$="E" THEN RUN "EXPENSE" ELSE IF X$="I" THEN RUN "INCOME" ELSE IF X$="B" THEN RUN "CHECKING" ELSE IF X$="A" THEN RUN "ACCTREC" ELSE IF X$="F" THEN 5000 ELSE IF X$="C" THEN 30000 ELSE IF X$="P" OR X$="S" THEN 240 ELSE 180
240 CLS:PRINT:PRINT TAB(10) "REMOVE DISK FROM DRIVE B":IF X$="P" THEN PRINT:PRINT TAB(10) "ENTER F WHEN A> APPEARS"
260 IF X$="S" THEN PRINT:PRINT TAB(10) "ENTER S WHEN A> APPEARS"
270 PRINT:PRINT:SYSTEM
300 COLOR 0,7:IF ERR=201 THEN PRINT "WRONG DISK IS IN DRIVE A, CATEGORY OF EXPENSE FILE CANNOT BE FOUND.":GOTO 400
320 IF ERR=202 THEN PRINT "EXPENSE FILE HAS NOT BEEN CLOSED OUT FOR THIS MONTH OR WRONG DISK IS IN DRIVE B":GOTO 400
330 IF ERR=203 THEN PRINT "INCOME FILE HAS NOT BEEN CLOSED OUT FOR THIS MONTH OR WRONG DISK IS IN DRIVE B":GOTO 400
340 IF ERR=204 THEN PRINT "EXPENSE TOTALS FILE CANNOT BE FOUND.":PRINT:PRINT "WRONG DISK IN DRIVE B .":GOTO 400
350 IF ERR=205 THEN PRINT "INCOME TOTALS FILE CANNOT BE FOUND.":PRINT:PRINT "WRONG DISK IN DRIVE B .":GOTO 400
360 IF ERR=71 THEN PRINT "DISK NOT IN DRIVE A OR DRIVE DOOR IS OPEN.":GOTO 400
370 IF ERR=24 OR ERR=27 THEN PRINT "PRINTER NOT ON OR OUT OF PAPER.":PRINT:PRINT "SET TOP OF PAGE AND TURN ON PRINTER.":GOTO 400
380 PRINT "AN UNDEFINED ERROR HAS OCCURRED":GOTO 400
400 PRINT:PRINT TAB(10) "F8 = ERROR CORRECTED - CONTINUE":PRINT:PRINT TAB(10) "ESC = RETURN TO MENU"
410 X$=INKEY$:IF X$="@" THEN COLOR 7,0:CLS:RESUME ELSE IF X$=CHR$(27) THEN 20 ELSE 410
430 '
5000 CLS:PRINT:PRINT TAB(10) "BOOKKEEPING FILE DISK WITH MOST RECENT CLOSED OUT INCOME AND EXPENSE FILES MUST BE IN DRIVE B .":PRINT:PRINT "READY PRINTER.":PRINT:PRINT:DEFDBL A-Z:DEFINT N,I,J:DL$="$$#########.##":INPUT "LAST MONTH CLOSED OUT ";MON$
5070 EXFL$="B:EXPENSE."+LEFT$(MON$,3):INFL$="B:INCOME."+LEFT$(MON$,3):OPEN "CATEGORY.FIL" AS 1:IF LOF(1)/128=0 THEN ERROR 201
5090 FIELD 1, 44 AS L$:FOR N= 1 TO LOF(1)/128:GET 1,N:IF LEFT$(L$,8)="PURCHASE" THEN IPUR=N
5130 NEXT:CLOSE 1:OPEN EXFL$ AS 1:IF LOF(1)/128=0 THEN ERROR 202
5160 FIELD 1, 8 AS D$, 8 AS C$, 25 AS B$, 9 AS A$, 18 AS E$:FOR N=2 TO LOF(1)/128:GET 1,N:IF LEFT$(E$,1)="*" THEN 5220
5200 TEXP=TEXP+CVD(A$):IF LEFT$(E$,8)="PURCHASE" THEN TPUR=TPUR+CVD(A$)
5220 NEXT:CLOSE 1:OPEN INFL$ AS 1:IF LOF(1)/128=0 THEN ERROR 203
5250 FOR N=2 TO LOF(1)/128:FIELD 1, 8 AS D$, 10 AS B$, 10 AS A$, 15 AS F$, 30 AS S$, 5 AS X$:GET 1,N:TDEP=TDEP+CVD(B$):IF LEFT$(X$,1)="M" THEN TMISC=TMISC+CVD(A$):GOTO 5320
5300 FIELD 1, 8 AS D$, 10 AS B$, 10 AS A$, 8 AS E$, 8 AS N$, 8 AS T$, 8 AS R$, 8 AS G$, 8 AS X$:TINC=TINC+CVD(N$)+CVD(T$)+CVD(R$)+CVD(X$)
5320 NEXT:DAT$=D$:CLOSE 1:OPEN "B:EXPENSE.TOT" AS 1:IF LOF(1)/128=0 THEN ERROR 204
5360 FIELD 1, 12 AS Q$:GET 1, IPUR:TTPUR=CVD(Q$):GET 1,LOF(1)/128:TTEXP=CVD(Q$):CLOSE 1:OPEN "B:INCOME.TOT" AS 1:IF LOF(1)/128=0 THEN ERROR 205
5430 FIELD 1, 12 AS Q$:GET 1, 12:TTSAL=CVD(Q$):FOR N=9 TO 11:GET 1,N:TTMISC=TTMISC+CVD(Q$):NEXT:GET 1,1:TTDEP=CVD(Q$):CLS:PRINT:PRINT TAB(10) "SUMMARY OF OPERATIONS ENDING "+DAT$+" YTD"
5530 PRINT:PRINT "SALES ";:PRINT USING DL$;TINC;TTSAL:LPRINT CHR$(27)CHR$(69)+CHR$(27)CHR$(71):LPRINT:LPRINT TAB(10) "SUMMARY OF OPERATIONS ENDING "+DAT$+" YTD"
5570 LPRINT CHR$(27)CHR$(70)+CHR$(27)CHR$(72):LPRINT "SALES ";:LPRINT USING DL$;TINC;TTSAL:PRINT "COST OF MERCHANDISE SOLD ";:PRINT USING DL$;TPUR;TTPUR
5610 LPRINT "COST OF MERCHANDISE SOLD ";:LPRINT USING DL$;TPUR;TTPUR:PRINT TAB(40) STRING$(39,45):LPRINT TAB(40) STRING$(39,45):PRINT " GROSS PROFIT ON SALES ";:PRINT USING DL$;TINC-TPUR;TTSAL-TTPUR
5670 LPRINT " GROSS PROFIT ON SALES ";:LPRINT USING DL$;TINC-TPUR;TTSAL-TTPUR:PRINT:PRINT "EXPENSES ";:PRINT USING DL$;TEXP-TPUR;TTEXP-TTPUR:LPRINT:LPRINT "EXPENSES ";
5720 LPRINT USING DL$;TEXP-TPUR;TTEXP-TTPUR:PRINT TAB(40) STRING$(39,45):LPRINT TAB(40) STRING$(39,45):PRINT " NET INCOME FROM SALES ";:PRINT USING DL$;TINC-TEXP;TTSAL-TTEXP:LPRINT " NET INCOME FROM SALES ";
5780 LPRINT USING DL$;TINC-TEXP;TTSAL-TTEXP:PRINT:PRINT "OTHER INCOME ";:PRINT USING DL$;TMISC;TTMISC:LPRINT:LPRINT "OTHER INCOME ";:LPRINT USING DL$;TMISC;TTMISC:PRINT TAB(40) STRING$(39,45)
5840 PRINT " TOTAL NET ";:PRINT USING DL$;TINC+TMISC-TEXP;TTSAL+TTMISC-TTEXP:LPRINT TAB(40) STRING$(39,45):LPRINT " TOTAL NET ";:LPRINT USING DL$;TINC+TMISC-TEXP;TTSAL+TTMISC-TTEXP
5890 PRINT:PRINT TAB(10) "CASH FLOW":PRINT:PRINT "DEPOSITS ";:PRINT USING DL$;TDEP;TTDEP:LPRINT CHR$(27)CHR$(69)+CHR$(27)CHR$(71):LPRINT:LPRINT TAB(10) "CASH FLOW"
5930 LPRINT CHR$(27)CHR$(70)+CHR$(27)CHR$(72):LPRINT "DEPOSITS ";:LPRINT USING DL$;TDEP;TTDEP:PRINT "PAID OUT ";:PRINT USING DL$;TEXP;TTEXP:PRINT TAB(40) STRING$(39,45)
5980 PRINT " NET CASH ";:PRINT USING DL$;TDEP-TEXP;TTDEP-TTEXP:LPRINT "PAID OUT ";:LPRINT USING DL$;TEXP;TTEXP:LPRINT TAB(40) STRING$(39,45)
6030 LPRINT " NET CASH ";:LPRINT USING DL$;TDEP-TEXP;TTDEP-TTEXP:LPRINT CHR$(140):PRINT:PRINT TAB(10) "PRESS F8 TO RETURN TO MENU"
6070 X$=INKEY$:IF X$<>"@" THEN 6070 ELSE 20
30000 OPEN "B:BACKUP.FIL" AS 4:IF LOF(4)/128=0 THEN 30020 ELSE GOSUB 30070
30020 CLS:PRINT:PRINT TAB(10) "ENTER A FOR FILE BACKUP MENU":SYSTEM
30070 OPEN "B:B.BAT" FOR OUTPUT AS 3:FOR N=1 TO LOF(4)/128:FIELD 4, 14 AS A$:GET 4,N:IF LEFT$(A$,6)="CHKDSC" THEN CHKDSC=1:GOTO 30150
30140 PRINT #3, "COPY "+A$+" "+"B:"
30150 NEXT:IF CHKDSC THEN PRINT #3, "CHKDSK A:":PRINT #3, "CHKDSK B:"
30155 PRINT #3, "REM REMOVE BOTH DISKS":PRINT #3, "REM INSERT PROGRAM DISK IN DRIVE A":PRINT #3, "REM ENTER A WHEN READY":CLOSE 3:CLOSE 4:KILL "B:BACKUP.FIL":RETURN
BKPG.DOC
SIMPLIFIED BUSINESS BOOKKEEPING
Copyright 1985 by Donald Paritz
GENERAL INFORMATION
SIMPLIFIED BUSINESS BOOKKEEPING is a collection of the following
programs:
EXPENSES - check register type, prints and files checks
and maintains totals for each category.
INCOME - designed for a small retail business using a
cash register, but may be adapted to any
business. Maintains totals by category and
checks cash income against deposits.
BANK ACCOUNT - uses totals from expense and income files to
balance checking account against bank statement.
PAYROLL - full featured payroll allowing for deductions
consistent with most state and city regulations.
Prints checks and stubs, maintains all records
and gives monthly report with tax payments due.
ACCOUNTS - enter all charges, payments, and credits for
RECEIVABLE each day. Maintains files and prints bills at
end of month as well as aging statement.
SUMMARY OF - income from sales, other income, income after
OPERATIONS expenses, cash flow.
The minimum hardware configuration for using these programs is
an IBM-PC or compatible computer with 128 K of memory, 2 DS DD
disk drives, and an IBM, Epson or other compatible printer.
All of these programs are menu driven so that there will rarely
be an occasion to refer to this manual. The manual should be
read through one time, however, to obtain a general overview
of the operation as well as pitfalls to avoid in data entry,
file handling, disk handling, etc..
In any case IT IS ABSOLUTELY NECESSARY TO READ AND RUN THE START
UP PROCEDURE since the program disk provided is not an operating
disk.
All programs are set to convert answers to capital letters. This
is necessary since comparative evaluations are made by programs
and these comparisons require capital letters.
Number input will request numbers as xx.xx, i.e. you will be
expected to use the decimal point. This is not necessary in the
case of numbers with trailing zeros, however if you take this
shortcut be sure that you know what you are doing. Examples:
Entering 77 is the same as 77.00; entering 77.5 is the same as
77.50, but if you wish to enter 50 cents you must enter .50 or
.5 since leaving out the decimal point will yield 50.00 or 5.00.
In most cases when you are prompted for input, pressing the Esc
key will return you to options for that program. It may then
be necessary to read the files to determine last information
written to files.
It is always necessary to backup file disks after each session
by choosing "Close Files and End" from the bookkeeping menu.
If this is not done the backup file will be destroyed and a new
one created the next time you run the program. This will lead
to some files not being backed up until the next time they are
used.
If you try to backup the wrong disk e.g. entering P for backup
payroll files and payroll disk is not in drive A, you will get
a message "file not found". Insert correct disk and proceed.
There is no protection for having the wrong backup disk in drive
B so be very careful to insert the correct disk.
When ending the fiscal year it is always necessary to prepare new
bookkeeping and backup bookkeeping disks and when ending the
calendar year it is always necessary to prepare new payroll and
accounts receivable file and backup disks.
Insert paper in your printer with ribbon guide in the far left
position (turn printer on and off) and paper guides positioned
so that top of ribbon guide is centered on top of paper and left
edge of paper (edge that will remain when tractor strip is
removed). Minor adjustments may later have to be made to adjust
for your printer.
After closing out files at the end of each month the backup
program will run check disk. You will have to calculate for each
disk the probability of the disk holding another month's data and
in the case of the payroll disk, another quarter's data.
Number of bytes in user files / months to date=bytes per month
The number of bytes remaining on disk must be greater than bytes
per month and in the case of the payroll disk, it must be 3 times
greater. It is advisable to allow a 10% cushion to accommodate an
increase in data for month or more if you expect a great deal
more data in the next month.
It is probably a good idea to run all programs for one month
while still maintaining your manual records. If any serious
errors are made during this time or if you decide on changing
category names, etc.. you can then prepare new file disks and
restart with next month.
START UP
Generally, the start up procedure involves transferring the
operating system to the program disk and then preparing two
copies of the program disk. Two copies are necessary since some
files will be kept on the program disk and a backup copy will be
necessary. The original program disk should be put away in a
safe place when finished.
A total of 8 blank disks will be needed for complete bookkeeping.
If not using Accounts Receivable or Payroll programs, you will
need 2 less disks per program not used.
Boot up your system using your DOS disk and then insert the
program disk in drive B.
Type and enter the following exactly as written:
B:STARTUP
Follow instructions as given by start up program.
Be sure to remove your DOS disk and insert a blank disk when
requested. Failure to do so will erase your DOS disk.
When both new program disks have been prepared, place a write
protect tab on your original program disk to avoid accidentally
destroying it.
Label one of your new disks Program Disk and the other one
Backup Program Disk. It is a good idea to boldly label all
backup disks with larger letters or another color, etc..
When preparing the file and backup disks you do not have to
prepare disks for Accounts Receivable or Payroll programs if you
are not using them. When instructed to insert these disks just
leave the previous disk in drive B.
FIRST PROGRAM TO BE RUN WHEN STARTING SYSTEM MUST BE "BANK
ACCOUNT".
BANK ACCOUNT
THIS FILE MUST BE PREPARED FIRST BEFORE RUNNING ANY PROGRAM
Both the expense program and income program write information to
the bank account file, therefore this file must be initiated
before running any other program.
This program will check the disk for an existing checking account
file. If there is none, you will be prompted for initialization
information. This will only happen when you first use the system
since the checking account file will be transferred to each new
fiscal year. If it happens at any other time, you may have the
wrong disk in drive B or the file may have been lost, etc..
If the file has been lost, reboot system and copy it from the
backup disk.
Generally this program will prompt you for the bank totals, any
outstanding checks or deposits from month not recorded by bank
and any bad checks. Total expenses and income will be drawn from
their respective files and the previous bank account totals will
be obtained from then checking account file.
If all figures balance a report will be printed indicating all
balances and adjustments. If they do not balance, corrective
choices will be given.
There maximum allowed for entries in this file are:
4 Bad checks
20 Checks outstanding
10 Deposits outstanding
Should you have more of any of these items, it will be necessary
to enter two or more as one entry, however, this is very
unlikely.
The book balance reported after reconciliation takes into account
all adjustments and unrecorded charges and represents actual cash
in account on closing date. Be sure to enter these in
appropriate files as directed by the bank account report.
****************** VERY IMPORTANT *******************************
If new bookkeeping file disks are prepared before Expense, Income
and Bank Account files have been closed out for month, you will
have to copy the bank account file to the new disk after all of
these files have been closed out.
Return to DOS by using Close Files and End routine or by booting
with DOS disk. Insert old disk with all files closed out in
drive A and new disk in drive B . Type and enter the
following:
COPY CHECKING.ACC B:
******************************************************************
EXPENSE PROGRAM
Two files must be set up before entering expenses with this
program.
CATEGORY OF EXPENSE FILE
First choose the Category of Expense option and enter up to 28
categories that you would like to have your expenses grouped
under. Your monthly report will accumulate and give the total of
each expense for month and year-to-date. Any expense that does
not specify one of these categories (OR SPELLS IT WRONG!) will
appear as a miscellaneous expense.
****************** VERY IMPORTANT *****************************
One of the categories must be called PURCHASES in order for
the summary of operations program to be able to obtain a cost of
goods sold.
NO TWO CATEGORIES MAY HAVE THE SAME FIRST 3 LETTERS
***************************************************************
PAYEE FILE
The next file to be set up is the Payee File. This file allows
you to select 3 letter abbreviations for your regular payees
and relieves you of the need to enter the category of expense
and the address of payee each time a check is written. It also
eliminates the possibility of misspelling a category of expense
when entering a payment.
Print out a copy of this list to be sure that you do not dup-
licate an abbreviation when adding to list.
If you wish to pay one of these payees, but the category of
expense is different from that on file, simply enter the full
name of payee instead of the abbreviation.
The expense program is very straight forward. You will be asked
to first open a file for the month by entering the month, year,
and first check number.
All entries after will be made by choosing "Add to File" and
entering the information as required for either check or non-
check expenses.
There is a special procedure for entering type of expense when
the check is for more than one type. An * is entered and you
will then be prompted for up to 3 types of expense with the
amount of each. These amounts must total amount of check or an
error message will be issued. An example is your Federal Tax
Deposit. Part of this will be for withheld federal income tax
and FICA and part will be payroll tax, employers FICA
contribution.
Checks may be printed at the time of entry or written at another
time and only the information entered in the file.
To void a check, use the read procedure and then choose revise.
Enter 0 for the amount of the check.
If you need to void a check from a previous month, enter as a
non-check expense with a minus value e.g. -50.00.
CHECK PRINTING
Checks suitable for this program may be obtained from many
sources. They must have a blank top stub and be compatible with
BPI, Accounting Plus or IMS Software. One source is:
NEBS Computer Forms
12 South St. Form #9024
Townsend, Ma. 01469
1-800=225-9550 To obtain samples.
As with all programs in this system the checks should be inserted
in printer so that top of ribbon guide is centered on left edge
of checks (edge that will remain when tractor strips are torn
off). There are two horizontal lines near the top of the left
tractor strip on the check stub. The starting point is with the
top of the ribbon guide on the topmost of these lines. Minor
adjustments may be necessary if you are not using an Epson or IBM
printer.
There are two options for printing information on check stub as
well as the option of not printing stub. If you choose the
invoice type stub you will be prompted for the date invoice
number and amount. The blank stub option allows you to print
anything you would like.
If you try to use the cursor keys to move around in the check
stub box and they print numbers instead, just press the Num
Lock key.
END OF MONTH - EXPENSE PROGRAM
When closing out the expense file at the end of the month you
will receive a detailed listing of each check printed as well
as a summary report. Be sure to switch disks carefully as
indicated to have the current files renamed on both the file
disk and the backup disk.
INCOME PROGRAM
CATEGORY OF INCOME FILE
THIS FILE MUST BE CREATED BEFORE USING THIS PROGRAM
Follow instructions carefully for creating this file. You will
be prompted for 3 categories of regular income, the second of
which will be Taxable Sales unless you have no taxable sales and
decide to change it. These categories are usually cash register
departments for a retail business. DO NOT ENTER TAX, CHARGE
SALES OR RECEIVED ON ACCOUNT AS ONE OF THESE CATEGORIES. If you
have taxable sales a fourth category of Tax will automatically be
created. Charge Sales and Received on Account are two additional
categories that are automatically programmed in.
You will also be prompted for two miscellaneous categories.
These are usually chosen from regular but infrequent income like
rents, interest, etc., but NOT SALES OF ANY TYPE.
All of your income entries will be collated under the categories
created in this file and any other income will be itemized and
accumulated as miscellaneous income in the monthly report.
MISCELLANEOUS INCOME CANNOT BE INCOME THAT IS CHARGED. ALL
CHARGE SALES MUST BE UNDER REGULAR INCOME CATEGORIES.
USING THE PROGRAM
At the beginning of each month you will asked for month, year and
sales tax rate. (Sales tax rate may only be changed at beginning
of month).
Once file has been opened for the month all entries will be made
by choosing "Add to File". You will be asked to choose regular
or miscellaneous income for each entry, with miscellaneous
referring to either of the two misc. categories you have chosen
or some other type of income.
If you choose regular income you will be prompted for deposit,
total cash, total charge, received on account and each regular
income category. You will not be prompted for a tax entry. The
program will calculate the tax as:
(Total Cash+Charge)-(Total of Income Categories+Rec'd on Acct.)
Program will allow for a 10% excess or a 5% deficiency in tax
collected. If tax figure is not in that range an error message
will be issued and you will have to reenter all amounts.
When entering miscellaneous income you will be prompted for the
deposit, amount of income, source and type of income.
No verification is done to assure that deposits are equal to cash
collected so file should be read occasionally to assure that
there is only an acceptable difference between these figures.
Reading file will give you a total cash collected and total
deposit figure.
When closing out month you will receive an itemized daily income
report as well as a summary report containing monthly and year-
to-date total cash, charge, received on account, taxable sales,
tax exempt sales (does not include miscellaneous income since
this income is assumed not to be sales), cash over or under per
deposits as well as totals for each category of income.
PAYROLL PROGRAM
**** THIS PROGRAM CAN ONLY BE RUN FROM THE EXPENSE PROGRAM ****
Two files must be created before using the payroll program, an
Employee Data File and a Payroll Deductions File.
Employee Data File
For each employee you will be prompted for personal information
like address, phone, licenses, etc.. as well as for payroll
deduction information like dependents, withholding options,
miscellaneous deductions.
If you enter a fixed percentage for a state or city deduction
this percentage will be fixed per state or city method, i.e. of
gross, federal tax, etc.. The fixed percentage must be more
than 1.2 to assure accuracy. Do not enter the % sign.
If discontinuing a miscellaneous deduction for an employee, just
enter 0 for the amount. Do not remove name of deduction until
starting new year, since you will still have year to date amounts
that require name of deduction.
PAYROLL DEDUCTIONS FILE
Must be set up and must be revised each year for new tax rates.
A variety of choices for basing state and city taxes are given
and will meet most situations. The tax table for Federal
Withholding must be set up using the PERCENTAGE METHOD in the
employers tax guide.
The maximum income for unemployment taxation assumes that the
federal is the same as the state maximum. If this is not true
an adjustment will have to be made at the end of the year when
filing the federal unemployment tax form.
USING THE PROGRAM
There are two methods of paying wages. An individual may be
paid and his deductions may be calculated automatically or
entered manually or you may choose automatic weekly payroll,
in which case you will only be prompted for each employees
regular and overtime hours. When last employee has been paid
a summary of tax information for month to date will be given.
Checks may be printed at time of payroll entry or at some other
time, however, if checks are not printed at time of entry they
will not be entered in expense file until actually printed using
expense program or entered (if issued without using expense
program).
REVISING FILE
The only method of revising file is to use Pay Individual option
with manual option. Entries may then be entered to offset the
error, e.g. -10.00 for $10.00 overpayment, however all entries
must be made so that gross equals total of deductions + net.
The adjustment to the employee may be made by voiding the check
in the expense file and issuing a new check or by issuing an
additional check for adjustment. No entries may be made in a
month already closed out. Adjustment will have to be made in
the new month if not known before closing out month.
When closing out month a report will be issued giving the totals
for each month, quarter and year to date as well as monthly tax
information and year to date tax information. If the month
closed out ends a quarter , a report for each employee will also
be issued for that quarter with monthly, quarterly and year to
date totals.
************************ VERY IMPORTANT *************************
A new file disk must be created at the beginning of each calendar
year regardless of room left on disk.
*****************************************************************
New file disks may not be started during the year unless they are
at the beginning of a quarter. Be sure to check disk after each
quarter is closed out to determine if enough space remains for
another quarter. If you are sure at the end of the second
quarter that there will not be enough room for the remainder of
the year, that would be a good time to start a new disk.
ACCOUNTS RECEIVABLE PROGRAM
A list of accounts must be prepared first using the add an
account option. Each account must have a unique account number
of up to 7 letters and/or numbers. If customer has only a two
line address, enter at least a space for the street address.
A message may be printed on the statement for each account. This
is useful if statement is addressed to a guardian or addressed
to same person for more than one type of account. The message
could say for example: "For Ted Jones Policy 1024" or "Medication
for Mary Smith" etc.. If there is an opening balance when
system is started, you will be able to enter the amount.
USING THE PROGRAM
Entries can be made daily, weekly, or monthly - just be sure that
all entries have been made before doing the monthly billing. It
is not possible to revise any entries. Corrections must be made
with a new entry and minus values will be accepted. When
entering payments or credits DO NOT ENTER AS MINUS VALUES,
program will automatically designate these as minus values.
BILLING
Statements must be of the type compatible with Apple, SBSG, or
Star Software systems. One source is NEBS Computer Forms (See
address in expense program section). Their catalog number is
#9060.
Insert statements in printer with ribbon guide in leftmost
position. Top of ribbon guide should be at top of statement and
centered on statement edge (edge with tractor strip removed).
After first statement is printed you will be asked if printer is
set correctly. If it is not, adjust paper without shutting off
printer or pressing off-line button.
If you choose regular billing, statements will start at first
entry after last billing and will go to end of file, even if
there are entries past billing date. The total due for each
account will be changed to amount due after last entry.
If you choose to bill using a start and stop date, statement
will only show entries between these dates and amount due will
be amount due after last of these entries. The total amount due
for each account will not be changed in the file, however, unless
the stop date includes an entry past the last entry previously
billed, e.g. you did regular billing at the end of June, but
customer needs a bill from May 15 to June 15 - statement will
be issued, but total due in customers file will remain the same
as it was at the end of June.
If you choose the print bills with balances not equal to zero and
you are billing with dates rather than regular billing, the zero
bills may still be printed.
After all statements have been printed, you will be instructed to
remove statements and insert regular paper. When you continue, a
summary of all accounts as well as their aging balances and total
of new billings for month will be printed.
If you are billing one account, there will be no summary of
accounts printed and this file will not be updated until billing
of all accounts is done.
************************ VERY IMPORTANT *************************
Billing must be done at end of calendar year. If you bill
earlier in December then enter remaining charges as January and
enter actual date in "for" column.
*****************************************************************
SUMMARY OF OPERATIONS PROGRAM
This program requires only entering the month recently closed out
and if files have not been closed out an error message will be
issued and you will have to return to menu.
If you forgot to run this program and have already run it for the
next month, you can still run it for the missing month, however
the year-to-date figures will be those including the last month
closed out.
In order for this report to correctly handle cost of goods sold,
one of the categories of expense must have been designated as
"PURCHASES". In the case of a business not dealing in a product
this is unnecessary and the cost of goods sold will always be 0
and the gross profit on sales will be 100%.
If you find this software useful in your business, a contribution
of $35.00 would be appreciated to enable continued developement
of this and similar programs.
Send to:
Donald Paritz
Box 602
Johnson, Vt. 05656
Thank you
CHECKING.BAS
10 CLEAR,,5120:CLS:KEY 8, "@":ON ERROR GOTO 2310
20 OPEN "B:CHECKING.ACC" AS 1:FIELD 1, 12 AS A$, 12 AS B$, 12 AS C$, 12 AS D$, 12 AS E$, 12 AS F$, 12 AS G$, 12 AS H$, 12 AS I$:DL$="$$######.##
60 MODE$=CHR$(27)+CHR$(45)+CHR$(1)+CHR$(27)+CHR$(71)+CHR$(27)+CHR$(78)+CHR$(6):XMOD$=CHR$(27)+CHR$(45)+CHR$(0)+CHR$(27)+CHR$(72):DEFDBL A-Z:DEFINT N,I,J:DIM CHECK%(20), AM(20):IF LOF(1)/128=0 THEN 150 ELSE GET 1,1
120 COLOR 0,7:PRINT TAB(10) "SET TOP OF PAGE AND TURN ON PRINTER":COLOR 7,0
130 PRINT:PRINT:GOTO 850
140 ' ****************** INITIALIZE CHECKING ACCOUNT FILE
150 PRINT " THERE IS NO CHECKING ACCOUNT BALANCE ON FILE-----COPY FILE FROM PREVIOUS DISK OR TURN ON PRINTER AND ENTER OPENING BALANCES BELOW":PRINT
160 INPUT "OPENING BOOK BALANCE";BB:INPUT "OPENING BANK BALANCE";BAB:INPUT "BOOK BALANCE DATE xx/xx/xx";ND$:INPUT "BANK BALANCE DATE xx/xx/xx";BD$:PRINT:GOSUB 210:GOTO 730
210 PRINT " LIST OF OUTSTANDING CHECKS":PRINT:TAM=0:FOR N=1 TO 20:INPUT "OUTSTANDING CHECK NO. (IF FINISHED, ENTER 0)";CHECK%(N):IF CHECK%(1)=0 THEN PRINT TAB(20) "NONE":GOTO 315
260 IF CHECK%(N)=0 THEN GOTO 315
270 INPUT "OUTSTANDING CHECK AMOUNT";AM(N):PRINT TAB(10) "CHECK N0. ";:PRINT CHECK%(N);:PRINT SPC(5) USING DL$;AM(N):TAM=TAM+AM(N):NEXT
315 IF C% THEN 640
320 PRINT:PRINT " LIST OF OUTSTANDING DEPOSITS":PRINT:TDP=0:FOR N=1 TO 10:INPUT "OUTSTANDING DEPOSIT (IF FINISHED, ENTER 0)";DEP(N):IF DEP(N)=0 THEN 370 ELSE 390
370 IF TDP=0 THEN PRINT TAB(10) "NONE"
380 GOTO 430
390 INPUT "DATE OF OUTSTANDING DEPOSIT xx/xx/xx";DT$(N):PRINT TAB(10) DT$(N)+" ";:PRINT USING DL$;DEP(N):TDP=TDP+DEP(N):NEXT
430 IF REC% THEN 440 ELSE 530
440 GET 1,1
450 DIF=MDP+DADJ-TDP+CVD(E$)-CVD(G$)-BDP
460 IF DIF<-0.005000001 THEN BEEP:COLOR 0,7:PRINT " BOOK DEPOSITS ARE";:PRINT USING DL$;ABS(DIF);:PRINT " LESS THAN BANK DEPOSITS.":PRINT " IF ADJUSTMENT NECESSARY, BE SURE TO ENTER IN NEXT INCOME FILE.":COLOR 7,0:GOTO 480
470 IF DIF>0.005000001 THEN BEEP:COLOR 0,7:PRINT " BOOK DEPOSITS ARE";:PRINT USING DL$;DIF;:PRINT " MORE THAN BANK DEPOSITS.":PRINT " IF ADJUSTMENT NECESSARY, BE SURE TO ENTER IN NEXT INCOME FILE.":COLOR 7,0 ELSE 540
480 COLOR 7,0:PRINT:PRINT:PRINT TAB(10) "M=REENTER DEPOSITS PER BANK":PRINT:PRINT TAB(10) "D=REENTER OUTSTANDING DEPOSITS":PRINT:PRINT TAB(10) "A=ADJUSTMENT":PRINT:PRINT
490 X$=INKEY$:IF X$="M" THEN M%=1:GOTO 1980 ELSE IF X$="D" THEN D%=1:GOTO 320 ELSE IF X$="A" THEN 500 ELSE 490
500 INPUT "ENTER ADJUSTMENT TO BOOK DEPOSITS ";DADJ:PRINT "ADJUSTMENT TO BOOK DEPOSITS":PRINT:PRINT TAB(10) USING DL$;DADJ:GOTO 450
530 IF D% THEN 630
540 PRINT:INPUT "TOTAL BANK CHARGES NOT ENTERED IN MONTHLY EXPENSE FILE (ENTER 0 IF NONE)";B(1):BC=0:PRINT:PRINT " BANK CHARGES (UNRECORDED)":PRINT SPC(20) USING DL$;B(1):BC=B(1):FOR N=2 TO 5
590 PRINT:INPUT "BAD CHECK NOT ENTERED IN MONTHLY EXPENSE FILE (ENTER 0 IF NONE)";B(N):IF B(N)=0 THEN 630 ELSE BC=BC+B(N)
610 PRINT " BAD CHECK (UNRECORDED) ";:PRINT USING DL$;B(N):NEXT
630 IF REC% THEN 640 ELSE 720
640 DIF=EP-BEP+CVD(D$)+BC+EADJ-TAM-CVD(F$)-CVD(H$)
650 IF DIF<-0.005000001 THEN BEEP:COLOR 0,7:PRINT " BOOK EXPENSES ARE";:PRINT USING DL$;ABS(DIF);:PRINT " LESS THAN BANK EXPENSES.":PRINT " IF ADJUSTMENT NECESSARY, BE SURE TO ENTER IN NEXT EXPENSE FILE.":COLOR 7,0:GOTO 670
660 IF DIF>0.005000001 THEN BEEP:COLOR 0,7:PRINT " BOOK EXPENSES ARE";:PRINT USING DL$;DIF;:PRINT " MORE THAN BANK EXPENSES.":PRINT " IF ADJUSTMENT NECESSARY, BE SURE TO ENTER IN NEXT EXPENSE FILE.":COLOR 7,0 ELSE 720
670 COLOR 7,0:PRINT:PRINT:PRINT TAB(10) "M=REENTER EXPENSES PER BANK":PRINT:PRINT TAB(10) "C=REENTER OUTSTANDING CHECKS":PRINT:PRINT TAB(10) "B=REENTER OUTSTANDING BANK CHARGES OR BAD CHECKS":PRINT:PRINT TAB(10) "A=ADJUSTMENT":PRINT:PRINT
680 X$=INKEY$:IF X$="M" THEN M%=1:GOTO 2000 ELSE IF X$="C" THEN FOR N=1 TO 20:CHECK%(N)=0:AM(N)=0:NEXT N:C%=1:GOTO 210 ELSE IF X$="B" THEN FOR N=1 TO 5:B(N)=0:NEXT N:B%=1:GOTO 540:ELSE IF X$="A" THEN 690 ELSE 680
690 INPUT "ENTER ADJUSTMENT TO EXPENSES ";EADJ:PRINT "ADJUSTMENT TO BOOK EXPENSES":PRINT:PRINT TAB(10) USING DL$;EADJ:GOTO 640
720 RETURN
730 IF ABS(BAB-BB-TAM+TDP+BC)>0.005000001 THEN TAM=0:TDP=0:BC=0:COLOR 0,7:PRINT "AMOUNTS OUT OF BALANCE---RECHCECK FIGURES AND REENTER":COLOR 7,0:PRINT:GOTO 160
740 LSET A$=MKD$(BB):LSET B$=MKD$(BAB):LSET C$=ND$:LSET D$=MKD$(TAM):LSET E$=MKD$(TDP):LSET F$=MKD$(BC):LSET G$=MKD$(DADJ):LSET H$=MKD$(EADJ):LSET I$=BD$:PUT 1,1:GOSUB 910:GOTO 2170
850 PRINT " CHOOSE":PRINT:PRINT TAB(10)"M=RETURN TO MENU":PRINT:PRINT TAB(10) "B=CURRENT BOOK BALANCE (ONLY IF ADJUSTMENTS AND UNRECORDED CHARGES":PRINT TAB(34) "HAVE BEEN ENTERED IN EXPENSE AND INCOME FILES)":PRINT
870 PRINT TAB(10) "C=RECONCILE BANK BALANCE":PRINT:PRINT TAB(10) "R=READ LAST RECONCILIATION":PRINT:PRINT TAB(10) "P=PRINT AND READ LAST RECONCILIATION"
880 X$=INKEY$:DEF SEG=64:POKE 23, (PEEK(23) OR 64):IF X$="B" THEN 1620 ELSE IF X$="C" THEN REC%=1:FL$="CHECKING.ACC":GOSUB 30210:GOTO 1900 ELSE IF X$="R" THEN 910 ELSE IF X$="P" THEN PRT%=1:GOTO 910 ELSE IF X$="M" THEN RUN "BKPG.BAS" ELSE 880
910 CLS:GET 1,1:FIELD 1, 12 AS A$, 12 AS B$, 12 AS C$, 12 AS D$, 12 AS E$, 12 AS F$, 12 AS G$, 12 AS H$, 12 AS I$:PRINT "RECONCILED - BANK CLOSING DATE "+I$+" BOOK CLOSING DATE "+C$:PRINT:PRINT TAB(10) "BOOK BALANCE" SPC(27);
960 PRINT USING DL$;CVD(A$):PRINT TAB(10) "BANK BALANCE ";:PRINT USING DL$;CVD(B$):IF REC% THEN PRINT TAB(10) "BOOK MONTHLY DEPOSITS"SPC(18); ELSE 1070
1000 PRINT USING DL$;MDP:PRINT TAB(10) "BANK MONTHLY DEPOSITS ";:PRINT USING DL$;BDP:PRINT TAB(10) "BOOK MONTHLY EXPENSES ";:PRINT USING DL$;EP:PRINT TAB(10) "BANK MONTHLY EXPENSES ";
1060 PRINT USING DL$;BEP
1070 PRINT TAB(10) "OUTSTANDING CHECKS ";:PRINT USING DL$;CVD(D$):PRINT TAB(10) "OUTSTANDING DEPOSITS ";:PRINT USING DL$;CVD(E$):PRINT TAB(10) "BANK CHARGES & BAD CHECKS (UNRECORDED) ";:PRINT USING DL$;CVD(F$)
1130 PRINT TAB(10) "ADJUSTMENTS TO DEPOSITS ";:PRINT USING DL$;CVD(G$):PRINT TAB(10) "ADJUSTMENTS TO EXPENSES ";:PRINT USING DL$;CVD(H$):PRINT:IF PRT% THEN 1180 ELSE 850
1180 LPRINT CHR$(27)CHR$(78)CHR$(6):LPRINT MODE$:LPRINT "RECONCILED - BANK CLOSING DATE "+I$+" BOOK CLOSING DATE "+C$:LPRINT:LPRINT:LPRINT TAB(5) "BOOK BALANCE ";:LPRINT USING DL$;CVD(A$)
1210 LPRINT TAB(5) "BANK BALANCE ";:LPRINT USING DL$;CVD(B$):IF REC% THEN LPRINT TAB(5) "BOOK MONTHLY DEPOSITS"SPC(31); ELSE 1310
1240 LPRINT USING DL$;MDP:LPRINT TAB(5) "BANK MONTHLY DEPOSITS ";:LPRINT USING DL$;BDP:LPRINT TAB(5) "BOOK MONTHLY EXPENSES ";:LPRINT USING DL$;EP
1290 LPRINT TAB(5) "BANK MONTHLY EXPENSES ";:LPRINT USING DL$;BEP
1310 LPRINT TAB(5) "OUTSTANDING CHECKS ";:LPRINT USING DL$;CVD(D$):LPRINT TAB(5) "OUTSTANDING DEPOSITS ";:LPRINT USING DL$;CVD(E$)
1350 LPRINT TAB(5) "BANK CHARGES & BAD CHECKS (UNRECORDED) ";:LPRINT USING DL$;CVD(F$):LPRINT TAB(5) "ADJUSTMENTS TO DEPOSITS ";:LPRINT USING DL$;CVD(G$)
1390 LPRINT TAB(5) "ADJUSTMENTS TO EXPENSES ";:LPRINT USING DL$;CVD(H$):IF PRT% =1 THEN 850
1420 LPRINT MODE$:LPRINT " LIST OF OUTSTANDING CHECKS":LPRINT XMOD$:FOR N=1 TO 20:IF CHECK%(1)=0 THEN LPRINT " NONE":GOTO 1470
1450 IF CHECK%(N)=0 THEN 1470 ELSE LPRINT TAB(10) "CHECK NO. ";:LPRINT CHECK%(N);
1460 LPRINT SPC(5) USING DL$;AM(N):NEXT
1470 LPRINT MODE$:LPRINT " LIST OF OUTSTANDING DEPOSITS":LPRINT XMOD$:FOR N=1 TO 10:IF DT$(1)="" THEN LPRINT " NONE":GOTO 1500 ELSE IF DT$(N)="" THEN 1500 ELSE LPRINT TAB(13) DT$(N)+" ";
1490 LPRINT USING DL$;DEP(N):NEXT
1500 IF DADJ<0.005000001 THEN 1510 ELSE LPRINT MODE$:LPRINT " ADJUSTMENT TO BOOK DEPOSITS (ENTER IN NEXT INCOME FILE)":LPRINT XMOD$:LPRINT SPC(31) USING DL$;DADJ
1510 IF EADJ<0.005000001 THEN 1520 ELSE LPRINT MODE$:LPRINT " ADJUSTMENT TO BOOK EXPENSES (ENTER IN NEXT EXPENSE FILE)":LPRINT XMOD$:LPRINT SPC(10) USING DL$;EADJ
1520 IF B(1)<0.005000001 THEN 1540 ELSE LPRINT MODE$:LPRINT " BANK CHARGES (UNRECORDED--ENTER IN NEXT EXPENSE FILE)":LPRINT XMOD$
1530 LPRINT SPC(31) USING DL$;B(1)
1540 FOR N=2 TO 5:IF N>2 THEN IF B(N) <0.005000001 THEN 1580 ELSE LPRINT SPC(31) USING DL$;B(N):GOTO 1570
1560 IF B(N)<0.005000001 THEN 1580 ELSE LPRINT MODE$:LPRINT " BAD CHECK (UNRECORDED--ENTER IN NEXT EXPENSE FILE)";:LPRINT XMOD$:LPRINT SPC(31) USING DL$;B(N)
1570 NEXT
1580 IF ABS(TADJ)<0.005000001 THEN 1610
1590 LPRINT:LPRINT TAB(6) MODE$+TADJ$+" BALANCE ADJUSTED BY "+XMOD$;:LPRINT USING DL$;TADJ:LPRINT:LPRINT "REASON FOR ADJUSTMENT: "+REAS$
1610 RETURN
1620 CLS:OPEN "B:EXPENSE.CUR" AS 2:FIELD 2, 8 AS D$, 8 AS C$, 25 AS B$, 9 AS A$, 18 AS E$:FOR N=2 TO LOF(2)/128:GET 2,N:IF ASC(E$)=42 THEN 1690
1680 AM=AM+CVD(A$):IF D$=" " THEN 1690
1687 DA1$=D$
1690 NEXT:CLOSE 2:OPEN "B:INCOME.CUR" AS 2:FIELD 2, 8 AS D$, 10 AS B$:FOR N=2 TO LOF(2)/128:GET 2,N:DP=DP+CVD(B$):NEXT:DA2$=D$:CLOSE 2:FIELD 1, 12 AS DD$:GET 1, 3:MDP=CVD(DD$):FIELD 1, 12 AS ZZ$:GET 1, 2:EP=CVD(ZZ$)
1800 FIELD 1, 12 AS A$, 12 AS B$, 12 AS C$, 12 AS D$, 12 AS E$, 12 AS F$, 12 AS G$, 12 AS H$, 12 AS I$:GET 1,1:BB=CVD(A$)+DP-AM-CVD(G$)+CVD(H$)+CVD(F$)+MDP-EP:PRINT " BOOK BALANCE AS OF---EXPENSES "+DA1$+" INCOME "+DA2$
1840 PRINT SPC(3) USING DL$;BB
1850 INPUT "TO PRINT, TURN ON PRINTER AND ENTER P ELSE JUST PRESS ENTER";PR$:IF PR$="" THEN 1890 ELSE IF PR$="P" THEN 1870 ELSE 1850
1870 LPRINT:LPRINT " BOOK BALANCE AS OF---EXPENSES "+DA1$+" INCOME "+DA2$:LPRINT USING DL$;BB
1890 CLOSE:CLEAR:LOAD "BKPG.BAS",R
1900 CLS:COLOR 0,7:PRINT " INCOME AND EXPENSE FILES MUST BE CLOSED OUT FOR THE MONTH":PRINT:PRINT "IF THEY HAVE NOT PRESS M TO RETURN TO MENU ELSE PRESS C TO CONTINUE ":COLOR 7,0
1920 X$=INKEY$:DEF SEG=64:POKE 23, (PEEK(23) OR 64):IF X$="M" THEN RUN "BKPG.BAS" ELSE IF X$="C" THEN CLS:GOTO 1950 ELSE 1920
1950 INPUT "DATE BANK STATEMENT CLOSED";BD$:INPUT "DATE BOOKS CLOSED";ND$:FIELD 1, 12 AS DD$:GET 1, 3:MDP=CVD(DD$)
1980 INPUT "DEPOSITS FOR MONTH PER BANK";BDP:IF M%=1 THEN 450
1982 FIELD 1, 12 AS ZZ$:GET 1, 2:EP=CVD(ZZ$)
2000 INPUT "EXPENSES FOR MONTH PER BANK";BEP:IF M% THEN 630
2010 INPUT "BANK BALANCE";BAB:GOSUB 210:GET 1,1:FIELD 1, 12 AS A$, 12 AS B$, 12 AS C$, 12 AS D$, 12 AS E$, 12 AS F$, 12 AS G$, 12 AS H$, 12 AS I$:BB=CVD(A$)+MDP-EP+DADJ-EADJ-CVD(G$)+CVD(H$)-BC+CVD(F$)
2050 IF ABS(BAB-BB-TAM+TDP)<0.005000001 THEN PRT%=2:GOTO 740 ELSE 2060
2060 PRINT:COLOR 0,7:BEEP:PRINT " ERROR---NOT RECONCILED ":COLOR 7,0:PRINT:PRINT "OLD BOOK BALANCE +DEPOSITS -EXPENSES =NEW BOOK BALANCE":PRINT USING "$$###########.##";CVD(A$),MDP,EP,BB
2090 PRINT " NEW BOOK BAL. +OUTSTAND. CHECKS-OUTSTAND. DEPOSIT=TRIAL BAL.":PRINT USING "$$##########.##";BB,TAM,TDP,BB+TAM-TDP:PRINT " TRIAL BALANCE DOES NOT EQUAL BANK BALANCE"
2120 PRINT USING "$$##########.##";BB+TAM-TDP-BC;:PRINT SPC(32);:PRINT BAB:PRINT TAB(10) "O=RETURN TO OPTIONS AND START OVER":PRINT:PRINT TAB(10) "A=ADJUSTMENT NECESSARY"
2140 X$=INKEY$:DEF SEG=64:POKE 23, (PEEK(23) OR 64):IF X$="O" THEN 10 ELSE IF X$="A" THEN 2210 ELSE 2140
2170 PRINT "P=PRINT AGAIN":PRINT "M=RETURN TO MENU":PRINT "B=CURRENT BOOK BALANCE (ONLY IF NEW EXPENSE AND INCOME FILES HAVE BEEN OPENED)":LPRINT CHR$(140)
2190 X$=INKEY$:IF X$="P" THEN PRT%=2:GOSUB 1180:GOTO 2170 ELSE IF X$="M" AND REC%=1 THEN 2201 ELSE IF X$="M" THEN 2209 ELSE IF X$="B" THEN 2201 ELSE 2190
2201 FIELD 1, 12 AS DD$:LSET DD$=MKD$(0):PUT 1, 3:FIELD 1, 12 AS ZZ$:LSET ZZ$=MKD$(0):PUT 1, 2:IF X$="B" THEN 1620
2209 RUN "BKPG.BAS"
2210 INPUT "CORRECT BOOK BALANCE";BB:INPUT "CORRECT BANK BALANCE";BAB:IF ABS(BAB-BB-TAM+TDP)>0.005000001 THEN COLOR 0,7:PRINT "AMOUNTS OUT OF BALANCE---RECHCECK FIGURES AND REENTER":COLOR 7,0:GOTO 2210
2240 INPUT " REASON FOR ADJUSTMENT (MAXIMUM 3 LINES) ";REAS$:PRINT " ENTER A IF BOOK BALANCE ADJUSTED":PRINT " ENTER B IF BANK BALANCE ADJUSTED":DEF SEG=64:POKE 23, (PEEK(23) OR 64)
2270 TADJ$=INKEY$:IF TADJ$="A" THEN TADJ$="BOOK" ELSE IF TADJ$="B" THEN TADJ$="BANK" ELSE 2270
2290 INPUT "AMOUNT OF ADJUSTMENT (ENTER AS + OR -) ";TADJ:PRT%=2:GOTO 740
2310 IF ERR=71 THEN COLOR 0,7:PRINT " FILE DISK NOT IN DRIVE B OR PROGRAM DISK NOT IN DRIVE A OR DOOR IS OPEN. CORRECT PROBLEM AND PRESS F8 WHEN READY ":GOTO 2350
2330 IF ERR=24 OR ERR=27 THEN COLOR 0,7:PRINT " PRINTER NOT ON OR OUT OF PAPER. SET TOP OF PAGE AND TURN ON PRINTER. PRESS F8 WHEN READY ":GOTO 2350
2350 X$=INKEY$:IF X$<>"@" THEN 2350 ELSE DEF SEG:POKE 160,0:COLOR 7,0:CLS:RESUME
30200 '
30210 IF BKUP THEN 30220 ELSE OPEN "B:BACKUP.FIL" AS 4:BKUP=1
30220 FIELD 4, 14 AS A$:IF LOF(4)/128=0 THEN 30280
30240 FOR N=1 TO LOF(4)/128:GET 4,N:IF FL$+STRING$(14-LEN(FL$),32)=A$ THEN 30300
30270 NEXT
30280 LSET A$=FL$:PUT 4, LOF(4)/128+1
30300 RETURN
EXPENSE.BAS
10 CLEAR,,1536:CLS:FOR N=1 TO 10:KEY N, "":NEXT:KEY 8, "@":ON KEY(7) GOSUB 9000:PRINT:PRINT:ON ERROR GOTO 10000
40 OPEN "B:EXPENSE.CUR" AS #1:DIM N(30), YTD(30)
50 PRINT " EXPENSE PROGRAM----PRESS KEY TO CHOOSE OPTION":PRINT:PRINT TAB(10) "O=OPEN NEW FILE":PRINT:PRINT TAB(10) "A=ADD TO FILE":PRINT
80 PRINT TAB(10) "R=READ REVISE OR PRINT FILE OR ADD NON-CHECK EXPENSE":PRINT:PRINT TAB(10) "P=PAYROLL":PRINT:PRINT TAB(10) "E=END MONTH--TURN ON PRINTER":PRINT
100 PRINT TAB(10) "M=RETURN TO MENU":PRINT: PRINT TAB(10) "F=PAYEE FILE":PRINT:PRINT TAB(10)"C=CATEGORY OF EXPENSE FILE":PRINT:PRINT TAB(10) "I=READ OR PRINT OLD EXPENSE FILE":DL$="$$######.##"
120 MODE$=CHR$(27)+CHR$(45)+CHR$(1)+CHR$(27)+CHR$(71)+CHR$(27)+CHR$(78)+CHR$(6):DEFDBL A-Z:DEFINT N,I,J:XMOD$=CHR$(27)+CHR$(45)+CHR$(0)+CHR$(27)+CHR$(72)
160 X$=INKEY$:DEF SEG=64:POKE 23, (PEEK(23) OR 64):IF X$="A" OR X$="P" THEN FL$="EXPENSE.CUR":GOSUB 30210 ELSE IF X$="E" THEN FL$="EXPENSE.TOT":GOSUB 30210:FL$="CHECKING.ACC":GOSUB 30210:FL$="CHKDSC":GOSUB 30210
170 IF X$="A"THEN GOSUB 400 ELSE IF X$="R"THEN 1690 ELSE IF X$="P"THEN RUN "PAYROLL.BAS"ELSE IF X$="O"THEN 1120 ELSE IF X$="M"THEN RUN"BKPG.BAS"ELSE IF X$="E"THEN 2590 ELSE IF X$="F"THEN 6000 ELSE IF X$="C"THEN 7000 ELSE IF X$="I"THEN 4000 ELSE 160
180 IF LOF(1)/128<8 THEN 190 ELSE 210
190 BEEP: COLOR 31: PRINT "FILE NOT OPENED FOR MONTH": COLOR 7:PRINT:PRINT:GOTO 50
210 CLS:OPEN "PAYEE.FIL" AS 2
220 FIELD 1, 8 AS D$, 8 AS C$, 25 AS B$, 9 AS A$, 18 AS E$
230 PRINT TAB(10) "TO USE TODAY'S DATE PRESS ENTER
240 PRINT TAB(10) "TO SET DIFFERENT DATE ENTER DATE":PRINT TAB(10) "IF FINISHED ENTER F":PRINT " ";:INLN%=8:GOSUB 20050:ND$=INPT$:IF ND$="F" OR ND$="f" THEN CLS:GOTO 10
280 IF ND$="" THEN IF LEFT$(DATE$,1)>"0" THEN ND$=LEFT$(DATE$,6)+RIGHT$(DATE$,2) ELSE ND$=MID$(DATE$,2,5)+RIGHT$(DATE$,2)
290 GET 1, LOF(1)/128:PRINT TAB(40)"C=CHECK EXPENSE":PRINT TAB(40) "N=NON-CHECK EXPENSE"
296 X$=INKEY$:IF X$="C" OR X$="c" THEN 300 ELSE IF X$="N" OR X$="n" THEN CHECK%=0:GOTO 311 ELSE 296
300 CODE%=LOF(1)/128:IF CODE%=9 THEN GET 1,1:CHECK%=CVI(F$):GOTO 320
310 IF CODE%>9 THEN CHECK%=CVI(C$)+1:GOTO 320
311 FOR N=2 TO 9:GET 1,N:IF LEFT$(D$,2)=" " THEN CODE%=N:GOTO 330
314 NEXT:PRINT "NO MORE RECORD SPACE AVAILABLE FOR NON-CHECK EXPENSES, HOLD UNTIL NEXT MONTH OR USE REVISE TO COMBINE WITH ANOTHER NON-CHECK EXPENSE. PRESS F8 TO RETURN TO OPTIONS."
316 X$=INKEY$:IF X$="@" THEN 10 ELSE 316
320 CODE%=CODE%+1:ADR$=""
330 PRINT:PRINT TAB(42) "PAY TO ";:INLN%=25:GOSUB 20050:PAY$=INPT$:IF LEN(PAY$)<4 THEN 1450
350 PRINT " AMOUNT PAID (USE DECIMAL POINT e.g. 000.00) ";:NBR=1:INLN%=9:GOSUB 20050:AM=VAL(INPT$):NBR=0
360 IF X$="N" OR X$="n" THEN PRINT " FOR "; ELSE PRINT "FOR (IF MORE THEN ONE TYPE OF EXPENSE ENTER *)? ";
361 INLN%=18:GOSUB 20050:EP$=INPT$:PRINT:IF EP$="*" THEN GOTO 490
380 GOSUB 900:GOTO 1020
400 CLS
410 GET 1, 1:FIELD 1, 10 AS M$, 5 AS Y$, 34 AS S$, 6 AS F$:FOR I=2 TO LOF(1)/128:CODE%=I:GET 1, CODE%:FIELD 1, 8 AS D$, 8 AS C$, 25 AS B$, 9 AS A$, 18 AS E$:NEXT:RETURN
490 ZM=AM:FIELD 1, 8 AS D$, 8 AS C$, 25 AS B$, 9 AS A$, 18 AS E$:CD%=CODE%:AM=0:FIELD 1, 8 AS D$, 8 AS C$, 25 AS B$, 9 AS A$, 18 AS E$:FOR I=1 TO 3:CODE%=CODE%+1
620 IF I=1 THEN PRINT "AMOUNT OF 1ST TYPE ";ELSE IF I=2 THEN PRINT "AMOUNT OF 2ND TYPE ";ELSE PRINT "AMOUNT OF 3RD TYPE (ENTER 0 IF DONE) ";
622 NBR=1:INLN%=9:GOSUB 20050:AM(I)=VAL(INPT$):NBR=0:IF AM(I)=0 THEN CODE%=CODE%-1:GOTO 730
640 PRINT TAB(34) "FOR ";:INLN%=18:GOSUB 20050:EP$(I)=INPT$:ZA=ZA+AM(I):NEXT I
730 IF ABS(ZM-ZA)<0.005000001 THEN 765
740 BEEP: BEEP: COLOR 0,7: PRINT "TOTAL OF AMOUNTS DOES NOT EQUAL CHECK AMOUNT-REDO": COLOR 7,0:CODE%=CD%:AM=0:ZA=0:ZM=0:FOR I=1 TO 3:AM(I)=0:EP$(I)="":NEXT:GOTO 330
760 FIELD 1, 8 AS D$, 8 AS C$, 25 AS B$, 9 AS A$, 18 AS E$
765 PRINT:PRINT TAB(10) "P=PRINT CHECK AND ENTER DATA":PRINT:PRINT TAB(10) "E=ENTER DATA ONLY":PRINT
767 PE$=INKEY$:IF PE$=CHR$(27) THEN 10 ELSE IF PE$<>"P" AND PE$<>"E" THEN 767
770 LSET D$=ND$:LSET C$=MKI$(CHECK%):LSET B$=PAY$:LSET A$=MKD$(ZM):LSET E$="*":PUT 1,CD%:FOR I=1 TO CODE%-CD%:LSET D$="":LSET C$=MKI$(CHECK%):LSET B$="":LSET A$=MKD$(AM(I)):LSET E$=EP$(I):PUT 1,CD%+I:NEXT:IF PE$="P" THEN AM=ZM:GOSUB 5000
878 ZA=0:GOTO 220
880 PRINT " AMOUNT PAID (USE DECIMAL POINT e.g. 000.00) ";:NBR=1:INLN%=9:GOSUB 20050:AM=VAL(INPT$):NBR=0:GOSUB 900: GOTO 1020
900 LSET D$=ND$:LSET C$=MKI$(CHECK%):LSET B$=PAY$:LSET A$=MKD$(AM):LSET E$=EP$:IF SKIP=1 THEN 1010
960 PRINT D$;:PRINT USING "#######"; CVI(C$);:PRINT " "+B$;:PRINT USING "$$#####.##"; CVD(A$);:PRINT " "+E$
1010 SKIP=0: RETURN
1020 PRINT:IF X$="C" OR X$="c" THEN PRINT TAB(10) "PRESS P TO PRINT CHECK AND ENTER DATA"
1030 PRINT TAB(10) "PRESS C TO CHANGE ENTRY":PRINT TAB(10) "PRESS E TO ENTER DATA"
1050 X$=INKEY$:DEF SEG=64:POKE 23, (PEEK(23) OR 64):IF X$="P" THEN GOSUB 5000:GOTO 1090 ELSE IF X$="C" THEN 230 ELSE IF X$="E" THEN 1090 ELSE IF X$=CHR$(27) THEN 50 ELSE 1050
1070 PRINT "DATE ";:INLN%=8:GOSUB 20050:ND$=INPT$:GOTO 330
1090 PUT #1, CODE%:ADR$="": CITY$="":GOTO 220
1120 CLS: GOSUB 410:IF CVI(F$)>0 THEN 1140 ELSE 1160
1140 BEEP:COLOR 31: PRINT "FILE ALREADY OPENED THIS MONTH OR LAST MONTHS FILE NOT CLOSED OUT": COLOR 7:GOTO 50
1160 PRINT " MONTH ";:GOSUB 20050:MON$=INPT$:PRINT " YEAR ";:NBR=1:INLN%=5:GOSUB 20050:YR=VAL(INPT$):PRINT "NUMBER OF FIRST CHECK ";:INLN%=6:GOSUB 20050:FCHECK%=VAL(INPT$):NBR=0:CODE%=1
1200 FIELD 1, 10 AS M$, 5 AS Y$, 34 AS S$, 6 AS F$:LSET M$=MON$:LSET Y$=MKI$(YR):LSET S$=" EXPENSE FILE FIRST CHECK #":LSET F$=MKI$(FCHECK%):PUT 1, 1:FOR CODE%=1 TO 9:ND$="":CHECK%=0:PAY$="":AM=0:EP$="":LSET D$=ND$:LSET C$=MKI$(CHECK%)
1290 LSET B$=PAY$:LSET A$=MKD$(AM):LSET E$=EP$:FIELD 1, 8 AS D$, 8 AS C$, 25 AS B$, 9 AS A$, 18 AS E$:PUT 1, CODE%:NEXT:GOTO 50
1450 FIELD 2, 5 AS F$, 35 AS G$, 35 AS H$, 35 AS I$, 16 AS J$:FOR N=1 TO LOF(2)/128:GET 2,N:IF PAY$=LEFT$(F$,3) THEN PAY$=G$:ADR$=H$:CITY$=I$:EP$=J$:GOTO 880
1490 NEXT:PRINT " ABBREVIATION NOT FOUND. USE 4 OR MORE LETTERS FOR PAYEE OR CHECK ABBREVIATION":GOTO 330
1690 CLS:PRINT:PRINT TAB(10) "R=READ ONLY":PRINT:PRINT TAB(10) "P=READ AND PRINT"
1693 PRT$=INKEY$:DEF SEG=64:POKE 23, (PEEK(23) OR 64):IF PRT$<>"P" AND PRT$<>"R" THEN 1693 ELSE CLS
1700 COLOR 0,7: PRINT " PRESS F8 TO READ RECORDS IN SEQUENCE. PRESS F7 TO STOP AT ANY POINT. PRESS F8 WHEN READY TO CONTINUE READING.":COLOR 7,0: PRINT:PRINT
1710 COLOR 0,7:PRINT " IF REVISING FILE, WRITE DOWN RECORD NUMBERS TO BE CHANGED.": PRINT:PRINT
1720 X$=INKEY$:IF X$<>"@" THEN 1720 ELSE DEF SEG:POKE 106,0:KEY(7) ON:COLOR 7,0
1740 PRINT "DATE CHECK PAID TO AMOUNT FOR REC":PRINT:IF LOF(1)/128=0 THEN PRINT " NO RECORDS IN FILE---PRESS F8 TO RETURN TO OPTIONS" ELSE 1750
1746 X$=INKEY$:IF X$<>"@" THEN 1746 ELSE CLS:GOTO 50
1750 GET 1, 1:FIELD 1, 10 AS M$,5 AS Y$, 34 AS S$, 6 AS F$:T=0:FOR I=2 TO LOF(1)/128:CODE%=I:GET 1, CODE%:FIELD 1, 8 AS D$, 8 AS C$, 25 AS B$, 9 AS A$, 18 AS E$:EP=ASC(E$):IF EP=42 THEN 1900
1880 IF EP=32 THEN 1980
1890 T=T+CVD(A$)
1900 PRINT D$;:PRINT USING "#######";CVI(C$);:PRINT " "+B$;:IF EP=42 THEN PRINT USING"**######.##";CVD(A$); ELSE PRINT USING " $$#####.##";CVD(A$);
1940 IF EP=42 THEN PRINT E$+" "; ELSE PRINT " "+E$;
1950 PRINT CODE%:IF CODE% MOD 20=0 THEN 1970 ELSE 1980
1970 PRINT:PRINT "DATE CHECK PAID TO AMOUNT FOR REC":PRINT
1980 NEXT:PRINT: PRINT:PRINT "TOTAL PAID OUT THROUGH CHECK NO. ";CVI(C$);" ";D$;" IS";:PRINT USING DL$;T:PRINT:PRINT:PRINT:IF PRT$="P" THEN 2590
2027 IF OLD% THEN KEY(7) OFF:PRINT:PRINT " PRESS F8 TO RETURN TO OPTIONS":GOTO 2028 ELSE 2030
2028 X$=INKEY$:IF X$<>"@" THEN 2028 ELSE CLS:GOTO 10
2030 PRINT TAB(10) "R=REVISE":PRINT:PRINT TAB(10) "O=RETURN TO OPTIONS":PRINT:PRINT TAB(10) "M=RETURN TO MENU":KEY(7) OFF
2040 X$=INKEY$:DEF SEG=64:POKE 23, (PEEK(23) OR 64):IF X$="R" THEN FL$="EXPENSE.CUR":GOSUB 30210:GOTO 2340 ELSE IF X$="O" THEN CLS:GOTO 10 ELSE IF X$="M" THEN RUN "BKPG.BAS" ELSE 2040
2060 FOR N=1 TO LOF(3)/128:GET 3, N:INS(1)=INSTR(L$,CHR$(44)):INS(2)=INSTR(INS(1)+2,L$,CHR$(44)):INS(3)=INSTR(INS(2)+2,L$,CHR$(44))
2110 IF LEFT$(EP$,3)=LEFT$(L$,3) OR LEFT$(EP$,3)=MID$(L$,INS(1)+2,3) OR LEFT$(EP$,3)=MID$(L$,INS(2)+2,3) OR LEFT$(EP$,3)=MID$(L$,INS(3)+2,3) THEN RETURN
2120 NEXT:LST=N:RETURN
2340 CLS
2350 PRINT:PRINT "RECORD NUMBER ";:NBR=1:INLN%=6:GOSUB 20050:CODE%=VAL(INPT$):GET 1, CODE%:COLOR 0,7:FIELD 1, 8 AS D$, 8 AS C$, 25 AS B$, 9 AS A$, 18 AS E$:GOSUB 960:PRINT TAB(76) CODE%: COLOR 7,0:PRINT "DATE ";:INLN%=8:GOSUB 20050:ND$=INPT$
2410 PRINT "CHECK NUMBER (ENTER 0 IF NON-CHECK EXPENSE) ";:INLN%=8:NBR=1:GOSUB 20050:CHECK%=VAL(INPT$):PRINT "AMOUNT ";:INLN%=9:GOSUB 20050:AM=VAL(INPT$):NBR=0:IF AM=0 THEN EP$="VOID":PAY$="": GOTO 2480
2440 PRINT "PAY TO (NO ABBREVIATIONS) ";:INLN%=25:GOSUB 20050:PAY$=INPT$:PRINT "FOR ";:INLN%=18:GOSUB 20050:EP$=INPT$:PRINT:PRINT:PRINT:PRINT
2480 GOSUB 900:PRINT TAB(10) "C=DATA IS CORRECT":PRINT:PRINT TAB(10) "N=DATA IS NOT CORRECT"
2500 X$=INKEY$:IF X$="C" THEN 2510 ELSE IF X$="N" THEN 2340 ELSE DEF SEG=64:POKE 23, (PEEK(23) OR 64):GOTO 2500
2510 PUT 1, CODE%:PRINT:PRINT " A=REVISE ANOTHER" TAB(89) "R=READ FILE" TAB(89) "O=RETURN TO OPTIONS" TAB(89) "M=RETURN TO MENU"
2570 X$=INKEY$:IF X$="A" THEN 2350 ELSE IF X$="R" THEN GOTO 1690 ELSE IF X$="M" THEN RUN"BKPG.BAS" ELSE IF X$="O" THEN CLS:GOTO 10 ELSE GOTO 2570
2590 DIM TE(30), YTD(30):DIM MIS$(30):FIELD 1, 8 AS D$:GET 1, LOF(1)/128:CLS:PRINT:PRINT TAB(10) "DATE OF LAST ENTRY IN FILE IS "+D$:PRINT:PRINT TAB(10) "C=CONTINUE END MONTH PROCEDURE":PRINT:PRINT TAB(10) "O=RETURN TO OPTIONS"
2605 DEF SEG=64:POKE 23, (PEEK(23) OR 64)
2606 X$=INKEY$:IF X$="O" THEN 10 ELSE IF X$<>"C" THEN 2606
2610 EM=1
2620 CLS:LOCATE 12,23:PRINT "PLEASE WAIT FOR NEXT INSTRUCTIONS.":GET 1,1:FIELD 1, 10 AS M$, 5 AS Y$, 34 AS S$, 6 AS F$:LPRINT CHR$(18):LPRINT MODE$:LPRINT M$;:LPRINT CVI(Y$);:LPRINT S$;:LPRINT CVI(F$):LPRINT:LPRINT
2710 LPRINT "DATE CK.NO. PAID TO AMT. FOR REC.NO.":LPRINT XMOD$:T=0:OPEN "CATEGORY.FIL" AS 3:FIELD 3, 44 AS L$:FOR I=2 TO LOF(1)/128:CODE%=I:GET 1, CODE%:FIELD 1, 8 AS D$, 8 AS C$, 25 AS B$, 9 AS A$, 18 AS E$
2770 EP=ASC(E$):IF EP=42 THEN 2850
2790 IF EP=32 THEN 2910
2800 T=T+CVD(A$):EP$=E$:GOSUB 2060:IF LEFT$(EP$,3)="VOI" THEN 2840
2830 IF N=LST THEN GOSUB 3720
2840 TE(N)=TE(N)+CVD(A$)
2850 LPRINT D$;:LPRINT USING "#######";CVI(C$);:LPRINT " "B$;:IF EP=42 THEN LPRINT USING"**######.##";CVD(A$); ELSE LPRINT USING DL$;CVD(A$);
2890 IF EP=42 THEN LPRINT E$+" "; ELSE LPRINT " "+E$;
2900 LPRINT USING"###";CODE%
2910 NEXT:IF PRT$="P" THEN LPRINT:LPRINT "TOTAL PAID OUT THROUGH CHECK NO. ";CVI(C$);" "D$;" IS";USING DL$;T:LPRINT CHR$(140):GOTO 2027
2920 LPRINT TAB(45) "___________":LPRINT TAB(10) " TOTAL PAID OUT THIS MONTH IS ";:LPRINT USING "$$######.##";T:CLS:PRINT "CHECK PRINTED PAGE TO BE SURE IT IS CORRECT. FILE WILL BE REMOVED FROM CURRENT STATUS WHEN PROGRAM CONTINUES.":PRINT
2955 PRINT TAB(10) "P=PRINT AGAIN":PRINT:PRINT TAB(10) "R=REVISE":PRINT:PRINT TAB(10) "C=CONTINUE"
2960 X$=INKEY$:DEF SEG=64:POKE 23, (PEEK(23) OR 64):IF X$="P" THEN CLEAR,,5120:GOTO 2620 ELSE IF X$="R" THEN GOTO 3500 ELSE IF X$="C" THEN 2980 ELSE 2960
2980 GET 1,1:LPRINT CHR$(140);:LPRINT MODE$:LPRINT " EXPENSES ";:LPRINT M$;:LPRINT CVI(Y$);:LPRINT " YTD REC.NO.":LPRINT XMOD$:IF SKIP=1 THEN 3120
3040 OPEN "B:EXPENSE.TOT" AS 2
3120 LPRINT:FOR N=1 TO LOF(3)/128+1:CODE%=N:GET 2, CODE%:FIELD 2, 12 AS Q$:IF N>LOF(3)/128 THEN LPRINT "MISCELLANEOUS ";:GOTO 3220
3180 GET 3, N:IF LEN(L$)<2 THEN 3330 ELSE LPRINT L$;
3220 LPRINT USING "$$######.##";TE(N);:IF SKIP=1 THEN 3270
3240 YTD(N)=CVD(Q$)+TE(N):TOT=TOT+TE(N):TY=TY+YTD(N)
3270 LPRINT USING "$$#########.##";YTD(N);:LPRINT USING "########";CODE%:IF SKIP=1 THEN 3330
3300 FIELD 2, 12 AS Q$:LSET Q$=MKD$(YTD(N)):PUT 2, CODE%
3330 NEXT:FIELD 2, 12 AS Z$:LSET Z$=MKD$(TY):PUT 2, 31:IF SKIP=1 THEN SKIP=0:GOTO 3380
3371 CLOSE 4:BKUP=0:OPEN "B:CHECKING.ACC" AS 4:FIELD 4, 12 AS ZZ$:LSET ZZ$=MKD$(TOT):PUT 4, 2:CLOSE 4
3380 LPRINT TAB(45) "___________ ____________":LPRINT TAB(23) "TOTAL PAID OUT";:LPRINT TAB(45) USING DL$;TOT;:LPRINT USING "$$#########.##";TY:GOSUB 3760:LPRINT CHR$(140)+CHR$(27)CHR$(64)
3435 CLS:PRINT TAB(10)"P=PRINT AGAIN":PRINT:PRINT TAB(10) "C=CONTINUE"
3440 X$=INKEY$:DEF SEG=64:POKE 23, (PEEK(23) OR 64):IF X$="P" THEN SKIP=1: GOTO 2980 ELSE IF X$="C" THEN GOTO 3460 ELSE 3440
3460 PUT 2, 31:FL$="EXPENSE."+LEFT$(M$,3):NAME "B:EXPENSE.CUR" AS FL$:GOSUB 30210
3484 CLS:PRINT:COLOR 0,7:PRINT " REMOVE FILE DISK FROM DRIVE B AND INSERT BACKUP DISK PRESS F8 WHEN READY":COLOR 7,0:PRINT:PRINT
3485 X$=INKEY$:IF X$<>"@" THEN 3485
3486 NAME "B:EXPENSE.CUR" AS FL$
3487 PRINT:PRINT:COLOR 0,7:PRINT " REMOVE BACKUP DISK FROM DIRVE B AND ADD EXPENSE.(MONTH JUST CLOSED) TO BOTH DISK LABELS":PRINT:PRINT" INSERT FILE DISK IN DRIVE B AND PRESS F8 WHEN READY":COLOR 7,0
3490 X$=INKEY$:IF X$<>"@" THEN 3490 ELSE RUN "BKPG.BAS"
3500 CLS:FOR N=1 TO LST:TE(N)=0:NEXT:PRINT "AFTER REVISING FILE, RETURN TO OPTIONS AND START END OF MONTH AGAIN. PRESS F8 TO CONTINUE"
3530 X$=INKEY$:IF X$<>"@" THEN 3530
3540 GOTO 2340
3720 J=J+1:MIS$(J)=EP$:MIS(J)=CVD(A$):RETURN
3760 LPRINT:LPRINT:LPRINT MODE$:LPRINT TAB(20) "SUMMARY OF MISCELLANEOUS EXPENSES":LPRINT:LPRINT XMOD$:FOR J=1 TO 10:IF MIS(1)=0 THEN LPRINT TAB(10) "NONE": GOTO 3830
3790 IF MIS$(J)="" AND MIS(J)=0 THEN 3830 ELSE 3800
3800 LPRINT TAB(10) MIS$(J)+" ";:LPRINT USING DL$;MIS(J):NEXT
3830 RETURN
4000 CLS:OLD%=1:COLOR 0,7:PRINT" INSERT DISK CONTAINING THE FILE YOU WISH TO READ IN DRIVE B":COLOR 7,0:PRINT:PRINT:PRINT "ENTER MONTH OF EXPENSE FILE TO BE READ ";
4040 X$=INKEY$:POKE 23, (PEEK(23) OR 64):IF X$<>CHR$(13) THEN PRINT X$;:OMON$=OMON$+X$:GOTO 4040
4070 FILE$="B:"+"EXPENSE."+LEFT$(OMON$,3):CLOSE 1:OPEN FILE$ AS 1:GOTO 1690
5000 CLS:LPRINT CHR$(27)CHR$(64):PRINT TAB(10) "N=NO MESSAGE ON CHECK STUB":PRINT:PRINT TAB(10)"I=INVOICE AND CREDIT TYPE MESSAGE":PRINT:PRINT TAB(10)"S=MISCELLANEOUS MESSAGE"
5007 X$=INKEY$:DEF SEG=64:POKE 23, (PEEK(23) OR 64):DEF SEG=64:POKE 23, (PEEK(23) AND 223):IF X$="N" THEN FOR J=1 TO 12:LPRINT:NEXT:GOTO 5021 ELSE IF X$="I" OR X$="S" THEN 5011 ELSE 5007
5011 CLS:PRINT "TYPE MESSAGE BETWEEN THE LINES IN ANY WAY THAT YOU WOULD LIKE IT PRINTED.":PRINT:PRINT "USE CURSOR KEYS TO MOVE AROUND.":LOCATE 5,1:PRINT STRING$(80,CHR$(22))
5014 IF X$="I" THEN LOCATE 6,1:PRINT "DATE INVOICE NUMBER AMOUNT ---- DATE INVOICE NUMBER AMOUNT "
5015 LOCATE 18,1:PRINT STRING$(80,CHR$(22)):LOCATE 19,20:PRINT "PRESS ENTER WHEN READY TO CONTINUE":IF X$="I" THEN LOCATE 7,1 ELSE LOCATE 6,1
5016 LINE INPUT X$:FOR N=6 TO 17:FOR J=1 TO 80:LPRINT CHR$(SCREEN(N,J));:NEXT J:NEXT
5021 CLS:IF ADR$<>"" THEN 5060 ELSE PRINT:PRINT TAB(13) "IF NO ADDRESS TO BE PRINTED --- JUST PRESS ENTER"
5023 PRINT:PRINT TAB(15) "TO PRINT ADDRESS OF PAYEE --- ENTER STREET ADDRESS OR BOX NO.":PRINT:PRINT TAB(35);:INLN%=40:GOSUB 20050:ADR$=INPT$:IF ADR$="" THEN CITY$="":GOTO 5060
5040 PRINT TAB(16) "CITY, STATE ZIP ";:INLN%=40:GOSUB 20050:CITY$=INPT$
5060 FOR N=1 TO 11:LPRINT:NEXT:LPRINT CHR$(27)CHR$(69)+CHR$(27)CHR$(71):LPRINT TAB(52) ND$+" "+CHR$(14);:LPRINT USING "**$###.##";AM:LPRINT:LPRINT:IF ADR$="" THEN LPRINT TAB(7) PAY$:LPRINT:LPRINT:LPRINT CHR$(27)CHR$(64):GOTO 5110
5100 LPRINT TAB(7) PAY$:LPRINT TAB(7) ADR$:LPRINT TAB(7) CITY$:LPRINT CHR$(27)CHR$(64)
5110 FOR N=1 TO 10:LPRINT:NEXT:ADR$="":ADD$="":CITY$="":MES$="":RETURN
6000 CLS:OPEN "A:PAYEE.FIL" AS 2
6020 FIELD 2, 5 AS F$, 35 AS G$, 35 AS H$, 35 AS I$, 16 AS J$
6025 IF CAT=1 THEN PRINT TAB(15) "CATEGORY OF EXPENSE FILE":PRINT ELSE PRINT TAB(15) "PAYEE FILE":PRINT
6030 PRINT TAB(10) "A=ADD TO OR START FILE":PRINT:PRINT TAB(10) "R=READ, REVISE, OR PRINT FILE":PRINT:PRINT TAB(10) "F=ALPHABETIZE FILE":PRINT:PRINT TAB(10) "O=RETURN TO OPTIONS":PRINT:PRINT TAB(10) "M=RETURN TO MENU":SKIP=0
6040 X$=INKEY$:DEF SEG=64:POKE 23, (PEEK(23) OR 64):IF X$="A" THEN 6060 ELSE IF X$="R" THEN 6200 ELSE IF X$="F" THEN 50000 ELSE IF X$="O" THEN CLS:GOTO 10 ELSE IF X$="M" THEN RUN "BKPG.BAS" ELSE 6040
6060 N=LOF(2)/128
6062 IF CAT THEN GOSUB 7040:GOTO 6062
6065 GOSUB 6070:GOTO 6065
6070 N=N+1
6080 PRINT " 3 LETTER ABBREVIATION FOR PAYEE (IF FINISHED ENTER F) ";:INLN%=3:GOSUB 20050:ABB$=INPT$:IF ABB$="F" THEN 6030
6095 IF LEN(ABB$)<>3 THEN COLOR 0,7:PRINT " ABBREVIATION MUST BE 3 LETTERS--REENTER ":COLOR 7,0:GOTO 6080
6100 PRINT "PAYEE ";:INLN%=35:GOSUB 20050:PAY$=INPT$:PRINT "STREET ADDRESS OR BOX NO. ";:INLN%=35:GOSUB 20050:ADR$=INPT$:PRINT "CITY, STATE ZIP ";:INLN%=35:GOSUB 20050:CITY$=INPT$:PRINT "TYPE OF EXPENSE ";:INLN%=16:GOSUB 20050:EP$=INPT$:LSET F$=ABB$
6150 LSET G$=PAY$:LSET H$=ADR$:LSET I$=CITY$:LSET J$=EP$:PUT 2, N:RETURN
6200 CLS:PRINT:PRINT TAB(10) "R=READ ONLY":PRINT:PRINT TAB(10) "P=READ AND PRINT"
6220 PRT$=INKEY$:IF PRT$="P" OR PRT$="R" THEN CLS:GOTO 6230 ELSE 6220
6230 COLOR 0,7: PRINT " PRESS F8 TO READ RECORDS IN SEQUENCE.":PRINT"PRESS AGAIN TO CONTINUE READING AFTER EACH STOP.":PRINT" PRESS ESCAPE TO RETURN TO OPTIONS.":COLOR 7,0: PRINT:PRINT
6240 COLOR 0,7:PRINT " IF REVISING FILE, WRITE DOWN RECORD NUMBERS TO BE CHANGED. IF THERE IS A RECORD NO LONGER USED, IT CAN BE REPLACED BY USING ITS RECORD NUMBER FOR A NEW ENTRY": PRINT:PRINT
6250 X$=INKEY$:IF X$<>"@" THEN 6250 ELSE COLOR 7,0:DEF SEG:POKE 106,0
6265 IF PRT$="P" THEN LPRINT CHR$(15)+CHR$(27)CHR$(78)CHR$(6):WIDTH "LPT1:", 132
6266 IF PRT$="P" AND CAT=1 THEN LPRINT CHR$(27)CHR$(45)CHR$(1):LPRINT TAB(40) "CATEGORY OF EXPENSE FILE "+DATE$:LPRINT CHR$(27)CHR$(45)CHR$(0)
6267 IF PRT$="P" AND CAT=0 THEN LPRINT CHR$(27)CHR$(45)CHR$(1):LPRINT TAB(50) "PAYEE FILE "+DATE$:LPRINT CHR$(27)CHR$(45)CHR$(0)
6270 FOR N=1 TO LOF(2)/128:GET 2, N:IF CAT THEN 7140
6330 PRINT "ABBREVIATION "+F$+" "+"REC.NO.";:PRINT N:PRINT G$:PRINT H$:PRINT I$:PRINT J$:PRINT:IF PRT$<>"P" THEN 6405
6390 LPRINT "REC.NO. ";:LPRINT N:LPRINT F$+" "+G$+" "+H$+" "+I$+" "+J$
6405 IF N MOD 3=0 THEN 6407 ELSE 6410
6407 RX$=INKEY$:IF RX$=CHR$(27) THEN CLS:GOTO 6020 ELSE IF RX$<>"@" THEN 6407
6410 NEXT:IF PRT$="P" THEN LPRINT CHR$(27)CHR$(64)+CHR$(140)
6420 PRINT TAB(10) "R=REVISE FILE": PRINT TAB(10) "O=RETURN TO OPTIONS FOR THIS FILE"
6430 X$=INKEY$:DEF SEG=64:POKE 23, (PEEK(23) OR 64):IF X$="R" THEN 6450 ELSE IF X$="O" THEN CLS:PRINT:PRINT:GOTO 6025 ELSE 6430
6450 PRINT "RECORD NUMBER TO BE CHANGED OR REPLACED ";:NBR=1:GOSUB 20050:N=VAL(INPT$):NBR=0:IF CAT THEN CLS:GOSUB 7050 ELSE GOSUB 6080
6470 PRINT "REVISE ANOTHER? Y OR N"
6475 X$=INKEY$:DEF SEG=64:POKE 23, (PEEK(23) OR 64):IF X$="Y" THEN 6450 ELSE IF X$="N" THEN CLS:PRINT:PRINT:GOTO 6025 ELSE 6475 EDIT 7005
7000 CLS:CAT=1:OPEN "A:CATEGORY.FIL" AS 2:FIELD 2, 44 AS L$:GOTO 6025
7040 N=N+1:IF SKIP THEN 7090
7050 CLS:PRINT "1. THERE IS A LIMIT OF 28 CATEGORIES.":PRINT "2. THE FIRST 3 LETTERS OF A CATEGORY MAY NOT BE THE SAME AS THE FIRST 3 LETTERS OF ANY OTHER."
7060 PRINT "3. EACH CATEGORY MAY BE SINGLE OR MADE UP OF UP TO 4 TYPES OF EXPENSE. THESE TYPES WILL BE COMPILED BY THE EXPENSE PROGRAM UNDER THIS CATEGORY.
7070 PRINT "4. IF THERE IS MORE THAN 1 TYPE OF EXPENSE IN A CATEGORY THEN:"TAB(5)"A. PRECEDE CATEGORY BY A QUOTATION MARK."TAB(5)"B. THERE MUST BE A COMMA AND A SPACE BETWEEN TYPES OF EXPENSE."
7080 PRINT:PRINT TAB(8) "EXAMPLE "+CHR$(34)+"DUES, LICENSES, EDUCATION"
7090 LOCATE 13,1:FOR I=1 TO 80:PRINT CHR$(42);:NEXT:DEF SEG=64:POKE 23, (PEEK(23) OR 64):PRINT "REC.NO. ";:PRINT N:PRINT "CATEGORY OF EXPENSE (IF FINISHED, ENTER F) ";:INLN%=44:GOSUB 20050:CAT$=INPT$:IF CAT$="F" THEN CLS:GOTO 6030
7120 LSET L$=CAT$:PUT 2, N:LOCATE 14,1:FOR I=1 TO 81:PRINT CHR$(32);:NEXT:SKIP=1:RETURN
7140 PRINT "REC.NO. ";:PRINT N;:PRINT " "+L$:PRINT:IF PRT$="P" THEN LPRINT "REC.NO. ";:LPRINT N;:LPRINT " "+L$:LPRINT
7160 GOTO 6410
9000 KEY(7) OFF:X$=INKEY$:IF X$=CHR$(27) THEN 10
9010 IF X$<>"@" THEN 9000 ELSE DEF SEG:POKE 106,0:KEY(7) ON:RETURN
10000 CLS:IF ERR=71 THEN COLOR 0,7:PRINT " FILE DISK NOT IN DRIVE B OR PROGRAM DISK NOT IN DRIVE A OR DOOR IS OPEN.":PRINT:PRINT" CORRECT PROBLEM AND PRESS F8 WHEN READY. ":GOTO 10050
10010 IF ERR=24 OR ERR=27 THEN COLOR 0,7:PRINT " PRINTER NOT ON OR OUT OF PAPER. SET TOP OF PAGE AND TURN ON PRINTER. PRESS F8 WHEN READY. ":GOTO 10050
10020 IF ERR=210 THEN DEF SEG=64:POKE 23, (PEEK(23) OR 64):RESUME
10030 IF ERR=53 THEN COLOR 0,7:PRINT " FILE NOT FOUND ":PRINT:PRINT " INSERT DISK CONTAINING FILE AND PRESS F8 WHEN READY .":GOTO 10050
10040 COLOR 0,7:PRINT "AN UNIDENTIFIED ERROR HAS OCCURRED":PRINT:PRINT "PRESS F8 TO RETURN TO OPTIONS":COLOR 7,0
10045 X$=INKEY$:IF X$<>"@" THEN 10045 ELSE 10
10050 X$=INKEY$:IF X$<>"@" THEN 10050 ELSE COLOR 7,0:CLS:DEF SEG:POKE 106,0:RESUME
20050 INPT$="":INPOS%=POS(0):DEF SEG=64:POKE 23, (PEEK(23) OR 64):POKE 23, (PEEK(23) OR 32):LOCATE,,1,6,7:IF INLN%=0 THEN INLN%=10
20110 IP$=INKEY$:IF IP$="" THEN 20110
20130 IF NBR THEN IF ASC(IP$)>57 THEN BEEP:GOTO 20110
20140 IF NBR THEN IF ASC(IP$)<48 AND ASC(IP$)<>46 THEN IF ASC(IP$)<>8 AND ASC(IP$)<>13 THEN IF ASC(IP$)<>45 THEN BEEP:GOTO 20110
20150 IF ASC(IP$)=29 THEN BEEP:GOTO 20110
20155 IF ASC(IP$)=27 THEN 10
20160 IP$=CHR$(ASC(IP$)+32*(IP$>="a" AND IP$<="z")):IF LEN(INPT$)=INLN% THEN IF ASC(IP$)<>13 AND ASC(IP$)<>8 THEN 20110
20180 IF ASC(IP$)=13 THEN PRINT:GOTO 20240
20190 IF ASC(IP$)=8 AND POS(0)=INPOS% THEN 20110
20200 IF ASC(IP$)=8 THEN GOSUB 20250:GOTO 20110
20210 INPT$=INPT$+IP$:PRINT IP$;:GOTO 20110
20240 INLN%=0:RETURN
20250 IF INPT$="" THEN 20110
20260 INPT$=LEFT$(INPT$,LEN(INPT$)-1):LOCATE CSRLIN,POS(0)-1:PRINT " ";:LOCATE CSRLIN,POS(0)-1:RETURN
30210 IF BKUP THEN 30220 ELSE OPEN "B:BACKUP.FIL" AS 4:BKUP=1
30220 FIELD 4, 14 AS A$:IF LOF(4)/128=0 THEN 30280
30240 FOR N=1 TO LOF(4)/128:GET 4,N:IF FL$+STRING$(14-LEN(FL$),32)=A$ THEN 30300
30270 NEXT
30280 LSET A$=FL$:PUT 4, LOF(4)/128+1
30300 RETURN
50000 CLS:GOTO 60000
50020 IF SHELLD%=1 THEN 50070
50030 DEF SEG=LD.ADDR:BLOAD "SHELLSRT",0:SHELLSRT=0:SHELLD%=1
50070 SEQ$="A":FIELD 2, 126 AS AA$:COUNT%=LOF(2)/128:IF SHELLD% THEN 50120
50110 DIM DIRLST$(COUNT%)
50120 FOR N=1 TO COUNT%:GET 2,N:DIRLST$(N-1)=AA$:NEXT:DEF SEG=LD.ADDR:CALL SHELLSRT(SEQ$,COUNT%,DIRLST$(0)):FOR N=0 TO COUNT%-1:PRINT DIRLST$(N):LSET AA$=DIRLST$(N):PUT 2, N+1:NEXT:PRINT:PRINT TAB(10) "PRESS F8 TO RETURN TO OPTIONS"
50240 MU$=INKEY$:IF MU$<>"@" THEN 50240 ELSE CLS:GOTO 6020
60000 TRUE%=-1:FALSE%=0:LDOUT%=FALSE%:GOSUB 60180:GOSUB 60230:GOSUB 60270:IF NOT LDOUT% THEN 60130
60030 GOSUB 60340:GOTO 60160
60050 '
60130 GOSUB 60380:CLEAR ,CLR.ADDR:GOSUB 60180:GOSUB 60430
60160 GOTO 50020
60170 END
60180 SUBR.SIZE=400:RETURN
60230 DEF SEG=0:SYS.MEMORY=PEEK(&H413)+PEEK(&H414)*256:RETURN
60270 DEF SEG=0:BASIC.DS=(PEEK(&H510)+PEEK(&H511)*256):OUTSIDE.BASIC.DS=BASIC.DS+4104+(SUBR.SIZE/16):IF OUTSIDE.BASIC.DS*16<SYS.MEMORY*1024 THEN LDOUT%=TRUE%
60330 RETURN
60340 LD.ADDR=OUTSIDE.BASIC.DS-(SUBR.SIZE/16):RETURN
60380 DEF SEG:TOP.STACK=PEEK(&H2C)+PEEK(&H2D)*256:CLR.ADDR=(TOP.STACK-SUBR.SIZE)-128:RETURN
60430 DEF SEG=0:BASIC.DS=16*(PEEK(&H510)+PEEK(&H511)*256):DEF SEG:TOP.STACK=PEEK(&H2C)+PEEK(&H2D)*256:LD.ADDR=(BASIC.DS+TOP.STACK)/16:LD.ADDR=INT(LD.ADDR+0.5):RETURN
FILES472.TXT
-----------------------------------------------------------------------
Disk No 472 Simplified Business Bookkeeping v1.1
----------------------------------------------------------------------
The minimum hardware configuration for using these programs is
an IBM-PC or compatible computer with 128 K of memory, 2 DS DD
disk drives, and an IBM, Epson or other compatible printer.
A EXE Information on how to use to *.bat files to backup your data
ACCTREC BAS Processes Accounts Receivables
AUTOEXEC BAT Request the DATE then loads BASICA BKPG /F:5
BKPG BAK Backup file of bookkeeping
BKPG BAS This is the bookkeeping program
BKPG DOC Author supplied documentation file
C BAT COPY PAYEE.FIL, CATEGORY.FIL, INCOME.FIL to B:, CHKDSK A: & B:
CHECKING BAS Maintains the checking account
EXPENSE BAS Keeps track of expenses
F BAT Creates and formats two new disks, for bookkeeping fiscal year
G BAT Copies totals to new backup bookkeeping disk, runs bkpg.bas
INCOME BAS Keeps track of income
L BAT Copies checking.acc to new backup bookkeeping disk, runs bkpg.bas
N BAT Creates two disks then loads basica and runs Payroll program
PAYROLL BAS Processes the payroll
R BAT Creates two disks then loads basica and runs A / R program
S BAT Format 6 disks by responding "Y" first 5 times, for startup
SHELLSRT BAS This is a shell sort program for sorting files
STARTUP BAT Author supplied User startup procedure batch file
X BAT Makes new backup copy of PAYROLL FILE DISK on drive B:
PC-SIG
1030D E. Duane Ave.
Sunnyvale, CA 94086
(408) 730-9291
(c) Copyright 1987 PC-SIG
INCOME.BAS
10 CLEAR,,1536:CLS:FOR I=1 TO 6: PRINT:NEXT:KEY 7, "":KEY 8, "@":ON KEY(7) GOSUB 2900:ON ERROR GOTO 3000
40 OPEN "B:INCOME.CUR" AS 1:OPEN "INCOME.FIL" AS 3:FIELD 3, 10 AS A$(1), 10 AS A$(2), 10 AS A$(3), 10 AS A$(4), 10 AS A$(5), 10 AS A$(6)
43 IF LOF(3)/128=0 THEN CLS:PRINT:PRINT TAB(10) "CATEGORY OF INCOME FILE MUST BE CREATED":PRINT:CAT$(2)="TAXABLE":GOTO 4030
50 PRINT " INCOME FILE-----PRESS KEY TO CHOOSE OPTION":PRINT:PRINT TAB(10) "0=OPEN NEW FILE":PRINT:PRINT TAB(10) "A=ADD TO FILE":PRINT:PRINT TAB(10) "R=READ, REVISE OR PRINT FILE":PRINT:PRINT TAB(10) "E=END MONTH--TURN ON PRINTER":PRINT
100 PRINT TAB(10) "M=RETURN TO MENU":PRINT:PRINT TAB(10) "H=READ OR PRINT OLD FILE":PRINT:PRINT TAB(10) "C=REVISE CATEGORY OF INCOME FILE"
110 DL$="$$######.##":MODE$=CHR$(27)+CHR$(45)+CHR$(1)+CHR$(27)+CHR$(71)+CHR$(27)+CHR$(78)+CHR$(6):DEFDBL A-Z:DEFINT N,I,J:XMOD$=CHR$(27)+CHR$(45)+CHR$(0)+CHR$(27)+CHR$(72):DIM T(20), YTD(20), AM(20), J(20), INC$(20):GET 3,1
174 FOR N=1 TO 6:CAT$(N)=A$(N):NEXT:IF LEFT$(CAT$(2),7)="TAXABLE" THEN JTAX=1
176 IF CAT$(4)=STRING$(10,32) THEN NCAT4=1
177 IF CAT$(5)=STRING$(10,32) THEN NCAT5=1
178 CLOSE 3
180 X$=INKEY$:DEF SEG=64:POKE 23, (PEEK(23) OR 64):POKE 23, (PEEK(23) OR 32):IF SKIP% THEN X$="E"
195 IF X$="A" THEN FL$="INCOME.CUR":GOSUB 30210 ELSE IF X$="E" THEN FL$="INCOME.TOT":GOSUB 30210:FL$="CHECKING.ACC":GOSUB 30210:FL$="CHKDSC":GOSUB 30210
200 IF X$="O" THEN 210 ELSE IF X$="A" THEN CLS:GOTO 360 ELSE IF X$="R" THEN 1070 ELSE IF X$="E" THEN EOM%=1:GOTO 1140 ELSE IF X$="M" THEN RUN "BKPG.BAS" ELSE IF X$="H" THEN 1061 ELSE IF X$="C" THEN 4000 ELSE 180
210 CLS:FOR I=1 TO LOF(1)/128:GET 1,I:NEXT:IF LOF(1)/128=0 THEN 260 ELSE 240
240 BEEP:COLOR 31:PRINT "FILE ALREADY OPENED FOR MONTH OR LAST MONTH'S FILE NOT CLOSED OUT":COLOR 7:CLEAR:GOTO 40
260 PRINT "MONTH ";:GOSUB 20050:MON$=INPT$:PRINT "YEAR ";:INLN%=4:NBR=1:GOSUB 20050:YR$=INPT$:IF JTAX=0 THEN 290 ELSE PRINT "SALES TAX RATE AS __% ";
285 INLN%=8:GOSUB 20050:TR=VAL(INPT$):NBR=0
290 CODE%=1:FIELD 1, 10 AS M$, 5 AS Y$, 8 AS H$:LSET M$=MON$:LSET Y$=YR$:LSET H$=MKD$(TR):PUT 1,CODE%:GOTO 410
360 FOR I=1 TO LOF(1)/128:GET 1,I:NEXT:IF LOF(1)/128=0 THEN 390 ELSE 410
390 BEEP:COLOR 31:PRINT "FILE NOT OPENED FOR MONTH":COLOR 7:CLEAR:GOTO 40
410 GET 1, LOF(1)/128:CODE%=LOF(1)/128
430 PRINT "CHOOSE":PRINT TAB(10) "R=REGULAR INCOME":PRINT TAB(10) "M=MISCELLANEOUS INCOME":PRINT TAB(10) "O=RETURN TO OPTIONS"
470 X$=INKEY$:DEF SEG=64:POKE 23, (PEEK(23) OR 64):IF X$="M" THEN 490 ELSE IF X$="R" THEN 700 ELSE IF X$="O" THEN 10 ELSE 470
490 CODE%=CODE%+1:GOSUB 510:GOTO 430
510 PRINT "DATE AS xx/xx/xx ";:INLN%=8:GOSUB 20050:ND$=INPT$:PRINT "FROM ";:INLN%=15:GOSUB 20050:FR$=INPT$:PRINT "AMOUNT ";:NBR=1:GOSUB 20050:AM=VAL(INPT$):PRINT "DEPOSIT ";:GOSUB 20050:DP=VAL(INPT$):NBR=0:MS=AM
560 PRINT "TYPE OF INCOME ";:LXN%=CSRLIN:IF NCAT4<>1 THEN PRINT:PRINT "ENTER 1 IF "+CAT$(4)
562 IF NCAT5<>1 THEN PRINT:PRINT "ENTER 2 IF "+CAT$(5)
563 IF NCAT4<>1 AND NCAT5<>1 THEN PRINT:PRINT "OR ENTER TYPE "; ELSE LOCATE LXN%,19
565 INLN%=30:GOSUB 20050:TP$=INPT$:IF VAL(TP$)=1 THEN TP$=CAT$(4) ELSE IF VAL(TP$)=2 THEN TP$=CAT$(5)
570 FIELD 1, 8 AS D$, 10 AS B$, 10 AS A$, 15 AS F$, 30 AS S$, 5 AS X$:LSET D$=ND$:LSET B$=MKD$(DP):LSET A$=MKD$(AM):LSET F$=FR$:LSET S$=TP$:LSET X$="M":PRINT "CHOOSE":PRINT TAB(10) "E=DATA OK, ENTER ON FILE":PRINT TAB(10) "C=CHANGE DATA"
660 X$=INKEY$:DEF SEG=64:POKE 23, (PEEK(23) OR 64):IF X$="E" THEN 680 ELSE IF X$="C" THEN 510 ELSE 660
680 PUT 1, CODE%:RETURN
700 CODE%=CODE%+1:GOSUB 720:GOTO 430
720 PRINT "DATE AS XX/XX/XX ";:INLN%=8:GOSUB 20050:ND$=INPT$:PRINT "DEPOSIT ";:NBR=1:GOSUB 20050:DP=VAL(INPT$):PRINT "TOTAL CASH ";:GOSUB 20050:AM=VAL(INPT$):PRINT "TOTAL CHARGE ";:INLN%=8:GOSUB 20050:CHG=VAL(INPT$)
760 PRINT CAT$(1)+" ";:INLN%=8:GOSUB 20050:XT=VAL(INPT$):PRINT CAT$(2)+" ";:INLN%=8:GOSUB 20050:TX=VAL(INPT$):PRINT CAT$(3)+" ";:INLN%=8:GOSUB 20050:RX=VAL(INPT$):PRINT "RECEIVED ON ACCT. ";
795 INLN%=8:GOSUB 20050:RA=VAL(INPT$):NBR=0:TAX=AM+CHG-XT-TX-RX-RA
805 IF JTAX<>1 AND ABS(TAX)>0.005000001 THEN BEEP:COLOR 0,7:PRINT "ERROR--TOTAL OF CATEGORIES IS NOT EQUAL TO TOTAL CASH+CHARGE--RECHECK AMOUNTS AND REENTER":COLOR 7,0:PRINT:GOTO 720 ELSE IF JTAX<>1 THEN 900
810 FIELD 1, 10 AS M$, 5 AS Y$, 8 AS H$:GET 1,1:TR=CVD(H$):IF TAX<0.01 AND TX<0.2 THEN 880
850 IF TAX>0.0108*TR*TX OR TAX<0.0095*TR*TX THEN 860 ELSE 880
860 PRINT "TAX=";:PRINT USING DL$;TAX:PRINT "% OF TAXABLE SALES=";:PRINT USING "##.##";(100*TAX)/TX:BEEP:COLOR 0,7:PRINT "ERROR--TAX IS OUT OF RANGE--RECHECK AMOUNTS AND REENTER DATA":COLOR 7,0:GOTO 720
880 PRINT "TAX=";:PRINT USING "$$####.##";TAX
900 PRINT "CHOOSE":PRINT TAB(10) "E=DATA OK, ENTER ON FILE":PRINT:PRINT TAB(10) "C=CHANGE DATA":PRINT:PRINT TAB(10) "O=DO NOT ENTER DATA, RETURN TO OPTIONS"
930 X$=INKEY$:DEF SEG=64:POKE 23, (PEEK(23) OR 64):IF X$="E" THEN 950 ELSE IF X$="C" THEN PRINT:PRINT TAB(10) "REENTER":PRINT:GOTO 720 ELSE IF X$="O" THEN 10 ELSE 930
950 FIELD 1, 8 AS D$, 10 AS B$, 10 AS A$, 8 AS E$, 8 AS N$, 8 AS T$, 8 AS R$, 8 AS G$, 8 AS X$:LSET D$=ND$:LSET B$=MKD$(DP):LSET A$=MKD$(AM):LSET E$=MKD$(CHG):LSET N$=MKD$(XT):LSET T$=MKD$(TX):LSET R$=MKD$(RX):LSET G$=MKD$(RA):LSET X$=MKD$(TAX)
1050 PUT 1, CODE%:TAX=0:LSET X$=MKD$(TAX):RETURN
1061 OLD%=1:CLS:COLOR 0,7:PRINT " INSERT DISK CONTAINING THE FILE TO BE READ IN DRIVE B ":COLOR 7,0:PRINT:PRINT:PRINT "ENTER MONTH OF INCOME FILE TO BE READ ";:GOSUB 20050:OMON$=INPT$:FILE$="B:"+"INCOME."+LEFT$(OMON$,3):CLOSE 1:OPEN FILE$ AS 1
1070 CLS:PRINT:PRINT TAB(10) "R=READ ONLY":PRINT:PRINT TAB(10) "P=READ AND PRINT"
1090 PRT$=INKEY$:DEF SEG=64:POKE 23, (PEEK(23) OR 64):IF PRT$="R" OR PRT$="P" THEN CLS:GOTO 1100 ELSE 1090
1100 COLOR 7,0:CLS:COLOR 0,7:PRINT:PRINT: PRINT " PRESS F8 TO READ RECORDS IN SEQUENCE. PRESS F7 TO STOP AT ANY POINT. PRESS F8 WHEN READY TO CONTINUE READING.":COLOR 7,0: PRINT:PRINT
1110 COLOR 0,7:PRINT " IF REVISING FILE, WRITE DOWN RECORD NUMBERS TO BE CHANGED.": PRINT:PRINT: COLOR 7,0
1120 X$=INKEY$:IF X$<>"@" THEN 1120 ELSE KEY(7) ON
1135 IF NOT EOM% THEN 1149
1140 FIELD 1, 8 AS D$:GET 1, LOF(1)/128:CLS:PRINT:PRINT TAB(10) "DATE OF LAST ENTRY IN FILE IS "+D$:PRINT:PRINT TAB(10) "C=CONTINUE END MONTH PROCEDURE":PRINT:PRINT TAB(10) "O=RETURN TO OPTIONS"
1144 XX$=INKEY$:DEF SEG=64:POKE 23, (PEEK(23) OR 64):IF XX$="O" THEN 10 ELSE IF XX$<>"C" THEN 1144
1149 GET 1,1:FIELD 1, 10 AS M$, 5 AS Y$:CLS:PRINT " "+M$;:PRINT " "+Y$;:PRINT " INCOME FILE":PRINT
1190 PRINT " CASH CHARGE ";:FOR N=1 TO 3:PRINT CAT$(N);:NEXT:PRINT " REC ON ACCT. ";:IF JTAX THEN PRINT "TAX":PRINT ELSE PRINT:PRINT
1199 IF REV%=1 THEN 1430
1200 IF PRT$="R" THEN 1290
1210 LPRINT CHR$(15);:WIDTH "LPT1:",132:LPRINT MODE$;:FIELD 1, 10 AS M$, 5 AS Y$, 8 AS H$:LPRINT " "+M$;:LPRINT " "+Y$;:LPRINT " INCOME FILE":LPRINT CHR$(27)CHR$(64)CHR$(15)
1280 LPRINT CHR$(27)CHR$(45)CHR$(1);" DATE DEPOSIT CASH CHARGE ";:LPRINT " ";:FOR I=1 TO 3:LPRINT CAT$(I);:IF I=2 THEN LPRINT " "; ELSE LPRINT " ";
1287 NEXT:LPRINT "REC ON ACCT. ";:IF JTAX THEN LPRINT "TAX REC.NO." ELSE LPRINT " REC.NO."
1289 LPRINT CHR$(27)CHR$(45)CHR$(0)
1290 TDP=0:TAM=0:TCHG=0:TXT=0:TTX=0:TRX=0:TMS=0:TRA=0:TTAX=0:N=0:FOR I=2 TO LOF(1)/128:CODE%=I:GET 1, CODE%:FIELD 1, 8 AS D$, 10 AS B$, 10 AS A$, 15 AS F$, 30 AS S$,5 AS X$:IF LEFT$(X$,1)="M" THEN N=N+1:J(N)=CODE%:GOTO 1480 ELSE 1345
1345 FIELD 1, 8 AS D$, 10 AS B$, 10 AS A$, 8 AS E$, 8 AS N$, 8 AS T$, 8 AS R$, 8 AS G$, 8 AS X$:TDP=TDP+CVD(B$):TAM=TAM+CVD(A$):TCHG=TCHG+CVD(E$):TXT=TXT+CVD(N$):TTX=TTX+CVD(T$):TRX=TRX+CVD(R$):TRA=TRA+CVD(G$):TTAX=TTAX+CVD(X$)
1400 PRINT " "+D$+" DEPOSIT";:PRINT USING DL$;CVD(B$);:PRINT " REC.NO. " CODE%
1430 PRINT USING DL$;CVD(A$);CVD(E$);CVD(N$);CVD(T$);CVD(R$);CVD(G$);:IF JTAX THEN PRINT USING DL$;CVD(X$) ELSE PRINT
1440 IF REV$="R" THEN 2470 ELSE IF PRT$="R" THEN 1480
1450 LPRINT " "+D$;:LPRINT USING"$$########.##";CVD(B$);CVD(A$);CVD(E$);CVD(N$);CVD(T$);CVD(R$);CVD(G$);:IF JTAX THEN LPRINT USING DL$;CVD(X$);
1470 LPRINT " "CODE%
1480 NEXT:NM=N:PRINT:PRINT " MISCELLANEOUS INCOME":PRINT:PRINT " DATE DEPOSIT AMT.RECD. FROM TYPE OF INCOME ":IF PRT$="R" THEN 1560
1530 LPRINT MODE$:LPRINT " MISCELLANEOUS INCOME":LPRINT:LPRINT " DATE DEPOSIT AMT.RECD. FROM TYPE OF INCOME REC.NO.":LPRINT XMOD$;CHR$(15):IF NM=0 THEN PRINT " NONE":LPRINT " NONE"
1560 FOR N=1 TO NM:FIELD 1, 8 AS D$, 10 AS B$, 10 AS A$, 15 AS F$, 30 AS S$,5 AS X$:GET 1,J(N):PRINT "REC.NO. ";:PRINT J(N):PRINT D$;:PRINT USING DL$;CVD(B$);:PRINT USING DL$;CVD(A$);:PRINT " "+F$+" "+S$;
1680 IF CAT$(4)=LEFT$(S$,10) THEN TINT=TINT+CVD(A$) ELSE IF CAT$(5)=LEFT$(S$,10) THEN TREN=TREN+CVD(A$) ELSE INC$(N)=S$:AM(N)=CVD(A$)
1690 TM=TM+CVD(A$):TDP=TDP+CVD(B$):TAM=TAM+CVD(A$):IF PRT$="R" THEN 1760
1720 LPRINT TAB(10) D$;:LPRINT USING DL$;CVD(B$);CVD(A$);:LPRINT " "+F$+" "+S$+" ";:LPRINT J(N)
1760 NEXT:IF EOM% THEN 2020
1775 GET 1,LOF(1)/128:PRINT:COLOR 0,7:PRINT " TOTALS TO DATE ";:PRINT D$:COLOR 7,0:PRINT:PRINT " TOTAL DEPOSITS";:PRINT USING DL$;TDP:PRINT " CASH CHARGE ";:FOR N=1 TO 3:PRINT CAT$(N);:NEXT
1818 PRINT " REC ON ACCT. ";:IF JTAX THEN PRINT "TAX":PRINT ELSE PRINT:PRINT
1820 PRINT USING DL$;TAM;TCHG;TXT;TTX;TRX;TRA;:IF JTAX THEN PRINT USING DL$;TTAX ELSE PRINT
1830 PRINT:PRINT " TOTAL SALES";:PRINT USING DL$;TXT+TTX+TRX+TTAX:IF PRT$="R" THEN 1920
1860 LPRINT MODE$:LPRINT " TOTALS TO DATE":LPRINT:LPRINT CHR$(27)CHR$(45)CHR$(1);" DATE DEPOSIT CASH CHARGE ";:LPRINT " ";:FOR N=1 TO 3:LPRINT CAT$(N);:IF N=2 THEN LPRINT " "; ELSE LPRINT " ";
1877 NEXT:LPRINT "REC ON ACCT. ";:IF JTAX THEN LPRINT "TAX" ELSE LPRINT
1879 LPRINT CHR$(27)CHR$(45)CHR$(0):LPRINT TAB(10) D$;:LPRINT USING "$$########.##";TDP;TAM;TCHG;TXT;TTX;TRX;TRA;:IF JTAX THEN LPRINT USING DL$;TTAX ELSE LPRINT
1900 LPRINT:LPRINT " TOTAL SALES ";:LPRINT USING DL$;TXT+TTX+TRX+TTAX
1920 PRINT:PRINT "CASH RECONCILIATION ";:IF TDP-TAM=0 THEN PRINT "DIFFERENCE=NONE" ELSE IF TDP-TAM<0 THEN PRINT "SHORTAGE";USING DL$;TDP-TAM ELSE PRINT "CASH OVER";USING DL$;TDP-TAM
1940 IF PRT$="R" THEN 1965
1950 LPRINT:LPRINT "CASH RECONCILIATION--------";:IF TDP-TAM=0 THEN LPRINT "DIFFERENCE=NONE" ELSE IF TDP-TAM<0 THEN LPRINT "SHORTAGE";USING DL$;TDP-TAM ELSE LPRINT "CASH OVER";USING DL$;TDP-TAM
1964 LPRINT CHR$(140)
1965 IF OLD% THEN KEY(7) OFF:PRINT:PRINT " PRESS F8 TO RETURN TO OPTIONS. " ELSE 1970
1966 Z$=INKEY$:IF Z$<>"@" THEN 1966 ELSE 10
1970 PRINT:PRINT:PRINT TAB(10) "R=REVISE FILE":PRINT TAB(10) "O=RETURN TO OPTIONS":PRINT TAB(10) "M=RETURN TO MENU":KEY(7) OFF
2000 REV$=INKEY$:DEF SEG=64:POKE 23, (PEEK(23) OR 64):IF REV$="R" THEN FL$="INCOME.CUR":GOSUB 30210:GOTO 2430 ELSE IF REV$="O" THEN 10 ELSE IF REV$="M" THEN RUN "BKPG.BAS" ELSE 2000
2020 OPEN "B:INCOME.TOT" AS 2:LPRINT CHR$(140);:IF LOF(2)/128=0 THEN 2050 ELSE 2110
2050 FOR N=1 TO 15:YTD(N)=0:FIELD 2, 12 AS Q$:LSET Q$=MKD$(YTD(N)):PUT 2, N:NEXT
2110 PRINT:PRINT TAB(10) "INCOME TOTALS":PRINT:GET 1,1:FIELD 1, 10 AS M$, 5 AS Y$, 8 AS H$:PRINT TAB(40) M$ SPC(10) "YTD":LPRINT MODE$:LPRINT " INCOME TOTALS":LPRINT
2160 LPRINT TAB(62) M$;Y$ SPC(7) "YTD" SPC(10) "REC.NO.":LPRINT CHR$(15);:LPRINT XMOD$:CLOSE 4:BKUP=0:OPEN "B:CHECKING.ACC" AS 4:FIELD 4, 12 AS DD$:LSET DD$=MKD$(TDP):PUT 4, 3:CLOSE 4
2170 T(1)=TDP:T(2)=TAM:T(3)=TCHG:T(4)=TXT:T(5)=TTX:T(6)=TRX:T(7)=TRA:T(8)=TTAX:T(9)=TINT:T(10)=TREN:T(11)=TM-TINT-TREN:T(12)=TXT+TTX+TRX+TTAX:T(13)=T(12)-TTX:T(14)=CVD(H$)*TTX/100:T(15)=TDP-TAM:DLX$="$$##########.##":FOR N=1 TO 15:CODE%=N
2190 FIELD 2, 12 AS Q$:IF N=1 THEN LPRINT "DEPOSITS";ELSE IF N=2 THEN LPRINT "CASH RECEIVED"; ELSE IF N=3 THEN LPRINT "CHARGE SALES";ELSE IF N=4 THEN LPRINT CAT$(1); ELSE IF N=5 THEN LPRINT CAT$(2);
2210 IF N=6 THEN LPRINT CAT$(3); ELSE IF N=7 THEN LPRINT"RECEIVED ON ACCOUNT";ELSE IF N=8 AND JTAX=1 THEN LPRINT"SALES TAX COLLECTED";ELSE IF N=9 AND NCAT4<>1 THEN LPRINT CAT$(4); ELSE IF N=10 AND NCAT5<>1 THEN LPRINT CAT$(5);
2220 IF N=11 THEN LPRINT "OTHER INCOME"; ELSE IF N=12 THEN LPRINT "TOTAL SALES";ELSE IF JTAX=1 AND N=13 THEN LPRINT "TAX EXEMPT SALES";ELSE IF JTAX=1 AND N=14 THEN LPRINT "SALES TAX DUE";ELSE IF N=15 THEN LPRINT "CASH OVER OR UNDER (-)";
2226 IF NCAT4 AND N=9 THEN 2290 ELSE IF NCAT5 AND N=10 THEN 2290
2240 GET 2, N:IF SKIP% THEN YTD(N)=CVD(Q$) ELSE IF N=15 THEN YTD(N)=YTD(1)-YTD(2) ELSE YTD(N)=CVD(Q$)+T(N)
2255 IF N=8 AND JTAX=0 THEN 2290 ELSE IF JTAX=0 THEN IF N=13 OR N=14 THEN 2290
2260 IF NCAT4 AND N=9 THEN 2290 ELSE IF NCAT5 AND N=10 THEN 2290
2270 LPRINT SPC(60-LPOS(X)) USING DLX$;T(N);YTD(N);:LPRINT SPC(10) CODE%:LPRINT
2290 LSET Q$=MKD$(YTD(N)):PUT 2, CODE%:NEXT:LPRINT CHR$(140)
2320 PRINT " CHOOSE":PRINT:PRINT TAB(10) "P=PRINT AGAIN":PRINT TAB(10) "R=REVISE FILE":COLOR 0,7:PRINT TAB(10) "C=CONTINUE--WILL REMOVE FILE FROM CURRENT STATUS":COLOR 7,0
2360 X$=INKEY$:DEF SEG=64:POKE 23, (PEEK(23) OR 64):IF X$="P" THEN CLEAR:SKIP%=1:EOM%=1:GOTO 40 ELSE IF X$="R" THEN GOTO 2540 ELSE IF X$="C" THEN 2410 ELSE 2360
2380 OPEN "B:INCOME.CUR" AS 1:SKIP%=1:GOTO 110
2410 FL$="INCOME."+LEFT$(M$,3):GOSUB 30210:NAME "B:INCOME.CUR" AS FL$:CLS:PRINT:COLOR 0,7:PRINT " REMOVE FILE DISK FROM DRIVE B AND INSERT BACKUP DISK." TAB(20)"PRESS F8 WHEN READY ":COLOR 7,0
2416 X$=INKEY$:IF X$<>"@" THEN 2416
2417 NAME "B:INCOME.CUR" AS FL$:PRINT:PRINT:COLOR 0,7:PRINT " REMOVE BACKUP DISK FROM DRIVE B AND ADD INCOME.(MONTH JUST CLOSED) TO BOTH DISK LABELS":PRINT:PRINT" INSERT FILE DISK IN DRIVE B PRESS F8 WHEN READY ":COLOR 7,0
2420 X$=INKEY$:IF X$<>"@" THEN 2420 ELSE RUN "BKPG.BAS"
2430 CLS:PRINT:PRINT TAB(10) "R=REVISE REGULAR INCOME FILE":PRINT:PRINT TAB(10) "M=REVISE MISC. INCOME FILE
2445 TYP$=INKEY$:DEF SEG=64:POKE 23, (PEEK(23) OR 64):IF TYP$="R" THEN 2460 ELSE IF TYP$="M" THEN 2500 ELSE 2445
2460 PRINT "REC.NO. TO BE CHANGED ";:NBR=1:GOSUB 20050:CODE%=VAL(INPT$):NBR=0:FIELD 1, 8 AS D$, 10 AS B$, 10 AS A$, 8 AS E$, 8 AS N$, 8 AS T$, 8 AS R$, 8 AS G$, 8 AS X$
2462 GET 1,CODE%:PRINT D$:PRINT " DEPOSIT ";:PRINT USING DL$;CVD(B$);:PRINT " REC.NO ";:PRINT CODE%:REV%=1:GOTO 1190
2470 GOSUB 720:PRINT "REVISE ANOTHER? Y/N"
2490 X$=INKEY$:DEF SEG=64:POKE 23, (PEEK(23) OR 64):IF X$="Y" THEN 2430 ELSE IF X$="N" THEN 10 ELSE 2490
2500 PRINT "REC.NO. TO BE CHANGED ";:NBR=1:GOSUB 20050:CODE%=VAL(INPT$):NBR=0:FIELD 1, 8 AS D$, 10 AS B$, 10 AS A$, 15 AS F$, 30 AS S$, 5 AS X$:GET 1,CODE%:PRINT " DATE DEPOSIT AMT.RECD. FROM TYPE OF EXPENSE "
2503 PRINT D$;:PRINT USING DL$;CVD(B$);CVD(A$);:PRINT " "+F$+" "+S$:GOSUB 510:PRINT "REVISE ANOTHER? Y/N"
2530 X$=INKEY$:IF X$="Y" THEN 2500 ELSE IF X$="N" THEN 10 ELSE 2530
2540 CLS
2550 PRINT "REC.NO. TO BE CHANGED ";:NBR=1:GOSUB 20050:CODE%=VAL(INPT$):NBR=0:N=CODE%:INPUT "NEW AMOUNT ";:NBR=1:INLN%=12:GOSUB 20050:YTD(N)=VAL(INPT$):NBR=0:FIELD 2, 12 AS Q$:LSET Q$=MKD$(YTD(N)):PUT 2,CODE%:GOSUB 2640
2620 PRINT "REVISE ANOTHER? Y/N"
2630 X$=INKEY$:IF X$="Y" THEN 2540 ELSE IF X$="N" THEN 2320 ELSE 2630
2640 FOR N=1 TO 20:GET 2, N:T(N)=CVD(Q$):NEXT:IF ABS(T(2)+T(3)-T(12)-T(7)-T(9)-T(10)-T(11))>0.005000001 THEN COLOR 0,7:PRINT " ERROR IN REC.NO. 2,3,12,7,9,10,OR 11":COLOR 7,0:GOTO 2540
2660 IF ABS(T(1)-T(2)-T(15))>0.005000001 THEN COLOR 0,7:PRINT " ERROR IN REC.NO. 1,2,OR 15":COLOR 7,0:GOTO 2550
2670 IF ABS(CVD(H$)*T(5)/100-T(14))>0.005000001 THEN COLOR 0,7:PRINT " ERROR IN REC.NO. 5 OR 14":COLOR 7,0:GOTO 2550
2680 IF ABS(T(4)+T(5)+T(6)+T(8)-T(12))>0.005000001 THEN COLOR 0,7:PRINT " ERROR IN REC.NO. 4,5,6,8,OR 12":COLOR 7,0:GOTO 2550
2690 IF ABS(T(12)-T(13)-T(5))>0.005000001 THEN COLOR 0,7:PRINT " ERROR IN REC.NO. 5,12,OR 13":COLOR 7,0:GOTO 2550
2700 GOTO 2620
2900 KEY(7) OFF:Z$=INKEY$:IF Z$<>"@" THEN 2900 ELSE DEF SEG:POKE 106,0:KEY(7) ON:RETURN
3000 IF ERR=71 THEN COLOR 0,7:PRINT " FILE DISK NOT IN DRIVE B OR PROGRAM DISK NOT IN DRIVE A OR A DRIVE DOOR IS OPEN. CORRECT PROBLEM AND PRESS F8 WHEN READY. ":GOTO 3050
3010 IF ERR=24 OR ERR=27 THEN COLOR 0,7:PRINT " PRINTER NOT ON OR OUT OF PAPER SET TOP OF PAGE AND TURN ON PRINTER. PRESS F8 WHEN READY ":GOTO 3050
3030 PRINT " AN UNDEFINED ERROR HAS OCCURRED":PRINT:PRINT " PRESS F8 TO RETURN TO OPTIONS."
3040 ER$=INKEY$:IF ER$<>"@" THEN 3040 ELSE 10
3050 ER$=INKEY$:IF ER$<>"@" THEN 3050 ELSE DEF SEG:POKE 106,0:COLOR 7,0:CLS:RESUME
4000 CLS:OPEN "INCOME.FIL" AS 3:FIELD 3, 10 AS A$(1), 10 AS A$(2), 10 AS A$(3), 10 AS A$(4), 10 AS A$(5), 10 AS A$(6)
4030 LOCATE 4,11:PRINT "THERE ARE 3 CATEGORIES OF REGULAR INCOME (USUALLY CASH REGISTER DEPARTMENTS)":LOCATE 6,11:PRINT "THE 2ND CATEGORY IS TAXABLE SALES. NO OTHER CATEGORY MAY INCLUDE TAXABLE SALES."
4035 LOCATE 8,11:PRINT "IF THERE WILL BE NO TAXABLE SALES, THIS CATEGORY CAN BE CHANGED.":LOCATE 10,11:PRINT "DO NOT USE TAX AS A CATEGORY. IT IS A FIXED CATEGORY IF THERE IS TAXABLE SALES"
4040 LOCATE 12,11:PRINT "TO LEAVE CATEGORY AS IS, JUST PRESS ENTER.":PRINT STRING$(79,45):LOCATE 15,27:PRINT "REGULAR INCOME CATEGORIES":FOR N=1 TO 3:LOCATE CSRLIN+1,11:PRINT "CATEGORY "N" "+CAT$(N);:LOCATE CSRLIN,28:INLN%=8:GOSUB 20050:NEXT
4100 ALOC=15:FOR N=1 TO 3:ALOC=ALOC+2:FOR J=28 TO 35:TCAT$(N)=TCAT$(N)+CHR$(SCREEN(ALOC,J)):NEXT:NEXT:CLS:LOCATE 4,11:PRINT " THERE ARE 2 CATAGORIES OF MISCELLANEOUS INCOME THAT WILL BE TOTTALLED."
4210 LOCATE 6,11: PRINT "ALL OTHER MISC. INCOME WILL BE TOTALLED AS MISCELLANEOUS":LOCATE 8,11:PRINT "USE COMMONLY RECEIVED CATEGORIES e.g. RENTS, INTEREST, ETC.":LOCATE 10,11:PRINT "TO LEAVE CATEGORY AS IS, JUST PRESS ENTER":PRINT STRING$(79,45)
4240 LOCATE 15,25:PRINT "MISCELLANEOUS INCOME CATEGORIES":LOCATE 17,11:PRINT "CATEGORY 1 "+CAT$(4):LOCATE 17,28:INLN%=8:GOSUB 20050:LOCATE 19,11:PRINT "CATEGORY 2 "+CAT$(5):LOCATE 19,28:INLN%=8:GOSUB 20050
4290 ALOC=15:FOR N=1 TO 2:ALOC=ALOC+2:FOR J=28 TO 35:TCAT$(N+3)=TCAT$(N+3)+CHR$(SCREEN(ALOC,J)):NEXT:NEXT:TCAT$(6)="MISCELLANEOUS":FOR N=1 TO 6:LSET A$(N)=TCAT$(N):NEXT:PUT 3,1:CLOSE 3:GOTO 10
20050 INPT$="":INPOS%=POS(0):DEF SEG=64:POKE 23, (PEEK(23) OR 64):POKE 23, (PEEK(23) OR 32):LOCATE,,1,6,7:IF INLN%=0 THEN INLN%=10
20110 IP$=INKEY$:IF IP$="" THEN 20110
20130 IF NBR THEN IF ASC(IP$)>57 THEN BEEP:GOTO 20110
20140 IF NBR THEN IF ASC(IP$)<48 AND ASC(IP$)<>46 THEN IF ASC(IP$)<>8 AND ASC(IP$)<>13 THEN IF ASC(IP$)<> 45 THEN BEEP:GOTO 20110
20150 IF ASC(IP$)=29 THEN BEEP:GOTO 20110
20155 IF ASC(IP$)=27 THEN 10
20160 IP$=CHR$(ASC(IP$)+32*(IP$>="a" AND IP$<="z")):IF LEN(INPT$)=INLN% THEN IF ASC(IP$)<>13 AND ASC(IP$)<>8 THEN 20110
20180 IF ASC(IP$)=13 THEN PRINT:GOTO 20240
20190 IF ASC(IP$)=8 AND POS(0)=INPOS% THEN 20110
20200 IF ASC(IP$)=8 THEN GOSUB 20250:GOTO 20110
20210 INPT$=INPT$+IP$:PRINT IP$;:GOTO 20110
20240 INLN%=0:RETURN
20250 IF INPT$="" THEN 20110
20260 INPT$=LEFT$(INPT$,LEN(INPT$)-1):LOCATE CSRLIN,POS(0)-1:PRINT " ";:LOCATE CSRLIN,POS(0)-1:RETURN
30210 IF BKUP THEN 30220 ELSE OPEN "B:BACKUP.FIL" AS 4:BKUP=1
30220 FIELD 4, 14 AS A$:IF LOF(4)/128=0 THEN 30280
30240 FOR N=1 TO LOF(4)/128:GET 4,N:IF FL$+STRING$(14-LEN(FL$),32)=A$ THEN 30300
30270 NEXT
30280 LSET A$=FL$:PUT 4, LOF(4)/128+1
30300 RETURN
60000 XX$=INKEY$:IF XX$<>"C" THEN 60000
60010 PRINT "OK"
NOTES472.TXT
SIMPLIFIED BUSINESS BOOKKEEPING
Copyright 1985 by Donald Paritz
All of these programs are menu driven. The file BKPG.DOC should be read through
one time, however, to obtain a general overview of the operation as well as
pitfalls to avoid in data entry, file handling, disk handling, etc..
In any case IT IS ABSOLUTELY NECESSARY TO READ AND RUN THE START UP PROCEDURE
since the program disk provided is not an operating disk.
CHECK PRINTING
Checks suitable for this program may be obtained from many sources. They
must have a blank top stub and be compatible with BPI, Accounting Plus or IMS
Software. One source is:
NEBS Computer Forms
12 South St. Form #9024
Townsend, Ma. 01469
1-800=225-9550 To obtain samples.
BILLING
Statements must be of the type compatible with Apple, SBSG, or Star Software
systems. One source is NEBS Computer Forms (See address in expense program
section of BKPG.DOC). Their catalog number is #9060.
If you find this software useful in your business, a contribution of $35.00
would be appreciated to enable continued developement of this and similar
programs.
Send to:
Donald Paritz
Box 602
Johnson, Vt. 05656
Thank you
PAYROLL.BAS
10 CLS:KEY 8, "@"
30 COLOR 0,7:PRINT TAB(10)"REMOVE PROGRAM DISK FROM DRIVE A AND INSERT PAYROLL DISK.":PRINT:PRINT TAB(10)"CURRENT EXPENSE FILE DISK MUST BE IN DRIVE B.":PRINT:PRINT TAB(10)"READY PRINTER.":PRINT:PRINT TAB(10) "PRESS F8 WHEN READY.":COLOR 7,0
40 X$=INKEY$:IF X$<>"@" THEN 40
50 CLS:CLEAR,,1536:PRINT TAB(5) "CHOOSE":PRINT:ON ERROR GOTO 7000
55 FOR N=1 TO 10:KEY N,"":NEXT:KEY 8, "@":DL$="$$######.##":MODE$=CHR$(27)+CHR$(45)+CHR$(1)+CHR$(27)+CHR$(71)+CHR$(27)+CHR$(78)+CHR$(6):DEFDBL A-Z:DEFINT N,I,J:XMOD$=CHR$(27)+CHR$(45)+CHR$(0)+CHR$(27)+CHR$(72):PAYROLL=1:OPEN "A:EMPLOYEE.CNT" AS 2
140 FIELD 2, 20 AS AA$, 15 AS BB$, 2 AS CC$, 9 AS DD$
160 PRINT TAB(10) "W=WEEKLY PAYROLL (AUTOMATIC)":PRINT:PRINT TAB(10) "I=PAY INDIVIDUAL (MANUAL)":PRINT:PRINT TAB(10)"M=END MONTH (QUARTER AND YEAR ALSO IF LAST MONTH OF EITHER)":PRINT:PRINT TAB(10)"O=RETURN TO EXPENSE PROGRAM OPTIONS
170 PRINT:PRINT TAB(10)"E=CREATE,READ,REVISE EMPLOYEE DATA FILE":PRINT:PRINT TAB(10)"D=CREATE,READ,REVISE PAYROLL DEDUCTIONS FILE":PRINT:PRINT TAB(10)"R=READ PAYROLL FILE":PRINT:PRINT:PRINT TAB(10)"F=PREPARE NEW FILE DISKS (NOT IF FIRST USE OF SYSTEM)"
175 PRINT:PRINT TAB(10) "B=ALPHABETIZE EMPLOYEE LIST"
180 X$=INKEY$:DEF SEG=64:POKE 23, (PEEK(23) OR 64):POKE 23, (PEEK(23) OR 32)
200 IF X$="W" OR X$="I" THEN 2840 ELSE IF X$="M" THEN FL$="CHKDSC":GOSUB 30210:CLOSE 4:BKUP=0:GOTO 2840 ELSE IF X$="O" THEN 30000 ELSE IF X$="E" THEN 240 ELSE IF X$="D" THEN 8000 ELSE IF X$="R" THEN 2920 ELSE IF X$="F" THEN 7300
210 IF X$="B" THEN 50000 ELSE 180
240 CLS:PRINT:PRINT TAB(10) "A=REHIRE EMPLOYEE WHO HAS ALREADY WORKED IN THIS CALENDER YEAR":PRINT:PRINT TAB(10) "N=HIRE NEW EMPLOYEEE":PRINT:PRINT TAB(10) "R=READ OR REVISE EMPLOYEE'S FILE OR DELETE EMPLOYEE"
260 EMD$=INKEY$:IF EMD$="" THEN 260
280 DEF SEG=64:POKE 23, (PEEK(23) OR 64):IF EMD$="A" THEN PRINT:PRINT "AFTER READING EMPLOYEE DATA ON FILE FOR THIS EMPLOYEE, REVISE DATA AS NECESSARY. PRESS F8 TO CONTINUE.":GOTO 300 ELSE 310
300 X$=INKEY$:IF X$<>"@" THEN 300 ELSE 1490
310 IF EMD$="R" THEN 1490 ELSE IF EMD$="N" THEN ES$="CURRENT":GOSUB 320:GOTO 400 ELSE 260
320 CLS
330 PRINT "ENTER EMPLOYEE'S LAST NAME ";:INLN%=20:GOSUB 20050:NAM2$=INPT$:PRINT "ENTER EMPLOYEE'S FIRST NAME ";:INLN%=15:GOSUB 20050:NAM1$=INPT$:PRINT "ENTER EMPLOYEE'S MIDDLE INITIAL ";:INLN%=2:GOSUB 20050:MDL$=LEFT$(INPT$,1)+".":RETURN
400 PRINT "ENTER STREET ADDRESS OR BOX NO. ";:INLN%=35:GOSUB 20050:ADR$=INPT$:IF REC1 THEN RETURN
430 PRINT "ENTER CITY,STATE,ZIP ";:INLN%=35:GOSUB 20050:CITY$=INPT$:IF REC1 THEN RETURN
460 PRINT "ENTER PHONE NUMBER ";:INLN%=13:GOSUB 20050:PHN$=INPT$:IF REC1 THEN RETURN
490 PRINT "ENTER SOCIAL SECURITY NUMBER ";:INLN%=15:GOSUB 20050:SS$=INPT$:IF REC2 THEN RETURN
520 PRINT "ENTER PROFESSIONAL LIC. NO. ";:INLN%=15:GOSUB 20050:PRF$=INPT$:IF REC2 THEN RETURN
550 PRINT "ENTER DRIVERS LICENSE NUMBER ";:INLN%=15:GOSUB 20050:DRV$=INPT$:IF REC2 THEN RETURN
580 PRINT "ENTER START DATE ";:INLN%=8:GOSUB 20050:SD$=INPT$:IF REC2 THEN RETURN
610 PRINT "ENTER M IF MARRIED S IF SINGLE ";:INLN%=1:GOSUB 20050:MAR$=INPT$:IF MAR$<>"M" AND MAR$<>"S" THEN PRINT " PLEASE ENTER M OR S ONLY":GOTO 610
640 IF REC2 THEN RETURN
650 PRINT "ENTER EXEMPTIONS CLAIMED ";:NBR=1:INLN%=2:GOSUB 20050:EXM%=VAL(INPT$):NBR=0:IF REC2 THEN EM%=1:RETURN
680 PRINT "ENTER S IF SALARY H IF HOURLY ";:INLN%=1:GOSUB 20050:RAT$=INPT$:IF RAT$<>"S" AND RAT$<>"H" THEN PRINT " PLEASE ENTER H OR S ONLY":GOTO 680
710 IF REC2 THEN RETURN
720 PRINT "ENTER WEEKLY OR HOURLY RATE ";:NBR=1:INLN%=7:GOSUB 20050:SAL=VAL(INPT$):NBR=0:IF REC2 THEN SL%=1:RETURN
750 PRINT "ENTER EMPLOYEE NUMBER IF NEEDED. JUST PRESS ENTER IF NONE. ";:INLN%=6:GOSUB 20050:ENO$=INPT$:IF REC2 THEN RETURN
780 PRINT "ENTER TYPE OF 1ST MISC. DEDUCT. JUST PRESS ENTER IF NONE. ";:INLN%=15:GOSUB 20050:MIS1$=INPT$:IF REC3 THEN 820
810 IF MIS1$="" THEN MIS1=0:MIS2=0:MIS3=0:GOTO 990
820 PRINT "ENTER AMT. OF 1ST MISC. DEDUCT. ";:NBR=1:INLN%=7:GOSUB 20050:MIS1=VAL(INPT$):NBR=0:IF REC3 THEN RETURN
850 PRINT "ENTER TYPE OF 2ND MISC. DEDUCT. JUST PRESS ENTER IF NONE. ";:INLN%=15:GOSUB 20050:MIS2$=INPT$:IF REC3 THEN 890
880 IF MIS2$="" THEN MIS2=0:MIS3=0:GOTO 990
890 PRINT "ENTER AMT. OF 2ND MISC. DEDUCT. ";:NBR=1:INLN%=7:GOSUB 20050:MIS2=VAL(INPT$):NBR=0:IF REC3 THEN RETURN
920 PRINT "ENTER TYPE OF 3RD MISC. DEDUCT. JUST PRESS ENTER IF NONE. ";:INLN%=15:GOSUB 20050:MIS3$=INPT$:IF REC3 THEN 960
950 IF MIS3$="" THEN MIS3=0:GOTO 990
960 PRINT "ENTER AMT. OF 3RD MISC. DEDUCT. ";:NBR=1:INLN%=7:GOSUB 20050:MIS3=VAL(INPT$):NBR=0:IF REC3 THEN RETURN
990 PRINT "ENTER 1 FOR REGULAR FED. WITHHOLD. ENTER PERCENT IF FIXED PERCENT. ENTER 0 IF EXEMPT. ";
1000 NBR=1:INLN%=6:GOSUB 20050:FWITH=VAL(INPT$):NBR=0:IF REC3 THEN FW%=1:RETURN
1020 PRINT "ENTER 1 FOR REGULAR STATE WITHHOLD. ENTER PERCENT IF FIXED PERCENT. ENTER 0 IF NO STATE WITHHOLDING OR IF EXEMPT. ";
1030 NBR=1:INLN%=6:GOSUB 20050:SWITH=VAL(INPT$):NBR=0:IF REC3 THEN SW%=1:RETURN
1050 PRINT "ENTER 1 FOR REGULAR CITY WITHHOLD. ENTER PERCENT IF FIXED PERCENT. ENTER 0 IF NO CITY WITHHOLDING OR IF EXEMPT. ";
1060 NBR=1:INLN%=6:GOSUB 20050:CWITH=VAL(INPT$):NBR=0:IF REC3 THEN CW%=1:RETURN
1080 FL$="A:"+LEFT$(NAM2$,8)+"."+LEFT$(NAM1$,3):OPEN FL$ AS 3:FIELD 3, 8 AS A$, 20 AS B$, 15 AS C$, 2 AS CA$, 35 AS D$, 35 AS E$, 13 AS F$:LSET A$=ES$:LSET B$=NAM2$:RSET C$=NAM1$:RSET CA$=MDL$:LSET D$=ADR$:LSET E$=CITY$:LSET F$=PHN$:PUT 3,1
1190 FIELD 3, 15 AS G$, 15 AS H$, 15 AS I$, 8 AS J$, 1 AS K$, 2 AS L$, 1 AS M$, 8 AS N$, 6 AS O$:LSET G$=SS$:LSET H$=PRF$:LSET I$=DRV$:LSET J$=SD$:LSET K$=MAR$:LSET L$=MKI$(EXM%):LSET M$=RAT$:LSET N$=MKS$(SAL):LSET O$=ENO$:PUT 3,2
1300 FIELD 3, 15 AS P$, 8 AS Q$, 15 AS R$, 8 AS S$, 15 AS T$, 7 AS U$, 7 AS V$, 7 AS W$, 7 AS Z$:LSET P$=MIS1$:LSET Q$=MKS$(MIS1):LSET R$=MIS2$:LSET S$=MKS$(MIS2):LSET T$=MIS3$:LSET U$=MKS$(MIS3):LSET V$=MKS$(FWITH):LSET W$=MKS$(SWITH)
1390 LSET Z$=MKS$(CWITH):PUT 3,3:GOSUB 30210:CLOSE 3:LSET AA$=NAM2$:LSET BB$=NAM1$:LSET CC$=MDL$:LSET DD$="CURRENT":PUT 2, LOF(2)/128+1:IF REC1 THEN RETURN
1480 GOTO 50
1490 CLS
1500 GOSUB 330:FOR N=1 TO LOF(2)/128:GET 2,N:IF NAM2$=LEFT$(AA$,LEN(NAM2$)) AND NAM1$=LEFT$(BB$,LEN(NAM1$)) THEN IF LEFT$(MDL$,1)="." OR LEFT$(MDL$,1)=LEFT$(CC$,1) THEN 1590 ELSE 1540
1540 NEXT:PRINT "NAME NOT FOUND. CHECK SPELLING AND REENTER PRESS R TO REENTER PRESS O TO RETURN TO OPTIONS"
1560 X$=INKEY$:DEF SEG=64:POKE 23, (PEEK(23) OR 64):IF X$="R" THEN 1500 ELSE IF X$="O" THEN 50 ELSE 1560
1590 FL$="A:"+LEFT$(AA$,8)+"."+LEFT$(BB$,3):NAM2$="":OPEN FL$ AS 3:GOSUB 30210:FIELD 3, 8 AS A$, 20 AS B$, 15 AS C$, 2 AS CA$, 35 AS D$, 35 AS E$, 13 AS F$:GET 3,1:IF EMD$="A" THEN LSET A$="CURRENT":PUT 3,1
1635 PRINT TAB(10) "R=READ ONLY":PRINT:PRINT TAB(10)"P=READ AND PRINT(TURN ON PRINTER)
1650 PRT$=INKEY$:DEF SEG=64:POKE 23, (PEEK(23) OR 64):IF PRT$<>"P" AND PRT$<>"R" THEN 1650
1680 CLS:GET 3,1:IF PRT$="P" THEN PRT=1
1705 FOR NS=1 TO LEN(C$):IF MID$(C$,NS,1)<>CHR$(32) THEN NOM$=MID$(C$,NS) ELSE NEXT
1710 PRINT "1. NAME " SPC(25) NOM$+" ";:IF LEFT$(CA$,1)=" " THEN PRINT " "+B$ ELSE PRINT CA$+" "+B$
1720 IF PRT THEN LPRINT "NAME " SPC(25) NOM$+" ";:IF LEFT$(CA$,1)=" " THEN LPRINT " "+B$ ELSE LPRINT CA$+" "+B$
1730 PRINT "2. EMPLOYEE STATUS ";:IF PRT THEN LPRINT "EMPLOYEE STATUS ";
1750 IF LEFT$(A$,3)="CUR" THEN PRINT SPC(14)"CURRENT" ELSE PRINT SPC(14)"EMPLOYMENT ENDED "+A$
1760 IF PRT THEN IF LEFT$(A$,3)="CUR" THEN LPRINT SPC(14)"CURRENT" ELSE LPRINT SPC(14) "EMPLOYMENT ENDED "+A$
1770 PRINT "3. ADDRESS" SPC(25) D$:IF PRT THEN LPRINT "ADDRESS" SPC(25) D$
1790 PRINT "4. CITY,STATE,ZIP" SPC(18) E$:IF PRT THEN LPRINT "CITY,STATE,ZIP" SPC(18) E$
1810 PRINT "5. PHONE NUMBER" SPC(20) F$:IF PRT THEN LPRINT "PHONE NUMBER" SPC(20)F$
1830 FIELD 3, 15 AS G$, 15 AS H$, 15 AS I$, 8 AS J$, 1 AS K$, 2 AS L$, 1 AS M$, 8 AS N$, 6 AS O$:GET 3,2:PRINT "6. SOCIAL SECURITY NO." SPC(13) G$:IF PRT THEN LPRINT "SOCIAL SECURITY NO." SPC(13) G$
1870 PRINT "7. PROFESSIONAL LICENSE NO." SPC(8) H$:IF PRT THEN LPRINT "PROFESSIONAL LICENSE NO." SPC(8)H$
1890 PRINT "8. DRIVERS LICENSE NO." SPC(13) I$:IF PRT THEN LPRINT "DRIVERS LICENSE NO." SPC(13) I$
1910 PRINT "9. START DATE" SPC(22) J$:IF PRT THEN LPRINT "START DATE" SPC(22)J$
1930 PRINT "10. MARRITAL STATUS" SPC(17) K$:IF PRT THEN LPRINT "MARRITAL STATUS" SPC(17) K$
1950 PRINT "11. EXEMPTIONS CLAIMED";:PRINT SPC(13) CVI(L$):IF PRT THEN LPRINT "EXEMPTIONS CLAIMED";:LPRINT SPC(13) CVI(L$)
1970 PRINT "12. PAY TYPE";:IF LEFT$(M$,1)="H" THEN PRINT SPC(24)"HOURLY" ELSE PRINT SPC(24) "SALARY"
1980 IF PRT THEN LPRINT "PAY TYPE";:IF LEFT$(M$,1)="H" THEN LPRINT SPC(24)"HOURLY" ELSE LPRINT SPC(24) "SALARY"
1990 PRINT "13. RATE";:PRINT SPC(22) USING DL$;CVS(N$);:PRINT " PER ";:IF LEFT$(M$,1)="H" THEN PRINT "HOUR" ELSE PRINT "WEEK"
2000 IF PRT THEN LPRINT "RATE";:LPRINT SPC(22) USING DL$;CVS(N$);:LPRINT " PER ";:IF LEFT$(M$,1)="H" THEN LPRINT "HOUR" ELSE LPRINT "WEEK"
2010 PRINT "14. EMPLOYEE NO." SPC(20) O$:IF PRT THEN LPRINT "EMPLOYEE NO." SPC(20) O$
2030 GET 3,3:FIELD 3, 15 AS P$, 8 AS Q$, 15 AS R$, 8 AS S$, 15 AS T$, 7 AS U$, 7 AS V$, 7 AS W$, 7 AS Z$:IF LEFT$(P$,1)=CHR$(32) THEN PRINT "15. MISCELLANEOUS DEDUCTION" ELSE PRINT "15. "+P$+" DEDUCTION ";:PRINT USING DL$;CVS(Q$)
2060 IF PRT THEN IF LEFT$(P$,1)=CHR$(32) THEN LPRINT "MISCELLANEOUS DEDUCTION" ELSE LPRINT P$+" DEDUCTION ";:LPRINT USING DL$;CVS(Q$)
2070 IF LEFT$(R$,1)=CHR$(32) THEN PRINT "16. MISCELLANEOUS DEDUCTION" ELSE PRINT "16. "+R$+" DEDUCTION ";:PRINT USING DL$;CVS(S$)
2080 IF PRT THEN IF LEFT$(R$,1)=" " THEN LPRINT "MISCELLANEOUS DEDUCTION" ELSE LPRINT R$+" DEDUCTION ";:LPRINT USING DL$;CVS(S$)
2090 IF LEFT$(T$,1)=CHR$(32) THEN PRINT "17. MISCELLANEOUS DEDUCTION" ELSE PRINT "17. "+T$+" DEDUCTION ";:PRINT USING DL$;CVS(U$)
2100 IF PRT THEN IF LEFT$(T$,1)=" " THEN LPRINT "MISCELLANEOUS DEDUCTION" ELSE LPRINT T$+" DEDUCTION ";:LPRINT USING DL$;CVS(U$)
2110 FWITH=CVS(V$):PRINT "18. FEDERAL WITHHOLDING ";:IF FWITH<0.9 THEN PRINT "EXEMPT" ELSE IF FWITH<1.1 THEN PRINT "REGULAR" ELSE PRINT USING "##.##%";CVS(V$)
2130 IF PRT THEN LPRINT "FEDERAL WITHHOLDING ";:IF CVS(V$)<0.9 THEN LPRINT "EXEMPT" ELSE IF CVS(V$)<1.1 THEN LPRINT "REGULAR" ELSE LPRINT USING "##.##%";CVS(V$)
2140 PRINT "19. STATE WITHHOLDING ";:IF CVS(W$)<0.9 THEN PRINT "NO STATE TAX OR EXEMPT" ELSE IF CVS(W$)<1.1 THEN PRINT "REGULAR" ELSE PRINT USING "##.##%";CVS(W$)
2150 IF PRT THEN LPRINT "STATE WITHHOLDING ";:IF CVS(W$)<0.9 THEN LPRINT "NO STATE TAX OR EXEMPT" ELSE IF CVS(W$)<1.1 THEN LPRINT "REGULAR" ELSE LPRINT USING "##.##%";CVI(W$)
2160 PRINT "20. CITY WITHHOLDING ";:IF CVS(Z$)<0.9 THEN PRINT "NO CITY TAX OR EXEMPT" ELSE IF CVS(Z$)<1.1 THEN PRINT "REGULAR" ELSE PRINT USING "##.##%";CVS(Z$)
2170 IF PRT THEN LPRINT "CITY WITHHOLDING ";:IF CVS(Z$)<0.9 THEN LPRINT "NO CITY TAX OR EXEMPT" ELSE IF CVS(Z$)<1.1 THEN LPRINT "REGULAR" ELSE LPRINT USING "##.##%";CVS(Z$):LPRINT:LPRINT
2175 IF PRT THEN LPRINT CHR$(140)
2180 PRINT:PRINT TAB(2) "A=READ ANOTHER R=REVISE FILE D=DELETE EMPLOYEE O=RETURN TO OPTIONS"
2190 X$=INKEY$:DEF SEG=64:POKE 23, (PEEK(23) OR 64):IF X$="A" THEN CLOSE 3:GOTO 1490 ELSE IF X$="R" THEN 2310 ELSE IF X$="D" THEN 2220 ELSE IF X$="O" THEN CLOSE:GOTO 50 ELSE 2190
2220 CLS:PRINT "ENTER DATE EMPLOYMENT ENDED ";:INLN%=8:GOSUB 20050:ES$=INPT$:GET 3,1:FIELD 3, 8 AS A$:LSET A$=ES$:PUT 3,1:GOSUB 30210:GET 2, LOC(2):GOSUB 2810:CLOSE:GOTO 50
2310 '
2320 LOCATE 21,1:PRINT STRING$(239,32):LOCATE 21,1:PRINT "ENTER NUMBER OF DATA TO BE CHANGED (ENTER 0 IF FINISHED) ";:INLN%=2:NBR=1:GOSUB 20050:I=VAL(INPT$):NBR=0:IF I=0 THEN 2430 ELSE IF I<6 THEN REC1=1 ELSE IF I<15 THEN REC2=1 ELSE REC3=1
2360 LOCATE 21,1:PRINT STRING$(79,32):LOCATE 21,1:ON I GOSUB 330,2400,400,430,460,490,520,550,580,610,650,680,720,750,780,850,920,990,1020,1050:GOTO 2320
2390 GOTO 2430
2400 PRINT "ENTER DATE EMPLOYMENT ENDED OR ENTER CURRENT ";:INLN%=8:GOSUB 20050:ES$=INPT$:ES=1:RETURN
2430 IF REC1 THEN 2440 ELSE 2520
2440 GET 3,1:FIELD 3, 8 AS A$, 20 AS B$, 15 AS C$, 2 AS CA$, 35 AS D$, 35 AS E$, 13 AS F$:IF ES=1 THEN LSET A$=ES$:GET 2, LOC(2):GOSUB 2810
2470 IF NAM2$<>"" THEN LSET B$=NAM2$:RSET C$=NAM1$:RSET CA$=MDL$:GOSUB 2760:NAME FL$ AS LEFT$(AA$,8)+"."+LEFT$(BB$,3):FL$=LEFT$(AA$,8)+"."+LEFT$(BB$,3)
2480 IF ADR$<>"" THEN LSET D$=ADR$
2490 IF CITY$<>"" THEN LSET E$=CITY$
2500 IF PHN$<>"" THEN LSET F$=PHN$
2510 PUT 3,1:GOSUB 30210
2520 IF REC2 THEN 2530 ELSE 2650
2530 GET 3,2:FIELD 3, 15 AS G$, 15 AS H$, 15 AS I$, 8 AS J$, 1 AS K$, 2 AS L$, 1 AS M$, 8 AS N$, 6 AS O$:IF SS$<>"" THEN LSET G$=SS$
2560 IF PRF$<>"" THEN LSET H$=PRF$
2570 IF DRV$<>"" THEN LSET I$=DRV$
2580 IF SD$<>"" THEN LSET J$=SD$
2590 IF MAR$<>"" THEN LSET K$=MAR$
2600 IF EM% THEN LSET L$=MKI$(EXM%)
2610 IF RAT$<>"" THEN LSET M$=RAT$
2620 IF SL% THEN LSET N$=MKS$(SAL)
2630 IF ENO$<>"" THEN LSET O$=ENO$
2640 PUT 3,2:GOSUB 30210
2650 IF REC3 THEN 2660 ELSE 2750
2660 GET 3,3:FIELD 3, 15 AS P$, 8 AS Q$, 15 AS R$, 8 AS S$, 15 AS T$, 7 AS U$, 7 AS V$, 7 AS W$, 7 AS Z$:IF LEFT$(P$,5)<>" " AND MIS1$=" " THEN LSET P$=MIS1$:LSET Q$=MKS$(0) ELSE IF MIS1$<>"" THEN LSET P$=MIS1$:LSET Q$=MKS$(MIS1)
2690 IF LEFT$(R$,5)<>" " AND MIS2$=" " THEN LSET R$=MIS2$:LSET S$=MKS$(0) ELSE IF MIS2$<>"" THEN LSET R$=MIS2$:LSET S$=MKS$(MIS2)
2700 IF LEFT$(T$,5)<>" " AND MIS3$=" " THEN LSET T$=MIS3$:LSET U$=MKS$(0) ELSE IF MIS3$<>"" THEN LSET T$=MIS3$:LSET U$=MKS$(MIS3)
2710 IF FW% THEN LSET V$=MKS$(FWITH)
2720 IF SW% THEN LSET W$=MKS$(SWITH)
2730 IF CW% THEN LSET Z$=MKS$(CWITH)
2740 PUT 3,3:GOSUB 30210
2750 GOTO 50
2760 GET 2, LOC(2):LSET AA$=NAM2$:LSET BB$=NAM1$:LSET CC$=MDL$:IF ES=0 THEN 2820
2810 LSET DD$=ES$
2820 PUT 2, LOC(2):RETURN
2840 CLS
2850 PRINT "ENTER FIRST 3 LETTERS OF MONTH ";:INLN%=3:GOSUB 20050:MON$=INPT$
2870 PRINT "ENTER DATE PAY PERIOD ENDED AS XX-XX-XX ";:INLN%=8:GOSUB 20050:PD$=INPT$:IF VAL(LEFT$(PD$,2))>12 THEN 2870 ELSE CH=VAL(LEFT$(PD$,2)):FOR N=1 TO CH:READ MO$:NEXT:IF MON$=MO$ THEN 2920
2900 PRINT:PRINT"MONTH DOES NOT MATCH DATE, PLEASE REENTER":RESTORE:GOTO 2850
2910 DATA JAN,FEB,MAR,APR,MAY,JUN,JUL,AUG,SEP,OCT,NOV,DEC
2920 OPEN "A:DEDUCT.FIL" AS 4:FIELD 4, 8 AS A$, 10 AS B$:GET 4,1:STATE$=A$:STAT=CVD(B$):GET 4,2:CITY$=A$:CIT=CVD(B$):GET 4,3:FIC=CVD(A$):FMAX=CVD(B$):GET 4,4:SUMP=CVD(A$):SMAX=CVD(B$):GET 4,5:FUMP=CVD(A$):EFIC=CVD(B$):GET 4,6:AL=CVD(A$)
3050 FIELD 4, 10 AS A$, 10 AS B$, 10 AS C$, 10 AS D$:DIM LOW(18), HIGH(18), FED(18), FEDP(18):FOR N=7 TO 23:GET 4,N:LOW(N-6)=CVD(A$):HIGH(N-6)=CVD(B$):FED(N-6)=CVD(C$):FEDP(N-6)=CVD(D$):NEXT:CLOSE 4:IF X$="M" THEN 3190 ELSE IF X$="R" THEN 5700
3140 OPEN "B:EXPENSE.CUR" AS 1:FIELD 1, 8 AS D$, 8 AS C$, 25 AS B$, 9 AS A$, 18 AS E$
3160 IF LOF(1)/128<8 THEN COLOR 0,7:PRINT"CURRENT EXPENSE FILE NOT YET OPENED FOR THIS MONTH.":PRINT:PRINT"REMOVE PAYROLL DISK FROM DRIVE A AND INSERT PROGRAM DISK":PRINT:PRINT"PRESS F8 TO RETURN TO EXPENSE PROGRAM AND OPEN FILE":COLOR 7,0:BEEP ELSE 3190
3170 R$=INKEY$:IF R$<>"@" THEN 3170
3180 RUN "EXPENSE.BAS"
3190 OPEN "PAYROLL.TOT" AS 5:FIELD 5, 8 AS A$, 12 AS B$, 10 AS C$, 10 AS D$, 10 AS E$, 10 AS F$, 10 AS G$, 10 AS H$, 10 AS I$, 10 AS J$, 10 AS K$, 8 AS L$, 8 AS M$, 1 AS N$:IF LOF(5)/128<2 THEN GOSUB 5620
3211 GET 5,CH+5:IF N$="C" THEN BEEP:CLS:LOCATE 12,5:PRINT "******** THIS MONTH HAS ALREADY BEEN CLOSED OUT ******** ":LOCATE 14,5:PRINT "************ PRESS F8 TO RETURN TO OPTIONS ***********":GOTO 3214
3213 GET 5,CH+4:IF CVD(B$)=0 THEN 3215 ELSE IF CH=1 OR N$="C" THEN 3215 ELSE BEEP:CLS:LOCATE 12,5:PRINT "*********** LAST MONTH HAS NOT BEEN CLOSED OUT ***********":LOCATE 14,5:PRINT "*********** PRESS F8 TO RETURN TO OPTIONS ***********":GOTO 3214
3214 YY$=INKEY$:IF YY$<>"@" THEN 3214 ELSE 50
3215 IF X$="M" AND CH MOD 3=0 THEN 3270 ELSE IF X$="M" THEN 6560
3220 PRINT TAB(22) "ENTER DATE OF CHECK ";:INLN%=8:GOSUB 20050:IF LEFT$(INPT$,1)="0" THEN ND$=MID$(INPT$,2,LEN(INPT$)-1) ELSE ND$=INPT$
3260 IF X$="I" THEN 5050
3270 FOR N=1 TO LOF(2)/128:GET 2,N:IF LEFT$(DD$,3)=" " THEN 50
3300 IF X$<>"M" AND LEFT$(DD$,3)<>"CUR" THEN 4900
3310 FL$="A:"+LEFT$(AA$,8)+"."+LEFT$(BB$,3)
3320 OPEN FL$ AS 3:NM=1:FIELD 3, 15 AS P$, 8 AS Q$, 15 AS R$, 8 AS S$, 15 AS T$, 7 AS U$, 7 AS V$, 7 AS W$, 7 AS Z$:GET 3,3:FWITH=CVS(V$):SWITH=CVS(W$):CWITH=CVS(Z$):MIS1$=P$:MIS2$=R$:MIS3$=T$:GET 3,2
3390 FIELD 3, 15 AS G$, 15 AS H$, 15 AS I$, 8 AS J$, 1 AS K$, 2 AS L$, 1 AS M$, 8 AS N$, 6 AS O$:GRS=CVS(N$):MAR$=K$:RAT$=M$:EXM%=CVI(L$):SS$=G$:GET 3,4
3420 FIELD 3, 8 AS A$, 12 AS B$, 10 AS C$, 10 AS D$, 10 AS E$, 10 AS F$, 10 AS G$, 10 AS H$, 10 AS I$, 10 AS J$, 10 AS K$, 8 AS L$, 8 AS M$, 1 AS N$:YGROSS=CVD(B$):GET 3,1:FIELD 3, 8 AS A$, 20 AS B$, 15 AS C$, 2 AS CA$, 35 AS D$, 35 AS E$, 13 AS F$
3460 FOR L%=1 TO 15:IF LEFT$(C$,L%)=STRING$(L%,32) THEN NEXT ELSE IF LEFT$(CA$,1)=" " THEN PAY$=RIGHT$(C$,16-L%)+" "+B$ ELSE PAY$=RIGHT$(C$,16-L%)+" "+LEFT$(CA$,1)+". "+B$
3465 IF X$="M" THEN GOSUB 30210:GOSUB 6150:GOTO 4900
3470 PRINT:PRINT " EMPLOYEE" SPC(16) PAY$ SPC(6) SS$:IF LEFT$(RAT$,1)="S" THEN PRINT " SALARY" ELSE PRINT
3480 IF MN$="M" THEN 3870 ELSE IF RF$="E" THEN 5750
3490 PRINT "DID EMPLOYEE WORK THIS WEEK? Y OR N"
3500 Y$=INKEY$:IF Y$="Y" AND LEFT$(RAT$,1)="S" THEN HRS=40:GOTO 3610 ELSE IF Y$="Y" THEN 3520 ELSE IF Y$="N" AND MN$<>"" THEN 5500 ELSE IF Y$="N" THEN 4900 ELSE 3500
3520 PRINT "ENTER REGULAR HOURS WORKED ";:INLN%=5:NBR=1:GOSUB 20050:HRS=VAL(INPT$):PRINT "ENTER OVERTIME HOURS WORKED ";:INLN%=5:GOSUB 20050:OHRS=VAL(INPT$):NBR=0:GROSS=(HRS+1.5*OHRS)*GRS:GOTO 3620
3580 PRINT "DID EMPLOYEE WORK THIS WEEK? Y OR N"
3590 Y$=INKEY$:IF Y$="Y" AND LEFT$(RAT$,1)="S" THEN 3610 ELSE IF Y$="Y" THEN 3490 ELSE IF Y$="N" THEN 4900 ELSE 3590
3610 GROSS=GRS
3620 IF FWITH<0.9 THEN 3720 ELSE IF FWITH<1.1 THEN 3630 ELSE 3730
3630 TAXABLE=GROSS-(EXM%*AL):IF LEFT$(MAR$,1)="S" THEN 3650 ELSE 3680
3650 FOR J=1 TO 8:IF TAXABLE<HIGH(J) THEN 3710
3670 NEXT J
3680 FOR J=9 TO 17:IF TAXABLE<HIGH(J) THEN 3710
3700 NEXT J
3710 FW=FED(J)+(FEDP(J)/100)*(TAXABLE-LOW(J)):GOTO 3740
3720 FW=0:GOTO 3740
3730 FW=GROSS*FWITH/100
3740 IF YGROSS>FMAX THEN FICA=0:GOTO 3770 ELSE IF GROSS+YGROSS>FMAX THEN 3760
3750 FICA=GROSS:GOTO 3770
3760 FICA=GROSS-(GROSS+YGROSS-FMAX)
3770 IF SWITH<0.9 THEN 3820 ELSE IF SWITH<1.1 THEN 3790
3780 SW=GROSS*SWITH/100:GOTO 3820
3790 IF LEFT$(STATE$,3)="FED" THEN SW=STAT/100*FW ELSE IF LEFT$(STATE$,3)="GRO" THEN SW=GROSS*STAT/100 ELSE IF LEFT$(STATE$,3)="ADJ" THEN SW=(GROSS-(EXM%*AL))*STAT/100
3800 GOTO 3820
3810 SW=0
3820 IF CWITH<0.9 THEN 3860 ELSE IF CWITH<1.1 THEN 3840
3830 CWITH=GROSS*CWITH/100:GOTO 3870
3840 IF LEFT$(CITY$,3)="GRO" THEN CW=GROSS*CIT/100 ELSE IF LEFT$(CITY$,3)="FED" THEN CW=FW*CIT/100 ELSE IF LEFT$(CITY$,3)="ADJ" THEN CW=(GROSS-EXM%*AL))*CIT/100 ELSE CW=SW*CIT/100
3850 GOTO 3870
3860 CW=0
3870 GET 3,3:FIELD 3, 15 AS P$, 8 AS Q$, 15 AS R$, 8 AS S$, 15 AS T$, 7 AS U$, 7 AS V$, 7 AS W$, 7 AS Z$:MIS1=CVS(Q$):MIS2=CVS(S$):MIS3=CVS(U$):IF MN$="M" THEN 5220
3930 DEF FNA(A)=(CINT((A-INT(A))*100))/100+INT(A):GROSS=FNA(GROSS):FICA=FNA(FICA):FICAC=FNA(FICA*(FIC/100)):FW=FNA(FW):SW=FNA(SW):CW=FNA(CW):PNET=FNA(GROSS-FW-FICAC-SW-CW-MIS1-MIS2-MIS3)
3960 IF YGROSS>SMAX THEN UNEMP=0 ELSE IF YGROSS+GROSS>SMAX THEN UNEMP=GROSS-(GROSS+YGROSS-SMAX) ELSE UNEMP=GROSS
3970 PRINT" GROSS";" FICA";" FED.WITH.";" ST.WITH.";" CITY WITH.":PRINT USING DL$;GROSS,FICAC,FW,SW,CW:PRINT:IF MIS1>0 THEN PRINT MIS1$;:PRINT USING DL$;MIS1
3975 IF MIS2>0 THEN PRINT MIS2$;:PRINT USING DL$;MIS2
3980 IF MIS3>0 THEN PRINT MIS3$;:PRINT USING DL$;MIS3
3990 PRINT:PRINT"NET PAID ";:PRINT USING DL$;PNET:PRINT:PRINT TAB(10) "P=PRINT CHECK AND ENTER DATA":PRINT:PRINT TAB(10) "E=ENTER DATA (ENTERS IN PAYROLL FILE ONLY)":PRINT:PRINT TAB(10) "C=CANCEL AND ENTER MANUALLY LATER"
4000 PRT$=INKEY$:IF PRT$="P" OR PRT$="E" THEN 4020
4010 IF X$="I" AND PRT$="C" THEN 5500 ELSE IF PRT$="C" THEN 4900 ELSE 4000
4020 IF LOF(3)/128<20 THEN GOSUB 5550
4025 FIELD 3, 8 AS A$, 12 AS B$, 10 AS C$, 10 AS D$, 10 AS E$, 10 AS F$, 10 AS G$, 10 AS H$, 10 AS I$, 10 AS J$, 10 AS K$, 8 AS L$, 8 AS M$, 1 AS N$:LSET A$=PD$:LSET B$=MKD$(GROSS):LSET C$=MKD$(FICA):LSET D$=MKD$(FW):LSET E$=MKD$(SW):LSET F$=MKD$(CW)
4090 LSET G$=MKD$(MIS1):LSET H$=MKD$(MIS2):LSET I$=MKD$(MIS3):LSET J$=MKD$(PNET):LSET K$=MKD$(UNEMP):LSET L$=MKS$(HRS):LSET M$=MKS$(OHRS):LSET N$="O":PUT 3,LOF(3)/128+1:GOSUB 30210:GET 3,4:GOSUB 4200:GOTO 4370
4200 LSET A$=PD$:GROSSS=0:FICAS=0:FWS=0:SWS=0:CWS=0:MIS1S=0:MIS2S=0:MIS3S=0:PNETS=0:UNEMPS=0:HRSS=0:OHRSS=0
4220 GROSSS=GROSS+CVD(B$):FICAS=FICA+CVD(C$):FWS=FW+CVD(D$):SWS=SW+CVD(E$):CWS=CW+CVD(F$):MIS1S=MIS1+CVD(G$):MIS2S=MIS2+CVD(H$):MIS3S=MIS3+CVD(I$):PNETS=PNET+CVD(J$):UNEMPS=UNEMP+CVD(K$):HRSS=HRS+CVS(L$):OHRSS=OHRS+CVD(M$):LSET B$=MKD$(GROSSS)
4240 LSET C$=MKD$(FICAS):LSET D$=MKD$(FWS):LSET E$=MKD$(SWS):LSET F$=MKD$(CWS):LSET G$=MKD$(MIS1S):LSET H$=MKD$(MIS2S):LSET I$=MKD$(MIS3S):LSET J$=MKD$(PNETS):LSET K$=MKD$(UNEMPS):LSET L$=MKS$(HRSS):LSET M$=MKS$(OHRSS):LSET N$="O":RETURN
4370 PUT 3,4:GET 3,CH+8:GOSUB 4200:PUT 3,CH+8:IF CH<4 THEN GET 3,5 ELSE IF CH<7 THEN GET 3,6 ELSE IF CH<10 THEN GET 3,7 ELSE GET 3,8
4420 GOSUB 4200:PUT 3,LOC(3):FIELD 5, 8 AS A$, 12 AS B$, 10 AS C$, 10 AS D$, 10 AS E$, 10 AS F$, 10 AS G$, 10 AS H$, 10 AS I$, 10 AS J$, 10 AS K$, 8 AS L$, 8 AS M$, 1 AS N$:GET 5,1:GOSUB 4200:PUT 5,1:GET 5,CH+5:GOSUB 4200:PUT 5,CH+5
4510 IF CH<4 THEN GET 5,2 ELSE IF CH<7 THEN GET 5,3 ELSE IF CH<10 THEN GET 5,4 ELSE GET 5,5
4520 GOSUB 4200:PUT 5,LOC(5):GET 5,LOF(5)/128:IF PD$=A$ THEN CODE%=LOF(5)/128 ELSE CODE%=LOF(5)/128+1
4550 GOSUB 4200:PUT 5, CODE%:IF PRT$="P" THEN 4580 ELSE IF MN$="M" OR MN$="A" THEN 5500 ELSE 4870
4580 GET 3,4:FIELD 3, 8 AS A$, 12 AS B$, 10 AS C$, 10 AS D$, 10 AS E$, 10 AS F$, 10 AS G$, 10 AS H$, 10 AS I$, 10 AS J$, 10 AS K$, 8 AS L$, 8 AS M$, 1 AS N$
4600 LPRINT CHR$(27)CHR$(45)CHR$(1)+CHR$(27)CHR$(69);:LPRINT PAY$;SPC(39-LEN(PAY$)) "WEEK ENDING "+PD$+" YR TO DATE":LPRINT SS$:LPRINT CHR$(27)CHR$(45)CHR$(0)+CHR$(27)CHR$(70):IF RAT$="S" THEN LPRINT:LPRINT:GOTO 4640
4630 LPRINT TAB(33)"REGULAR HOURS ";:LPRINT USING "########.##";HRS,CVS(L$):LPRINT TAB(33)"OVERTIME HOURS ";:LPRINT USING "########.##"; OHRS,CVS(M$)
4640 LPRINT TAB(33)"GROSS ";:LPRINT USING DL$;GROSS,CVD(B$):LPRINT TAB(33)"FICA ";:LPRINT USING DL$;FICAC,CVD(C$)*(FIC/100):LPRINT TAB(33) "FED. WITH. ";:LPRINT USING DL$;FW,CVD(D$)
4650 LPRINT TAB(33) "STATE WITH. ";:LPRINT USING DL$;SW,CVD(E$):IF CVD(F$)>0 OR CW>0 THEN LPRINT TAB(33)"CITY WITH. ";:LPRINT USING DL$;CW,CVD(F$) ELSE CNT=CNT+1
4670 IF CVD(G$)>0 OR MIS1>0 THEN LPRINT TAB(33) MIS1$+" ";:LPRINT USING DL$;MIS1,CVD(G$) ELSE CNT=CNT+1
4680 IF CVD(H$)>0 OR MIS2>0 THEN LPRINT TAB(33) MIS2$+" ";:LPRINT USING DL$;MIS2,CVD(H$) ELSE CNT=CNT+1
4690 IF CVD(I$)>0 OR MIS3>0 THEN LPRINT TAB(33) MIS3$+" ";:LPRINT USING DL$;MIS3,CVD(I$) ELSE CNT=CNT+1
4700 LPRINT:LPRINT TAB(33) "NET PAID ";:LPRINT USING DL$;PNET, CVD(J$):FOR J=1 TO 9+CNT:LPRINT:NEXT J:LPRINT CHR$(27)CHR$(69)+CHR$(27)CHR$(71):LPRINT TAB(52) ND$+" "+CHR$(14);:LPRINT USING "**$###.##";PNET:LPRINT:LPRINT
4760 LPRINT TAB(7) PAY$:LPRINT:LPRINT:LPRINT CHR$(27)CHR$(64):FOR J=1 TO 10:LPRINT:NEXT:GET 1, LOF(1)/128:FIELD 1, 8 AS D$, 8 AS C$, 25 AS B$, 9 AS A$, 18 AS E$:IF LOF(1)/128=9 THEN 4801 ELSE CHECK%=CVI(C$)+1:GOTO 4810
4801 FIELD 1, 10 AS M$, 5 AS Y$, 34 AS S$, 6 AS F$:GET 1,1:CHECK%=CVI(F$):FIELD 1, 8 AS D$, 8 AS C$, 25 AS B$, 9 AS A$, 18 AS E$
4810 LSET D$=ND$:LSET C$=MKI$(CHECK%):LSET B$=PAY$:LSET A$=MKD$(PNET):LSET E$="WAGES":PUT 1, LOF(1)/128+1:CNT=0:GROSS=0:FICA=0:FW=0:SW=0:CW=0:MIS1=0:MIS2=0:MIS3=0:PNET=0:UNEMP=0:IF MN$="M" OR MN$="A" THEN 5500
4890 CLS
4900 CLOSE 3:HRS=0:OHRS=0:IF N=LOF(2)/128 THEN 4910 ELSE NEXT N
4910 FIELD 5, 8 AS A$, 12 AS B$, 10 AS C$, 10 AS D$, 10 AS E$, 10 AS F$, 10 AS G$, 10 AS H$, 10 AS I$, 10 AS J$, 10 AS K$, 8 AS L$, 8 AS M$, 1 AS N$:IF X$="M" THEN 6560
4920 CLS:GET 5,CH+5:PRINT PD$:PRINT:PRINT"TOTAL WAGES PAID THIS MONTH ";:PRINT USING DL$;CVD(B$):PRINT:PRINT"FICA WITHHELD THIS MONTH ";:PRINT USING DL$;CVD(C$)*FIC/100:PRINT"FED.INCOME TAX WITHHELD THIS MONTH ";:PRINT USING DL$;CVD(D$)
4925 PRINT:PRINT TAB(9) "TOTAL WITHHELD THIS MONTH ";:PRINT USING DL$;CVD(C$)*(FIC/100)+CVD(D$):PRINT "EMPLOYERS FICA CONTRIBUTION DUE ";:PRINT USING DL$;CVD(C$)*(EFIC/100)
4935 PRINT "TOTAL FICA DUE THIS MONTH ";:PRINT USING DL$;CVD(C$)*(EFIC+FIC)/100;:PRINT " ON ";:PRINT USING DL$;CVD(C$)
4940 PRINT "TOTAL TAX DEPOSIT DUE THIS MONTH ";:PRINT USING DL$;(EFIC+FIC)/100*CVD(C$)+CVD(D$):PRINT:PRINT "IF THIS AMOUNT LESS ANY DEPOSITS ALREADY MADE THIS MONTH IS GREATER THAN $3000.00 THAN ADDITIONAL DEPOSIT IS DUE IN 3 DAYS."
4950 PRINT:PRINT TAB(10) "R=PRINT DEPOSIT INFORMATION (BE SURE PAPER IS IN PRINTER, NOT CHECKS)":PRINT:PRINT TAB(10) "O=RETURN TO OPTIONS"
4960 X$=INKEY$:IF X$<>"O" AND X$<>"R" THEN 4960
4980 IF X$="O" THEN 50 ELSE ELSE IF X$="R" THEN 4990
4990 LOCATE 11,1:PRINT STRING$(254,32):DEF SEG=4095:POKE 0,205:POKE 1,5:POKE 2,203:PRINT.SCREEN=0:CALL PRINT.SCREEN:GOTO 50
5050 CLS
5060 GOSUB 330:FL$="A:"+LEFT$(NAM2$,8)+"."+LEFT$(NAM1$,3):IF RF$="E" THEN 5120
5090 PRINT:PRINT TAB(10) "A=AUTOMATIC CALCULATION":PRINT:PRINT TAB(10) "M=ENTER AMOUNTS MANUALLY (CAN BE USED TO ENTER CORRECTIONS)"
5100 MN$=INKEY$:IF MN$<>"A" AND MN$<>"M" THEN 5100
5120 FIELD 2, 20 AS AA$, 15 AS BB$, 2 AS CC$, 9 AS DD$:FOR Z%=1 TO LOF(2)/128:GET 2,Z%:IF NAM2$=LEFT$(AA$,LEN(NAM2$)) AND NAM1$=LEFT$(BB$,LEN(NAM1$)) THEN IF LEFT$(MDL$,1)="." OR LEFT$(MDL$,1)=LEFT$(CC$,1) THEN 3320 ELSE 5160
5160 NEXT:PRINT "NAME NOT FOUND. CHECK SPELLING AND REENTER PRESS R TO REENTER PRESS O TO RETURN TO OPTIONS"
5180 Q$=INKEY$:DEF SEG=64:POKE 23, (PEEK(23) OR 64):IF Q$="R" THEN 5060 ELSE IF Q$="O" THEN 50 ELSE 5180
5210 ***********************************
5220 PRINT "THIS PROCEDURE MAY BE USED TO PAY AN INDIVIDUAL EMPLOYEE OR TO ENTER CORRECTION ***** FOR CURRENT MONTH ONLY UNLESS PREVIOUS MONTH HAS NOT BEEN CLOSED OUT. ****" +" CORRECTIONS MAY BE + OR - , BUT TOTAL OF DEDUCTIONS+NET MUST EQUAL GROSS."
5230 PRINT TAB(24)"ENTER 0 FOR ANY DATA NOT NEEDED.":PRINT:PRINT " ENTER REGULAR HOURS WORKED ";:INLN%=8:NBR=1:GOSUB 20050:HRS=VAL(INPT$):PRINT "ENTER OVERTIME HOURS WORKED ";:INLN%=8:GOSUB 20050:OHRS=VAL(INPT$):PRINT TAB(13)"ENTER GROSS PAY ";
5290 INLN%=12:GOSUB 20050:GROSS=VAL(INPT$):PRINT TAB(18) "ENTER AMOUNT SUBJECT TO FICA ";:INLN%=9:GOSUB 20050:FICA=VAL(INPT$):DEF FNA(A)=(CINT((A-INT(A))*100))/100+INT(A):FICA=FNA(FICA*(FIC/100))
5300 PRINT " FICA DEDUCTION IS ";:PRINT USING "####.##";FICA:PRINT " ENTER FEDERAL WITHHOLDING ";
5330 INLN%=9:GOSUB 20050:FW=VAL(INPT$):PRINT " ENTER STATE WITHHOLDING ";:INLN%=9:GOSUB 20050:SW=VAL(INPT$):PRINT " ENTER CITY WITHHOLDING ";:INLN%=9:GOSUB 20050:CW=VAL(INPT$):PRINT "ENTER AMT. SUBJECT TO UNEMP. ";
5377 INLN%=10:GOSUB 20050:UNEMP=VAL(INPT$):IF LEFT$(MIS1$,3)<>" " THEN PRINT MIS1$+" DEDUCTION":LOCATE CSRLIN-1,31 ELSE 5400
5390 INLN%=9:GOSUB 20050:MIS1=VAL(INPT$)
5400 IF LEFT$(MIS2$,3)<>" " THEN PRINT MIS2$+" DEDUCTION":LOCATE CSRLIN-1,31: ELSE 5420
5410 INLN%=9:GOSUB 20050:MIS2=VAL(INPT$)
5420 IF LEFT$(MIS3$,3)<>" " THEN PRINT MIS3$+" DEDUCTION":LOCATE CSRLIN-1,31: ELSE 5440
5430 INLN%=9:GOSUB 20050:MIS3=VAL(INPT$)
5440 PRINT TAB(19) "ENTER NET ";:INLN%=9:GOSUB 20050:PNET=VAL(INPT$):NBR=0:IF ABS(GROSS-FICA-FW-SW-CW-MIS1-MIS2-MIS3-PNET)>0.005000001 THEN 5470 ELSE 3970
5470 PRINT "AMOUNTS ARE OUT OF BALANCE. GROSS MUST EQUAL TOTAL DEDUCTIONS+NET.":PRINT "RECHECK FIGURES AND REENTER": PRINT "PRESS F8 WHEN READY."
5480 Z$=INKEY$:IF Z$="@" THEN CLS:GOTO 5220 ELSE 5480
5500 CLS:PRINT:PRINT:PRINT TAB(10) "N=NEXT EMPLOYEE (ONLY IF SAME DATE)":PRINT:PRINT TAB(10) "F=FINISHED, RETURN TO PAYROLL OPTIONS"
5510 W$=INKEY$:IF W$="N" THEN CLOSE 3:GOTO 5050 ELSE IF W$="F" THEN 4910 ELSE 5510
5540 '
5550 FOR J=4 TO 20:FIELD 3, 8 AS A$, 12 AS B$, 10 AS C$, 10 AS D$, 10 AS E$, 10 AS F$, 10 AS G$, 10 AS H$, 10 AS I$, 10 AS J$, 10 AS K$, 8 AS L$, 8 AS M$, 1 AS N$:INIT$=MKD$(0)
5580 LSET A$=" ":LSET B$=INIT$:LSET C$=INIT$:LSET D$=INIT$:LSET E$=INIT$:LSET F$=INIT$:LSET G$=INIT$:LSET H$=INIT$:LSET I$=INIT$:LSET J$=INIT$:LSET K$=INIT$:LSET L$=INIT$:LSET M$=INIT$:LSET N$=" ":PUT 3,J:NEXT J:RETURN
5620 FOR J=1 TO 17:FIELD 5, 8 AS A$, 12 AS B$, 10 AS C$, 10 AS D$, 10 AS E$, 10 AS F$, 10 AS G$, 10 AS H$, 10 AS I$, 10 AS J$, 10 AS K$, 8 AS L$, 8 AS M$, 1 AS N$:INIT$=MKD$(0)
5660 LSET A$=" ":LSET B$=INIT$:LSET C$=INIT$:LSET D$=INIT$:LSET E$=INIT$:LSET F$=INIT$:LSET G$=INIT$:LSET H$=INIT$:LSET I$=INIT$:LSET J$=INIT$:LSET K$=INIT$:LSET L$=INIT$:LSET M$=INIT$:LSET N$=" ":PUT 5,J:NEXT J:RETURN
5700 CLS:DEFINT S,O:PRINT:PRINT TAB(10) "E=EMPLOYEES FILE":PRINT:PRINT TAB(10) "T=TOTALS FILE":DEF SEG=64:POKE 23, (PEEK(23) OR 64)
5730 RF$=INKEY$:IF RF$="E" THEN 5050 ELSE IF RF$="T" THEN 6050 ELSE 5730
5750 PRINT:PRINT TAB(10) "ENTER MONTH TO READ WHOLE MONTH":PRINT:PRINT TAB(10) "ENTER DATE AS XX/XX/XX OR RANGE OF DATES AS XX/XX/XX-XX/XX/XX TO READ"
5755 PRINT:PRINT TAB(10) "ENTER T-NAME OF MONTH TO READ MONTHLY TOTALS":PRINT:PRINT TAB(10) "ENTER Q-NUMBER OF QUARTER TO READ QUARTERLY TOTALS":PRINT:PRINT TAB(10) "ENTER Y TO READ YEAR-TO-DATE TOTALS":INLN%=17:GOSUB 20050:RL$=INPT$
5765 IF ASC(RL$)=84 THEN STP$="T":RL$=MID$(RL$,3):GOTO 5810 ELSE IF ASC(RL$)=81 THEN STP$="T":GET 3,VAL(MID$(RL$,3))+4-OT:GOTO 5820 ELSE IF ASC(RL$)=89 THEN STP$="T":GET 3,4-OT:GOTO 5820
5770 IF ASC(RL$)<64 THEN STRT=VAL(LEFT$(RL$,2)):STRT2=VAL(MID$(RL$,4,2)) ELSE 5810
5780 RESTORE:FOR CH%=1 TO 12:CH=CH%:READ M0$: IF VAL(LEFT$(RL$,2))=CH THEN MON$=MO$:GOTO 5790 ELSE NEXT
5790 IF LEN(RL$)<9 THEN STP=STRT:STP2=STRT2+1:GOTO 5820
5800 STP=VAL(MID$(RL$,10,2)):STP2=VAL(MID$(RL$,13,2))+1:GOTO 5820
5810 RESTORE:FOR CH%=1 TO 12:CH=CH%:READ MO$:IF LEFT$(RL$,3)=MO$ THEN STRT=CH:STP=CH+1 ELSE NEXT
5815 IF STP$="T" THEN GET 3,CH+8-OT
5820 PRINT:PRINT TAB(10) "R=READ ONLY":PRINT:PRINT TAB(10) "P=READ AND PRINT":DEF SEG=64:POKE 23, (PEEK(23) OR 64)
5840 PRT$=INKEY$:IF PRT$="P" OR PRT$="R" THEN CLS:GOTO 5842 ELSE 5840
5842 IF OT THEN PRINT TAB(16) "************TOTALS FOR ALL EMPLOYEES************":PRINT: :GOTO 5843 ELSE LOCATE 25,5:PRINT"**********"+NAM1$+" "+NAM2$+"**********":LOCATE 1,1
5843 IF PRT$="P" THEN LPRINT CHR$(27)CHR$(78)CHR$(10):JT=7:GOTO 6180
5845 IF STP$="T" THEN 5900
5850 COLOR 0,7: PRINT " PRESS F8 TO READ RECORDS IN SEQUENCE. PRESS F7 TO STOP AT ANY POINT. PRESS F8 WHEN READY TO CONTINUE READING.":COLOR 7,0: PRINT:PRINT:KEY(7) ON:ON KEY(7) GOSUB 9460
5860 RD$=INKEY$:IF RD$<>"@" THEN 5860 ELSE DEF SEG:POKE 106,0
5880 FOR N=21 TO LOF(3)/128:GET 3,N
5900 FIELD 3, 8 AS A$, 12 AS B$, 10 AS C$, 10 AS D$, 10 AS E$, 10 AS F$, 10 AS G$, 10 AS H$, 10 AS I$, 10 AS J$, 10 AS K$, 8 AS L$, 8 AS M$, 1 AS N$:IF STP$="T" THEN 5941
5910 IF STRT2=0 AND STRT=<VAL(LEFT$(A$,2)) THEN 5940 ELSE IF STRT2=0 THEN 5980
5920 IF STRT=VAL(LEFT$(A$,2)) AND STRT2=<VAL(MID$(A$,4,2)) THEN 5940 ELSE IF STRT<VAL(LEFT$(A$,2)) THEN 5940 ELSE 5980
5930 GOTO 5980
5940 IF STP2=0 AND STP=VAL(LEFT$(A$,2)) THEN 5990 ELSE IF STP=VAL(LEFT$(A$,2)) AND STP2=<VAL(MID$(A$,4,2)) THEN 5990 ELSE IF STP<VAL(LEFT$(A$,2)) THEN 5990
5941 QT$=" QUARTER TOTALS TO DATE":IF NM THEN ORDT=LOC(3)-3 ELSE ORDT=LOC(3)
5942 IF ORDT>5 AND ORDT<18 THEN HD$=RL$+" TOTALS TO DATE":GOTO 5944 ELSE IF ORDT>17 THEN HD$=A$:GOTO 5944
5943 IF ORDT=1 THEN HD$="YEAR-TO-DATE TOTALS" ELSE IF ORDT=2 THEN HD$="1ST"+QT$ ELSE IF ORDT=3 THEN HD$="2ND"+QT$ ELSE IF ORDT=4 THEN HD$="3RD"+QT$ ELSE IF ORDT=5 THEN HD$="4TH"+QT$
5944 PRINT:PRINT HD$;" REGULAR HOURS ";CVS(L$);" OVERTIME HOURS ";:IF CVS(M$)<0.1 THEN PRINT 0 ELSE PRINT CVS(M$):PRINT
5945 PRINT" GROSS";" FICA";" FED.WITH.";" ST.WITH.";" CITY WITH.";" NET PAID":PRINT USING DL$;CVD(B$),CVD(C$)*(FIC/100),CVD(D$),CVD(E$),CVD(F$),CVD(J$):PRINT:IF CVD(G$)>0.1 THEN PRINT MIS1$;:PRINT USING DL$;CVD(G$)
5950 IF CVD(H$)>0.1 THEN PRINT MIS2$;:PRINT USING DL$;CVD(H$)
5955 IF CVD(I$)>0.1 THEN PRINT MIS3$;:PRINT USING DL$;CVD(I$)
5958 IF PRT$="P" THEN 6280
5959 IF STP$="T" THEN 5990
5980 NEXT:IF OT THEN 6100
5990 IF STP$="T" THEN IF OT THEN 6100 ELSE 5992
5991 STP$="T":GET 3,CH+8-OT:GOTO 5900
5992 STRT=0:STRT2=0:STRT$="":STP=0:STP2=0:STP$="":KEY(7) OFF
5995 PRINT:PRINT TAB(10) "A=READ ANOTHER RECORD FOR SAME EMPLOYEE":PRINT:PRINT TAB(10) "E=READ ANOTHER EMPLOYEES RECORDS":PRINT:PRINT TAB(10) "T=READ TOTALS FILE":PRINT:PRINT TAB(10) "O=RETURN TO OPTIONS"
6000 Z$=INKEY$:DEF SEG=64:POKE 23, (PEEK(23) OR 64):IF Z$="A" THEN CLS:GOTO 5750 ELSE IF Z$="E" THEN CLOSE 3:GOTO 5050 ELSE IF Z$="T" THEN CLOSE 3:GOTO 6050 ELSE IF Z$="O" THEN 50 ELSE 6000
6050 NM=0:OT=3:OPEN "PAYROLL TOT" AS 3
6070 CLS:PRINT:PRINT TAB(10) "ENTER Y TO READ YEAR-TO-DATE TOTALS":PRINT:PRINT TAB(10) "ENTER Q-NUMBER OF QUARTER TO READ QUARTERLY TOTALS":PRINT:PRINT TAB(10) "ENTER T-MONTH TO READ MONTHLY TOTALS":INLN%=17:GOSUB 20050:RL$=INPT$:RT=1
6090 GOTO 5765
6100 PRINT:PRINT TAB(10) "A=READ ANOTHER RECORD IN TOTALS FILE":PRINT:PRINT TAB(10) "E=READ AN EMPLOYEES RECORD":PRINT:PRINT TAB(10) "O=RETURN TO OPTIONS"
6110 RF$=INKEY$:DEF SEG=64:POKE 23, (PEEK(23) OR 64):IF RF$="A" THEN 6070 ELSE IF RF$="E" THEN OT=0:CLOSE 3:GOTO 5050 ELSE IF RF$="O" THEN 50 ELSE 6110
6150 E0M=1:IF CH MOD 3=0 THEN QT=1
6170 IF CH=12 THEN YR=1
6180 LPRINT CHR$(15)+CHR$(27)CHR$(78)CHR$(10):WIDTH "LPT1:",132:IF N<>1 THEN 6190
6185 IF TTLS THEN 6200
6190 LPRINT CHR$(27)CHR$(45)CHR$(1) TAB(20) PAY$+" "+SS$
6200 LPRINT "DATE REG.HRS. OT HRS. GROSS FICA FED.WITH. ST.WITH. ";:IF CIT>0 THEN NT=1:LPRINT "CIT.WITH. ";
6220 IF MIS1$<>STRING$(15,32) THEN NT1=1:LPRINT MIS1$;
6230 IF MIS2$<>STRING$(15,32) THEN NT2=1:LPRINT MIS2$;
6240 IF MIS3$<>STRING$(15,32) THEN NT3=1:LPRINT MIS3$;
6245 IF MIS1$=STRING$(15,32) THEN LPRINT " ";
6246 IF TTLS THEN LPRINT " NET":LPRINT:GOTO 6410
6250 LPRINT" NET":LPRINT CHR$(27)CHR$(45)CHR$(0):IF JT=7 THEN 5845
6255 FOR J=21 TO LOF(3)/128:FIELD 3, 8 AS A$:GET 3,J:IF VAL(LEFT$(A$,2))>CH THEN 6410 ELSE IF VAL(LEFT$(A$,2))<CH-2 THEN 6400
6280 DX$="$$#######.##":IF JT=7 AND STP$="T" THEN LPRINT HD$:LPRINT A$; ELSE IF JT=7 OR JT=0 THEN LPRINT A$;
6287 FIELD 3, 8 AS A$, 12 AS B$, 10 AS C$, 10 AS D$, 10 AS E$, 10 AS F$, 10 AS G$, 10 AS H$, 10 AS I$, 10 AS J$, 10 AS K$, 8 AS L$, 8 AS M$, 1 AS N$
6288 LPRINT " ";:LPRINT USING "####.##";CVS(L$);:IF CVS(M$)<0.1 THEN LPRINT " 0.00"; ELSE LPRINT USING "#####.##";CVS(M$);
6290 LPRINT USING DX$;CVD(B$);CVD(C$)*(FIC/100); CVD(D$); CVD(E$);:IF CIT>0.01 THEN LPRINT USING DX$;CVD(F$);
6310 IF CVD(G$)>0.1 THEN LPRINT USING DX$;CVD(G$);
6320 IF CVD(H$)>0.1 THEN LPRINT USING DX$;CVD(H$);
6330 IF CVD(I$)>0.1 THEN LPRINT " ";:LPRINT USING DX$;CVD(I$);
6340 LPRINT " ";:LPRINT USING DX$;CVD(J$):IF JT=6 THEN LPRINT:LPRINT " FICA WAGES PAID ";:LPRINT USING DL$;CVD(C$)
6350 ON JT GOTO 6440,6450,6470,6490,6510,6530,5959
6400 NEXT
6410 RESTORE:FOR NZ=1 TO CH:READ MO$:IF NZ=CH-2 THEN MO1$=MO$:GOTO 6411 ELSE IF NZ=CH-1 THEN MO2$=MO$:GOTO 6411 ELSE 6411
6411 NEXT NZ:RESTORE:LPRINT CHR$(27)CHR$(45)CHR$(1);:FOR NY=1 TO 3:IF CH MOD 3=0 AND NY=1 THEN GET 3,CH+6-OT:LPRINT MO1$+". TOT";:GOTO 6430
6415 IF CH MOD 3=0 AND NY=2 THEN GET 3,CH+7-OT:LPRINT MO2$+". TOT";:GOTO 6430
6416 IF NY=1 OR NY=2 THEN 6440
6420 GET 3,CH+8-OT:LPRINT MO$+". TOT";
6430 JT=1:GOTO 6280
6440 NEXT NY:LSET N$="C":PUT 3,LOC(3):LPRINT:GET 3,5-OT:JT=2:LPRINT "1ST QTR ";:GOTO 6280
6450 IF CH=3 THEN LSET N$="C":PUT 3,5-OT
6460 IF CH>3 THEN GET 3,6-OT:JT=3:LPRINT "2ND QTR ";:GOTO 6280
6470 IF CH=6 THEN LSET N$="C":PUT 3,6-OT
6480 IF CH>6 THEN GET 3,7-OT:JT=4:LPRINT "3RD QTR ";:GOTO 6280
6490 IF CH=9 THEN LSET N$="C":PUT 3,7-OT
6500 IF CH>9 THEN GET 3,8-OT:JT=5:LPRINT "4TH QTR ";:GOTO 6280
6510 IF CH=12 THEN LSET N$="C":PUT 3,8-OT
6520 GET 3,4-OT:JT=6:LPRINT RIGHT$(PD$,2)+" YTD ";:GOTO 6280
6530 IF CH=12 THEN LSET N$="C":PUT 3,4-OT
6532 IF TTLS THEN 6590
6535 LPRINT CHR$(27)CHR$(45)CHR$(0):JT=0:IF QT>0.5 OR N MOD 4=0 THEN LPRINT CHR$(12)
6550 RETURN
6560 CLOSE 3:OPEN "PAYROLL.TOT" AS 3:FIELD 3, 8 AS A$, 12 AS B$, 10 AS C$, 10 AS D$, 10 AS E$, 10 AS F$, 10 AS G$, 10 AS H$, 10 AS I$, 10 AS J$, 10 AS K$, 8 AS L$, 8 AS M$, 1 AS N$
6580 TTLS=1:OT=3:LPRINT CHR$(14)+CHR$(27)CHR$(45)CHR$(1):LPRINT "PAYROLL TOTALS":GET 3,1:LPRINT CHR$(15):WIDTH "LPT1:",132:IF CVD(G$)>0.01 THEN MIS1$="MISC. 1" ELSE MIS1$=STRING$(15,32)
6587 IF CVD(H$)>0.01 THEN MIS2$="MISC. 2" ELSE MIS2$=STRING$(15,32)
6588 IF CVD(I$)>0.01 THEN MIS3$="MISC. 3" ELSE MIS3$=STRING$(15,32)
6589 GOTO 6200
6590 LPRINT CHR$(18);:WIDTH "LPT1:",80:FOR J=1 TO 3:LPRINT STRING$(55,42):IF J=1 THEN GET 3,CH+5:LPRINT MO$;:LPRINT ". TAXES DUE":GOTO 6610 ELSE IF J=3 THEN GET 3,1:GOTO 6606
6601 IF CH<4 THEN LPRINT "1ST QTR TAXES DUE":GET 3,2 ELSE IF CH<7 THEN LPRINT "2ND QTR TAXES DUE":GET 3,3 ELSE IF CH<10 THEN LPRINT "3RD QTR TAXES DUE":GET 3,4 ELSE LPRINT "4TH QTR TAXES DUE":GET 3,5
6603 GOTO 6610
6606 IF VAL(RIGHT$(PD$,2))>82 THEN LPRINT "19"; ELSE LPRINT "20";
6607 LPRINT RIGHT$(PD$,2)+" TAXES DUE YTD"
6610 LPRINT "FICA WITHHELD ";:LPRINT USING DL$;CVD(C$)*(FIC/100):LPRINT "FED.INCOME TAX WITHHELD ";:LPRINT USING DL$;CVD(D$):LPRINT:LPRINT TAB(9)" TOTAL WITHHELD ";:LPRINT USING DL$;CVD(C$)*(FIC/100)+CVD(D$)
6615 LPRINT "EMPLOYERS FICA CONTRIBUTION DUE ";:LPRINT USING DL$;CVD(C$)*(EFIC/100):LPRINT " TOTAL FICA TAXES ";:LPRINT USING DL$;CVD(C$)*(FIC+EFIC)/100;:LPRINT " ON ";:LPRINT USING DL$;CVD(C$)
6620 LPRINT"TOTAL TAX DEPOSIT DUE ";:LPRINT USING DL$;(EFIC+FIC)/100*CVD(C$)+CVD(D$):IF J=1 THEN LPRINT:LPRINT "IF THIS AMOUNT LESS ANY DEPOSITS ALREADY MADE THIS MONTH IS GREATER THAN $3000.00 THAN ADDITIONAL DEPOSIT IS DUE IN 3 DAYS
6630 LPRINT "STATE WITHHOLDING DUE ";:LPRINT USING DL$;CVD(E$):IF CIT>0 THEN LPRINT "WITHHOLDING DUE ";:LPRINT USING DL$;CVD(F$)
6650 LPRINT "STATE UNEMPLOYMENT TAX DUE ";:LPRINT USING DL$;CVD(K$)*(SUMP/100);:LPRINT " ON ";:LPRINT USING DL$;CVD(K$):LPRINT "FEDERAL UNEMPLOYMENT TAX DUE ";:LPRINT USING DL$;CVD(K$)*(FUMP/100):NEXT
6680 LPRINT CHR$(12)+CHR$(27)CHR$(64):CLS:PRINT:PRINT TAB(15) "PRESS P TO PRINT AGAIN ELSE JUST PRESS ENTER"
6700 AG$=INKEY$:IF AG$="P" THEN 6560 ELSE IF AG$=CHR$(13) THEN 50 ELSE 6700
7000 CLS:IF ERR=71 THEN COLOR 0,7:PRINT " FILE DISK NOT IN DRIVE B OR PAYROLL DISK NOT IN DRIVE A OR DOOR IS OPEN.":PRINT:PRINT"CORRECT PROBLEM AND PRESS F8 WHEN READY. ":GOTO 7100
7020 IF ERR=24 OR ERR=27 THEN COLOR 0,7:PRINT " PRINTER NOT ON OR OUT OF PAPER. SET TOP OF PAGE AND TURN ON PRINTER. PRESS F8 WHEN READY. ":GOTO 7100
7030 IF ERR=53 THEN COLOR 0,7:PRINT " FILE NOT FOUND ":PRINT:PRINT " INSERT DISK CONTAINING FILE AND PRESS F8 WHEN READY. ":GOTO 7100
7040 PRINT " AN UNDEFINED ERROR HAS OCCURRED":PRINT:PRINT "PRESS F8 TO RETURN TO MENU"
7050 ER$=INKEY$:IF ER$<>"@" THEN 7050 ELSE COLOR 7,0:GOTO 50
7100 ER$=INKEY$:IF ER$<>"@" THEN 7100 ELSE COLOR 7,0:CLS:DEF SEG:POKE 106,0:RESUME
7300 CLS:PRINT:PRINT "DO YOU HAVE TWO BLANK DISKS AVAILABLE WHICH HAVE BEEN FORMATTED WITH THE N PROCEDURE FROM THE PROGRAM DISK Y/N ?"
7320 FR$=INKEY$:DEF SEG=64:POKE 23, (PEEK(23) OR 64):IF FR$="Y" THEN 7400 ELSE IF FR$="N" THEN 7350 ELSE 7320
7350 CLS:PRINT:PRINT TAB(10)"REMOVE BOTH DISKS AND INSERT PROGRAM DISK IN DRIVE A.":PRINT:PRINT TAB(10)"PRESS F8 WHEN READY"
7360 RD$=INKEY$:IF RD$="@" THEN 7380 ELSE 7360
7380 PRINT:PRINT:PRINT TAB(10) "YOU WILL BE RETURNED TO PAYROLL PROGRAM AFTER DISKS HAVE BEEN FORMATTED AND YOU WILL HAVE TO SELECT F OPTION AGAIN.":PRINT:PRINT TAB(10) "ENTER N WHEN A> PROMPT APPEARS.":SYSTEM
7400 PRINT:PRINT TAB(10) "MOST RECENT PAYROLL FILE DISK MUST BE IN DRIVE A":PRINT:PRINT TAB(10) "IS THIS FOR A NEW YEAR Y/N ?"
7410 NY$=INKEY$:DEF SEG=64:POKE 23, (PEEK(23) OR 64):IF NY$="" THEN 7410
7440 PRINT:PRINT TAB(10) "INSERT NEW PAYROLL FILE DISK IN DRIVE B":PRINT:PRINT TAB(10) "PRESS F8 WHEN READY."
7450 CP$=INKEY$:IF CP$="@" THEN 7465 ELSE 7450
7465 CLS:LOCATE 12,22:PRINT "COPYING FILES *** PLEASE WAIT"
7470 OPEN "B:EMPLOYEE.CNT" AS 1:FOR N=1 TO LOF(2)/128:FIELD 2, 20 AS AA$, 15 AS BB$, 2 AS CC$, 9 AS DD$:GET 2,N:FL$="A:"+LEFT$(AA$,8)+"."+LEFT$(BB$,3):NFL$="B:"+LEFT$(AA$,8)+"."+LEFT$(BB$,3):IF NY$="Y" THEN IF LEFT$(DD$,3)<>"CUR" THEN 7750
7525 A$=AA$:B$=BB$:C$=CC$:D$=DD$:FIELD 1, 20 AS AA$, 15 AS BB$, 2 AS CC$, 9 AS DD$:LSET AA$=A$:LSET BB$=B$:LSET CC$=C$:LSET DD$=D$:PUT 1,LOF(1)/128+1:OPEN FL$ AS 3:OPEN NFL$ AS 4
7565 FIELD 3, 8 AS A$, 20 AS B$, 15 AS C$, 2 AS CA$, 35 AS D$, 35 AS E$, 13 AS F$:GET 3,1:G$=A$:H$=B$:I$=C$:J$=CA$:K$=D$:L$=E$:M$=F$:FIELD 4, 8 AS A$, 20 AS B$, 15 AS C$, 2 AS CA$, 35 AS D$, 35 AS E$, 13 AS F$
7590 LSET A$=G$:LSET B$=H$:LSET C$=I$:LSET CA$=J$:LSET D$=K$:LSET E$=L$:LSET F$=M$:PUT 4,1:FIELD 3, 15 AS G$, 15 AS H$, 15 AS I$, 8 AS J$, 1 AS K$, 2 AS L$, 1 AS M$, 8 AS N$, 6 AS O$:GET 3,2
7620 A$=G$:B$=H$:C$=I$:D$=J$:E$=K$:F%=CVI(L$):P$=M$:Q!=CVS(N$):R$=O$:FIELD 4, 15 AS G$, 15 AS H$, 15 AS I$, 8 AS J$, 1 AS K$, 2 AS L$, 1 AS M$, 8 AS N$, 6 AS O$
7630 LSET G$=A$:LSET H$=B$:LSET I$=C$:LSET J$=D$:LSET K$=E$:LSET L$=MKI$(F%):LSET M$=P$:LSET N$=MKS$(Q!):LSET O$=R$:PUT 4,2:FIELD 3, 15 AS P$, 8 AS Q$, 15 AS R$, 8 AS S$, 15 AS T$, 7 AS U$, 7 AS V$, 7 AS W$, 7 AS Z$:GET 3,3
7660 A$=P$:B!=CVS(Q$):C$=R$:D!=CVS(S$):E$=T$:F!=CVS(U$):G!=CVS(V$):H!=CVS(W$):I!=CVS(Z$):FIELD 4, 15 AS P$, 8 AS Q$, 15 AS R$, 8 AS S$, 15 AS T$, 7 AS U$, 7 AS V$, 7 AS W$, 7 AS Z$
7670 LSET P$=A$:LSET Q$=MKS$(B!):LSET R$=C$:LSET S$=MKS$(D!):LSET T$=E$:LSET U$=MKS$(F!):LSET V$=MKS$(G!):LSET W$=MKS$(H!):LSET Z$=MKS$(I!):PUT 4,3:IF NY$="Y" OR NY$="y" THEN 7750
7700 FOR I=4 TO 8:FIELD 3, 8 AS A$, 12 AS B$, 10 AS C$, 10 AS D$, 10 AS E$, 10 AS F$, 10 AS G$, 10 AS H$, 10 AS I$, 10 AS J$, 10 AS K$, 8 AS L$, 8 AS M$, 1 AS N$:GET 3,I
7725 Z$=A$:B=CVD(B$):C=CVD(C$):D=CVD(D$):E=CVD(E$):F=CVD(F$):G=CVD(G$):H=CVD(H$):I#=CVD(I$):J#=CVD(J$):K=CVD(K$):L!=CVS(L$):M!=CVS(M$):Y$=N$
7730 FIELD 4, 8 AS A$, 12 AS B$, 10 AS C$, 10 AS D$, 10 AS E$, 10 AS F$, 10 AS G$, 10 AS H$, 10 AS I$, 10 AS J$, 10 AS K$, 8 AS L$, 8 AS M$, 1 AS N$
7735 LSET A$=Z$:LSET B$=MKD$(B):LSET C$=MKD$(C):LSET D$=MKD$(D):LSET E$=MKD$(E):LSET F$=MKD$(F):LSET G$=MKD$(G):LSET H$=MKD$(H):LSET I$=MKD$(I#):LSET J$=MKD$(J#):LSET K$=MKD$(K):LSET L$=MKS$(L!):LSET M$=MKS$(M!):LSET N$=Y$:PUT 4,I:NEXT I
7750 CLOSE 3:CLOSE 4:NEXT N:IF NY$="Y" OR NY$="y" THEN CLOSE 1:GOTO 7900
7780 OPEN "A:PAYROLL.TOT" AS 3:OPEN "B:PAYROLL.TOT" AS 4:FOR J=1 TO 5:FIELD 3, 8 AS A$, 12 AS B$, 10 AS C$, 10 AS D$, 10 AS E$, 10 AS F$, 10 AS G$, 10 AS H$, 10 AS I$, 10 AS J$, 10 AS K$, 8 AS L$, 8 AS M$, 1 AS N$:GET 3,J
7825 Z$=A$:B=CVD(B$):C=CVD(C$):D=CVD(D$):E=CVD(E$):F=CVD(F$):G=CVD(G$):H=CVD(H$):I#=CVD(I$):J#=CVD(J$):K=CVD(K$):L!=CVS(L$):M!=CVS(M$):Y$=N$
7830 FIELD 4, 8 AS A$, 12 AS B$, 10 AS C$, 10 AS D$, 10 AS E$, 10 AS F$, 10 AS G$, 10 AS H$, 10 AS I$, 10 AS J$, 10 AS K$, 8 AS L$, 8 AS M$, 1 AS N$
7835 LSET A$=Z$:LSET B$=MKD$(B):LSET C$=MKD$(C):LSET D$=MKD$(D):LSET E$=MKD$(E):LSET F$=MKD$(F):LSET G$=MKD$(G):LSET H$=MKD$(H):LSET I$=MKD$(I#):LSET J$=MKD$(J#):LSET K$=MKD$(K):LSET L$=MKS$(L!):LSET M$=MKS$(M!):LSET N$=Y$:PUT 4,J:NEXT J
7860 CLOSE 1:CLOSE 3:CLOSE 4
7900 IF SECOND THEN 7990
7905 CLS:PRINT:PRINT TAB(10)"REMOVE NEW FILE DISK FROM DRIVE B AND INSERT BACKUP FILE DISK.":PRINT:PRINT TAB(10)"PRESS F8 WHEN READY."
7910 SD$=INKEY$:IF SD$="@" THEN SECOND=1:GOTO 7470 ELSE 7910
7990 PRINT:PRINT TAB(10) "REMOVE BOTH DISKS":PRINT:PRINT TAB(10)"INSERT BOOKKEEPING FILE DISK IN DRIVE B":PRINT:PRINT TAB(10)"INSERT NEW PAYROLL FILE DISK IN DRIVE A":PRINT:PRINT TAB(10) "PRESS F8 WHEN READY"
7995 ES$=INKEY$:IF ES$<>"@" THEN 7995 ELSE 50
8000 CLS:CLOSE 2:OPEN "A:DEDUCT.FIL" AS 2:FL$="DEDUCT.FIL":GOSUB 30210
8020 COLOR 0,7:LOCATE 25,1:PRINT " ENTER ALL PERCENTAGES AS GIVEN NOT AS DECIMAL e.g. 12%=12 6.7%=6.7 ":COLOR 7,0:LOCATE 1,1
8030 PRINT TAB(7)"PAYROLL DEDUCTIONS FILE FOR WEEKLY PAYROLL---PERCENTAGE METHOD":PRINT:PRINT TAB(10)"C=CREATE FILE":PRINT:PRINT TAB(10)"R=READ, REVISE, OR PRINT FILE":PRINT:PRINT TAB(10)"O=PAYROLL OPTIONS":SKIP=0
8050 X$=INKEY$:DEF SEG=64:POKE 23, (PEEK(23) OR 64):IF X$="C" THEN 8080 ELSE IF X$="R" THEN 8760 ELSE IF X$="O" THEN 50 ELSE 8050
8080 IF LOF(2)/128>0 THEN COLOR 0,7:PRINT " THIS FILE ALREADY EXISTS. USE READ AND REVISE TO MAKE CHANGES. PRESS ANY KEY TO RETURN TO OPTIONS FOR FILE. "
8085 AK$=INKEY$:IF AK$="" THEN 8085 ELSE COLOR 7,0:CLS:GOTO 8020
8090 CLS:COLOR 0,7:LOCATE 25,1:PRINT " ENTER ALL PERCENTAGES AS GIVEN NOT AS DECIMAL e.g. 12%=12 6.7%=6.7 ":COLOR 7,0:LOCATE 1,1
8100 PRINT TAB(10) "IF NO STATE TAX" SPC(40) "ENTER-----NONE":PRINT TAB(10) "IF STATE WITHHOLDING BASED ON FEDERAL WITHHOLDING ENTER--FEDERAL":PRINT TAB(10) "IF STATE WITHHOLDING IS PERCENT OF GROSS INCOME ENTER----GROSS"
8110 PRINT TAB(10) "IF PERCENT OF (GROSS INCOME-FED. ALLOW. PER DEPENDENT) ENTER---ADJUST":PRINT SPC(64);:INPUT STATE$:PRINT SPC(34);:INPUT "PERCENTAGE (IF NONE, ENTER 0) ";STAT:IF SKIP%=1 THEN 8330
8150 CLS:COLOR 0,7:LOCATE 25,1:PRINT " ENTER ALL PERCENTAGES AS GIVEN NOT AS DECIMAL e.g. 12%=12 6.7%=6.7 ":COLOR 7,0:LOCATE 1,1
8160 PRINT TAB(10) "IF NO CITY TAX" SPC(41) "ENTER-----NONE":PRINT TAB(10) "IF CITY WITHHOLDING BASED ON FEDERAL WITHHOLDING ENTER--FEDERAL":PRINT TAB(10)"IF CITY WITHHOLDING BASED ON STATE WITHHOLDING ENTER----STATE"
8170 PRINT TAB(10) "IF CITY WITHHOLDING IS PERCENT OF GROSS INCOME ENTER----GROSS":PRINT TAB(10) "IF PERCENT OF (GROSS INCOME-FED. ALLOW. PER DEPENDENT) ENTER---ADJUST":PRINT SPC(64);:INPUT CITY$
8190 PRINT SPC(33);:INPUT "PERCENTAGE (IF NONE, ENTER 0) ";CIT:IF SKIP%=2 THEN 8360
8210 FIELD 2, 8 AS A$, 10 AS B$:CLS:COLOR 0,7:LOCATE 25,1:PRINT " ENTER ALL PERCENTAGES AS GIVEN NOT AS DECIMAL e.g. 12%=12 6.7%=6.7 ":COLOR 7,0:LOCATE 1,1
8230 PRINT SPC(44);:INPUT "FICA MAXIMUM INCOME ";MAX:PRINT SPC(37);:INPUT "EMPLOYEE'S FICA PERCENTAGE ";FIC:IF SKIP%=3 THEN 8390
8260 PRINT SPC(33);:INPUT "STATE UNEMPLOYMENT-MAX. INCOME ";SMAX:PRINT SPC(34);:INPUT "STATE UNEMPLOYMENT PERCENTAGE ";SUMP:IF SKIP%=4 THEN 8420
8290 PRINT SPC(31);:INPUT "FEDERAL UNEMPLOYEMENT PERCENTAGE ";FUMP:IF SKIP%=5 THEN 8450
8310 PRINT SPC(38);:INPUT "EMPLOYERS FICA PERCENTAGE ";EFIC:IF SKIP%=5 THEN 8450
8330 LSET A$=STATE$:LSET B$=MKD$(STAT):PUT 2,1:IF SKIP%=1 THEN 9320
8360 LSET A$=CITY$:LSET B$=MKD$(CIT):PUT 2,2:IF SKIP%=2 THEN 9320
8390 LSET A$=MKD$(FIC):LSET B$=MKD$(MAX):PUT 2,3:IF SKIP%=3 THEN 9320
8420 LSET A$=MKD$(SUMP):LSET B$=MKD$(SMAX):PUT 2,4:IF SKIP%=4 THEN 9320
8450 IF RV$="U" THEN LSET A$=MKD$(FUMP):GOTO 8460 ELSE IF RV$="E" THEN LSET B$=MKD$(EFIC):GOTO 8460 ELSE LSET A$=MKD$(FUMP):LSET B$=MKD$(EFIC)
8460 PUT 2, 5:IF SKIP%=5 THEN 9320
8470 CLS:COLOR 0,7:LOCATE 25,1:PRINT " ENTER ALL PERCENTAGES AS GIVEN NOT AS DECIMAL e.g. 12%=12 6.7%=6.7 ":COLOR 7,0:LOCATE 1,1
8480 PRINT "INFORMATION FOR LAST SECTION IS OBTAINED FROM IRS FEDERAL EMPLOYERS TAX GUIDE---TABLES FOR PERCENTAGE METHOD WITHHOLDING."
8490 INPUT "FEDERAL WITHHOLDING ALLOWANCE PER DEPENDENT (FROM EMPLOYERS TAX GUIDE - PERCENTAGE METHOD )";AL:FIELD 2, 8 AS A$:LSET A$=MKD$(AL):PUT 2,6:IF SKIP%=6 THEN 9320
8540 PRINT "FOR EACH RANGE YOU WILL NEED TO ENTER 4 ANSWERS SEPERATED BY COMMAS-------------LOW END OF RANGE, HIGH END, DOLLAR AMOUNT TO DEDUCT, PERCENTAGE TO DEDUCT. IF NO LOW IS GIVEN, ENTER 0. IF NO HIGH IS GIVEN, ENTER 99999."
8550 PRINT "EXAMPLE--TABLE SAYS OVER $62 BUT NOT OVER $171 $4.20+16% OF EXCESS OVER $62----------ENTRY WOULD BE 62,171,4.20,16
8560 IF SKIP% THEN 9360
8570 PRINT:PRINT TAB(32) "SINGLE EMPLOYEE":FOR N=7 TO 14:PRINT "RANGE";:PRINT N-6;:INPUT " ";LOW,HIGH,FED,FEDP:GOSUB 8670:NEXT:PRINT:PRINT TAB(31) "MARRIED EMPLOYEE":PRINT:FOR N=15 TO 22:PRINT "RANGE";:PRINT N-14;:INPUT " ";LOW,HIGH,FED,FEDP
8650 GOSUB 8670:NEXT
8670 FIELD 2, 10 AS A$, 10 AS B$, 10 AS C$, 10 AS D$:LSET A$=MKD$(LOW):LSET B$=MKD$(HIGH):LSET C$=MKD$(FED):LSET D$=MKD$(FEDP):PUT 2,N:LOW=0:HIGH=0:FED=0:FEDP=0:IF SKIP% THEN 9320 ELSE 8030
8750 RETURN
8760 CLS:KEY(7) ON:ON KEY(7) GOSUB 9460:PRINT:PRINT TAB(10) "R=READ ONLY":PRINT:PRINT TAB(10) "P=READ AND PRINT":DEF SEG=64:POKE 23, (PEEK(23) OR 64)
8800 PRT$=INKEY$:IF PRT$="P" OR PRT$="R" THEN CLS:GOTO 8810 ELSE 8800
8810 COLOR 0,7: PRINT " PRESS F8 TO READ RECORDS IN SEQUENCE. PRESS F7 TO STOP AT ANY POINT. PRESS F8 WHEN READY TO CONTINUE READING.":COLOR 7,0: PRINT:PRINT
8820 COLOR 0,7:PRINT " IF REVISING FILE, WRITE DOWN RECORD NUMBERS TO BE CHANGED. IF THERE IS A RECORD NO LONGER USED, IT CAN BE REPLACED BY USING ITS RECORD NUMBER FOR A NEW ENTRY": PRINT:PRINT: COLOR 7,0
8830 X$=INKEY$:IF X$<>"@" THEN 8830 ELSE DEF SEG:POKE 106,0
8850 PRINT " PAYROLL DEDUCTIONS FILE FOR WEEKLY PAYROLL---PERCENTAGE METHOD":PRINT:IF PRT$="P" THEN LPRINT CHR$(27)CHR$(78)CHR$(6):LPRINT MODE$:LPRINT " PAYROLL DEDUCTIONS FILE FOR WEEKLY PAYROLL---PERCENTAGE METHOD":LPRINT XMOD$
8870 FIELD 2, 8 AS A$, 10 AS B$:GET 2,1:PCT$="##.##%":PRINT "STATE TAX TYPE--"+A$+" ";:PRINT USING PCT$;CVD(B$);:PRINT " REC.NO. 1":IF PRT$="P" THEN LPRINT "STATE TAX TYPE--"+A$+" ";:LPRINT USING PCT$;CVD(B$);:LPRINT " REC.NO. 1"
8920 GET 2,2:PRINT "CITY TAX TYPE---"+A$+" ";:PRINT USING PCT$;CVD(B$);:PRINT " REC.NO. 2":IF PRT$="P" THEN LPRINT "CITY TAX TYPE---"+A$+" ";:LPRINT USING PCT$;CVD(B$);:LPRINT " REC.NO. 2"
8950 GET 2,3:PRINT "FICA MAX.INCOME-";:PRINT USING DL$;CVD(B$);:PRINT " ";:PRINT USING PCT$;CVD(A$);:PRINT " REC.NO. 3"
8970 IF PRT$="P" THEN LPRINT "FICA MAX.INCOME-";:LPRINT USING DL$;CVD(B$);:LPRINT " ";:LPRINT USING PCT$;CVD(A$);:LPRINT " REC.NO. 3"
8980 GET 2, 4
8990 PRINT"STATE UNEMP.MAX-";:PRINT USING DL$;CVD(B$);:PRINT " ";:PRINT USING PCT$;CVD(A$);:PRINT" REC.NO. 4":IF PRT$="P" THEN LPRINT"STATE UNEMP.MAX-";:LPRINT USING DL$;CVD(B$);:LPRINT" ";:LPRINT USING PCT$;CVD(A$);:LPRINT" REC.NO. 4"
9000 GET 2,5:PRINT "FED.UNEMP. RATE";:PRINT " ";:PRINT USING PCT$;CVD(A$);:PRINT " REC.NO. 5":PRINT "EMPLOYERS FICA RATE ";:PRINT USING PCT$;CVD(B$);:PRINT " REC.NO. 5"
9020 IF PRT$="P" THEN LPRINT "FED.UNEMP. RATE";:LPRINT " ";:LPRINT USING PCT$;CVD(A$);:LPRINT " REC.NO. 5":LPRINT "EMPLOYERS FICA RATE ";:LPRINT USING PCT$;CVD(B$);:LPRINT " REC.NO. 5"
9030 GET 2,6:PRINT "FED.WITH.ALLOW. PER DEPENDENT ";:PRINT USING "$$##.##";CVD(A$);:PRINT " REC.NO. 6":IF PRT$="P" THEN LPRINT "FED.WITH.ALLOW. PER DEPENDENT ";:LPRINT USING "$$##.##";CVD(A$);:LPRINT " REC.NO. 6"
9060 PRINT:PRINT TAB(20) "SINGLE EMPLOYEES TAX TABLE":PRINT:IF PRT$="P" THEN LPRINT MODE$:LPRINT TAB(20) "SINGLE EMPLOYEES TAX TABLE":LPRINT XMOD$
9080 PRINT TAB(16) "LOW HIGH DOLLAR AMT. PERCENTAGE REC.NO":PRINT:IF PRT$="P" THEN LPRINT TAB(16) "LOW HIGH DOLLAR AMT. PERCENTAGE REC.NO.":LPRINT
9100 FOR N=7 TO LOF(2)/128:FIELD 2, 10 AS A$, 10 AS B$, 10 AS C$, 10 AS D$:GET 2,N:IF N<>15 THEN 9170 ELSE PRINT:PRINT TAB(20) "MARRIED EMPLOYEES TAX TABLE":PRINT
9140 PRINT TAB(16) "LOW HIGH DOLLAR AMT. PERCENTAGE REC.NO":PRINT:IF PRT$="P" THEN LPRINT MODE$:LPRINT TAB(20) "MARRIED EMPLOYEES TAX TABLE":LPRINT XMOD$
9160 IF PRT$="P" THEN LPRINT TAB(16) "LOW HIGH DOLLAR AMT. PERCENTAGE REC.NO.":LPRINT
9170 IF N<15 THEN PRINT "RANGE";:PRINT N-6; ELSE PRINT "RANGE";:PRINT N-14;
9180 IF N<15 AND PRT$="P" THEN LPRINT "RANGE";:LPRINT N-6; ELSE IF PRT$="P" THEN LPRINT "RANGE";:LPRINT N-14;
9190 PRINT USING DL$;CVD(A$);CVD(B$);CVD(C$);:PRINT SPC(9) USING "##.##";CVD(D$);:PRINT SPC(7) N:IF PRT$="P" THEN LPRINT USING DL$;CVD(A$);CVD(B$);CVD(C$);:LPRINT SPC(9);:LPRINT USING "##.##";CVD(D$);:LPRINT SPC(7) N
9210 NEXT:KEY(7) OFF:IF PRT$="P" THEN LPRINT CHR$(140)
9230 PRINT:PRINT TAB(10) "R=REVISE FILE": PRINT:PRINT TAB(10) "O=RETURN TO OPTIONS FOR THIS FILE"
9240 X$=INKEY$:DEF SEG=64:POKE 23, (PEEK(23) OR 64):IF X$="R" THEN 9270 ELSE IF X$="O" THEN CLS:PRINT:PRINT:GOTO 8030 ELSE 9240
9270 CLS:INPUT " RECORD NUMBER TO BE REVISED";N:SKIP%=N:IF SKIP%<7 THEN FIELD 2, 8 AS A$, 10 AS B$
9300 IF N=1 THEN 8100 ELSE IF N=2 THEN 8160 ELSE IF N=3 THEN 8230 ELSE IF N=4 THEN 8260 ELSE IF N=5 THEN 9420 ELSE IF N=6 THEN 8490
9310 GOTO 8540
9320 PRINT:PRINT TAB(10) "R=REVISE ANOTHER":PRINT:PRINT TAB(10) "O=RETURN TO OPTIONS FOR THIS FILE"
9330 X$=INKEY$:DEF SEG=64:POKE 23, (PEEK(23) OR 64):IF X$="R" THEN 9270 ELSE IF X$="O" THEN 8030 ELSE 9330
9360 FIELD 2, 10 AS A$, 10 AS B$, 10 AS C$, 10 AS D$:GET 2, N:PRINT "REC.NO ";:PRINT N:PRINT TAB(7) "LOW HIGH DOLLAR AMT. PERCENTAGE REC.NO":PRINT
9390 PRINT USING DL$;CVD(A$);CVD(B$);CVD(C$);:PRINT SPC(9);:PRINT USING ".##";CVD(D$);:PRINT SPC(8) N:PRINT:INPUT "NEW---LOW,HIGH,DOLLAR AMT.TO DEDUCT,PERCENT TO DEDUCT (SEPARATED BY COMMAS) ";LOW,HIGH,FED,FEDP:GOSUB 8670
9420 CLS:PRINT TAB(10) "U=REVISE FED. UNEMPLOYEMENT RATE":PRINT:PRINT TAB(10) "E=REVISE EMPLOYERS FICA RATE":GET 2,5
9440 RV$=INKEY$:IF RV$="U" THEN 8290 ELSE IF RV$="E" THEN 8310 ELSE 9440
9460 KEY(7) OFF:XZ$=INKEY$:IF XZ$=CHR$(27) THEN 50
9470 IF XZ$<>"@" THEN 9460 ELSE DEF SEG:POKE 106,0:KEY(7) ON:RETURN
20050 INPT$="":INPOS%=POS(0):DEF SEG=64:POKE 23, (PEEK(23) OR 64):POKE 23, (PEEK(23) OR 32):LOCATE,,1,6,7:IF INLN%=0 THEN INLN%=10
20110 IP$=INKEY$:IF IP$="" THEN 20110
20130 IF NBR THEN IF ASC(IP$)>57 THEN BEEP:GOTO 20110
20140 IF NBR THEN IF ASC(IP$)<48 AND ASC(IP$)<>46 THEN IF ASC(IP$)<>8 AND ASC(IP$)<>13 THEN BEEP:GOTO 20110
20150 IF ASC(IP$)=29 THEN BEEP:GOTO 20110
20155 IF ASC(IP$)=27 THEN 50
20160 IP$=CHR$(ASC(IP$)+32*(IP$>="a" AND IP$<="z")):IF LEN(INPT$)=INLN% THEN IF ASC(IP$)<>13 AND ASC(IP$)<>8 THEN 20110
20180 IF ASC(IP$)=13 THEN PRINT:GOTO 20240
20190 IF ASC(IP$)=8 AND POS(0)=INPOS% THEN 20110
20200 IF ASC(IP$)=8 THEN GOSUB 20250:GOTO 20110
20210 INPT$=INPT$+IP$:PRINT IP$;:GOTO 20110
20240 INLN%=0:RETURN
20250 IF INPT$="" THEN 20110
20260 INPT$=LEFT$(INPT$,LEN(INPT$)-1):LOCATE CSRLIN,POS(0)-1:PRINT " ";:LOCATE CSRLIN,POS(0)-1:RETURN
30000 OPEN "BACKUP.FIL" AS 4:IF LOF(4)/128=0 THEN 30020 ELSE GOSUB 30070
30020 CLS:PRINT:PRINT TAB(10) "REMOVE DISK FROM DRIVE A.":PRINT:PRINT TAB(10) "INSERT PROGRAM DISK IN DRIVE A.":PRINT:PRINT TAB(10) "PRESS F8 WHEN READY."
30030 X$=INKEY$:IF X$<>"@" THEN 30030
30050 RUN "EXPENSE.BAS"
30070 OPEN "P.BAT" FOR OUTPUT AS 3:FOR N=1 TO LOF(4)/128:FIELD 4, 14 AS A$:GET 4,N:IF LEFT$(A$,6)="CHKDSC" THEN CHKDSC=1:GOTO 30150
30140 PRINT #3, "COPY "+A$+" "+"B:"
30150 NEXT:PRINT #3, "COPY EMPLOYEE.CNT B:":PRINT #3, "COPY PAYROLL.TOT B:":IF CHKDSC THEN PRINT #3, "CHKDSK A:":PRINT #3, "CHKDSK B:"
30155 PRINT #3, "REM REMOVE BOTH DISKS":PRINT #3, "REM INSERT PROGRAM DISK IN DRIVE A":PRINT #3, "REM ENTER A WHEN READY":CLOSE 3:CLOSE 4:KILL "BACKUP.FIL":RETURN
30210 IF BKUP THEN 30220 ELSE OPEN "BACKUP.FIL" AS 4:BKUP=1
30220 FIELD 4, 14 AS A$:SHORT=INSTR(FL$,CHR$(32)):IF SHORT>0 THEN FL$=LEFT$(FL$,SHORT-1)+RIGHT$(FL$,4)
30230 IF LOF(4)/128=0 THEN 30280
30240 FOR J=1 TO LOF(4)/128:GET 4,J:IF FL$+STRING$(14-LEN(FL$),32)=A$ OR LEFT$(A$,3)="*.*" THEN 30300
30270 NEXT
30280 LSET A$=FL$:PUT 4, LOF(4)/128+1
30300 RETURN
50000 CLS:GOTO 60000
50020 IF SHELLD%=1 THEN 50070
50030 DEF SEG=LD.ADDR:BLOAD "SHELLSRT",0:SHELLSRT=0:SHELLD%=1
50070 SEQ$="A":CLOSE 2:OPEN "EMPLOYEE.CNT" AS 2:FIELD 2, 46 AS AA$:COUNT%=LOF(2)/128:IF SHEELD% THEN 50120
50110 DIM DIRLST$(COUNT%)
50120 FOR N=1 TO COUNT%:GET 2,N:DIRLST$(N-1)=AA$:NEXT:DEF SEG=LD.ADDR:CALL SHELLSRT(SEQ$,COUNT%,DIRLST$(0)):FOR N=0 TO COUNT%-1:PRINT DIRLST$(N):LSET AA$=DIRLST$(N):PUT 2, N+1:NEXT:PRINT:PRINT TAB(10) "PRESS F8 TO RETURN TO OPTIONS"
50240 MU$=INKEY$:IF MU$<>"@" THEN 50240 ELSE 50
59190 PRINT DIRLST$(N)
60000 TRUE%=-1:FALSE%=0:LDOUT%=FALSE%:GOSUB 60180:GOSUB 60230:GOSUB 60270:IF NOT LDOUT% THEN 60130
60030 GOSUB 60340:GOTO 60160
60050 '
60130 GOSUB 60380:CLEAR ,CLR.ADDR:GOSUB 60180:GOSUB 60430
60160 GOTO 50020
60170 END
60180 SUBR.SIZE=400:RETURN
60230 DEF SEG=0:SYS.MEMORY=PEEK(&H413)+PEEK(&H414)*256:RETURN
60270 DEF SEG=0:BASIC.DS=(PEEK(&H510)+PEEK(&H511)*256):OUTSIDE.BASIC.DS=BASIC.DS+4104+(SUBR.SIZE/16):IF OUTSIDE.BASIC.DS*16<SYS.MEMORY*1024 THEN LDOUT%=TRUE%
60330 RETURN
60340 LD.ADDR=OUTSIDE.BASIC.DS-(SUBR.SIZE/16):RETURN
60380 DEF SEG:TOP.STACK=PEEK(&H2C)+PEEK(&H2D)*256:CLR.ADDR=(TOP.STACK-SUBR.SIZE)-128:RETURN
60430 DEF SEG=0:BASIC.DS=16*(PEEK(&H510)+PEEK(&H511)*256):DEF SEG:TOP.STACK=PEEK(&H2C)+PEEK(&H2D)*256:LD.ADDR=(BASIC.DS+TOP.STACK)/16:LD.ADDR=INT(LD.ADDR+0.5):RETURN
Directory of PC-SIG Library Disk #0472
Volume in drive A has no label
Directory of A:\
A EXE 1920 11-27-84 9:38p
ACCTREC BAS 23936 7-09-85 9:07p
AUTOEXEC BAT 25 3-04-85 3:10p
BKPG BAK 24960 8-16-85 7:28p
BKPG BAS 6144 12-25-84 11:20a
BKPG DOC 25249 8-16-85 7:40p
C BAT 121 9-14-84 2:55p
CHECKING BAS 10624 3-04-85 8:51p
EXPENSE BAS 18560 6-06-85 7:45p
F BAT 466 9-20-84 12:53p
FILES472 TXT 1725 1-29-87 11:41a
G BAT 275 9-20-84 1:03p
INCOME BAS 15360 11-28-84 9:36p
L BAT 248 9-20-84 12:57p
N BAT 398 10-26-84 4:18p
NOTES472 TXT 1360 2-10-86 12:25p
PAYROLL BAS 46592 4-25-85 8:58p
R BAT 304 10-26-84 4:19p
S BAT 855 3-04-85 9:04p
SHELLSRT BAS 384 8-25-84 9:50a
STARTUP BAT 437 3-04-85 9:00p
X BAT 227 9-20-84 2:09p
22 file(s) 180170 bytes
130048 bytes free