PCjs Machines
Home of the original IBM PC emulator for browsers.
PC-SIG Diskette Library (Disk #62)
[PCjs Machine "ibm5150"]
Waiting for machine "ibm5150" to load....
Information about “INVENTORY PROGRAM”
A very sensible program for the homeowner, Home Inventory lets you add,
change, or delete inventory as your life and lifestyle changes. A good
program to have for insurance purposes. The program will print out the
overall inventory to either screen or printer.
And, because it is written in BASIC language, it is an excellent study
tool for aspiring programmers.
Special Requirements: A version of BASIC.
How to Start: Type GO (press enter).
Suggested Registration: None
File Descriptions:
CHARS2 BAS Displays ASCII character set in octal, hex or decimal.
LINREGRS BAS Calculates multiple linear regression coefficients.
WB-UPTLE BAS Addition to PC-TALK 2.0 to allow file transmission
while using host computers editor.
MAILIST2 BAS Mailing list program - with search and alphabetic sort.
INVENTRY BAS Helps to keep list of possessions on computer.
INVENTRY DAT Data file for INVENTRY.BAS.
INVENTRY DOC Few notes for INVENTRY.BAS - very short.
CASHACC BAS Simple cash accounting system.
REMCACC BAS Remark lines which may be merged with CASHACC.BAS.
TESTDATA ACC Part of CASHACC.BAS.
MONTHS HBW Data file.
CASHACC.BAS
15 REM ****************************************
20 REM * CASH ACCOUNTS PROGRAM, VERSION 1.0 *
25 REM * MAURICE FERYN 06/19/82 *
26 REM * Rt #1, Box 394 *
27 REM * Mead, WA 99021 *
28 REM * Phone: 509-466-3685 *
30 REM ****************************************
31 REM MERGE with REMCACC for a listing with remarks.
100 REM INITIALIZE , DECLARE AND DIMENSION VARIABLES
105 SCREEN 0,0,0: WIDTH 80
110 DEFINT C,F,I,B: DEFSNG A: DEFDBL D: DEFSTR S: FD=0: CA=195: CE=195:B=13: KEY OFF
120 DIM AAC1(CA), SAC2(CA), DAC3(CA), DAC4(CA)
130 DIM SEN1(CE), SEN2(CE), SEN3(CE), DEN4(CE), AEN5(CE)
135 ON ERROR GOTO 8500
140 REM HEADER, PRINT AND DATE
150 CLS: PRINT TAB(30);: COLOR 0,7: PRINT" CASH ACCOUNTS ": COLOR 7,0: PRINT
160 INPUT"ENTER TODAY'S DATE (MO/DA/YR) ";SCDATE
300 REM DISPLAY MAIN MENU AND SELECT OPTION
310 FL=1: CLS
320 WHILE FL
330 PRINT TAB(30);:COLOR 0,7: PRINT " MAIN MENU ": COLOR 7,0
340 PRINT:PRINT:PRINT
345 PRINT"1. INITIALIZE PROGRAM"
347 PRINT"2. INPUT DATA"
350 PRINT"3. ADD, DELETE OR PRINT ACCOUNTS"
360 PRINT"4. ENTER OR EDIT CURRENT TRANSATIONS"
370 PRINT"5. REPORTS"
380 PRINT"6. START NEW ACCOUNTING PERIOD"
390 PRINT"7. SAVE DATA"
394 PRINT"8. END RUN"
400 PRINT: PRINT "TYPE the number of the option desired ";:S= INPUT$(1): I= VAL(S)
405 IF I<1 OR I>8 THEN BEEP
410 IF I>2 AND I<8 AND FD=0 THEN GOSUB 8000
420 ON I GOSUB 500,8000,1000,2000,3000,4000,5000,7000
430 CLS
440 WEND
445 END
500 REM INITIALIZE PROGRAM
510 CLS: PRINT:PRINT TAB(30): COLOR 0,7:PRINT " INITIALIZE PROGRAM ":COLOR 7,0:PRINT:PRINT
520 FL1=1
530 WHILE FL1
540 AAC1(1)=100:SAC2(1)="ASSET ACCOUNTS"
550 PRINT"The account for CHECKBOOK balance is assigned the number 101"
560 PRINT"and the PETTY CASH account is assigned the number 102"
570 PRINT: PRINT"Enter initial balances for these accounts as requested":PRINT
580 AAC1(2)=101:SAC2(2)="CHECKBOOK":AAC1(3)=102:SAC2(3)="PETTY CASH":IACN=3:IALI=4: IAIN=4: IAEX=4: IENN=0
590 FOR C=2 TO IACN
600 PRINT AAC1(C);" ";SAC2(C);:INPUT " Balance ";DAC4(C)
610 NEXT C: FL1=0
620 WEND:FD=1:RETURN
1000 REM ADD, EDIT OR PRINT ACCOUNTS SUBROUTINE
1010 FL1=1
1030 WHILE FL1
1040 CLS: PRINT TAB(25);:COLOR 0,7: PRINT" ADD, EDIT OR PRINT ACCOUNTS ":COLOR 7,0: PRINT: PRINT
1050 PRINT "1. ADD ACCOUNTS"
1060 PRINT "2. EDIT ACCOUNTS"
1070 PRINT "3. PRINT CHART OF ACCOUNTS"
1080 PRINT: PRINT "TYPE the number of the option desired else `E'to end";: S= INPUT$(1)
1085 IF S="E" OR S="e" THEN FL1=0: I=0 ELSE I= VAL(S)
1090 IF I<1 OR I>3 THEN BEEP
1100 ON I GOSUB 1200,1400,1600
1120 WEND
1130 RETURN
1200 REM ADD ACCOUNTS SUBROUTINE
1210 CLS: GOSUB 1800
1220 PRINT TAB(30) "ADD ACCOUNTS": PRINT: PRINT
1230 FL2=1
1240 INPUT "ENTER account # else `E' to end";S
1250 IF S="E" OR S="e" THEN FL2=0 ELSE A= VAL(S):SDDATE=SCDATE
1260 REM INPUT ACCOUNT INFORMATION LOOP
1270 WHILE FL2
1275 C=0: FL3=0
1277 AT=A*10 - INT(A*10):IF AT<>0 OR A<100 OR A>999.9 THEN INPUT "Bad range, Redo";S:A=VAL(S):GOTO 1277
1280 C=C + 1: IF C<(IACN + 1) THEN IF A=AAC1(C) THEN FL3=1 ELSE GOTO 1280
1290 IF FL3=1 THEN INPUT "Number entered is current, redo";S:A=VAL(S):C=0:FL3=0: GOTO 1277
1300 GOSUB 1850: REM ADJUST ACCOUNT POINTERS
1310 I=CSRLIN: LOCATE I,31: PRINT"|";:LOCATE I,1: INPUT "NAME ";SAC2(CS)
1320 INPUT "BALANCE";DAC4(CS): DAC3(CS)=0: PRINT: PRINT
1340 INPUT "ENTER account # else `E' to end";S
1350 IF S="E" OR S="e" THEN FL2=0 ELSE A= VAL(S)
1360 WEND
1370 RETURN
1400 REM EDIT ACCOUNTS SUBROUTINE
1410 CLS: GOSUB 1800: REM PRINT BOTTOM LINE
1420 PRINT TAB(30)"EDIT ACCOUNTS": PRINT: PRINT
1430 FL2=1
1440 INPUT "ENTER account # else `E' to end";S
1450 IF S="E" OR S="e" THEN FL2=0 ELSE A= VAL(S):SDDATE=SCDATE
1460 REM EDIT ACCOUNTS LOOP
1470 WHILE FL2
1480 C=0
1490 C=C+1: IF A=AAC1(C) THEN FL3=1:CE=C ELSE IF C=IACN THEN FL3=0 ELSE GOTO 1490
1500 IF FL3=0 THEN INPUT"ACCOUNT NOT FOUND, REDO";A: GOTO 1480 ELSE PRINT"NAME ";SAC2(CE): PRINT"MONTHLY BALANCE ";DAC3(C): PRINT"YTD BALANCE ";DAC4(C)
1510 PRINT: INPUT"IS THIS THE RIGHT ACCOUNT, Y/N ";S
1520 IF S="Y" OR S="y" THEN FL4=1 ELSE FL4=0
1530 WHILE FL4
1540 PRINT:INPUT"Retype account #";S:A=VAL(S):AT=A*10 - INT(A*10):IF AT<>0 OR A<100 OR A>999.9 THEN PRINT"Bad range, Redo":GOTO 1540
1545 IF A<>AAC1(CE) THEN GOSUB 1950: GOSUB 1850 ELSE CS=CE
1550 I=CSRLIN: LOCATE I,31: PRINT"|";:LOCATE I,1: INPUT "NAME ";SAC2(CS)
1555 INPUT "BALANCE";DAC4(CS): DAC3(CS)=0: PRINT: PRINT
1557 IF SAC2(CS)="" THEN SE=SC:GOSUB 1950
1560 FL4=0
1570 WEND
1580 INPUT "ENTER account # else `E' to end";S
1590 IF S="E" OR S="e" THEN FL2=0 ELSE A= VAL(S)
1595 WEND
1596 RETURN
1600 REM PRINT CHART OF ACCOUNTS SUBROUTINE
1610 PRINT: PRINT: PRINT"Ready printer and hit ENTER else type `E' to return to menu";:S= INPUT$(1)
1620 IF S= "E" OR S= "e" THEN GOTO 1680
1630 LPRINT CHR$(15);CHR$(27);CHR$(48):WIDTH "LPT1:",132:CI=INT(IACN/3 + 1)
1640 FOR C=1 TO CI
1650 LPRINT USING " ###.# \ \ ###.# \ \ ###.# \ \";AAC1(C),SAC2(C),AAC1(C+CI),SAC2(C+CI),AAC1(C+2*CI),SAC2(C+2*CI)
1660 NEXT C
1670 LPRINT CHR$(18);CHR$(27);CHR$(50);CHR$(12)
1680 RETURN
1800 REM PRINT BOTTOM LINE SUBROUTINE
1810 LOCATE 25,1: COLOR 0,7: PRINT" Acc. #'s: Asset 103-199; Liability 201-299; Income 301-599; Expense 601-899 ";:COLOR 7,0
1820 LOCATE 1,1: RETURN
1850 REM ADJUST ACCOUNT POINTERS
1855 IF A<200 THEN IALI = IALI + 1
1860 IF A<300 THEN IAIN = IAIN + 1
1870 IF A<600 THEN IAEX = IAEX + 1
1880 GOSUB 1900: REM GO SUB SORT
1890 RETURN
1900 REM ADD ACCOUNT SORT SUBROUTINE
1910 C=IACN
1920 IF A<AAC1(C) THEN AAC1(C+1)=AAC1(C):SAC2(C+1)=SAC2(C):DAC3(C+1)=DAC3(C):DAC4(C+1)=DAC4(C):C=C-1: GOTO 1920
1930 CS=C+1: AAC1(CS)=A: IACN=IACN+1
1940 RETURN
1950 REM DELETE ACCOUNT SORT SUBROUTINE
1955 IF AAC1(CE)<200 THEN IALI = IALI - 1
1960 IF AAC1(CE)<300 THEN IAIN = IAIN - 1
1965 IF AAC1(CE)<600 THEN IAEX = IAEX - 1
1970 FOR C=CE TO (IACN-1): AAC1(C)=AAC1(C+1): SAC2(C)=SAC2(C+1):DAC3(C)=DAC3(C+1): DAC4(C)=DAC4(C+1): NEXT C
1975 IACN=IACN-1
1980 RETURN
2000 REM ENTER OR EDIT TRANSACTIONS SUBROUTINE
2010 FL1=1
2020 WHILE FL1
2030 CLS:PRINT TAB(25);:COLOR 0,7: PRINT" ENTER or EDIT TRANSACTIONS ":COLOR 7,0:PRINT:PRINT
2040 PRINT"1. ENTER TRANSACTIONS"
2050 PRINT"2. EDIT TRANSACTIONS"
2060 PRINT: PRINT "TYPE the number of the option desired else `E'to end";: S= INPUT$(1)
2070 IF S="E" OR S="e" THEN FL1=0: I=0 ELSE I= VAL(S)
2080 IF I<1 OR I>2 THEN BEEP
2090 ON I GOSUB 2200,2500
2100 WEND
2110 RETURN
2200 REM ENTER TRANSACTIONS SUBROUTINE
2210 CLS: GOSUB 2800: REM PRINT BOTTOM LINE
2220 DBAL=DAC4(2):SH="ENTER":GOSUB 2830: REM PRINT HEADING SUBROUTINE
2230 CF=IENN+1:CE=0:PRINT USING "###";CF;:PRINT TAB(4);:INPUT;S: IF S="E" OR S="e" THEN FL2=0 ELSE FL2=1:SDDATE=SCDATE
2240 WHILE FL2
2245 IR=CSRLIN:IF VAL(LEFT$(S,1))=0 AND LEFT$(S,1)<>"D" AND S<>"C+" AND S<>"C-" AND S<>"I" AND S<>"A+" AND S<>"A-" AND S<>"E" THEN LOCATE IR,4:PRINT" Redo";:LOCATE IR,4:INPUT;S:GOTO 2245
2247 IF S="E" THEN FL2=0:GOTO 2350
2250 IENN=IENN+1:C=IENN:CL=IENN:SEN1(C)=S
2260 IF LEFT$(S,1)="I" THEN LOCATE IR,11:INPUT;SEN2(C):LOCATE IR,22:INPUT;SEN3(C):LOCATE IR,79:PRINT "|";:FL3=0 ELSE FL3=1
2270 WHILE FL3
2280 LOCATE IR,11:INPUT;SEN2(C):LOCATE IR,22:INPUT;SEN3(C):LOCATE IR,54:PRINT "| ";
2282 LOCATE IR,56:INPUT;S:D=VAL(S):IF D=0 THEN LOCATE IR,56:PRINT" Redo ":GOTO 2282 ELSE DEN4(C)=D
2284 LOCATE IR,70:INPUT;S:A=VAL(S):IF A=0 THEN LOCATE IR,70:PRINT" Redo ":GOTO 2284 ELSE AEN5(C)=A
2290 FT=0:FOR CT=1 TO IACN: IF AEN5(C)=AAC1(CT) THEN FT=1
2295 NEXT CT:IF FT=0 THEN LOCATE IR,70:PRINT" Bad #";:GOTO 2284
2310 FL3=0
2320 WEND
2325 IF INT(VAL(LEFT$(SEN1(C),2)))<>0 THEN DBAL=DBAL-DEN4(C) ELSE IF LEFT$(SEN1(C),1)="D" THEN DBAL=DBAL+DEN4(C)
2330 PRINT:CE=CE+1:IF CE>20 THEN IR=CSRLIN:LOCATE 1,1:GOSUB 2830:LOCATE IR,1 ELSE IR=CSRLIN:LOCATE IH,64:PRINT USING "$###,###.##";DBAL:LOCATE IR,1
2340 PRINT USING "###";C+1;:PRINT TAB(4);:INPUT;S: IF S="E" OR S="e" THEN FL2=0
2350 WEND
2360 REM EDIT CURRENT TRANSACTIONS
2370 FL2=0:IF CE<>0 THEN CLS:PRINT:PRINT"Do you want to EDIT the previous transactions, Y/N";:S=INPUT$(1)
2380 IF S="Y" OR S="y" THEN FL2=1
2390 WHILE FL2
2400 CLS:GOSUB 2860: REM PRINT BOTTOM LINE
2410 SH=" EDIT":GOSUB 2830: REM PRINT HEADER
2420 FL3=1:C=CF:SP="|"
2430 WHILE FL3
2440 GOSUB 2600:IF C<>CL THEN C=C+1 ELSE FL3=0
2450 WEND:FL2=0
2460 WEND
2470 COLOR 23,0:PRINT "Entering transactions":COLOR 7,0:FOR C=CF TO CL:IF LEFT$(SEN1(C),1)<>"I" THEN GOSUB 2910
2475 NEXT C
2480 RETURN
2500 REM EDIT SPECIFIC TRANSACTION SUBROUTINE
2510 CLS:GOSUB 2860: REM PRINT BOTTOM LINE
2520 DBAL=DAC4(2):SH="EDIT":GOSUB 2830: REM PRINT HEADER
2530 INPUT"ENTER Transaction # else `E' to end";S
2540 IF S="E" OR S="e" THEN FL2=0 ELSE FL2=1:C=VAL(S):FL4=0:SDDATE=SCDATE
2550 WHILE FL2
2555 IF LEFT$(SEN1(C),1)<>"I" THEN GOSUB 2934 : REM ADJUST ACCOUNTS
2560 GOSUB 2600:IF LEFT$(SEN1(C),1)<>"I" THEN GOSUB 2910
2565 INPUT"ENTER Transaction # else `E' to end";S
2570 IF S="E" OR S="e" THEN FL2=0 ELSE C=VAL(S)
2580 WEND
2590 RETURN
2600 REM EDIT TRANSACTIONS SUBROUTINE
2610 FL4=1:IF LEFT$(SEN1(C),1)="I" THEN GOSUB 2750 ELSE GOSUB 2760
2612 LOCATE ,,,B:IR=CSRLIN:IF IR>23 THEN LOCATE 1,1:GOSUB 2830:LOCATE IR,1
2615 WHILE FL4
2620 S=INPUT$(1):IF S=CHR$(13) THEN I=0:FL4=0:PRINT"" ELSE I=VAL(S):IR=CSRLIN
2630 ON I GOSUB 2680,2690,2700,2710,2720
2640 LOCATE ,,,B
2650 WEND
2660 IR=CSRLIN:IF IR>23 THEN LOCATE 1,1:GOSUB 2830:LOCATE IR,1 ELSE LOCATE IH,64:PRINT USING "$###,###.##";DBAL:LOCATE IR,1
2670 RETURN
2680 IF INT(VAL(LEFT$(SEN1(C),2)))<>0 THEN DBAL=DBAL+DEN4(C) ELSE IF LEFT$(SEN1(C),1)="D" THEN DBAL=DBAL-DEN4(C)
2682 LOCATE IR,4,1,1,B:INPUT;S:IF VAL(LEFT$(S,1))=0 AND LEFT$(S,1)<>"D" AND S<>"C-" AND S<>"C+" AND S<>"I" AND S<>"A+" AND S<>"A-" THEN LOCATE IR,4,0:PRINT" Redo":GOTO 2682 ELSE SEN1(C)=S
2684 IF INT(VAL(LEFT$(SEN1(C),2)))<>0 THEN DBAL=DBAL-DEN4(C) ELSE IF LEFT$(SEN1(C),1)="D" THEN DBAL=DBAL+DEN4(C)
2686 RETURN
2690 LOCATE IR,11,1,1,B:INPUT;SEN2(C):RETURN
2700 LOCATE IR,22,1,1,B:INPUT;SEN3(C):RETURN
2710 IF INT(VAL(LEFT$(SEN1(C),2)))<>0 THEN DBAL=DBAL+DEN4(C) ELSE IF LEFT$(SEN1(C),1)="D" THEN DBAL=DBAL-DEN4(C)
2712 LOCATE IR,56,1,1,B:INPUT;S:D=VAL(S):IF D=0 THEN LOCATE IR,56:PRINT" Redo ":GOTO 2712 ELSE DEN4(C)=D
2714 IF INT(VAL(LEFT$(SEN1(C),2)))<>0 THEN DBAL=DBAL-DEN4(C) ELSE IF LEFT$(SEN1(C),1)="D" THEN DBAL=DBAL+DEN4(C)
2716 RETURN
2720 LOCATE IR,70,1,1,B:INPUT;S:A=VAL(S):IF A=0 THEN LOCATE IR,70:PRINT" Redo ":GOTO 2720 ELSE AEN5(C)=A:FT=0:FOR CT=1 TO IACN: IF AEN5(C)=AAC1(CT) THEN FT=1
2725 NEXT CT:IF FT=0 THEN LOCATE IR,70:PRINT" Bad #";:GOTO 2720
2730 RETURN
2750 REM PRINT INFORMATION TRANSACTION DATA
2752 PRINT USING "### \ \ \ \ \ \!";C,SEN1(C),SEN2(C),SEN3(C),SP
2754 RETURN
2760 REM PRINT CHECK, DEP, CASH, OR ADJ TRANSACTIONS
2764 PRINT USING "### \ \ \ \ \ \! $###,###.## ###.#";C,SEN1(C),SEN2(C),SEN3(C),SP,DEN4(C),AEN5(C)
2766 RETURN
2800 REM PRINT BOTTOM LINE SUBROUTINE
2810 LOCATE 25,1: COLOR 0,7: PRINT" CODE:Chk.- #; Dep.- D + opt.#; Cash - C+/C-; Inf.- I; Adj.- A+/A-; End - E ";:COLOR 7,0
2820 LOCATE 1,1: RETURN
2830 REM PRINT HEADING SUBROUTINE
2840 IH=CSRLIN:PRINT TAB(20) SH;" TRANSACTIONS";TAB(50);:PRINT USING "CHECK BALANCE $###,###.##";DBAL
2842 PRINT " 1 2 3 4 5 "
2844 PRINT " # Code Date Description ..................| Amount Acc# "
2850 RETURN
2860 REM PRINT BOTTOM LINE SUBROUTINE
2870 LOCATE 25,1:COLOR 0,7:PRINT " TO EDIT: Hit the col. #, ENTER new data else hit ENTER when the line is okay ";:COLOR 7,0
2880 LOCATE 1,1:RETURN
2900 REM ENTER OR DELETE TRANSACTIONS TO ACCOUNTS SUBROUTINES
2910 REM ENTER TRANSACTION INFORMATION TO ACCOUNTS SUBROUTINE
2912 IT=VAL(LEFT$(SEN1(C),1)):IF IT<>0 THEN DAC4(2)=DAC4(2) - DEN4(C)
2914 ST=LEFT$(SEN1(C),1):IF ST="D" THEN DAC4(2)=DAC4(2) + DEN4(C)
2916 IF SEN1(C)="C+" THEN DAC4(3)=DAC4(3) + DEN4(C)
2918 IF SEN1(C)="C-" THEN DAC4(3)=DAC4(3) - DEN4(C)
2920 CA=0
2922 CA=CA+1:IF AEN5(C)<>AAC1(CA) THEN GOTO 2922
2924 IF IT<>0 OR SEN1(C)="C-" THEN IF AEN5(C)<200 OR AEN5(C)>599.9 THEN GOSUB 2962 ELSE GOSUB 2964
2926 IF ST="D" OR SEN1(C)="C+" THEN IF AEN5(C)<200 OR AEN5(C)>599.9 THEN GOSUB 2964 ELSE GOSUB 2962
2928 IF SEN1(C)="A+" THEN GOSUB 2962
2930 IF SEN1(C)="A-" THEN GOSUB 2964
2932 RETURN
2934 REM DELETE TRANSACTION INFORMATION TO ACCOUNTS SUBROUTINE
2936 IT=VAL(LEFT$(SEN1(C),1)):IF IT<>0 THEN DAC4(2)=DAC4(2) + DEN4(C)
2938 ST=LEFT$(SEN1(C),1):IF ST="D" THEN DAC4(2)=DAC4(2) - DEN4(C)
2940 IF SEN1(C)="C+" THEN DAC4(3)=DAC4(3) - DEN4(C)
2942 IF SEN1(C)="C-" THEN DAC4(3)=DAC4(3) + DEN4(C)
2944 CA=0
2946 CA=CA+1:IF AEN5(C)<>AAC1(CA) THEN GOTO 2946
2948 IF IT<>0 OR SEN1(C)="C-" THEN IF AEN5(C)<200 OR AEN5(C)>599.9 THEN GOSUB 2964 ELSE GOSUB 2962
2950 IF ST="D" OR SEN1(C)="C+" THEN IF AEN5(C)<200 OR AEN5(C)>599.9 THEN GOSUB 2962 ELSE GOSUB 2964
2952 IF SEN1(C)="A+" THEN GOSUB 2964
2954 IF SEN1(C)="A-" THEN GOSUB 2962
2956 RETURN
2960 REM ADD OR SUBTRACT ACCOUNT BALANCES
2962 DAC4(CA)=DAC4(CA) + DEN4(C):DAC3(CA)=DAC3(CA) + DEN4(C):RETURN
2964 DAC4(CA)=DAC4(CA) - DEN4(C):DAC3(CA)=DAC3(CA) - DEN4(C):RETURN
3000 REM REPORTS SUBROUTINE
3010 FL1=1:GOSUB 3904
3040 WHILE FL1
3050 CLS:PRINT TAB(25);:COLOR 0,7:PRINT" REPORT to ";SP;" ":COLOR 7,0:PRINT:PRINT
3060 PRINT "1. ACCOUNTS"
3070 PRINT "2. TRANSACTIONS"
3080 PRINT "3. CHANGE OUTPUT TO PRINTER"
3090 PRINT "4. CHANGE OUTPUT TO SCREEN"
3100 PRINT:PRINT "TYPE the number of the option desired else `E' to end";:S=INPUT$(1)
3110 IF S="E" OR S="e" THEN FL1=0:I=0 :CLOSE #2 ELSE I=VAL(S)
3120 IF I<1 OR I>4 THEN BEEP
3130 ON I GOSUB 3200,3500,3902,3904
3140 WEND
3150 RETURN
3200 REM REPORT ACCOUNTS SUBROUTINE
3210 FL2=1:IF SP="PRINTER" THEN CLT=50 ELSE CLT=15
3220 WHILE FL2
3230 CLS:PRINT TAB(25);"REPORT ACCOUNTS to ";SP:PRINT:PRINT
3240 PRINT"1. ASSET"
3242 PRINT"2. LIABILITY"
3244 PRINT"3. INCOME"
3246 PRINT"4. EXPENSE"
3248 PRINT"5. SELECT RANGE"
3250 PRINT:PRINT"TYPE the number of the option desired else `E' to end";:S=INPUT$(1)
3260 IF S="E" OR S="e" THEN FL2=0:I=0 ELSE I=VAL(S):DTOTMO=0:DTOTYTD=0:IF SP="SCREEN" THEN CLS ELSE PRINT " Writing to printer"
3270 IF I<1 OR I>5 THEN BEEP
3280 ON I GOSUB 3310,3320,3330,3340,3350
3290 WEND
3300 RETURN
3310 REM PRINT ASSET ACCOUNTS
3314 CL=0:C1=1:C2=IALI-1:SH=" ASSET ACCOUNTS"
3318 GOSUB 3400: RETURN
3320 REM PRINT LIABILITY ACCOUNTS
3324 CL=0:C1=IALI:C2=IAIN-1:SH=" LIABILITY ACCOUNTS"
3328 GOSUB 3400: RETURN
3330 REM PRINT INCOME ACCOUNTS
3334 CL=0:C1=IAIN:C2=IAEX-1:SH=" INCOME ACCOUNTS"
3338 GOSUB 3400: RETURN
3340 REM PRINT EXPENSE ACCOUNTS
3344 CL=0:C1=IAEX:C2=IACN:SH=" EXPENSE ACCOUNTS"
3348 GOSUB 3400: RETURN
3350 REM PRINT SELECT ACCOUNT RANGE
3354 PRINT TAB(20);"SELECT ACCOUNT RANGE FOR REPORT":PRINT
3358 I=CSRLIN:INPUT"ENTER low account # and high account #. Ex: 200,500 ";SC1,SC2
3362 IF VAL(SC1)=0 OR VAL(SC2)=0 OR VAL(SC1)>VAL(SC2) THEN LOCATE I,1:PRINT "Redo! ";:GOTO 3358
3366 C=1
3370 IF AAC1(C)=>VAL(SC1) THEN C1=C ELSE C=C+1:GOTO 3370
3374 C=IACN
3378 IF AAC1(C)<=VAL(SC2) THEN C2=C ELSE C=C-1: GOTO 3378
3382 PRINT:PRINT "ENTER name for account range, up to 40 char. ":INPUT ST
3386 SH=" "+ST:CL=0
3390 CLS: GOSUB 3400: RETURN
3400 REM PROCESS AND PRINT ACCOUNTS SUBROUTINE
3404 GOSUB 3908: REM PRINT HEADER
3408 FOR C = C1 TO C2
3412 CS=C:A=AAC1(C+1) - INT(AAC1(C+1))
3416 IF A<>0 THEN FL4=1:DAC3(CS)=0:DAC4(CS)=0 ELSE FL4=0
3420 WHILE FL4
3424 C=C+1:DAC3(CS)=DAC3(CS) + DAC3(C):DAC4(CS)=DAC4(CS) + DAC4(C)
3428 CP=C:GOSUB 3912:CL=CL+1
3432 A=AAC1(C+1) - INT(AAC1(C+1))
3436 IF A=0 THEN FL4=0
3440 WEND
3444 CP=CS:DTOTMO=DTOTMO+DAC3(CP):DTOTYTD=DTOTYTD+DAC4(CP):GOSUB 3912:CL=CL+1
3448 IF C=>C2 THEN GOSUB 3950:IF SP="SCREEN" THEN INPUT "Hit ENTER to continue";S
3452 IF CL=>CLT AND C<>C2 AND SP="SCREEN" THEN INPUT "Hit ENTER to continue";S
3456 IF CL=>CLT AND C<>C2 THEN PRINT#2,CHR$(12);: GOSUB 3908:CL=0
3460 NEXT C
3464 PRINT#2,CHR$(12)
3468 RETURN
3500 REM REPORT TRANSACTIONS SUBROUTINE
3510 FL2=1: IF SP="PRINTER" THEN CLT=50 ELSE CLT=15
3520 WHILE FL2
3530 CLS:PRINT TAB(25); "REPORT TRANSACTIONS to ";SP:PRINT:PRINT
3532 PRINT "1. CHECKS"
3534 PRINT "2. DEPOSITS"
3536 PRINT "3. CASH"
3538 PRINT "4. INFORMATION"
3540 PRINT "5. ADJUSTMENTS"
3542 PRINT "6. ALL"
3550 PRINT:PRINT "TYPE the number of the option desired else `E' to end";:S=INPUT$(1)
3560 IF S="E" OR S="e" THEN FL2=0:I=0 ELSE I=VAL(S):CL=0:IF SP="SCREEN" THEN CLS ELSE PRINT " Writing to printer"
3570 IF I<1 OR I>6 THEN BEEP
3580 ON I GOSUB 3600,3620,3640,3660,3680,3700
3585 WEND:RETURN
3598 REM PRINT VARIOUS TRANSACTIONS SUBROUTINES
3600 SH=" CHECKS":GOSUB 3920:GOSUB 3940
3602 FOR C=1 TO IENN
3604 IT = VAL(LEFT$(SEN1(C),1)): IF IT<>0 THEN GOSUB 3720
3606 NEXT C:IF CL=0 THEN PRINT#2," *** NO ENTRIES ***"
3607 IF SP="SCREEN" THEN INPUT "Hit ENTER to continue";S
3608 PRINT#2,CHR$(12):RETURN
3620 SH=" DEPOSITS":GOSUB 3920:GOSUB 3940
3622 FOR C=1 TO IENN
3624 IF LEFT$(SEN1(C),1)="D" THEN GOSUB 3720
3626 NEXT C:IF CL=0 THEN PRINT#2," *** NO ENTRIES ***"
3627 IF SP="SCREEN" THEN INPUT "Hit ENTER to continue";S
3628 PRINT#2,CHR$(12):RETURN
3640 SH=" PETTY CASH":GOSUB 3920:GOSUB 3940
3642 FOR C=1 TO IENN
3644 IF LEFT$(SEN1(C),1)="C" THEN GOSUB 3720
3646 NEXT C:IF CL=0 THEN PRINT#2," *** NO ENTRIES ***"
3647 IF SP="SCREEN" THEN INPUT "Hit ENTER to continue";S
3648 PRINT#2,CHR$(12):RETURN
3660 SH=" INFORMATION":GOSUB 3930:GOSUB 3940
3662 FOR C=1 TO IENN
3664 IF SEN1(C)="I" THEN GOSUB 3720
3666 NEXT C:IF CL=0 THEN PRINT#2," *** NO ENTRIES ***"
3667 IF SP="SCREEN" THEN INPUT "Hit ENTER to continue";S
3668 PRINT#2,CHR$(12):RETURN
3680 SH=" ADJUSTMENTS":GOSUB 3920:GOSUB 3940
3682 FOR C=1 TO IENN
3684 IF LEFT$(SEN1(C),1)="A" THEN GOSUB 3720
3686 NEXT C:IF CL=0 THEN PRINT#2," *** NO ENTRIES ***"
3687 IF SP="SCREEN" THEN INPUT "Hit ENTER to continue";S
3688 PRINT#2,CHR$(12):RETURN
3700 SH=" ALL TRANSACTIONS":GOSUB 3920:GOSUB 3940
3702 FOR C=1 TO IENN
3704 GOSUB 3720
3706 NEXT C:IF CL=0 THEN PRINT#2," *** NO ENTRIES ***"
3707 IF SP="SCREEN" THEN INPUT "Hit ENTER to continue";S
3708 PRINT#2,CHR$(12):RETURN
3720 REM PRINT TRANSACTION DATA SUBROUTINE
3722 IF CL=>CLT AND SP="SCREEN" THEN INPUT "Hit ENTER to continue";S
3724 IF CL=>CLT THEN PRINT#2,CHR$(12):GOSUB 3940:CL=0
3726 IF SEN1(C)<>"I" THEN GOSUB 3742 ELSE GOSUB 3744
3728 CL=CL+1
3730 RETURN
3740 REM PRINT TRANSACTION DATA LINE
3742 PRINT#2,USING" ### \ \ \ \ \ \ $###,###.## ###.#";C,SEN1(C),SEN2(C),SEN3(C),DEN4(C),AEN5(C):RETURN
3744 PRINT#2,USING" ### \ \ \ \ \ \";C,SEN1(C),SEN2(C),SEN3(C):RETURN
3900 REM SET PRINTER OR SCREEN FILE
3902 CLOSE #2:PRINT:INPUT"Check printer then hit ENTER";S1:SP="PRINTER":OPEN "LPT1:" FOR OUTPUT AS 2:RETURN
3904 CLOSE #2:SP="SCREEN":OPEN "SCRN:" FOR OUTPUT AS 2:RETURN
3908 REM PRINT ACCOUNTS HEADER
3910 PRINT#2,SH;TAB(70);SDDATE:PRINT#2,""
3911 PRINT#2, " NUMBER NAME PERIOD BAL. CURRENT BAL.":PRINT#2,"":RETURN
3912 REM PRINT ACCOUNTS DATA
3913 PRINT#2,USING" ###.# \ \ $$,###,###.## $$,###,###.##";AAC1(CP),SAC2(CP),DAC3(CP),DAC4(CP):RETURN
3919 REM SET TRANSACTION COLUMN HEADING AND PRINT HEADER SUBROUTINES
3920 SC= " # Code Date Description ...................| Amount Acc#":RETURN
3930 SC= " # Code Date Description .......................................|":RETURN
3940 PRINT#2,SH;TAB(70);SDDATE:PRINT#2,"":PRINT#2,"":PRINT#2,SC:PRINT#2,"":RETURN
3950 REM PRINT ACCOUNT TOTALS
3952 PRINT#2,TAB(45);"------------ ------------"
3954 PRINT#2,TAB(36);USING "TOTAL $$,###,###.## $$,###,###.##";DTOTMO,DTOTYTD
3956 RETURN
4000 REM START NEW ACCOUNTING PERIOD SUBROUTINE
4010 PRINT:COLOR 0,7:PRINT" Start new accounting period ":COLOR 7,0
4020 PRINT"Do you want to save current data, TYPE Y,N or any other key to cancel";:S=INPUT$(1)
4030 IF S="Y" OR S="y" THEN GOSUB 8200
4040 IF S="N" OR S="n" THEN PRINT"TYPE `OK' to start new accounting period";:S=INPUT$(2)
4050 IF S="OK" OR S="ok" THEN FOR C=1 TO IACN:DAC3(C)=0:NEXT C:IENN=0 ELSE COLOR 17,7: PRINT " DATA NOT CLEARED ": COLOR 7,0: FOR C=1 TO 3000:NEXT C
4060 RETURN
5000 REM SAVE DATA SUBROUTINE
5010 PRINT:COLOR 0,7:PRINT" Save data ":COLOR 7,0
5020 PRINT "Is this what you want, Y/N ":S=INPUT$(1)
5030 IF S="Y" OR S="y" THEN FL1=1
5040 WHILE FL1
5050 GOSUB 8200
5060 PRINT"Do you want another copy, Y/N ":S=INPUT$(1)
5070 IF S="N" OR S="n" THEN FL1=0 ELSE FL1=1
5080 WEND
5100 RETURN
7000 REM END RUN
7010 CLS:PRINT :PRINT TAB(30);:COLOR 0,7:PRINT " END RUN ":COLOR 7,0:PRINT
7020 PRINT "Do you need to save data or return to Main Menu, Y/N":S=INPUT$(1): IF S="N" OR S="n" THEN FL=0
7030 RETURN
8000 REM DATA INPUT SUBROUTINE
8010 CLS: PRINT TAB(30);:COLOR 0,7:PRINT " DATA INPUT ":COLOR 7,0: PRINT
8012 IF I>2 AND I<8 THEN PRINT "You need to input data first!"
8015 FL1=0:PRINT"Is this what you want, Y/N ":S=INPUT$(1):IF S="Y" OR S="y" THEN FL1=1 ELSE I=0
8018 WHILE FL1
8020 INPUT "Insert data disk and then hit ENTER";S
8030 PRINT "Data files on disk are;": FILES "*.ACC"
8040 PRINT: INPUT "ENTER file name(without ext.), N to check another disk or E to end";S: IF S="N" OR S="n" THEN FL2=0 ELSE IF S="E" OR S="e" THEN FL1=0:FL2=0 ELSE FL2=1
8043 WHILE FL2
8045 SA=S + SPACE$(8-LEN(S)) + ".ACC"
8050 OPEN SA FOR INPUT AS 1
8055 PRINT: COLOR 23,0:PRINT"Loading data":COLOR 7,0
8060 INPUT#1, IACN,IALI,IAIN,IAEX
8070 FOR C=1 TO IACN: INPUT#1, AAC1(C),SAC2(C),DAC3(C),DAC4(C): NEXT C
8080 CLOSE #1
8085 SF=S+ SPACE$(8-LEN(S)) + ".ENT"
8090 OPEN SF FOR INPUT AS 1
8100 INPUT#1, SDDATE,IENN
8110 PRINT "Date of Data ";SDDATE:FOR C=1 TO 1500:NEXT C
8120 FOR C=1 TO IENN: INPUT#1, SEN1(C),SEN2(C),SEN3(C),DEN4(C),AEN5(C): NEXT C
8125 CLOSE #1:FL2=0:FL1=0:FD=1
8127 WEND
8128 WEND
8130 RETURN
8200 REM DATA OUTPUT SUBROUTINE
8210 PRINT: INPUT"SAVE DATA, Insert disk then hit ENTER ";S
8220 PRINT: INPUT"ENTER accounting period name(up to 8 chr) ";S
8230 SA= S + ".ACC":SF= S + ".ENT"
8240 OPEN SA FOR OUTPUT AS 1
8245 PRINT:I=CSRLIN: COLOR 23,0:PRINT"Saving data";:COLOR 7,0:LOCATE I,1
8250 WRITE#1, IACN,IALI, IAIN, IAEX
8260 FOR C=1 TO IACN: WRITE#1, AAC1(C),SAC2(C),DAC3(C),DAC4(C): NEXT C
8270 CLOSE #1
8280 OPEN SF FOR OUTPUT AS 1
8290 WRITE#1, SDDATE, IENN
8300 FOR C=1 TO IENN: WRITE#1, SEN1(C), SEN2(C), SEN3(C), DEN4(C), AEN5(C): NEXT C
8305 CLOSE #1
8310 RETURN
8500 REM ERROR TRAPPING
8510 IF (ERR=53) THEN PRINT"File not on disk":RESUME 8040
8520 IF (ERR=27) OR (ERR=68) THEN INPUT "Check printer, then hit ENTER to return to MAIN MENU ";S:RESUME 300
8530 IF (ERR=70) OR (ERR=71) THEN INPUT "Check disk, then hit ENTER to return to MAIN MENU ";S:RESUME 300
8540 IF (ERR=61) THEN PRINT "Disk is full":RESUME 8200 ELSE INPUT "UNKNOWN ERROR, Hit ENTER to return to MAIN MENU";S: RESUME 300
CHARS2.BAS
10 KEY OFF
20 PRINT CHR$(12)
30 INPUT "Radix? (8, 10, or 16) ",RADIX
40 IF RADIX = 8 OR RADIX = 10 OR RADIX = 16 THEN 60
50 GOTO 20
60 PRINT CHR$(12)
70 FOR C=0 TO 255
80 LOCATE INT(C-(INT(C/20)*20))+1,INT(C/20)*6+1
90 IF RADIX <> 10 THEN 120
100 PRINT USING "### ";C;
110 GOTO 160
120 IF RADIX <> 16 THEN GOTO 150
130 PRINT USING "\ \ ";HEX$(C);
140 GOTO 160
150 PRINT USING "\ \ ";OCT$(C);
160 IF C = 7 OR (C>=9 AND C<=13) OR (C>=29 AND C<=31)THEN 220
170 COLOR 15
180 PRINT CHR$(C);
190 COLOR 7
200 PRINT CHR$(186)
210 GOTO 260
220 COLOR 15
230 PRINT " ";
240 COLOR 7
250 PRINT CHR$(186)
260 NEXT C
270 LOCATE 25,1
280 PRINT "Strike 'Enter'...";
290 INPUT A$
300 KEY ON
310 END
FILES62.TXT
Disk No: 62
Program Title: INVENTORY PROGRAM
PC-SIG version: 1.2
PERSONAL HOME INVENTORY lets you add, change, or delete inventory
entries. It prints out the completed inventory file to either the
screen or printer. The cash/checkbook accounting program lets you input
data, add, delete, edit, and print reports of the transactions. The
mailing list in a database program that lets you add, change, or delete
names. It can do a search via the last name, city, or state. It
alphabetize entries, prints a roster, can do mailing labels, and more.
These programs are fun to work with, and a great way to become familiar
with database programs. All programs are written in BASIC, are menu
driven, and use screen inputs for data entries.
Usage: Utilities.
Special Requirements: A version of BASIC.
How to Start: Type GO (press enter).
Suggested Registration: None
File Descriptions:
CHARS2 BAS Displays ASCII character set in octal, hex or decimal.
LINREGRS BAS Calculates multiple linear regression coefficients.
WB-UPTLE BAS Addition to PC-TALK 2.0 to allow file transmission
while using host computers editor.
MAILIST2 BAS Mailing list program - with search and alphabetic sort.
INVENTRY BAS Helps to keep list of possessions on computer.
INVENTRY DAT Data file for INVENTRY.BAS.
INVENTRY DOC Few notes for INVENTRY.BAS - very short.
CASHACC BAS Simple cash accounting system.
REMCACC BAS Remark lines which may be merged with CASHACC.BAS.
TESTDATA ACC Part of CASHACC.BAS.
MONTHS HBW Data file.
PC-SIG
1030D East Duane Avenue
Sunnyvale Ca. 94086
(408) 730-9291
(c) Copyright 1985,86,87,88,89 PC-SIG, Inc.
GO.TXT
╔═════════════════════════════════════════════════════════════════════════╗
║ <<<< Disk No: 62 Inventory Program >>>> ║
╠═════════════════════════════════════════════════════════════════════════╣
║ ║
║ To run the BASIC language programs on this disk, please consult the ║
║ section of your computer manual concerning BASIC programs and thier ║
║ use. ║
║ ║
╚═════════════════════════════════════════════════════════════════════════╝
INVENTRY.BAS
10 'CLS:INPUT "CHANGE LINE 1020 TO YOUR NAME AND ADDRESS. THEN DELETE LINE 10. PRESS ENTER TO CONTINUE",DUMMY$
20 '***********************************************************************
30 '***********************************************************************
40 '**** ****
50 '**** HOME INVENTORY PROGRAM ****
60 '**** by ****
70 '**** Brian Mann ****
80 '**** (804) 320-4901 ****
90 '**** ****
100 '**** COPYRIGHT OCTOBER, 1982 BY BRIAN D. MANN ****
110 '**** FOR NONPROFIT DISTRIBUTION ONLY. ALL RIGHTS RESERVED. ****
120 '**** ****
130 '***********************************************************************
140 '***********************************************************************
150 DEF SEG=0 '------------------------------─────┐
160 K=PEEK(&H417) OR &H40 ' │ SET CAPS
170 POKE &H417,K '-------------------------─────┘
180 ROOM =0:SUB=0:SUBTTL=0:BUFFER=0
190 SIZE=100:DIM DES$(SIZE), NO(SIZE), DOL(SIZE), RM(SIZE)
200 KEY OFF:FOR I=1 TO 10: KEY I,"":NEXT
210 RESTORE 'sets data statements to reset
220 GOTO 900 'main menu
230 CLS'########################### PRINT INPUT SCREEN ROUTINE ##################
240 RESTORE
250 BUFFER=BUFFER+1
260 DATA 5,45,8,41,12,37,14,57,16,42,0,0
270 COLOR 15,0,0
280 LOCATE 2,28 :PRINT "HOME INVENTORY PROGRAM";
290 COLOR 7,0,0
300 LOCATE 5,10:PRINT "ENTER `S' TO SAVE, `M' FOR MENU==> "
310 LOCATE 8,10 :PRINT "ENTER DESCRIPTION OF ITEM ===> ";
320 LOCATE 10,20: PRINT "^ stop description here";
330 LOCATE 12,10:PRINT "ENTER NUMBER OF ITEMS ===> 1";
340 LOCATE 14,10: PRINT "ENTER REPLACEMENT COST OF INDIVIDUAL ITEM ===> 1 (EXAMPLE: 875.67)";
350 LOCATE 16,10: PRINT "ENTER LOCATION OF ITEM(S) ===> ";ROOM
360 LOCATE 18,10: PRINT "1=LIVING ROOM, 2=KITCHEN/DINING ROOM, 3=DOWNSTAIRS BATH, 4=UPSTAIRS BATH, 5=BEDROOM, 6=STUDY, 7=ATTIC, 8=OUTSIDE"
370 LOCATE 23,5:PRINT "USE THE ENTER KEY TO MOVE FROM ONE FIELD TO ANOTHER."
380 LOCATE 24,5:PRINT "SAVE AN ENTRY ON THE SCREEN BEFORE GOING TO THE MENU.";
390 LOCATE 1,1:PRINT USING "BUFFER AT ## OF ###";BUFFER,SIZE;
400 GOTO 440
410 INPUT "",A$
420 IF R=5 AND A$="S" THEN COLOR 7,0,0: GOTO 490
430 IF R=5 AND A$="M" THEN COLOR 7,0,0: GOTO 800
440 READ R,C
450 COLOR 15,0,0
460 IF R=0 AND C=0 THEN RESTORE:READ R,C
470 LOCATE R,C
480 GOTO 410
490 '############################ BEGINNING OF READ SCREEN ROUTINE ###########
500 DESC$="":X$="" ' RESET VARIABLES
510 FLAG1=1 ' RESET BUFFER DUMP VARIABLE
520 FOR I=41 TO 80
530 X=SCREEN(8,I) ' READ THE SCREEN AT 8,41-80 ONE CHAR AT A TIME
540 X$=CHR$(X)' CHANGE THE CHAR CODE TO A LETTER
550 DESC$=DESC$+X$' BUILD THE WORD FROM THE CHARACTERS
560 NEXT' GO TO THE NEXT CHARACTER
570 FOR I=1 TO 20
580 X=SCREEN(9,I) ' READ THE SCREEN AT 9,1-20 ONE CHAR AT A TIME
590 X$=CHR$(X)' CHANGE THE CHAR CODE TO A LETTER
600 DESC$=DESC$+X$' BUILD THE WORD FROM THE CHARACTERS
610 NEXT' GO TO THE NEXT CHARACTER
620 NUM$="":X$=""' THE REST USE THE SAME LOGIC
630 FOR I=37 TO 40
640 X=SCREEN(12,I)
650 X$=CHR$(X)
660 NUM$=NUM$+X$
670 NEXT
680 NUM=VAL(NUM$)
690 DOLLAR$="":X$=""
700 FOR I=57 TO 63
710 X=SCREEN(14,I)
720 X$=CHR$(X)
730 DOLLAR$=DOLLAR$+X$
740 NEXT
750 DOLLAR=VAL(DOLLAR$)
760 ROOM=SCREEN(16,42)
770 ROOM=VAL(CHR$(ROOM))
780 DES$(BUFFER)=DESC$:NO(BUFFER)=NUM:DOL(BUFFER)=DOLLAR:RM(BUFFER)=ROOM' BUILD A BUFFER TO SAVE TIME IN ENTERING
790 IF BUFFER=SIZE THEN 800 ELSE 230' IS IT FULL?
800 IF FLAG1=0 THEN 900' HAS THE BUFFER BEEN DUMPED? 0 FOR YES, 1 FOR NO
810 WIDTH 40:LOCATE 12,10: PRINT "HOLD FOR DISK OPERATION"
820 OPEN "INVENTRY.DAT" FOR APPEND AS #1
830 IF A$="M" OR A$="m" THEN BUFFER = BUFFER - 1' MENU OPTION ADDS TO COUNTER WITHOUT ADDING TO ARRAY
840 FOR B=1 TO BUFFER
850 WRITE#1, DES$(B);NO(B),DOL(B),RM(B)
860 DES$(B)="":NO(B)=0:DOL(B)=0:RM(B)=0
870 NEXT
880 CLOSE:WIDTH 80: BUFFER=0: FLAG1=0' RESET
890 IF A$="S" OR A$="s" THEN 230 ELSE 900
900 REM -----------------MASTER MENU-----------------
910 WIDTH 80:CLS
920 BUFFER=0
930 COLOR 15,0,0
940 LOCATE 5,29: PRINT "HOME INVENTORY PROGRAM";
950 COLOR 7,0,0
960 LOCATE 6,37:PRINT "by"
970 LOCATE 7,31:PRINT "BRIAN D. MANN"
980 COLOR 15,0,0
990 LOCATE 10,32: PRINT "MASTER MENU";
1000 COLOR 7,0,0
1010 LOCATE 12,10: PRINT "DO YOU WISH TO ==>"
1020 LOCATE 14,20: PRINT "1. FILE AN ITEM IN THE INVENTORY.":LOCATE 16,20:PRINT "2. PRINT THE ITEMS ALREADY FILED.":LOCATE 18,20:PRINT "3. DELETE AN ENTRY"
1030 LOCATE 20,20: PRINT "4. EXIT THE PROGRAM"
1040 LOCATE 12,30: INPUT "",P
1050 IF P=1 THEN 230' ENTRY PANEL
1060 IF P=2 THEN 1110' PRINT ROUTINE
1070 IF P=3 THEN 1710' DELETE ITEM
1080 IF P=4 THEN 1100' EXIT
1090 BEEP: LOCATE 24,10: PRINT "YOU ENTERED ";P; "TRY AGAIN";:GOTO 1040
1100 CLS:END
1110 '########################### PRINT ROUTINE ################################
1120 CLS
1130 COLOR 15
1140 LOCATE 8,35: PRINT" PRINT ROUTINE"
1150 COLOR 7
1160 LOCATE 12,10: PRINT "DO YOU WISH TO ==>"
1170 LOCATE 14,20: PRINT "1. PRINT THE LISTED ITEMS TO THE SCREEN.":LOCATE 16,20:PRINT "2. PRINT THE LISTED ITEMS TO THE PRINTER.":LOCATE 18,20:PRINT "3. RETURN TO THE MASTER MENU."
1180 LOCATE 12,30: INPUT "",P1
1190 SUB=0
1200 IF P1=1 THEN 1240
1210 IF P1=2 THEN 1240
1220 IF P1=3 THEN 900
1230 BEEP: GOTO 1180
1240 CLS
1250 I1=0
1260 ON ERROR GOTO 1920
1270 OPEN "INVENTRY.DAT" FOR INPUT AS #1
1280 IF EOF(1) THEN CLOSE: GOTO 1650
1290 I1=I1+1
1300 INPUT#1,DESC$,NUM,DOLLAR,ROOM
1310 IF ROOM=1 THEN ROOM$="LIVING ROOM":GOTO 1400
1320 IF ROOM=2 THEN ROOM$="KITCHEN/DINING ROOM":GOTO 1400
1330 IF ROOM=3 THEN ROOM$="DOWNSTAIRS BATHROOM":GOTO 1400
1340 IF ROOM=4 THEN ROOM$="UPSTAIRS BATHROOM":GOTO 1400
1350 IF ROOM=5 THEN ROOM$="MASTER BEDROOM":GOTO 1400
1360 IF ROOM=6 THEN ROOM$="STUDY":GOTO 1400
1370 IF ROOM=7 THEN ROOM$="ATTIC":GOTO 1400
1380 IF ROOM=8 THEN ROOM$="OUTSIDE":GOTO 1400
1390 ROOM$="UNSPECIFIED"
1400 SUBTTL=NUM*DOLLAR
1410 SUB=SUB+SUBTTL' KEEP UP WITH ACCUMULATED WORTH
1420 IF P1=2 THEN GOTO 1470
1430 PRINT USING "### & REPLACEMENT COST=$####.## NUM. OF ITEMS= ### SUBTOTAL= ####.## LOCATION:&";I1;DESC$;DOLLAR;NUM;DOLLAR*NUM;ROOM$
1440 PRINT
1450 IF I1/7=INT(I1/7) THEN LOCATE 24,40:INPUT "PRESS ENTER TO CONTINUE";Z$
1460 GOTO 1280
1470 REM ############################# OUTPUT TO PRINTER #####################
1480 CLS
1490 IF I1 <>1 THEN 1600
1500 INPUT "WHAT IS THE DATE (IN THE FORM 08/12/82) ==>";DAT$
1510 INPUT "SET THE TOP OF FORM ON THE PRINTER AND PRESS ENTER WHEN READY";Z$
1520 WIDTH "LPT1:",132
1530 LPRINT CHR$(27) "0":LPRINT CHR$(27) "C" CHR$(88)'SET 8LINES/INCH AND 88 LINE FORM IT IS IMPORTANT THAT THIS IS DONE BEFORE ANYTHING IS PRINTED
1540 LPRINT CHR$(14);" HOME INVENTORY"
1550 LPRINT "BRIAN AND KAREN MANN. 628 ELGIN TERRACE, RICHMOND, VA. 23225 (804) 320-4901"
1560 LPRINT " AS OF ";DAT$;
1570 LPRINT CHR$(15)
1580 LPRINT SPC(72) "REPLACEMENT NUMBER OF"
1590 LPRINT "ITEM" SPC(25) "DESCRIPTION" SPC(31)" COST (EACH) ITEMS SUBTOTAL LOCATION"
1600 IF I1/80 <> INT(I1/80) THEN 1630 ELSE LPRINT CHR$(12)
1610 LPRINT SPC(72) "REPLACEMENT NUMBER OF"
1620 LPRINT "ITEM" SPC(25) "DESCRIPTION" SPC(31)" COST (EACH) ITEMS SUBTOTAL LOCATION"
1630 LPRINT USING "### & $####.## ### ####.## &";I1;DESC$;DOLLAR;NUM;DOLLAR*NUM;ROOM$
1640 GOTO 1280
1650 ' ############################ EXIT ROUTINE ###########################
1660 IF P1=1 THEN PRINT USING "THE TOTAL WORTH OF THE FILED OBJECTS IS $#####.##";SUB:GOTO 1690
1670 IF P1=2 THEN LPRINT USING "THE TOTAL WORTH OF THE FILED OBJECTS IS $#####.##";SUB:
1680 IF P1=2 THEN LPRINT CHR$(12):LPRINT CHR(27) "@";
1690 INPUT "PRESS ENTER TO RETURN TO THE MENU";Z$
1700 GOTO 900
1710 ' ########################### DELETE ITEM ROUTINE ####################
1720 CLS
1730 LOCATE 2,2:PRINT "IT IS EASIER AND MORE FLEXIBLE TO DELETE ITEMS USING THE EDLIN PROGRAM SUPPLIED"
1740 LOCATE 3,2:PRINT "WITH IBM-DOS. EDIT THE `INVENTRY.DAT' FILE AND DELETE THE APPROPRIATE LINE.";
1750 LOCATE 8,35:COLOR 15:PRINT "DELETE ITEM":COLOR 7
1760 LOCATE 10,17:INPUT "ENTER THE ITEM NUMBER OF THE ITEM TO BE DELETED ( OR `0' TO RETURN TO THE MENU)===> ",ITEM
1770 IF ITEM = 0 THEN 900
1780 COLOR 23: LOCATE 24,31:PRINT "HOLD FOR DISK OPERATION";:COLOR 7:LOCATE 1,1
1790 I=1
1800 ON ERROR GOTO 1920
1810 NAME "INVENTRY.DAT" AS "TEMP.DAT"
1820 OPEN "TEMP.DAT" FOR INPUT AS #1
1830 OPEN "INVENTRY.DAT" FOR APPEND AS #2
1840 IF EOF(1) THEN 1890
1850 INPUT#1, DESC$,NUM,DOLLAR,ROOM
1860 IF I <> ITEM THEN WRITE#2, DESC$,NUM,DOLLAR,ROOM ELSE LOCATE 15,1:PRINT USING "ENTRY & DELETED";DESC$
1870 I=I+1
1880 GOTO 1840
1890 CLOSE
1900 KILL"TEMP.DAT"
1910 GOTO 900
1920 '######################## ERROR HANDLING ROUTINE #########################
1930 CLOSE:IF ERR=53 THEN 1960
1940 IF ERR=58 THEN 1980
1950 SOUND 100,20:PRINT USING "ERROR NUMBER ### IN LINE ##### . PRESS ENTER TO RETURN TO MAIN MENU.";ERR,ERL:INPUT Z1$: GOTO 900
1960 WIDTH 40: SOUND 100,20: LOCATE 12,10: PRINT "THERE IS NO INVENTRY.DAT ON THE DISK!!!":INPUT "PRESS ENTER TO RETURN TO THE MENU",Z1$
1970 WIDTH 80:GOTO 900
1980 SOUND 100,20:PRINT "FILE TEMP.DAT ALREADY EXISTS. "
1990 INPUT "DO YOU WISH IT DELETED (Y OR N) ";ANS$
2000 IF ANS$<>"Y" THEN GOTO 900
2010 KILL "TEMP.DAT"
2020 GOTO 1800
INVENTRY.DOC
HOME INVENTORY PROGRAM
This program allows you to keep a list of your possesions on your
computer. It is completely menu driven and used easy screen input for
data entry. It prints the inventory on an Epson MX-80 (or equivalent)
printer.
LINREGRS.BAS
10 REM*************************************************************************
20 REM******-- Multiple Linear Regression --******
30 REM*****-- --******
40 REM******-- From: --******
50 REM*****-- Alonso,J.R.F. --******
60 REM******-- BASIC Programs for Business Applications --******
70 REM*****-- Prentice-Hall, Inc. --******
80 REM*****-- --******
90 REM******-- Programmed by: --******
100 REM******-- David Hopper --*****
110 REM*****-- SENES Consultants Limited --*****
120 REM*****-- 499 McNicoll Avenue --*****
130 REM*****-- Willowdale, Ontario --*****
140 REM*****-- M2H 2C9 --*****
150 REM*****-- (416) 499 5030 --*****
160 REM************************************************************************
170 REM******-- This program calculates multiple linear regression --*****
180 REM*****-- coefficients, Bj, that fit the equation " --*****
190 REM*****-- Y=B0 + B1*X1 + B2*X2 + ... + BJ*XJ + ... + BP*XP --*****
200 REM*****-- to a set of N values of a dependent variable Y --*****
210 REM*****-- each of the N values corresponding to P known values of --*****
220 REM*****-- the P independent variables Xj, where 1<J<P --*****
230 REM*****-- The design matrix is --*****
240 REM*****-- --*****
250 REM*****-- X(1,1) X(1,2) ... X(1,J) ...X(1,P) = Y(1) --*****
260 REM*****-- X(2,1) X(2,2) ... X(2,J) ... X(2,P) = Y(2) --*****
270 REM*****-- : : : : : --*****
280 REM*****-- X(I,1) X(I,2) ... X(I,J) ... X(I,P) = Y(I) --*****
290 REM*****-- : : : : : --*****
300 REM*****-- X(N,1) X(N,2) ... X(N,J) ... X(N,P) = Y(N) --*****
310 REM*****-- --*****
320 REM*****-- The maximum number of Y values permitted is 50 --*****
330 REM*****-- The maximum number of X values permitted is 500(10 X 50)--*****
340 REM***********************************************************************
350 OPTION BASE 1
360 DEFINT I-P
370 DEFDBL A-H,Q-Z
380 ON ERROR GOTO 2730
390 DIM X(50,10),Y(50),X1(10),C(10,10),D(10),X5(10)
400 CLS:KEY OFF:WIDTH 80
410 PRINT :PRINT
420 T$=STRING$(79,205)
430 PRINT T$
440 PRINT
450 PRINT " This program calculates multiple linear regression coefficients Bj"
460 PRINT " that fit the equation "
470 PRINT " Y=B0 + B1*X1 + B2*X2 + ... + BJ*XJ + ... + BP*XP"
480 PRINT " to a set of N values of a dependent variable Y"
490 PRINT " each of the N values corresponding to P known values of the "
500 PRINT " P independent variables XJ, where 1<J<P"
510 PRINT " The design matrix is"
520 PRINT
530 PRINT "X(1,1) X(1,2) ... X(1,J) ...X(1,P) = Y(1)"
540 PRINT "X(2,1) X(2,2) ... X(2,J) ... X(2,P) = Y(2)"
550 PRINT " : : : : :
560 PRINT "X(I,1) X(I,2) ... X(I,J) ... X(I,P) = Y(I)"
570 PRINT " : : : : :
580 PRINT "X(N,1) X(N,2) ... X(N,J) ... X(N,P) = Y(N)"
590 PRINT
600 PRINT " The maximum number of Y values permitted is 50"
610 PRINT " The maximum number of X values permitted is 500(10 X 50)"
620 PRINT
630 PRINT T$
640 PRINT " Press any key to continue "
650 A$=INKEY$:IF A$="" THEN 650
660 CLS
670 PRINT :PRINT :PRINT
680 INPUT " Enter the number of Y values ";N
690 IF N<=50 GOTO 730
700 IF N>50 THEN PRINT " Maximum number of Y values allowed is 50"
710 PRINT " Press any key to return to the start"
720 C$=INKEY$:IF C$="" THEN 720 ELSE 400
730 INPUT " Enter the number of independent variables";P
740 IF P<=10 GOTO 780
750 IF P>10 THEN PRINT " Maximum number of X values is exceeded"
760 PRINT " Press any key to return to the start"
770 D$=INKEY$:IF D$="" THEN 770 ELSE 400
780 FOR I=1 TO P
790 FOR J=1 TO P
800 C(I,J)=0#
810 NEXT J
820 D(I)=0#
830 NEXT I
840 FOR I=1 TO N
850 FOR J=1 TO P
860 X(I,J)=0#
870 PRINT "Enter X(";I",";J")=";:INPUT X(I,J)
880 NEXT J
890 PRINT USING "Enter Y(##) =";I;:
900 INPUT Y(I)
910 NEXT I
920 REM************************************************************************
930 REM******-- Calculate moments --******
940 REM************************************************************************
950 FOR I=1 TO P
960 X1(I)=0#
970 FOR I1=1 TO N
980 X1(I)=X1(I)+X(I1,I)
990 NEXT I1
1000 X1(I)=X1(I)/N
1010 NEXT I
1020 Y1=0
1030 FOR I1=1 TO N
1040 Y1=Y1+Y(I1)
1050 NEXT I1
1060 Y1=Y1/N
1070 REM************************************************************************
1080 REM*****-- Compute coefficients --******
1090 REM***********************************************************************
1100 FOR J=1 TO P
1110 REM*****-- Calculate D(J) --******
1120 S1=0
1130 FOR I=1 TO N
1140 S1=S1+(Y(I)-Y1)*(X(I,J)-X1(J))
1150 NEXT I
1160 D(J)=S1
1170 S1=0
1180 FOR K=J TO P
1190 IF J>K GOTO 1270
1200 REM*****-- Calculate C(J,K) --*****
1210 S1=0
1220 FOR I=1 TO N
1230 S1=S1+(X(I,J)-X1(J))*(X(I,K)-X1(K))
1240 NEXT I
1250 C(J,K)=S1
1260 C(K,J)=C(J,K)
1270 NEXT K
1280 NEXT J
1290 CLS:SCREEN 0,0,0
1300 PRINT " Correlation matrices follow, C X B = D, to be solved for vector B"
1310 PRINT " where C is a P X P matrix and B and D are P X 1 vectors "
1320 FOR I= 1 TO P
1330 PRINT " Correlation matrix C(";I;",J) elements "
1340 FOR J =1 TO P
1350 PRINT "C(";I;",";J;")=";C(I,J)
1360 NEXT J
1370 NEXT I
1380 PRINT " Coefficient matrix D(J) vector elements "
1390 FOR I= 1 TO P
1400 PRINT "D(";I;")=";D(I)
1410 NEXT I
1420 FOR I= 1 TO P
1430 D1(I)=D(I)
1440 NEXT I
1450 PRINT " Press any key to continue "
1460 B$=INKEY$:IF B$ = "" THEN 1460
1470 REM***********************************************************************
1480 REM*****-- Solve system C X B = D for B --*****
1490 REM*****-- where C is the correlation matrix and --*****
1500 REM*****-- D is the right hand vector --*****
1510 REM*****-- Matrix routines are in subroutines --*****
1520 REM***********************************************************************
1530 GOSUB 2300 `MATRIX INVERSION
1540 GOSUB 2560 `MATRIX MULTIPLICATION
1550 H1 = 0#
1560 FOR I=1 TO P
1570 H1=H1+X5(I)*X1(I)
1580 NEXT I
1590 Q0=Y1-H1
1600 CLS:SCREEN 0,0,0
1610 PRINT :PRINT :PRINT
1620 PRINT " Calculated multiple linear regression coefficients "
1630 PRINT
1640 PRINT USING " B 0 = #.###^^^^ ";Q0
1650 FOR I=1 TO P
1660 PRINT USING " B ## = #.###^^^^";I, X5(I)
1670 NEXT I
1680 REM*****-- Write ANOVA table
1690 PRINT :PRINT :PRINT
1700 Y9=0
1710 FOR I=1 TO N
1720 Y9=Y9+(Y(I)-Y1)^2
1730 NEXT I
1740 C9=Y9
1750 C1=0
1760 FOR I=1 TO P
1770 C1=C1+X5(I)*D1(I)
1780 NEXT I
1790 C2=C9-C1
1800 L=N-1
1810 K=L-P
1820 C8=C1/P
1830 C7=C2/K
1840 C6=C9/L
1850 PRINT " | | SUM OF SQ |DEG OF FR | MEAN SQ |
1860 PRINT " |~~~~~~~~~~~~~~~~~~~~~~~~|~~~~~~~~~~~~~~|~~~~~~~~~~|~~~~~~~~~~~~|
1870 PRINT USING " | Due to regression | #.###^^^^ | ### | #.###^^^^ |";C1,P,C8
1880 PRINT USING " | About regression | #.###^^^^ | ### | #.###^^^^ |";C2,K,C7
1890 PRINT USING " | Total | #.###^^^^ | ### | #.###^^^^ |";C9,L,C6
1900 PRINT " ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~"
1910 Z1=SQR(1#-(C2/C9))
1920 PRINT :PRINT
1930 PRINT USING " Coefficient of multiple regression R = ##.### ";Z1
1940 PRINT USING " R^2 = ##.### ";Z1^2
1950 F=(Z1^2)*(N-P-1)/((1-Z1^2)*P)
1960 PRINT USING " The F-statistic is F = ##.### ";F
1970 REM***********************************************************************
1980 REM*****-- Statistical routines directly from: --*****
1990 REM*****-- Madron,D.W. --*****
2000 REM***********************************************************************
2010 RP=1#
2020 P2=N-P-1
2030 IF P*P2*F = 0# THEN 2250
2040 IF F<1# THEN 2090
2050 A=P
2060 B=P2
2070 F1=F
2080 GOTO 2120
2090 A=P2
2100 B=P
2110 F1=1#/F
2120 A1=2#/(9#*A)
2130 B1=2#/(9#*B)
2140 X=((1#-B1)*F1^0.3333333#-1#+A1)
2150 Y=SQR(B1*F1^0.666666667#+A1)
2160 Z=ABS(X/Y)
2170 IF B<4# THEN 2190
2180 GOTO 2200
2190 Z=Z*(1#+0.08#*Z^4#/B^3#)
2200 Z1=(0.115194#+Z*(0.000344#+Z*0.019527#))
2210 RP=0.5#/(1#+Z*(0.196854#+Z*Z1))^4#
2220 IF F<1# THEN 2240
2230 GOTO 2250
2240 RP=1#-RP
2250 RP=RP
2260 PRINT USING " The P statistic is P = ##.#### ";RP
2270 PRINT USING " For ## observations of ## independent variables";N,P
2280 KEY ON
2290 END
2300 REM**********************************************************************
2310 REM*****-- Subroutine MATINV --*****
2320 REM*****-- Extracted from : --*****
2330 REM*****-- Madron, Douglas William --*****
2340 REM*****-- "Multiple Regression for the TRS-80" --*****
2350 REM*****-- BYTE ,October 1981, pp. 430-447 --*****
2360 REM*****-- --*****
2370 REM*****-- Adapted by: --*****
2380 REM*****-- David Hopper --*****
2390 REM*****-- --*****
2400 REM*****-- Note that this inversion routine writes the --*****
2410 REM*****-- inverted matrix over the original matrix --*****
2420 REM**********************************************************************
2430 FOR K= 1 TO P:D=-1/C(K,K)
2440 FOR J = 1 TO P:IF J=K THEN 2460
2450 C(K,J)=C(K,J)*D
2460 NEXT J
2470 D=-D
2480 FOR I= 1 TO P:IF I=K THEN 2540
2490 E=C(I,K)
2500 FOR J = 1 TO P:IF J=K THEN 2520
2510 C(I,J)=C(I,J)+C(K,J)*E:GOTO 2530
2520 C(I,K)=C(I,K)*D
2530 NEXT J
2540 NEXT I
2550 C(K,K)=D:NEXT K:RETURN
2560 REM**********************************************************************
2570 REM*****-- Subroutine MATMUL --******
2580 REM*****-- To multiply a P X P matrix by a P X 1 matrix --******
2590 REM*****-- and return a P X 1 matrix --******
2600 REM*****-- In this case the multiplication is --******
2610 REM*****-- C X D = B --******
2620 REM**********************************************************************
2630 B(I)=0#
2640 FOR I = 1 TO P
2650 FOR J= 1 TO P
2660 X5(I)=X5(I)+C(I,J)*D(J)
2670 NEXT J
2680 NEXT I
2690 RETURN
2700 REM**********************************************************************
2710 REM******-- Error trapping routine --******
2720 REM**********************************************************************
2730 IF ERR<> 6 THEN 2760
2740 CLS:BEEP:LOCATE 5,28
2750 PRINT " Overflow error. Data set is not compatible with this program": STOP
2760 IF ERR<>11 THEN 2810
2770 CLS:BEEP:LOCATE 5,28
2780 PRINT " Division by zero error. Caused by either an ill-conditioned"
2790 LOCATE 6,28
2800 PRINT " matrix of data or a perfect data set. Check your data":STOP
2810 ON ERROR GOTO 0
2820 RESUME
MAILIST2.BAS
100 REM MAILING LABEL PROGRAM FOR 'Business Mailing Labels'
200 REM MAILING LABEL PROGRAM FOR 'Business Mailing Labels'
300 REM Created by:
400 REM Alde╛n C!. Olander III <AL>
500 REM WB9YYN
600 REM (312) 671-0441
700 REM
800 REM Modified by: Paul J. Mayer, Jr.
900 REM WB9ZHG
1000 REM (312) 671-3130
1100 REM
1200 REM Modified by: Eugene L. Plantz 4/12/82
1300 REM For the IBM Personal Computer
1400 REM (312) 843-8584
1500 REM
1550 Z$=""
1570 WIDTH 80
1600 CLEAR 10000
1700 KEY OFF:SCREEN 0,0
1730 KEY 1,"GETPUT":KEY(1) ON:ON KEY(1) GOSUB 19400
1735 KEY 2," Add ":KEY(2) ON:ON KEY(2) GOSUB 4500
1740 KEY 3,"Delete":KEY(3) ON:ON KEY(3) GOSUB 6400
1745 KEY 4,"PrintL":KEY(4) ON:ON KEY(4) GOSUB 9800
1750 KEY 5,"Search":KEY(5) ON:ON KEY(5) GOSUB 13700
1755 KEY 6,"Finish":KEY(6) ON:ON KEY(6) GOSUB 17700
1760 KEY 7,"------":KEY(7) ON:ON KEY(7) GOSUB 23600
1765 KEY 8,"Alpha ":KEY(8) ON:ON KEY(8) GOSUB 23800
1770 KEY 9,"Change":KEY(9) ON:ON KEY(9) GOSUB 25900
1775 KEY 10,"Roster":KEY(10) ON:ON KEY(10) GOSUB 32100
1790 KEY ON:DEF SEG:POKE 106,0
1800 DIM A$(250),A1$(250),A2$(250),A3$(250),A4$(250),A5$(250),A6$(250),A7$(250)
1900 ' ON ERROR GOTO 2000
2000 CLS:COLOR 8,7
2100 PRINT " This program is self prompting and will ask for your"
2200 PRINT " instructions. The following options are available:"
2300 PRINT:COLOR 7,0
2400 PRINT "F1 - PUT OR GET LIST TO/FROM DISK"
2500 PRINT "F2 - ADD NEW NAMES TO THE LIST"
2600 PRINT "F3 - DELETE NAMES FROM THE LIST"
2700 PRINT "F4 - PRINT LABELS"
2800 PRINT "F5 - SEARCH BY LAST NAME, CITY, OR STATE AND PRINT"
2900 PRINT "F6 - FINISH"
3000 PRINT "F7 - EXCHANGE DATA DISK IN EITHER DRIVE (CLOSES FILES)"
3100 PRINT "F8 - ALPHABETIZE YOUR DATA LIST ON DISK"
3200 PRINT "F9 - CORRECT INFORMATION IN DATA FILE"
3300 PRINT "F10- PRINT ROSTER OF NAMES AND OTHER INFORMATION"
3400 FOR I=1 TO 4:PRINT :NEXT I
3450 IF Z$="" GOTO 3450
3500 ' INPUT "WHICH OPTION DO YOU WANT? (0,1,2,3,4,5,6,7,8 OR 9) - ";N1
3600 ' ON N1 GOSUB 4500,6400,9800,13700
3700 ' IF N1=0 THEN GOSUB 19400
3800 ' IF N1=5 THEN GOTO 17700
3900 ' IF N1=6 THEN GOSUB 23600
4000 ' IF N1=7 THEN GOSUB 23800
4100 ' IF N1=8 THEN GOSUB 25900
4200 ' IF N1=9 THEN GOSUB 32100
4300 ' IF N1 >= 9 THEN COLOR 26,0:PRINT "WRONG NUMBER - TRY AGAIN!!":COLOR 7,0:PRINT :GOTO 3500
4400 GOTO 2000
4500 CLS:COLOR 8,7
4600 PRINT "TO STOP INPUT TYPE 'NONE' FOR LAST NAME "
4700 PRINT
4800 PRINT:COLOR 7,0
4900 R=R+1
5000 REM
5100 PRINT TAB(5);R;" ";:LINE INPUT "LAST NAME ? ";A$(R)
5200 IF A$(R)="NONE" OR A$(R)="none" THEN R=R-1:RETURN 2000
5300 PRINT TAB(5);R;" ";:LINE INPUT "FIRST NAME, MIDDLE INITIAL? ";A2$(R)
5400 PRINT TAB(5);R;" ";:LINE INPUT "STREET ADDRESS? ";A1$(R)
5500 PRINT TAB(5);R;" ";:LINE INPUT "CITY? ";A3$(R)
5600 PRINT TAB(5);R;" ";:LINE INPUT "STATE? ";A4$(R)
5700 PRINT TAB(5);R;" ";:LINE INPUT "ZIP CODE? ";A5$(R)
5800 PRINT TAB(5);R;" ";:LINE INPUT "HOME PHONE? ";A6$(R)
5900 PRINT TAB(5);R;" ";:LINE INPUT "BUSINESS PHONE? ";A7$(R)
6000 PRINT:LINE INPUT" IS THIS INFO CORRECT? (Y OR N) ";B$
6100 IF B$="N" OR B$="n" THEN GOSUB 25800:GOTO 5000
6200 FOR I=1 TO 4:PRINT :NEXT I
6300 GOTO 4600
6400 CLS:COLOR 8,7
6500 PRINT " This is the DELETE part of the program. You may "
6600 PRINT " locate the desired line by agency name or city. THINK"
6700 PRINT " before using as once DELETED the information "
6800 PRINT " IT CANNOT BE RECOVERED!!!! "
6900 COLOR 7,0
7000 FOR I=1 TO 4:PRINT :NEXT I
7100 PRINT " 0 - RETURN TO MAIN PROGRAM"
7200 PRINT " 1 - LOCATE INFORMATION FOR DELETE BY LAST NAME"
7300 PRINT " 2 - LOCATE INFORMATION FOR DELETE BY CITY"
7400 FOR I=1 TO 4:PRINT :NEXT I
7500 LINE INPUT "WHICH OPTION DO YOU WANT? (0,1, OR 2) <0> ";N1$
7600 IF N1$="" OR N1$="0" THEN RETURN 2000
7700 IF N1$="1" OR N1$="2" THEN GOSUB 15400
7800 IF N1$="1" OR N1$="2" THEN GOTO 8000
7900 GOTO 7000
8000 PRINT :LINE INPUT "DO YOU WANT TO DELETE THIS INFORMATION? ";N$
8100 IF LEFT$(N$,1)="Y" OR LEFT$(N$,1)="y" THEN GOSUB 8300
8200 GOTO 7000
8300 FOR I=1 TO 4:PRINT :NEXT I:COLOR 8,7
8400 PRINT "WHEN YOU ENTER THE NUMBER THINK BEFORE HITTING RETURN!!"
8500 PRINT "IF YOU HAVE CHANGED YOUR MIND THEN ENTER A '0' "
8600 COLOR 7,0
8700 INPUT "WHAT IS THE NUMBER OF THE RECORD TO BE DELETED? ";X
8800 IF X=0 THEN A$="":RETURN
8900 '
9000 COLOR 26,0:PRINT " HOLD TIGHT! I'M WORKING ON YOUR DATA - BE PATIENT ":COLOR 7,0
9100 A$(X)="":A1$(X)="":A2$(X)="":A3$(X)="":A4$(X)="":A5$(X)=""
9200 A6$(X)="":A7$(X)=""
9300 FOR D= X TO R
9400 A$(D)=A$(D+1):A1$(D)=A1$(D+1):A2$(D)=A2$(D+1):A3$(D)=A3$(D+1)
9500 A4$(D)=A4$(D+1):A5$(D)=A5$(D+1):A6$(D)=A6$(D+1):A7$(D)=A7$(D+1)
9600 NEXT D
9700 R=R-1:RETURN
9800 PRINT :PRINT :PRINT :PRINT :PRINT
9900 PRINT " 0 - RETURN TO MAIN PROGRAM"
10000 PRINT " 1 - TYPE ALL LABELS IN FILE"
10100 PRINT " 2 - TYPE LABELS FOR xxxxx ZIP CODE"
10200 FOR I=1 TO 4:PRINT :NEXT I
10300 LINE INPUT " WHICH OPTION DO YOU WANT? (0,1, OR 2) <0> ";P$
10400 IF P$="" OR P$="0" THEN PRINT :PRINT :PRINT :PRINT :PRINT :RETURN 2000
10500 IF P$="1" THEN 10900
10600 IF P$="2" THEN 12000
10700 COLOR 26,0:PRINT " THAT'S NOT A VALID CHOICE ! TRY AGAIN..":COLOR 7,0
10800 FOR I=1 TO 4:PRINT :NEXT I:GOTO 9900
10900 FOR I=1 TO 4:PRINT :NEXT I
11000 INPUT " WHAT IS THE NUMBER OF LINES YOU WANT BETWEEN LABELS? ";L
11100 GOSUB 13200
11200 FOR I=1 TO R
11300 PRINT #2," ";A2$(I);" ";A$(I)
11400 PRINT #2," ";A1$(I)
11500 PRINT #2," ";A3$(I);", ";A4$(I);" ";A5$(I)
11600 FOR J=1 TO L:PRINT #2,:NEXT J
11700 NEXT I
11800 CLOSE #2
11900 GOTO 9900
12000 FOR I=1 TO 4:PRINT :NEXT I
12100 INPUT " WHAT IS THE NUMBER OF LINES YOU WANT BETWEEN LABELS? ";L
12200 LINE INPUT "WHAT IS THE ZIP FOR YOUR LABELS? ";B$
12300 GOSUB 13200
12400 FOR I=1 TO R
12500 IF B$=A5$(I) THEN PRINT #2," ";A2$(I);" ";A$(I)
12600 IF B$=A5$(I) THEN PRINT #2," ";A1$(I)
12700 IF B$=A5$(I) THEN PRINT #2," ";A3$(I);", ";A4$(I);" ";A5$(I)
12800 IF B$=A5$(I) THEN FOR J=1 TO L:PRINT #2,:NEXT J
12900 NEXT I
13000 CLOSE #2
13100 GOTO 9900
13200 PRINT :PRINT :PRINT :PRINT :PRINT
13300 LINE INPUT " Output to SCREEN or PRINTER ? (S or P) <S> ";S$
13400 IF LEFT$(S$,1)="P" THEN OPEN "O",#2,"LPt1:":RETURN
13500 IF LEFT$(S$,1)="p" THEN OPEN "O",#2,"LPt1:":RETURN
13600 OPEN "O",#2,"scrn:":RETURN
13700 CLS:COLOR 8,7
13800 PRINT " This is the search and find option. "
13900 PRINT " You may locate a specific LAST NAME, CITY,"
14000 PRINT " or all those listed under a STATE. ":COLOR 7,0
14100 PRINT
14200 PRINT
14300 PRINT " 0 - RETURN TO MAIN PROGRAM"
14400 PRINT " 1 - LOCATE BY LAST NAME"
14500 PRINT " 2 - LOCATE BY CITY"
14600 PRINT " 3 - LOCATE ALL IN STATE"
14700 FOR I=1 TO 4:PRINT :NEXT I
14800 LINE INPUT "WHICH OPTION DO YOU WANT? (0,1,2 OR 3) <0> ";N1$
14900 IF N1$="" OR N1$="0" THEN PRINT :PRINT :PRINT :PRINT :PRINT :RETURN 2000
15000 IF N1$="1" THEN GOSUB 15400
15100 IF N1$="2" THEN GOSUB 15400
15200 IF N1$="3" THEN GOSUB 15400
15300 GOTO 14100
15400 CLS
15500 IF N1$="1" THEN PRINT "WHAT IS THE LAST NAME YOU ARE LOOKING FOR? ";
15600 IF N1$="2" THEN PRINT "WHAT IS THE CITY? ";
15700 IF N1$="3" THEN PRINT "WHAT IS THE STATE? ";
15800 LINE INPUT B$
15900 FOR I = 1 TO 4:PRINT :NEXT I
16000 X=1
16100 FOR I = 1 TO R
16200 IF B$=A$(I) THEN 16900
16300 IF B$=A3$(I) THEN 16900
16400 IF B$=A4$(I) THEN 16900
16500 X=X+1
16600 NEXT I
16700 IF X = I THEN COLOR 8,7:PRINT " NOT ON THIS LIST ":COLOR 7,0 ':GOTO 4170
16800 FOR I=1 TO 2000:NEXT I:RETURN
16900 PRINT
17000 PRINT I;" ";A2$(I);" ";A$(I)
17100 PRINT A1$(I)
17200 PRINT A3$(I);", ";A4$(I);" ";A5$(I)
17300 PRINT A6$(I);" ";A7$(I)
17400 FOR P=1 TO 300:NEXT P
17500 PRINT
17600 GOTO 16600
17700 '
17800 PRINT
17900 FOR I=1 TO 4:PRINT :NEXT I:COLOR 8,7
18000 PRINT "REMEMBER, if you exit the program without saving ";:COLOR 7,0:PRINT" ":COLOR 8,7
18100 PRINT "your new data the disk file is the same as it was";:COLOR 7,0:PRINT" ":COLOR 8,7
18200 PRINT "when you started! If you made CHANGES you must ";:COLOR 7,0:PRINT" ":COLOR 8,7
18300 PRINT "SAVE THE NEW DATA!!!! ";:COLOR 7,0:PRINT" "
18400 COLOR 7,0:PRINT " HAVE YOU SAVED YOUR NEW DATA TO YOUR DISK FILE? "
18500 LINE INPUT " <YES OR NO> ? ";N$
18600 IF LEFT$(N$,1)="N" OR LEFT$(N$,1)="n" THEN E=1:GOSUB 19400:GOTO 18800
18700 IF LEFT$(N$,1)<>"Y" AND LEFT$(N$,1)<>"y" THEN GOTO 17700
18800 CLOSE #1
18900 CLOSE #2
19000 COLOR 8,7:PRINT :PRINT :PRINT " IF YOU GOOFED AND DID NOT SAVE YOUR DATA YOU MAY RESTART THE PROGRAM"
19100 PRINT " BY TYPING 'GOTO 2000' <CR> THEN 'CONTINUE' <CR> AND THE PROGRAM"
19200 PRINT " WILL RESTART WITH YOUR DATA INTACT!!!":COLOR 26,0:PRINT:COLOR 7,0
19300 END
19400 CLS
19410 E=0
19500 C$=CHR$(34)
19600 PRINT " 0 - RETURN TO MAIN PROGRAM"
19700 PRINT " 1 - GET LIST FROM DISK FILE"
19800 PRINT " 2 - PUT LIST ON DISK":PRINT
19900 COLOR 8,7
20000 PRINT " NOTE: If you PUT your files to the disk and have"
20100 PRINT " not previously gotten all info from the disk you"
20200 PRINT " will save only the info in the computer and will"
20300 PRINT " ERASE your disk file.......THINK FIRST. ":PRINT:COLOR 7,0
20400 LINE INPUT " WHICH OPTION DO YOU WANT? (0,1, OR 2) <0> ";N$
20500 IF N$="" OR N$="0" THEN IF E=1 THEN RETURN 18800 ELSE RETURN 2000
20600 IF N$="1" THEN GOSUB 23200
20700 IF N$="2" THEN GOSUB 23200
20800 IF N$="1" THEN 21100
20900 IF N$="2" THEN 22200
21000 PRINT :PRINT :PRINT :GOTO 19600
21100 '
21200 COLOR 26,0:PRINT TAB(10);" HOLD ON WHILE I GET YOUR DATA ! ":COLOR 7,0
21300 ON ERROR GOTO 23710
21400 OPEN "I",#1,D$
21450 ON ERROR GOTO 2000
21500 INPUT #1,R
21600 FOR I=1 TO R
21700 INPUT #1,A$(I),A1$(I),A2$(I),A3$(I),A4$(I),A5$(I),A6$(I),A7$(I)
21800 NEXT I
21900 CLOSE #1
22000 FOR X=1 TO 8:PRINT:NEXT X
22100 IF E=1 THEN RETURN 18800 ELSE RETURN 2000
22200 '
22300 COLOR 26,0:PRINT TAB(10);" HOLD ON I'M PUTTING YOUR DATA AWAY ":COLOR 7,0
22400 '
22500 OPEN "O",#1,D$
22600 PRINT #1,R
22700 FOR I=1 TO R
22800 PRINT #1,C$;A$(I);C$;",";C$;A1$(I);C$;",";C$;A2$(I);C$;",";C$;A3$(I);C$;",";C$;A4$(I);C$;",";C$;A5$(I);C$;",";C$;A6$(I);C$;",";C$;A7$(I);C$
22900 NEXT I
23000 CLOSE #1
23100 IF E=1 THEN RETURN 18800 ELSE RETURN 2000
23200 PRINT:PRINT:
23300 LINE INPUT " WHAT IS THE NAME OF YOUR DATA FILE? <ie MAIL.DAT> ";D$
23400 IF D$="" THEN LET D$="MAIL.DAT"
23500 RETURN
23600 RESET
23700 RETURN 2000
23710 IF ERR=53 THEN PRINT:PRINT:COLOR 26,0:PRINT TAB(20);"Input File Not Found":COLOR 7,0:PRINT:PRINT:RESUME 20400
23800 CLS
23805 COLOR 26,0
23810 PRINT "WARNING:";:COLOR 8,7:PRINT" This section will alphabetize a file read in "
23820 PRINT " from disk. BUT it wipes out any file in memory."
23830 PRINT " Therefore, if you have changed any data in the "
23840 PRINT " file in memory and did not save it, it will be "
23850 PRINT " LOST. To continue, type <CR>, to exit type in "
23860 PRINT " ESC. "
23870 COLOR 7,0
23875 A$=INKEY$:IF LEN(A$)=0 THEN GOTO 23875
23878 IF A$=CHR$(13) THEN RETURN 23890:IF A$=CHR$(27) THEN RETURN 2000
23880 RETURN 2000
23890 CLEAR (15000):DIM A$(200):I%=1
23900 CLS:COLOR 8,7
24050 PRINT "This section of the program will alphabetize your"
24100 PRINT "data file. You will be asked for the file to be "
24200 PRINT "sorted 'eg. MAIL.DAT' and the output file name "
24300 PRINT "which you must give a different name to such as "
24400 PRINT "eg. 'ALPH.DAT'. You must use function 1 to load"
24500 PRINT "the newly sorted file or even the old file. ":COLOR 7,0
24600 PRINT
24700 PRINT
24800 INPUT "SEQ FILE NAME TO BE SORTED.. ";P$
24805 IF P$="" THEN GOTO 1600
24810 INPUT "OUTPUT FILE NAME... ";T$
24812 ON ERROR GOTO 25810
24815 OPEN "I",1,P$
24817 ON ERROR GOTO 2000
24818 OPEN "O",2,T$
25000 IF EOF(1) THEN 25100 ELSE LINE INPUT#1,A$(I%):I%=I%+1:GOTO 25000
25100 I%=I%-1:C%=I%:B%=I%
25200 C%=INT(C%/2):PRINT C%:IF C%=0 THEN 25700 ELSE D%=1:E%=B%-C%
25300 F%=D%
25400 G%=F%+C%:IF A$(F%)<=A$(G%) THEN 25600
25500 SWAP A$(F%),A$(G%):F%=F%-C%:IF F%<1 THEN 25600 ELSE 25400
25600 D%=D%+1:IF D%>E% THEN 25200 ELSE 25300
25700 FOR X%=1 TO I%:PRINT #2,A$(X%):NEXT X%:CLOSE:GOTO 1600
25800 FOR I=1 TO 6:PRINT:NEXT I:RETURN 2000
25810 IF ERR=53 THEN PRINT:PRINT:COLOR 26,0:PRINT TAB(20);"Input File Not Found":COLOR 7,0:RESUME 24600
25900 REM
26000 REM ** CORRECTION ROUTINE **
26100 REM
26200 FOR X=1 TO 6:PRINT:NEXT X
26300 PRINT "YOU CAN SEARCH BY LAST NAME OR CITY"
26400 PRINT "TO FIND ENTRY TO BE CORRECTED.":PRINT :PRINT
26500 PRINT "0 - RETURN TO MAIN MENU"
26600 PRINT "1 - SEARCH BY LAST NAME"
26700 PRINT "2 - SEARCH BY CITY "
26800 PRINT :INPUT "WHICH OPTION DO YOU WANT? <0,1, OR 2> <0> ";N1$
26900 IF N1$="" OR N1$="0" THEN RETURN 2000
27000 IF N1$="1" THEN GOSUB 15400
27100 IF N1$="2" THEN GOSUB 15400
27200 INPUT "WHAT IS THE NUMBER OF THE RECORD TO BE CHANGED? (0 to exit)";X
27300 J=X
27350 IF X=0 THEN RETURN 2000
27400 GOTO 27700
27500 IF N1$=0 THEN RETURN 2000
27600 GOTO 26100
27700 REM MAKE ENTRY CORRECTION
27800 FOR X=1 TO 6:PRINT:NEXT X
27900 COLOR 8,7:PRINT "Make Corrections on your data. If no change hit CR.":COLOR 7,0
28000 PRINT "OLD LAST NAME IS - ";A$(J)
28100 LINE INPUT "NEW LAST NAME - ";H$(J)
28200 IF H$(J)="" THEN H$(J)=A$(J)
28300 PRINT "OLD FIRST NAME AND MIDDLE INITIAL IS - ";A2$(J)
28400 LINE INPUT "NEW FIRST NAME AND MIDDLE INITIAL - ";H2$(J)
28500 IF H2$(J)=""THEN H2$(J)=A2$(J)
28600 PRINT "OLD STREET ADDRESS IS - ";A1$(J)
28700 LINE INPUT "NEW STREET ADDRESS IS - ";H1$(J)
28800 IF H1$(J)="" THEN H1$(J)=A1$(J)
28900 PRINT "OLD CITY - ";A3$(J)
29000 LINE INPUT "NEW CITY - ";H3$(J)
29100 IF H3$(J)="" THEN H3$(J)=A3$(J)
29200 PRINT "OLD STATE - ";A4$(J)
29300 LINE INPUT "NEW STATE - ";H4$(J)
29400 IF H4$(J)="" THEN H4$(J)=A4$(J)
29500 PRINT "OLD ZIP CODE - ";A5$(J)
29600 LINE INPUT "NEW ZIP CODE - ";H5$(J)
29700 IF H5$(J)="" THEN H5$(J)=A5$(J)
29800 PRINT "OLD HOME PHONE - ";A6$(J)
29900 LINE INPUT "NEW HOME PHONE - ";H6$(J)
30000 IF H6$(J)="" THEN H6$(J)=A6$(J)
30100 PRINT "OLD BUSINESS PHONE - ";A7$(J)
30200 LINE INPUT "NEW BUSINESS PHONE -";H7$(J)
30300 IF H7$(J)="" THEN H7$(J)=A7$(J)
30400 FOR X=1 TO 6:PRINT:NEXT X
30500 PRINT TAB(10)H$(J):PRINT TAB(10)H2$(J)
30600 PRINT TAB(10)H1$(J):PRINT TAB(10)H3$(J)
30700 PRINT TAB(10)H4$(J):PRINT TAB(10)H5$(J):PRINT
30800 PRINT TAB(10)H6$(J):PRINT TAB(10)H7$(J) :PRINT
30900 LINE INPUT "IS THIS CORRECT (Y OR N) <Y> ";X2$
31000 FOR X=1 TO 6:PRINT:NEXT X
31100 IF X2$="n" OR X2$="N" THEN 27700
31200 GOSUB 32000
31300 REM STORE NEW DATA
31400 OPEN "O",1,D$
31500 PRINT #1,R
31600 FOR I=1 TO R
31700 PRINT #1,C$;A$(I);C$;",";C$;A1$(I);C$;",";C$;A2$(I);C$;",";C$;A3$(I);C$;",";C$;A4$(I);C$;","C$;A5$(I);C$;",";C$;A6$(I);C$;","C$;A7$(I);C$
31800 NEXT I
31900 CLOSE #1:RETURN 2000
32000 A$(J)=H$(J):A1$(J)=H1$(J):A2$(J)=H2$(J):A3$(J)=H3$(J):A4$(J)=H4$(J):A5$(J)=H5$(J):A6$(J)=H6$(J):A7$(J)=H7$(J):GOTO 26100
32100 PRINT :PRINT :PRINT :PRINT :PRINT
32200 OPEN "O",#2,"lpt1:" ' AT:
32300 WIDTH #2,132
32400 PRINT #2,"=======NAME====================STREET ADDRESS==========CITY==========STATE==========ZIP====HOME PHONE===BUSINESS PHONE=="
32500 FOR I=1 TO R
32600 PRINT #2," ";A$(I);", ";A2$(I);TAB(30);" ";A1$(I);TAB(52);" ";A3$(I);TAB(70);" ";A4$(I);TAB(83);" ";A5$(I);TAB(91);" ";A6$(I);TAB(105);" ";A7$(I)
32700 NEXT I
32800 CLOSE
32900 RETURN 2000
REMCACC.BAS
35 ' Remarks program for CASHACC 6/19/82
36 ' MERGE this program with CASHACC for a complete listing.
37 ' This program is designed for IBM monitor and EPSON/IBM printer.
38 ' Change line 110 of CASHACC to B=7 for Color/Graphics.
40 '********** VARIABLES *******************
42 ' The first character indicates the type;
43 ' S - string: I,C,F,B - integer: A - single precision: D - double precision
50 ' ******* VARIABLE LIST ****************
51 ' DATE:
52 ' SCDATE - Current date
53 ' SDDATE - Data date
54 ' ACCOUNTS:
55 ' AAC1( ) - Account #
56 ' SAC2( ) - Account name
57 ' DAC3( ) - Account, period balance
58 ' DAC4( ) - Account, period balance
59 ' IACN - Current number of accounts
60 ' IALI - Array location of first liability account
61 ' IAIN - Array location of first income account
62 ' IAEX - Array location of first expense account
63 ' CA - Maximum number of accounts allowed
64 ' DTOTMO - Sum of accounting period balance for accounts reported
65 ' DTOTYTD - Sum of current balances for accounts reported
66 ' DBAL - Temporary checking account balance
70 ' TRANSACTIONS:
71 ' SEN1( ) - Transaction code; Checks-#, Deposits-D + opt. #, Cash-C+/C-, Information-I, Adjustments-A+/A-
72 ' SEN2( ) - Transaction date
73 ' SEN3( ) - Transaction description
74 ' DEN4( ) - Transaction amount
75 ' AEN5( ) - Transaction account number
76 ' IENN - Current number of transactions
77 ' CE - Maximum number of transaction allowed
80 ' FLAGS:
81 ' FL,FL1,FL2,FL3,FL4,FT - General flags
82 ' FD - Data flag; 0-not in memory, 1-data in memory
85 ' COUNTERS, POINTERS, INDEXING
86 ' C,CT,CA,CF,CE,CP,CI,CS - General usage
87 ' CLT - Maximum lines of data per page or screen
88 ' CL - Cuirrent # of data lines
89 ' C1,C2 - First, last account to report
90 ' SC1,SC2 - Low, high account to report
91 ' IR - Cursor row; IH - Header row
92 ' OTHER:
93 ' ST,S, A, D - General string, single precision, or double precision input
94 ' B - Bottom of cursor; I,IT - General integer storage
95 ' A,AT - Account referencing; SF,SA - Accounting period name
96 ' SH - Header string; SC - Column head string
97 ' SP - String to print; ST - Name of account range selected
300 REM DISPLAY MAIN MENU AND SELECT OPTION
301 ' This is the executive program. The main menu is displayed and then the
302 ' available memory is checked and displayed. One of the options may then
303 ' be selected by typing the number of the option desired.
500 REM INITIALIZE PROGRAM
501 ' This subroutine is used the first time the program is run. Information is
502 ' displayed about the CHECKBOOK and PETTY CASH accounts and then initial
503 ' balances may be entered for these accounts.
1000 REM ADD, EDIT OR PRINT ACCOUNTS SUBROUTINE
1001 ' This option is used to add initial accounts or addition accounts, edit
1002 ' accounts that are in memory, or print a condensed list of accounts that
1003 ' are currently in memory. The subroutines are menu driven and this option
1004 ' may be used at anytime.
1200 REM ADD ACCOUNTS SUBROUTINE
1201 ' This subroutine is used to add accounts. The range of accounts numbers to
1202 ' use is displayed at the bottom of the screen. To create a subaccount, add
1203 ' one decimal place to the main account number. After a number is entered,
1204 ' it is checked against existing numbers. If the number does not exist, the
1205 ' account name is then entered and then an initial balance is entered.
1206 ' Input continues until a "E" or "e" is entered for the account number.
1400 REM EDIT ACCOUNTS SUBROUTINE
1401 ' This subroutine is used to edit current accounts. After the account
1402 ' number is entered, current information is displayed. If it is the account
1403 ' desired, then it is edited by retyping all of the account information. If
1405 ' a new number is entered, the old account is deleted. An account may also be
1406 ' deleted by re-entering the same number and then only hit ENTER when the name
1407 ' is requested.
1600 REM PRINT CHART OF ACCOUNTS SUBROUTINE
1601 ' This subroutine is designed to work with the Epson or IBM printers. First
1602 ' a code is sent to condense the print and then a list is printed that gives
1603 ' the accounts numbers and names. This list can then be used when the program
1604 ' is running as a reference of the accounts in memory.
2000 REM ENTER OR EDIT TRANSACTIONS SUBROUTINE
2001 ' This option is used to enter new transactions or edit transactions that are
2002 ' in memory. These transactions are distinquished by a code and include;
2003 ' checks(enter the #), deposits(enter D and then an optional #), petty cash
2004 ' (enter C+ to add cash income and C- to pay cash expense), account adjustments
2005 ' (enter A+ to add to an account and A- to subtract from an account) and
2006 ' information entries(enter I for code). Transactions from previous accounting
2007 ' periods cannot be edited and adjustment entries should be used to make corrections.
2200 REM ENTER TRANSACTIONS SUBROUTINE
2201 ' This subroutine is used to enter transaction information which includes;
2202 ' code, date, description, amount, and account #. The procedure is to enter
2203 ' all of the transactions and then the entries are listed and may be edited
2204 ' before account balances are adjusted. Note: the petty cash account will be
2205 ' adjusted when checks are entered and charged to that account.
2500 REM EDIT SPECIFIC TRANSACTION SUBROUTINE
2501 ' This subroutine is used to edit specific transactions. The transaction number
2502 ' must be entered, then it is displayed and may then be edited. All account
2503 ' balances will be adjusted as necessary according to any changes made.
3000 REM REPORTS SUBROUTINE
3001 ' This option is used to report to screen or printer all account and transaction
3002 ' information.
3200 REM REPORT ACCOUNTS SUBROUTINE
3201 ' This subroutine reports account information by type or a selection of an
3202 ' account # range. If a range is selected a name may be entered for the range
3203 ' of accounts. The balances of any accounts with subaccounts are summed at
3204 ' this time and totals are printed for the complete range that is listed.
3500 REM REPORT TRANSACTIONS SUBROUTINE
3501 ' This subroutine is used to report transactions by type or all transactions.
4000 REM START NEW ACCOUNTING PERIOD SUBROUTINE
4001 ' This option will erase any transactions entries that are in memory and
4002 ' will set account period balances back to zero. The user is given the chance
4003 ' to first return to the main menu to save data if necessary. To complete the
4004 ' process the user must also type "OK".
5000 REM SAVE DATA SUBROUTINE
5001 ' This option is used to control the data output subroutine. Several copies
5002 ' may be saved and a different version of the accounting period name must be
5003 ' used if copies are put on the same disk.
8000 REM DATA INPUT SUBROUTINE
8001 ' This option is used to input previous data. It may be selected by itself
8002 ' or may be selected by other options if data is needed in memory. Data is
8003 ' saved as account(ACC) files and transaction(ENT) files but only the accounting
8004 ' period name is used to select data to load. Data files are listed on the
8005 ' screen for selection. While data is loading the date of the data is displayed.
8006 ' This date is the last time new accounts or transactions were added or when
8007 ' editing was done.
8200 REM DATA OUTPUT SUBROUTINE
8201 ' This subroutine is used to write data to a disk file. An accounting period
8202 ' name must be entered and then two files are written. A file of the accounts
8203 ' and their balances with the extension ACC and a file of all transactions
8204 ' with the extension ENT. A data date is also recorded with the account file.
8205 ' This date is the current date entered at the beginning of the program runor else the last time changes were made to both files if no changes were done this
8206 ' time.
WB-UPTLE.BAS
1 '***************** MODIFICATION FOR PC-TALK, VERSION 2.0 ******************
2 '
3 'FILENAME: WB-UPTLE
4 '
5 'PURPOSE: ALLOWS AUTOMATIC FILE TRANSMISSION WHILE USING AN EDITOR OF A
6 ' HOST COMPUTER WHICH REQUIRES THE USER TO WAIT FOR ITS PROMPT
7 ' BETWEEN THE TRANSMISSION OF EACH LINE.
8 '
9 'NOTES: THIS FUNCTION IS USED IN CONJUNCTION WITH THE TRANSMIT FILE FUNCTION.
10 ' IT IS TOGGLED ON/OFF WITH ALT-N. IT MUST BE TOGGLED ON BEFORE
11 ' INVOKING THE TRANSMIT FILE FUNCTION.
12 '
13 ' THIS FUNCTION MUST NOT BE USED IF THE RECEIVING COMPUTER ACCEPTS
14 ' THE TRANSMITTED FILE AS ONE BLOCK OF DATA, BECAUSE THIS WOULD
15 ' CAUSE THE PROGRAM TO HANG UP WAITING FOR A PROMPT.
16 '
17 ' THIS FUNCTION MUST NOT BE USED WITH THE FAST TRANSMIT MODE.
18 '
19 ' THIS PATCH DOES NOT CONFLICT WITH THE FOLLOWING PATCHES:
20 ' TM-BREAK
21 ' TM-DIAL2
22 ' TM-LDIR1
23 ' TM-TIME1
24 '
25 ' THE DELAYS ON LINES 464 AND 4218 MAY BE MODIFIED IF NECESSARY.
26 '
27 'DIRECTIONS: DELETE THE FIRST 32 LINES OF THIS FILE. THEN SAVE AS
28 ' AN ASCII FILE (USE ",A OPTION OF BASIC SAVE COMMAND)
29 ' AND MERGE WITH VERSION 2.0 OF PC-TALK.
30 '************************************************************************
31 'WILLIAM HT BAILEY PHILA., PA DECEMBER 1982
32 '************************************************************************
147 UPLOAD=FALSE
461 IF V$<>CHR$(10) THEN 470
462 IF NOT UPLOAD THEN 475
463 IF EOF(1) THEN 463
464 FOR J=1 TO 1000: NEXT J: A$=INPUT$(LOC(1),#1): GOTO 475
1305 '
1310 '
1315 ' - Automatic Upload To Line Editor -
1320 '
1325 '
1330 IF CODE<>49 THEN 1400
1335 IF NOT UPLOAD THEN UPLOAD=TRUE ELSE GOTO 1370
1340 PRINT: PRINT "=== UPLOAD TO LINE EDITOR MODE ON ===": BEEP
1345 PRINT: PRINT "NOTE: This mode should not used if:
1350 PRINT " 1. The receiving computer accepts the transmitted file"
1355 PRINT " as a single data block"
1360 PRINT " -OR-"
1365 PRINT " 2. The FAST TRANSMIT mode is activated.": GOTO 400
1370 UPLOAD=FALSE: PRINT
1375 PRINT "=== UPLOAD TO LINE EDITOR MODE OFF ===": BEEP: GOTO 400
1380 '
1385 '
1390 '
1395 '
4216 IF V$<>CHR$(10) OR NOT UPLOAD THEN 4220
4217 IF EOF(1) THEN 4217
4218 FOR J=1 TO 1000: NEXT J
Directory of PC-SIG Library Disk #0062
Volume in drive A has no label
Directory of A:\
CASHACC BAS 19328 10-21-82
CHARS2 BAS 640 1-07-82
INVENTRY BAS 10112 1-01-80
INVENTRY DAT 505
INVENTRY DOC 301 1-01-80
LINREGRS BAS 11136 9-27-82
MAILIST2 BAS 16000 10-24-82
MONTHS HBW 640 11-30-82
REMCACC BAS 8192 10-17-82
TESTDATA ACC 1280 7-22-82
WB-UPTLE BAS 2432 12-20-82
FILES62 TXT 1702 1-27-89 2:07p
GO BAT 38 10-19-87 3:56p
GO TXT 694 12-02-88 11:29a
14 file(s) 73000 bytes
83968 bytes free