PCjs Machines
Home of the original IBM PC emulator for browsers.
PC-SIG Diskette Library (Disk #406)
[PCjs Machine "ibm5150"]
Waiting for machine "ibm5150" to load....
Information about “FINANCIAL WORKSHEETS”
A variety of BASIC programs and LOTUS 1-2-3 worksheet templates
suitable for personal and business use, including such tasks as;
financial and real estate analysis, portfolio and personal
property worksheets, and others to help analyze and control your
finances. Also included is a spreadsheet program written in
BASIC and an address book program.
System Requirements: 64K, one disk drive and monochrome display
How to Start: To run the BASIC programs consult the directions in
GETTING STARTED for you configuration. To run the LOTUS 1-2-3 files
consult your LOTUS 1-2-3 manual.
File Descriptions:
PRINTCON BAS Printer setup
PERSONAL BAS Personal address book
PERS BAS Data file for personal address book
PERPCAL BAS Calendar for any year
KALK BAS Compound interest computation program
FINPGM BAS Financial analysis program
PC-PAD BAS Editor/spreadsheet/viewer program
MORTGAGE BAS Amortization program
LOANS BAS Loan analyzer
FINANCE BAS Home finance program
DATAPGM BAS Statistical analysis program
CHECK BAS Home check book program
BUSPGM BAS Business financial program
MENU2-1 BAT Main program for use with BASICA 2.0
MENU1-1 BAT Main program for use with BASICA 1.0
AUTO2-1 BAT Autoexecute batch file DOS 2.X
AUTO1-1 BAT Autoexecute batch file DOS 1.X
STOCK BAS Stock market analysis
REALPGM BAS Real estate analysis program
GROWTH WKS LOTUS 123 - accumulation planning worksheet
EDFNDWKS WKS LOTUS 123 - plan for educational expenses
DIVIDEND WKS LOTUS 123 - dividend and interest report
BUDGET WKS LOTUS 123 - budget worksheet
WEALTH WKS LOTUS 123 - compute your networth worksheet
TX5J WKS LOTUS 123 - 5 year income tax averaging worksheet
SECURITY WKS LOTUS 123 - social security analysis worksheet
RETIRE WKS LOTUS 123 - retirement analysis
PROPERTY WKS LOTUS 123 - personal property tracking worksheet
PAYMENTS WKS LOTUS 123 - expenditures and cash flow worksheet
INVEST WKS LOTUS 123 - portfolio summary worksheet
INSURE WKS LOTUS 123 - insurance calculator
PCSIG Listing of included files
BUSPGM.BAS
1 KEY(10) ON:ON KEY(10) GOSUB 3
2 GOTO 5
3 RUN"MENU.BAT"+CHR$(13)
5 CLS
6 LOCATE 23,24:PRINT "Press F10 to EXIT program.
100 REM -----------------------------
110 N$= "BUSINESS PROGRAMS"
120 REM -----------------------------
130 GOSUB 6200 'INITIALIZE
140 REM SET UP MENU ARRAY
150 X$(1)="STRAIGHT-LINE DEPRECIATION"
160 X$(2)="DECLINING-BALANCE DEPRECIATION"
170 X$(3)="SUM-OF-YEARS'-DIGITS DEPRECIATION"
180 X$(4)="BREAK-EVEN POINT"
190 X$(5)="ECONOMIC ORDERING QUANTITY"
200 X$(6)="SALES PRICE WITH DISCOUNT"
210 X$(7)="WEIGHTED AVERAGE"
220 X$(8)="SALESPERSON' COMMISSION"
230 X$(9)="WAGES WITH OVERTIME"
240 X$(10)="EXECUTIVE DECISION MAKER"
250 N=10 : GOSUB 7000 'DISPLAY MENU
260 ON X GOSUB 280,500,740,990,1140,1310,1550,1840,2010,2210
270 Q2$="RUN" : GOSUB 3400 'ASK FOR ANOTHER RUN
271 IF YN$="N" THEN END ELSE GOTO 100
280 REM ----------------------------------
290 N$= "STRAIGHT-LINE DEPRECIATION"
300 REM ----------------------------------
310 GOSUB 6200 : K=1
320 REM GET INPUT PARAMETERS
330 Q1$="ENTER DATA" : Q2$=""
340 Q3$="PRES. BOOK VALUE ($)" : GOSUB 6600
350 Q3$="SALVAGE VALUE ($)" : GOSUB 6600
360 Q3$="LIFE (YRS) " : GOSUB 6600
370 REM PRINT DEPR SCHEDULE
380 D=(PAR(1)-PAR(2))/PAR(3)
390 PRINT
400 PRINT"YEAR DEPR($) VALUE($)"
410 FOR A= 1 TO PAR(3)
420 PRINT A; TAB(6);
430 PRINT USING "#######,.##";D,PAR(1)-D*A
440 IF A <> 12 THEN 470
450 GOSUB 7400 'WAIT FOR KEY
460 LOCATE 8,1 'RESET POINTER
470 NEXT A
480 Q2$="COMPUTE" : GOSUB 3400 'ASK FOR ANOTHER
490 IF YN$="N" THEN RETURN ELSE GOTO 280
500 REM ----------------------------------------
510 N$= "DECLINING-BALANCE DEPRECIATION"
520 REM ----------------------------------------
530 GOSUB 6200 : K=1
540 REM GET INPUT PARAMETERS
550 Q1$="ENTER DATA" : Q2$=""
560 Q3$="PRES. BOOK VALUE ($)" : GOSUB 6600
570 Q3$="LIFE (YRS) " : GOSUB 6600
580 Q3$="% ACCEL DEPRECIATION" : GOSUB 6600
590 REM PRINT DEPR SCHEDULE
600 RV=PAR(1)
610 PRINT
620 PRINT"YEAR DEPR($) VALUE($)"
630 FOR A= 1 TO PAR(2)
640 PRINT A; TAB(6);
650 D=RV*PAR(3)/100/PAR(2)
660 PRINT USING "#######,.##";D,RV-D
670 RV=RV-D
680 IF A <> 12 THEN 710
690 GOSUB 7400 'WAIT
700 LOCATE 8,1
710 NEXT A
720 Q2$="COMPUTE" : GOSUB 3400 'ASK FOR ANOTHER
730 IF YN$="N" THEN RETURN ELSE GOTO 500
740 REM -------------------------------------------
750 N$= "SUM-OF-YEARS'-DIGITS DEPRECIATION"
760 REM -------------------------------------------
770 GOSUB 6200 : K=1
780 REM GET INPUT PARAMETERS
790 Q1$="ENTER DATA" : Q2$=""
800 Q3$="PRES. BOOK VALUE ($)" : GOSUB 6600
810 Q3$="SALVAGE VALUE ($)" : GOSUB 6600
820 Q3$="LIFE (YRS) " : GOSUB 6600
830 REM PRINT DEPR SCHEDULE
840 D=PAR(1)-PAR(2)
850 RV=PAR(1)
860 PRINT
870 PRINT"YEAR DEPR($) VALUE($)"
880 FOR A= 1 TO PAR(3)
890 D1=D*(PAR(3)+1-A)/(PAR(3)*(PAR(3)+1)/2)
900 PRINT A; TAB(6);
910 PRINT USING "#######,.##";D1,RV-D1
920 RV=RV-D1
930 IF A <> 12 THEN 960
940 GOSUB 7400
950 LOCATE 8,1
960 NEXT A
970 Q2$="COMPUTE" : GOSUB 3400 'ASK FOR ANOTHER
980 IF YN$="N" THEN RETURN ELSE GOTO 740
990 REM ------------------------------
1000 N$= "BREAK-EVEN POINT"
1010 REM ------------------------------
1020 GOSUB 6200 : K=1
1030 REM GET INPUT PARAMETERS
1040 Q1$="ENTER DATA" : Q2$=""
1050 Q3$="FIXED COSTS ($)" : GOSUB 6600
1060 Q3$="COST PER UNIT ($)" : GOSUB 6600
1070 Q3$="SALES PRICE ($)" : GOSUB 6600
1080 PRINT
1090 PRINT "BREAK-EVEN POINT -> ";
1100 US=INT(PAR(1)/(PAR(3)-PAR(2))*100+0.5)/100
1110 PRINT USING "#####,"; US; :PRINT " UNITS"
1120 Q2$="COMPUTE" : GOSUB 3400 'ASK FOR ANOTHER
1130 IF YN$="N" THEN RETURN ELSE GOTO 990
1140 REM ------------------------------------
1150 N$= "ECONOMIC ORDERING QUANTITY"
1160 REM ------------------------------------
1170 GOSUB 6200 : K=1
1180 REM GET INPUT PARAMETERS
1190 Q1$="ENTER DATA" : Q2$=""
1200 Q3$="COST TO ORDER ($)" : GOSUB 6600
1210 Q3$="ANNUAL UNITS USED " : GOSUB 6600
1220 Q3$="UNIT CARRYING COST($)" : GOSUB 6600
1230 REM COMPUTE AND PRINT
1240 PRINT
1250 EOQ=INT(SQR(2*PAR(1)*PAR(2)/PAR(3)))
1260 PRINT " EOQ = ";
1270 PRINT USING "#####,"; EOQ;
1280 PRINT " UNITS"
1290 Q2$="COMPUTE" : GOSUB 3400 'ASK FOR ANOTHER
1300 IF YN$="N" THEN RETURN ELSE GOTO 1140
1310 REM -----------------------------------
1320 N$= "SALES PRICE WITH DISCOUNT"
1330 REM -----------------------------------
1340 GOSUB 6200 : K=1
1350 REM GET INPUT PARAMETERS
1360 Q1$="ENTER DATA" : Q2$=""
1370 Q3$="RETAIL PRICE ($)" : GOSUB 6600
1380 Q3$="DISCOUNT (%)" : GOSUB 6600
1390 Q3$="SALES TAX (%)" : GOSUB 6600
1400 REM COMPUTE AND PRINT
1410 PRINT
1420 PRINT " PRICE";TAB(24);
1430 PRINT USING "$$####,.##";PAR(1)
1440 D=PAR(1)*PAR(2)/100
1450 PRINT " DISCOUNT";TAB(24);
1460 PRINT USING "$$####,.##";D
1470 T=(PAR(1)-D)*PAR(3)/100
1480 PRINT " TAX";TAB(24);
1490 PRINT USING "$$####,.##";T
1500 PRINT
1510 PRINT "TOTAL";TAB(24);
1520 PRINT USING "$$####,.##";PAR(1)-D+T
1530 Q2$="COMPUTE" : GOSUB 3400 'ASK FOR ANOTHER
1540 IF YN$="N" THEN RETURN ELSE GOTO 1310
1550 REM ------------------------------
1560 N$= "WEIGHTED AVERAGE"
1570 REM ------------------------------
1580 DIM D(100,1)
1590 GOSUB 6200 : K=1
1600 REM GET INPUT PARAMETERS
1610 PRINT "ENTER DATA, RETURN WHEN DONE"
1620 PRINT : PRINT "VALUE UNITS"
1630 ND=0
1640 J=7
1650 LOCATE J,1 : PRINT " ";
1660 LOCATE J,1 : INPUT D(ND,0)
1670 LOCATE J,12 : INPUT D(ND,1)
1680 IF D(ND,1)=0 THEN 1720
1690 ND=ND+1
1700 J=J+1
1710 IF J=17 THEN 1640 ELSE 1650
1720 REM NOW COMPUTE AND PRINT
1730 AVE=0 : U=0
1740 FOR I = 0 TO ND-1
1750 AVE= AVE+D(I,0)*D(I,1)
1760 U=U+D(I,1)
1770 NEXT I
1780 AVE=AVE/U
1790 LOCATE 16,3
1800 PRINT "WEIGHTED AVERAGE IS : ";
1810 PRINT USING "######,"; AVE
1820 Q2$="COMPUTE" : GOSUB 3400 'ASK FOR ANOTHER
1830 IF YN$="N" THEN RETURN ELSE GOTO 1590
1840 REM ----------------------------------
1850 N$= "SALESPERSON'S COMMISSION"
1860 REM ----------------------------------
1870 GOSUB 6200 : K=1
1880 REM GET INPUT PARAMETERS
1890 Q1$="ENTER DATA" : Q2$=""
1900 Q3$="MONTHLY DRAW ($)" : GOSUB 6600
1910 Q3$="MONTHLY SALES ($)" : GOSUB 6600
1920 Q3$="COMMISSION (%) " : GOSUB 6600
1930 REM COMPUTE AND PRINT
1940 PRINT
1950 PRINT "COMMISSION EARNED ";TAB(24)
1960 PRINT USING "$$####,.##";PAR(2)*PAR(3)/100
1970 PRINT"DUE (LESS DRAW) ";TAB(24)
1980 PRINT USING "$$####,.##";PAR(2)*PAR(3)/100-PAR(1)
1990 Q2$="COMPUTE" : GOSUB 3400 'ASK FOR ANOTHER
2000 IF YN$="N" THEN RETURN ELSE GOTO 1840
2010 REM ------------------------------
2020 N$= "WAGES WITH OVERTIME"
2030 REM ------------------------------
2040 GOSUB 6200 : K=1
2050 REM GET INPUT PARAMETERS
2060 Q1$="ENTER DATA" : Q2$=""
2070 Q3$="BASE RATE ($/HR)" : GOSUB 6600
2080 Q3$="OT PAY FACTOR" : GOSUB 6600
2090 Q3$="BASE HOURS WORKED" : GOSUB 6600
2100 Q3$="OT HOURS WORKED" : GOSUB 6600
2110 REM COMPUTE AND PRINT
2120 PRINT
2130 PRINT " BASE PAY ";TAB(24)
2140 PRINT USING "$$####,.##";PAR(1)*PAR(3)
2150 PRINT " OT PAY ";TAB(24)
2160 PRINT USING "$$####,.##";PAR(1)*PAR(2)*PAR(4)
2170 PRINT " TOTAL PAY";TAB(24)
2180 PRINT USING "$$####,.##";PAR(1)*PAR(3)+PAR(1)*PAR(2)*PAR(4)
2190 Q2$="COMPUTE" : GOSUB 3400 'ASK FOR ANOTHER
2200 IF YN$="N" THEN RETURN ELSE GOTO 2010
2210 REM ----------------------------------
2220 N$= "EXECUTIVE DECISION MAKER"
2230 REM ----------------------------------
2240 GOSUB 6200 : K=1
2250 PRINT "PLEASE TYPE YOUR QUESTION"
2260 PRINT "=>";
2270 INPUT Q$ : Y=LEN(Q$)
2280 IF Y < 6 THEN 2300
2290 Y=INT(Y/2) : GOTO 2280
2300 ON Y GOTO 2310,2320,2330,2340,2350
2310 PRINT "NOT ON YOUR LIFE" : GOTO 2360
2320 PRINT "GO FOR IT !! " : GOTO 2360
2330 PRINT "YOU'D BETTER BELIEVE IT" : GOTO 2360
2340 PRINT "FLIP A COIN !" : GOTO 2360
2350 PRINT "MAKE YOUR BREAK- QUICKLY"
2360 Q2$="ASK A QUESTION" : GOSUB 3400 'ASK FOR ANOTH
2370 IF YN$="N" THEN RETURN ELSE GOTO 2210
3400 REM "ANOTH"
3401 ' --------------------------------
3402 ' ASK FOR ANOTHER RUN
3403 '
3404 'THIS ROUTINE ASKS THE USER WHETHER TO CONTINUE
3405 '
3406 'CALLING PARAMETERS:
3407 ' Q2$= STRING TO SPECIFY WHAT OPERATION TO DO
3408 '
3409 'RETURNED PARAMETERS:
3410 ' YN$= A "Y" OR "N" FOR YES OR NO
3411 '
3412 ' --------------------------------
3420 Q1$="WOULD YOU LIKE TO "
3430 Q3$="AGAIN Y OR N ?"
3440 GOSUB 5000 'PRESENT DIALOG
3450 GOSUB 7800 'ASK YES OR NO
3460 RETURN
5000 REM "DIALOG"
5001 ' -------------------------------
5002 ' DIALOGUE
5003 '
5004 'CALLING PARAMETERS:
5005 ' Q1$,Q2$,Q3$, = QUESTIONS TO DISPLAY
5006 '
5007 'RETURNED PARAMETERS:
5008 ' NONE
5009 '
5010 'COMMENT: UNUSED QUESTION STRINGS SHOULD BE SET
5011 ' TO NULL ("")
5012 '
5013 ' -------------------------------
5020 FOR I= 20 TO 23
5030 LOCATE I,1
5040 IF I > 20 THEN 5080
5050 FOR J= 1 TO 40 'DRAW A BORDER
5060 PRINT "-";
5070 NEXT J
5080 IF I = 21 THEN PRINT Q1$; 'FIRST QUESTION
5090 IF I = 22 THEN PRINT Q2$; 'SECOND QUESTION
5100 IF I = 23 THEN PRINT Q3$; 'THIRD QUESTION
5109 REM RESTORE CURSOR HERE AFTER 3RD QUEST
5110 CP1=POS(N)
5120 CP=POS(N) 'CURSOR COLUMN POSITION
5130 IF CP>40 THEN 5150
5140 PRINT " "; : GOTO 5120 'ERASE ANY PRIOR INFO
5149 REM RESTORE CURSOR FOR USER RESPONSE
5150 LOCATE I,CP1
5160 NEXT I
5170 RETURN
5400 REM "INCH"
5401 ' ------------------------------
5402 ' INPUT CHARACTER
5403 '
5404 'CALLING PARAMETERS:
5405 ' NONE
5406 '
5407 'RETURNED PARAMETERS:
5408 ' CH$=INPUT CHARACTER
5409 '
5410 ' ------------------------------
5420 REM WAIT FOR INPUT CHARACTER
5430 CH$= INKEY$ : IF CH$="" THEN 5430
5440 Z=ASC(CH$)
5450 IF Z < 97 OR Z > 122 THEN 5470
5460 Z=Z-32
5470 CH$=CHR$(Z)
5480 RETURN
6200 REM "INIT"
6201 '----------------------------------
6202 ' INITIALIZE DISPLAY
6203 '
6204 'THIS ROUTINE CLEARS THE SCREEN
6205 ' AND PRINTS THE PROGRAM TITLE
6206 'CALLING PARAMETERS:
6207 ' N$=TITLE OF PROGRAM
6208 '
6209 'RETURNED PARAMETERS:
6210 ' NONE
6211 '
6212 ' ----------------------------------
6220 CLS 'CLEAR SCREEN
6230 PRINT N$ : PRINT 'TITLE
6240 KEY OFF
6250 RETURN
6600 REM "INPAR"
6601 ' --------------------------------
6602 ' INPUT PARAMETERS
6603 '
6604 'CALLING PARAMETERS:
6605 ' Q1$,Q2$=USER INSTRUCTIONS
6606 ' Q3$=NAME OF DATA ITEM
6607 '
6608 'RETURNED PARAMETERS:
6609 ' PAR(K)=THE DATA ITEM OBTAINED
6610 '
6611 'COMMENT: CALL WITH K=1 FOR FIRST DATA ITEM
6612 ' K AUTOMATICALLY UPDATED
6613 '
6614 ' -------------------------------
6620 GOSUB 5000 'ASK QUESTIONS
6630 INPUT PAR(K) 'GET VALUE
6640 REM ECHO QUESTION AND ANSWER
6650 LOCATE K+2,3
6660 PRINT Q3$; TAB(24);
6670 PRINT USING "######,.##"; PAR(K)
6680 K=K+1
6690 RETURN
7000 REM "MENU"
7001 ' ------------------------------
7002 ' MENU PROGRAM
7003 '
7004 'THIS PROGRAM DISPLAYS A MENUE
7005 ' AND CHOOSES A PROGRAM
7006 'CALLING PARAMETERS:
7007 ' N= NO. OF MENU ITEMS
7008 ' X$(I)= ARRAY OF PROGRAM NAMES
7009 '
7010 'RETURNED PARAMETERS:
7011 ' X=PROGRAM NUMBER CHOSEN
7012 '
7013 ' ------------------------------
7020 CLS
7030 FOR I = 1 TO N 'DISPLAY MENU
7040 IF I=10 THEN PRINT 0; ELSE PRINT I;
7050 PRINT "= " ; X$(I)
7060 NEXT I
7070 Q1$="" : Q2$=""
7080 Q3$="CHOOSE PROGRAM :"
7085 PRINT:PRINT" F10 to EXIT program.
7090 GOSUB 5000 'ASK QUESTIONS
7100 GOSUB 5400 'INPUT CHAR
7110 X= VAL(CH$)
7119 REM SEE IF CHAR IN RANGE
7120 IF X>=1 AND X<=N THEN RETURN
7130 IF X=0 AND N=10 THEN 7140 ELSE 7150
7140 X=10 : RETURN
7150 Q1$="ILLEGAL CHOICE, CHOOSE AGAIN"
7160 GOSUB 5000
7170 GOTO 7100
7400 REM "PAUSE"
7401 ' -------------------------------
7402 ' WAIT FOR ANY KEY
7403 '
7404 'THIS ROUTINE WAITS FOR USER TO STRIKE KEY
7405 '
7406 'CALLING PARAMETERS:
7407 ' NONE
7408 '
7409 'RETURNED PARAMETERS
7410 ' NONE
7411 '
7412 ' -------------------------------
7420 Q1$="STRIKE ANY KEY TO CONTINUE"
7430 Q2$="" : Q3$=""
7440 GOSUB 5000 'CALL DIALOG
7450 X$=INKEY$ : IF X$ = "" THEN 7450 'WAIT FOR KEY
7460 RETURN
7800 REM "YESNO"
7801 ' -------------------------------
7802 ' YES-NO
7803 '
7804 'CALLING PARAMETERS:
7805 ' NONE
7806 '
7807 'RETURNED PARAMETERS:
7808 ' YN$= CONTAINS A Y OR N
7809 '
7810 ' -------------------------------
7815 LOCATE 24,40:PRINT" F10 to EXIT program.
7820 REM WAIT FOR KEY TO BE STRUCK
7830 YN$=INKEY$ : IF YN$="" THEN 7830
7840 IF YN$="y" THEN YN$="Y"
7850 IF YN$="n" THEN YN$="N"
7860 IF YN$ = "Y" OR YN$ = "N" THEN 7890
7870 REM NOT YES OR NO TRY AGAIN
7880 GOTO 7830
7890 PRINT YN$ : RETURN
CHECK.BAS
10 ' CHECKBOOK PROGRAM
20 ' THIS PROGRAM WILL PROCESS MULTIPLE ACCOUNTS (WITH THE LIMIT CURRENTLY SET TO 5).
30 KEY OFF
31 SCREEN 0
32 WIDTH 80
40 CLEAR 4000 'RESERVE STRING SPACE
50 DEFDBL A
60 MN=150 'CHECKS PER MONTH
70 MA=5 'MAX ACCOUNTS
80 DIM CR$(MN,MA),AB(MA),AN(MA) 'CHK RES, ACCT. BAL.,ACCT #
90 DIM CN(MA),NU$(25),MO$(12) 'CHK NOS, AMOUNTS, MONTHS
100 '---------------------------------------------------------------------------
110 'OPEN FILES, PROCESS DATE
120 REM
130 CLS
140 T$="CHEKBOOK -- A CHECK ACCOUNTING PROGRAM"
150 PRINT TAB(32-(LEN(T$)/2))T$
160 PRINT:PRINT "SYSTEM INITIALIZATION IN PROCESS,PLEASE WAIT"
170 ON ERROR GOTO 250
180 OPEN "I",1,"CRF/DAT": ON ERROR GOTO 0
190 FOR I=1 TO MA: INPUT #1,AN(I) : NEXT I
200 FOR I=1 TO MA : INPUT #1,AB(I) : NEXT I
210 FOR I=1 TO MA ; INPUT #1,CN(I) : NEXT I
220 IF EOF(1) THEN CLOSE: GOTO 300
230 INPUT #1,I,J : LINE INPUT #1,CR$(I,J)
240 GOTO 220
250 PRINT"ERROR, CHECK REGISTER FILE NOT FOUND.FILE WILL BE CREATED!"
260 PRINT "HIT ENTER TO CONTINUE"
270 A$=INKEY$ : IF A$="" GOTO 270 ELSE IF ASC(A$)<>13 GOTO 270
280 RESUME 290
290 ON ERROR GOTO 0
300 DT$=LEFT$(DATE$,2)+"/"+MID$ (DATE$,4,2)+"/"+RIGHT$(DATE$,2) : GOSUB 2510
310 IF VAL(DT$)<>0 GOTO 340
320 LINE INPUT "ENTER TODAY'S DATE (MM.DD.YY): ";DT$
330 GOTO 310
340 REM -------------------------------------------------------------------
350 REM DISPLAY MENU,GET AND VALIDATE OPTIONS
360 REM
370 CLS
380 PRINT STRING$(24,"-")"CHEKBOOK MENU "STRING$(25,"-")
390 PRINT:PRINT
400 PRINT" 1 -- POST POST A HAND WRITTEN CHECK"
410 PRINT" 2 -- WRITE WRITE A CHECK"
420 PRINT" 3 -- STATEMENT GENERATE THE CHECK STATEMENTS"
430 PRINT" 4 -- SETUP SETUP A NEW ACCOUNT"
440 PRINT" 5 -- DEPOSIT POST A DEPOSIT TO ACCOUNT"
450 PRINT" 6 -- PURGE PURGE CURRENT MONTH'S CRF"
460 PRINT" 7 -- END TERMINATE THE PROGRAM"
470 LOCATE 3,57 : PRINT DT$;
480 LOCATE 4,57 : PRINT RIGHT$(TIME$,8);
490 LOCATE 2,1 : PRINT "SELECT OPTION===> ";: LOCATE ,,1
500 A$=INKEY$ : IF A$="" GOTO 500
510 PRINTA$; : LOCATE ,,0 : OP=VAL(A$)
520 IF OP>=1 AND OP <=7 GOTO 550
530 LOCATE 1,49 : PRINT "INVALID OPTION";
540 GOTO 490
550 ON OP GOSUB 940, 1240, 1300, 1860, 2070, 2810, 2430
560 GOTO 370
570 REM-----------------------------------------------------------------------
580 REM COMMON CHECK DATA INPUT ROUTINE
590 REM
600 FOR I=3 TO 16:LOCATE I,1: PRINT STRING$(64," "):NEXT I
610 LOCATE 3,1
620 CD$(1)=" ACCOUNT:"+STRING$(15,CHR$(95))
630 CD$(2)=" WRITTEN TO:"+STRING$(25,CHR$(95))
640 CD$(3)=" CHECK AMOUNT:$"+STRING$(7,CHR$(95))
650 CD$(4)=" NOTES: "+STRING$(25,CHR$(95))
660 DX$=STRING$(1,CHR$(95)): DX$=DX$+"/"+DX$+"/"+DX$
670 CD$(5)=" DATE WRITTEN: "+DX$
680 CD$(6)=" CHECK NUMBER: "+STRING$(7,CHR$(95))
690 CN=-1
700 FOR I=1 TO 4: PRINT CD$(I): NEXT I
710 IF CC=1 THEN PRINT CD$(5) : PRINT CD$(6)
720 LOCATE 3,15,1 : GOSUB 840 : AC=VAL(IX$)
730 LOCATE 4,18,1 : GOSUB 840 : WT$=IX$
740 LOCATE 5,20,1 : GOSUB 840 : AM=VAL(IX$)
750 LOCATE 6,13,1 : GOSUB 840 : NT$=IX$
760 IF CC<>1 GOTO 800
770 LOCATE 7,20,1 : GOSUB 840 : DW$=IX$
780 LOCATE 8,20,1 : GOSUB 840 : CN=VAL(IX$)
790 PRINT
800 LOCATE 9,1 : INPUT "is this correct";AN$
810 IF AN$="NO" OR AN$="N" GOTO 600
820 IF AN$<>"YES" AND AN$<>"Y" GOTO 800
830 FOR I=9 TO 16 :LOCATE I,1 : PRINT STRING$(64," "): NEXT I : LOCATE 9,1 : RETURN
840 IX$="" :A$=INKEY$
850 A$=INKEY$ : IF A$="" THEN 850 ELSE IF ASC(A$)<>13 AND ASC(A$)<>0 AND ASC(A$)<>8 THEN PRINT A$;
860 IF ASC(A$)>31 THEN IX$=IX$+A$ : GOTO 850
870 IF ASC(A$)=8 THEN IF LEN(IX$)>0 THEN IX$= LEFT$(IX$,LEN(IX$)-1) : PRINT -CHR$(2); : GOTO 850
880 IF ASC(A$)=24 THEN PRINT " "; : FOR I=1 TO LEN(IX$) : PRINT CHR$(29)+" "=CHR$(29); : NEXT I : IX$="": GOTO 850
890 IF ASC(A$)=13 THEN LOCATE ,,0 : RETURN
900 GOTO 850
910 REM-----------------------------------------------------------------------
920 REM POST A HAND WRITTEN CHECK HERE
930 REM
940 IF AN(1)=0 THEN GOSUB 1860
950 CLS
960 PRINT STRING$(20,"-")" CHECK POSTING ROUTINE "STRING$(21,"-")
970 CC=1 : GOSUB 600
980 FOR I=1 TO MA : IF AC=AN(I) GOTO 1020 ELSE NEXT I
990 PRINT"ERROR, ACCOUNT NOT FOUND, RE-ENTER,"
1000 INPUT "ACCOUNT NUMBER";AC
1010 GOTO 980
1020 FOR J=1 TO MN : IF CR$(J,I)="" GOTO 1050 ELSE NEXT J
1030 PRINT"ERROR, CHECK REGISTER IS FULL. HIT ENTER TO CONTINUE."
1040 GOTO 1190
1050 CR$(J,I)=WT$+CHR$(255)+STR$(AM)+CHR$(255)+NT$+CHR$(255)
1060 IF DW$<>"" THEN CR$(J,I)=CR$(J,I)+DW$ ELSE CR$(J,I)=CR$(J,I)+LEFT$(TIME$,8)
1070 IF CC<>0 GOTO 1130
1080 IF (AB(I)-AM)>=0 GOTO 1130 ELSE PRINT "BALANCE WILL GO NEGATIVE."
1090 PRINT"WRITE CHECK ANYWAY"
1100 IF AN$="YES" OR AN$="Y" GOTO 1130
1110 IF AN$="NO" OR AN$="N" THEN CR$(J,I)="" : RETURN
1120 GOTO 1090
1130 AB(I)=AB(I)-AM
1140 IF CN=-1 THEN CN=CN(I) : CN(I)=CN(I)+1
1150 CR$(J,I)=STR$(CN)+CHR$(255)+CR$(J,I)
1160 IF AB(I)<0 THEN PRINT "BALANCE IS NOW NEGATIVE."
1170 IF OP<>1 THEN RETURN
1180 PRINT"ACCOUNT POSTED. HIT ENTER TO CONTINUE."
1190 A$=INKEY$ : IF A$="" GOTO 1190 ELSE IF ASC(A$)<>13 GOTO 1190
1200 RETURN
1210 REM--------------------------------------------------------------------
1220 REM WRITE A CHECK ROUTINE
1230 REM
1240 IF AN(1)=0 THEN GOSUB 1860
1250 CLS
1260 PRINT STRING$(20,"-")" CHECK WRITING ROUTINE " STRING$(21,"-")
1270 CC=0 : GOSUB 600 : GOSUB 980
1280 IF AN$<>"N" AND AN$<>"NO" THEN GOSUB 2550
1290 RETURN
1300 REM---------------------------------------------------------------------
1310 REM PRINT CHECK REGISTER
1320 REM
1330 CLS
1340 PRINT STRING$(21,"-")" PRINT CHECK REGISTER "STRING$(21,"-")
1350 PRINT
1360 HD$="CHK # TO WHOM WRITTEN AMOUNT
1370 F$="***** \ \$**,***.**\ \ \ \"
1380 D$=" \ \$**,***.** \ \ \ \"
1390 INPUT "FOR ALL ACCOUNTS";AN$
1400 IF AN$="YES" OR AN$="Y" GOTO 1460
1410 IF AN$<>"NO" AND AN$<>"N" GOTO 1390
1420 INPUT "ACCOUNT";AC
1430 FOR I=1 TO MA : IF AN(I)=AC GOTO 1470 ELSE NEXT I
1440 PRINT "ERROR, ACCOUNT NOT FOUND. RE-ENTER."
1450 GOTO 1420
1460 I=1
1470 PRINT "ACCOUNT NUMBER: "AN(I);TAB(59);
1480 PRINT "REPORT DATE: ";LEFT$(TIME$,8)
1490 PRINT " "
1500 PRINT "CHECK REGISTER:"
1510 PRINT " "
1520 PRINT JD$
1530 PRINT" "
1540 CA=0 : DP=0
1550 J=1
1560 IF CR$(J,I)="" GOTO 1720
1570 CR$=CR$(J,I)
1580 FOR K=1 TO 4
1590 L=INSTR(CR$,CHR$(255))
1600 PT$(K)=LEFT$(CR$,L-1)
1610 CR$=RIGHT$(CR$,LEN(CR$)-L)
1620 NEXT K
1630 CN=VAL(PT$(1))
1640 AM=VAL(PT$(3))
1650 IF CN>=0 THEN CA=CA+AM : GOTO 1690
1660 PRINT USING D$;PT$(2),AM,PT$(4),CR$
1670 DP=DP+AM
1680 GOTO 1700
1690 PRINT USING F$;CN,PT$(2),AM,PT$(4),CR$
1700 J=J+1
1710 GOTO 1560
1720 PRINT " "
1730 PRINT USING "BEGINNING BALANCE: $**,***.**";AB(I)=CA-DP
1740 PRINT USING "DEPOSITS: $**,***.**";DP
1750 PRINT USING "TOTAL CHECKS: $**,***.**";CA
1760 PRINT USING "CURRENT BALANCE: $**,***.**";AB(I)
1770 IF AN$="NO" OR AN$="N" GOTO 1820
1780 I=I+1
1790 PRINT " "
1800 PRINT " "
1810 IF I<MA AND AN(I)<>0 GOTO 1470
1820 IF OP<>3 THEN RETURN
1830 PRINT "HIT ENTER TO CONTINUE"
1840 A$=INKEY$ : IF A$="" GOTO 1840 ELSE IF ASC(A$)<>13 GOTO 1840
1850 RETURN
1860 REM--------------------------------------------------------------------
1870 REM SET-UP AN ACCOUNT
1880 REM
1890 CLS
1900 PRINT STRING$(20,"-")" ACCOUNT SET-UP ROUTINE "STRING$(20,"-")
1910 PRINT
1920 IF AN(1)=0 THEN PRINT "NO ACCOUNTS SET-UP YET."
1930 PRINT
1940 FOR I=1 TO MA : IF AN(I)=0 GOTO 1970 ELSE NEXT I
1950 PRINT "ERROR, ACCOUNT RESGISTER FULL"
1960 RETURN
1970 INPUT "ACCOUNT NUMBER";AN(I)
1980 INPUT "STARTING ACCOUNT BALANCE";AB(I)
1990 INPUT "NEXT CHECK NUMBER FOR THIS ACCOUNT";CN(I)
2000 PRINT
2010 PRINT "ACCOUNT ESTABLISHED. HIT ENTER TO CONTINUE."
2020 A$=INKEY$ : IF A$="" GOTO 2020 ELSE IF ASC(A$)<>13 GOTO 2020
2030 RETURN
2040 REM-----------------------------------------------------------------------
2050 REM POST A DEPOSIT
2060 REM
2070 CLS
2080 PRINT STRING$(24,"-")" POST A DEPOSIT "STRING$(24,"-")
2090 PRINT
2100 INPUT "ACCOUNT NUBMER";AC
2110 FOR I=1 TO MA : IF AN(I)=AC GOTO 2140 ELSE NEXT I
2120 PRINT "ERROR,ACCOUNT NUMBER NOT FOUND. RE-ENTER"
2130 GOTO 2100
2140 INPUT "DEPOSIT AMOUNT";DA
2150 FOR J=1 TO MN : IF CR$(J,I)="" GOTO 2190 ELSE NEXT J
2160 PRINT"ERROR, CHECK REGISTER FULL. HIT ENTER TO CONTINUE"
2170 A$=INKEY$ : IF A$="" GOTO 2170 ELSE IF ASC(A$)<>13 GOTO 2170
2180 GOTO 2230
2190 CR$(J,I)="-1"+CHR$(255)+ LEFT$(TIME$,8)
2200 AB(I)=AB(I)+DA
2210 PRINT"DEPOSIT POSTED. HIT ENTER TO CONTINUE."
2220 A$=INKEY$ :IF A$="" GOTO 2220 ELSE IF ASC(A$)<>13 GOTO 2220
2230 RETURN
2240 REM----------------------------------------------------------------
2250 REM TERMINATION PROCESSING
2260 REM
2270 CLS
2280 PRINT STRING$(21,"-")" TERMINATION PROCESSING "STRING$(22,"-")
2290 PRINT
2300 PRINT "WRITING CHECK REGISTER FILE."
2310 OPEN "O",1,"CRF/DAT"
2320 FOR I=1 TO MA : PRINT #1,AN(I) : NEXT I
2330 FOR I=1 TO MA : PRINT #1,AB(I) : NEXT I
2340 FOR I=1 TO MA : PRINT #1,CN(I) : NEXT I
2350 FOR I=1 TO MA
2360 FOR J=1 TO MN
2370 IF CR$(J,I)="" GOTO 2400
2380 PRINT #1,J,I,CR$(J,I)
2390 NEXT J
2400 NEXT I
2410 CLOSE
2420 PRINT "PROGRAM ENDED."
2430 RUN"MENU.BAT"
2440 REM-----------------------------------------------------------------------
2450 REM FORMAT AND PRINT CHECK (DATA)
2460 REM
2470 DATA ONE, TWO, THREE, FOUR, FIVE, SIX, SEVEN, EIGHT, NINE, TEN
2480 DATA ELEVEN, TWELVE, THIRTEEN, FOURTEEN, FIFTEEN, TWENTY, THIRTY
2490 DATA FORTY, FIFTY, SIXTY,SEVENTY, EIGHTY, NINETY
2500 DATA JAN, FEB, MAR, APR, MAY, JUN, JUL, AUG, SEP, OCT, NOV, DEC
2510 FOR I=1 TO 23 : READ NU$(I) : NEXT I : FOR I=1 TO 12 : READ MO$(I) : NEXT I : RETURN
2520 REM-----------------------------------------------------------------------
2530 REM FORMAT AND PRINT CHECK
2540 REM
2550 WD$=""
2560 A1=INT(AM/1000)
2570 A2=INT((AM-A1*1000)/100)
2580 A3=INT(AM-(A1*1000+A2*100))
2590 A4=AM-INT(AM)
2600 IF A1<>0 THEN WD$=NU$(A1)+"THOUSAND"
2610 IF A2<> 0 THEN WD$=WD$+NU$(A2)+" HUNDRED "
2620 IF A3=0 GOTO 2700
2630 IF A3<16 THEN WD$=WD$+NU$(A3) : GOTO 2700
2640 IF A3<20 GOTO 2690
2650 A5=INT(A3/10) : A3=A3-10*A5
2660 IF A3<>0 GOTO 2680
2670 WD$=WD$=NU$(A5+14): GOTO 2700
2680 WD$=WD$ +NU$(A5+14)+"-"+NU$(A3) : GOTO 2700
2690 WD$=WD$+NU$(A3-10)+"TEEN"
2700 WD$=WD$+" AND"+STR$(INT(A4*100))+"/100'S"
2710 PRINT TAB(41);MO$(VAL(TIME$));" ";MID$ (TIME$,4,2);",";TAB(56);MID$(TIME$,7,2)
2720 PRINT " "
2730 PRINT TAB(10);WT$;TAB(58); : PRINT USING "**,***.**";AM
2740 PRINT TAB(10);WT$;TAB(58); : PRINT USING "**,***.**";AM
2750 PRINT " "
2760 PRINT WD$
2770 PRINT " "
2780 PRINT WD$
2790 PRINT TAB(5);NT$
2800 RETURN
2810 REM ----------------------------------------------------------------
2820 REM PURGE CURRENT CRF
2830 REM
2840 CLS
2850 PRINT STRING$(22,"-")" PURGE CURRENT CRF "STRING$(23,"-")
2860 GOSUB 1360
2870 IF AN$="YES" OR AN$="Y" GOTO 2890
2880 FOR I=1 TO MA : IF AN(I)=AC GOTO 2900 ELSE NEXT I
2890 FOR I=T TO MA
2900 FOR J=1 TO NM
2910 CR$(J,I)=""
2920 NEXT J
2930 IF AN$="NO" OR AN$="N" GOTO 2950
2940 NEXT I
2950 PRINT "CRF PURGED. HIT ENTER TO CONTINUE."
2960 A$=INKEY$ : IF A$="" GOTO 2960 ELSE IF ASC(A$)<>13 GOTO 2960
2970 RETURN
DATAPGM.BAS
1 KEY(10) ON:ON KEY(10) GOSUB 3
2 GOTO 5
3 RUN"MENU.BAT"+CHR$(13)
5 CLS
6 LOCATE 23,24:PRINT "Press F10 to EXIT program.
100 REM ------------------------------
110 N$= "DATA ANALYSIS PROGRAMS"
120 REM ------------------------------
130 OPTION BASE 1 'SET UP ARRAY SUBSCRIPTS
140 DIM P(80),R(80),D(80)
150 GOSUB 6200 'INITIALIZE
160 REM SET UP MENU
170 X$(1)="INPUT DATA"
180 X$(2)="PLOT DATA"
190 X$(3)="MEAN AND STANDARD DEVIATION"
200 X$(4)="3-POINT MOVING AVERAGE"
210 X$(5)="WEIGHTED MOVING AVERAGE"
220 X$(6)="4-POINT CENTERED AVERAGE"
230 X$(7)="LINEAR REGRESSION"
231 X$(8)="TERMINATE PROGRAM"
240 N=8 : GOSUB 7000
241 IF X=8 THEN RUN"MENU.BAT
250 ON X GOSUB 690,920,1140,1360,1560,1760,1960
260 GOTO 150
270 REM -----------------------------------
280 REM DRAW AXES
290 REM -----------------------------------
300 CLS
310 FOR I=1 TO 21 'Y AXIS
320 LOCATE I,6 : PRINT " I"
330 NEXT I
340 FOR I=1 TO 16 STEP 5 'Y AXIS SCALE
350 LOCATE I,6 : PRINT"-"
360 LOCATE I,1
365 PRINT USING "####"; MX-(MX-MN)/4*(I-1)/5
370 NEXT I
380 LOCATE 21,8
390 FOR I= 1 TO 32 'X AXIS
400 PRINT "-";
410 NEXT I
420 FOR I=8 TO 38 STEP 5 'X AXIS TICKS
430 LOCATE 21,I : PRINT "I";
440 LOCATE 22,I-1 : PRINT I-7
450 NEXT I
460 RETURN
470 REM ----------------------------------
480 REM SCALE DATA AND PLOT IT
490 REM ----------------------------------
500 FOR I= 1 TO ND
510 P1=21-INT(20*(D(I)-MN)/(MX-MN))
520 P2=21-INT(20*(R(I)-MN)/(MX-MN))
530 IF CH$ <> "I" THEN 570
540 IF P1 > 21 OR P1 < 1 THEN GOTO 670
550 LOCATE P1,I+8 : PRINT "*"
560 GOTO 650
570 IF CH$ <> "R" THEN 610
580 IF P2 > 21 OR P2 < 1 THEN GOTO 670
590 LOCATE P2,I+8 : PRINT "+"
600 GOTO 650
610 REM MUST BE BOTH PLOTS
620 IF P1 > 21 OR P1 < 1 OR P2 > 21 OR P2 < 1 THEN 670
630 LOCATE P1,I+8 : PRINT "*"
640 LOCATE P2,I+8 : PRINT "+"
650 NEXT I
660 RETURN
670 ERF=1 : RETURN
680 RETURN
690 REM -----------------------------------
700 N$= "INPUT DATA"
710 REM -----------------------------------
720 REM THIS PROGRAM ACCEPTS UP TO 80 DATA VALUES
730 GOSUB 6200 'INITIALIZE
740 Q1$="TYPE IN DATA VALUES IN ORDER"
750 Q2$="TYPE D WHEN DONE"
760 Q3$="" : GOSUB 5000 'DIALOG
770 ND=0 'NO. OF DATA POINTS
780 J=6
790 FOR I= 1 TO 80
800 LOCATE J,10
810 PRINT " " 'BLANK LINE
820 LOCATE J,5
830 PRINT "VALUE ";I; TAB(20);
840 INPUT D$
850 IF D$="D" OR D$="d" THEN 910
860 ND=ND+1 'COUNT DATA POINTS
870 D(I)=VAL(D$) 'STORE DATA
880 J=J+1
890 IF J=16 THEN J=6 'RESET POINTER
900 NEXT I
910 RETURN
920 REM ------------------------------
930 N$= "PLOT DATA ROUTINE"
940 REM ------------------------------
950 Q2$="INPUT OR REDUCED OR BOTH"
955 Q3$="DATA (I OR R OR B)"
960 GOSUB 5000
970 GOSUB 5400 'GET CHAR
980 IF CH$ ="I" OR CH$ ="R" OR CH$="B" THEN 990 ELSE 970
990 Q1$="" :Q2$=""
1000 Q3$="CHOOSE MAX SCALE : "
1010 GOSUB 5000 : INPUT MX
1020 Q3$="CHOOSE MIN SCALE : "
1030 GOSUB 5000 : INPUT MN
1040 GOSUB 270 'DRAW AXES
1050 ERF=0
1060 GOSUB 470 'PLOT DATA
1070 IF ERF<>1 THEN 1110 'OUT OF RANGE ERROR
1080 Q1$="DATA OUT OF RANGE"
1090 Q2$="PLEASE RESPECIFY" :BEEP
1100 GOTO 1000
1110 LOCATE 24,1
1120 PRINT "STRIKE ANY KEY TO CONTINUE";
1130 CH$=INKEY$ :IF CH$="" THEN 1130 ELSE RETURN
1140 REM -------------------------------------
1150 N$= "MEAN AND STANDARD DEVIATION"
1160 REM -------------------------------------
1170 GOSUB 6200
1180 REM COMPUTE THE MEAN
1190 ME=0
1200 FOR I = 1 TO ND
1210 ME=ME+D(I)
1220 NEXT I
1230 ME=ME/ND
1240 REM COMPUTE STANDARD DEVIATION
1250 SD=0
1260 FOR I=1 TO ND
1270 SD=SD+(D(I)-ME)^2
1280 NEXT I
1290 SD=(SD/ND)^0.5
1300 PRINT "MEAN OF INPUT DATA";TAB(20);
1310 PRINT USING "######,.##";ME
1320 PRINT "STANDARD DEVIATION";TAB(20);
1330 PRINT USING "######,.##";SD
1340 GOSUB 7400
1350 RETURN
1360 REM -----------------------------
1370 N$= "3-POINT MOVING AVERAGE"
1380 REM -----------------------------
1390 GOSUB 6200 'INITIALIZE
1400 REM SET UP THE RESULT IN R(I)
1410 R(1)=0 : R(2)=0 : R(3)=0
1420 FOR I = 4 TO ND
1430 R(I)=(D(I-3)+D(I-2)+D(I-1))/3
1440 NEXT I
1450 Q1$="DO YOU WANT TO PRINT THE"
1460 Q2$="DATA (Y OR N)"
1470 Q3$="" : GOSUB 5000
1480 GOSUB 7800 'ASK YES OR NO
1490 IF YN$="N" THEN RETURN
1500 CLS
1510 FOR I = 4 TO ND
1520 PRINT R(I),
1530 NEXT I
1540 GOSUB 7400 'WAIT FOR KEY
1550 RETURN
1560 REM ---------------------------------
1570 N$= "3-PT. WEIGHTED MOVING AVERAGE"
1580 REM ---------------------------------
1590 GOSUB 6200 'INITIALIZE
1600 REM SET UP THE RESULT IN R(I)
1610 R(1)=0 : R(2)=0 : R(3)=0
1620 FOR I = 4 TO ND
1630 R(I)=(D(I-3)+2*D(I-2)+3*D(I-1))/6
1640 NEXT I
1650 Q1$="DO YOU WANT TO PRINT THE"
1660 Q2$="DATA (Y OR N)"
1670 Q3$="" : GOSUB 5000 'ASK YES OR NO
1680 GOSUB 7800
1690 IF YN$="N" THEN RETURN
1700 CLS
1710 FOR I = 4 TO ND
1720 PRINT R(I),
1730 NEXT I
1740 GOSUB 7400 'WAIT FOR KEY
1750 RETURN
1760 REM -----------------------------
1770 N$= "4-PT. CENTERED AVERAGE"
1780 REM -----------------------------
1790 GOSUB 6200 'INITIALIZE
1800 REM SET UP THE RESULT IN R(I)
1810 R(1)=0 : R(2)=0 : R(3)=0 : R(4)=0 : R(5)=0
1820 FOR I = 6 TO ND
1830 R(I)=(D(I-5)+2*(D(I-4)+D(I-3)+D(I-2))+D(I-1))/8
1840 NEXT I
1850 Q1$="DO YOU WANT TO PRINT THE"
1860 Q2$="DATA (Y OR N)"
1870 Q3$="" : GOSUB 5000
1880 GOSUB 7800 'ASK YES OR NO
1890 IF YN$="N" THEN RETURN
1900 CLS
1910 FOR I = 4 TO ND
1920 PRINT R(I),
1930 NEXT I
1940 GOSUB 7400 'WAIT FOR KEY
1950 RETURN
1960 REM -----------------------------
1970 N$= "LINEAR REGRESSION"
1980 REM -----------------------------
1990 GOSUB 6200 'INITIALIZE
2000 SX=0 : SY=0 : SXY=0 : SX2=0
2010 FOR I = 1 TO ND
2020 SX=SX+I
2030 SY=SY+D(I)
2040 SXY=SXY+D(I)*I
2050 SX2=SX2+I^2
2060 NEXT I
2070 M=(SXY-SX*SY/ND)/(SX2-SX^2/ND)
2080 B=SY/ND-M*SX/ND
2090 PRINT " Y=";M;"X + " ;B
2100 REM UPDATE RESULT ARRAY
2110 FOR I= 1 TO ND
2120 R(I)=B+M*I
2130 NEXT I
2140 GOSUB 7400
2150 RETURN
5000 REM "DIALOG"
5001 ' -------------------------------
5002 ' DIALOGUE
5003 '
5004 'CALLING PARAMETERS:
5005 ' Q1$,Q2$,Q3$, = QUESTIONS TO DISPLAY
5006 '
5007 'RETURNED PARAMETERS:
5008 ' NONE
5009 '
5010 'COMMENT: UNUSED QUESTION STRINGS SHOULD BE SET
5011 ' TO NULL ("")
5012 '
5013 ' -------------------------------
5020 FOR I= 20 TO 23
5030 LOCATE I,1
5040 IF I > 20 THEN 5080
5050 FOR J= 1 TO 40 'DRAW A BORDER
5060 PRINT "-";
5070 NEXT J
5080 IF I = 21 THEN PRINT Q1$; 'FIRST QUESTION
5090 IF I = 22 THEN PRINT Q2$; 'SECOND QUESTION
5100 IF I = 23 THEN PRINT Q3$; 'THIRD QUESTION
5109 REM RESTORE CURSOR HERE AFTER 3RD QUEST
5110 CP1=POS(N)
5120 CP=POS(N) 'CURSOR COLUMN POSITION
5130 IF CP>40 THEN 5150
5140 PRINT " "; : GOTO 5120 'ERASE ANY PRIOR INFO
5149 REM RESTORE CURSOR FOR USER RESPONSE
5150 LOCATE I,CP1
5160 NEXT I
5170 RETURN
5400 REM "INCH"
5401 ' ------------------------------
5402 ' INPUT CHARACTER
5403 '
5404 'CALLING PARAMETERS:
5405 ' NONE
5406 '
5407 'RETURNED PARAMETERS:
5408 ' CH$=INPUT CHARACTER
5409 '
5410 ' ------------------------------
5420 REM WAIT FOR INPUT CHARACTER
5430 CH$= INKEY$ : IF CH$="" THEN 5430
5440 Z=ASC(CH$)
5450 IF Z < 97 OR Z > 122 THEN 5470
5460 Z=Z-32
5470 CH$=CHR$(Z)
5480 RETURN
6200 REM "INIT"
6201 '----------------------------------
6202 ' INITIALIZE DISPLAY
6203 '
6204 'THIS ROUTINE CLEARS THE SCREEN
6205 ' AND PRINTS THE PROGRAM TITLE
6206 'CALLING PARAMETERS:
6207 ' N$=TITLE OF PROGRAM
6208 '
6209 'RETURNED PARAMETERS:
6210 ' NONE
6211 '
6212 ' ----------------------------------
6220 CLS 'CLEAR SCREEN
6230 PRINT N$ : PRINT 'TITLE
6240 KEY OFF
6250 RETURN
7000 REM "MENU"
7001 ' ------------------------------
7002 ' MENU PROGRAM
7003 '
7004 'THIS PROGRAM DISPLAYS A MENUE
7005 ' AND CHOOSES A PROGRAM
7006 'CALLING PARAMETERS:
7007 ' N= NO. OF MENU ITEMS
7008 ' X$(I)= ARRAY OF PROGRAM NAMES
7009 '
7010 'RETURNED PARAMETERS:
7011 ' X=PROGRAM NUMBER CHOSEN
7012 '
7013 ' ------------------------------
7020 CLS
7030 FOR I = 1 TO N 'DISPLAY MENU
7040 IF I=10 THEN PRINT 0; ELSE PRINT I;
7050 PRINT "= " ; X$(I)
7060 NEXT I
7070 Q1$="" : Q2$=""
7080 Q3$="CHOOSE PROGRAM :"
7085 PRINT:PRINT " Press F10 to EXIT program.
7090 GOSUB 5000 'ASK QUESTIONS
7100 GOSUB 5400 'INPUT CHAR
7110 X= VAL(CH$)
7119 REM SEE IF CHAR IN RANGE
7120 IF X>=1 AND X<=N THEN RETURN
7130 IF X=0 AND N=10 THEN 7140 ELSE 7150
7140 X=10 : RETURN
7150 Q1$="ILLEGAL CHOICE, CHOOSE AGAIN"
7160 GOSUB 5000
7170 GOTO 7100
7400 REM "PAUSE"
7401 ' -------------------------------
7402 ' WAIT FOR ANY KEY
7403 '
7404 'THIS ROUTINE WAITS FOR USER TO STRIKE KEY
7405 '
7406 'CALLING PARAMETERS:
7407 ' NONE
7408 '
7409 'RETURNED PARAMETERS
7410 ' NONE
7411 '
7412 ' -------------------------------
7420 Q1$="STRIKE ANY KEY TO CONTINUE"
7430 Q2$="" : Q3$=""
7440 GOSUB 5000 'CALL DIALOG
7450 X$=INKEY$ : IF X$ = "" THEN 7450 'WAIT FOR KEY
7460 RETURN
7800 REM "YESNO"
7801 ' -------------------------------
7802 ' YES-NO
7803 '
7804 'CALLING PARAMETERS:
7805 ' NONE
7806 '
7807 'RETURNED PARAMETERS:
7808 ' YN$= CONTAINS A Y OR N
7809 '
7810 ' -------------------------------
7815 LOCATE 23,24:PRINT "Press F10 to EXIT program.
7820 REM WAIT FOR KEY TO BE STRUCK
7830 YN$=INKEY$ : IF YN$="" THEN 7830
7840 IF YN$="y" THEN YN$="Y"
7850 IF YN$="n" THEN YN$="N"
7860 IF YN$ = "Y" OR YN$ = "N" THEN 7890
7870 REM NOT YES OR NO TRY AGAIN
7880 GOTO 7830
7890 PRINT YN$ : RETURN
FILES406.TXT
------------------------------------------------------------------------
Disk No 406 FINANCIAL PROGRAMS & LOTUS WORKSHEETS v1 DS
------------------------------------------------------------------------
A variety of BASIC programs and LOTUS 1-2-3 worksheet templates for
personal and business financial and real estate analysis. Included
is a spreadsheet program written in Basic and an address book program.
AUTO1-1 BAT Autoexecute batch file DOS 1.X
AUTO2-1 BAT Autoexecute batch file DOS 2.X
MENU1-1 BAT Main program for use with BASICA 1.0
MENU2-1 BAT Main program for use with BASICA 2.0
BUSPGM BAS Business financial program
CHECK BAS Home check book program
DATAPGM BAS Statistical analysis program
FINANCE BAS Home finance program
FINPGM BAS Financial analysis program
KALK BAS Compound interest computation program
LOANS BAS Loan analyzer
MORTGAGE BAS Amortization program
PC-PAD BAS Editor/spreadsheet/viewer program
PERPCAL BAS Calendar for any year
PERS BAS Data file for personal address book
PERSONAL BAS Personal address book
PRINTCON BAS Printer setup
REALPGM BAS Real estate analysis program
STOCK BAS Stock market analysis
BUDGET WKS LOTUS 123 - budget worksheet
DIVIDEND WKS LOTUS 123 - dividend and interest report
EDFNDWKS WKS LOTUS 123 - plan for educational expenses
GROWTH WKS LOTUS 123 - accumulation planning worksheet
INSURE WKS LOTUS 123 - insurance calculator
INVEST WKS LOTUS 123 - portfolio summary worksheet
PAYMENTS WKS LOTUS 123 - expenditures and cash flow worksheet
PROPERTY WKS LOTUS 123 - personal property tracking worksheet
RETIRE WKS LOTUS 123 - retirement analysis
SECURITY WKS LOTUS 123 - social security analysis worksheet
TX5J WKS LOTUS 123 - 5 year income tax averaging worksheet
WEALTH WKS LOTUS 123 - compute your networth worksheet
PC Software Interest Group (PC-SIG)
1030 E Duane, Suite J
Sunnyvale, CA 94086
(408) 730-9291
FINANCE.BAS
5 CLS
10 '
50 CLEAR 2000
85 D$="$###,#.###":E$="$#######,#.##":G$="$#####,#.##":H$="######,#.##"
90 A1$="INITIAL BALANCE : $":A2$="NUMBER OF PAYMENTS PER YEAR :"
92 O1$="REGULAR PAYMENT":O2$="TOTAL OF PAYMENTS":O3$="TOTAL INTEREST PAID"
94 H1$="VALUE OF INVESTMENT":H2$="VALUE OF ACCUM. INTEREST":H3$="TOTAL VALUE"
95 DEFDBL Q,Y,X,W,P,D,O,J,K,R,C,S,L,H,I:DIM A(20)
100 CLS:PRINT TAB(10)"IBM PERSONAL COMPUTER HOME FINANCE PROGRAMS":PRINT :PRINT
110 PRINT:PRINT"LOAN AMORITIZATION CALCULATIONS";:PRINT TAB(50)"1"
120 PRINT:PRINT"LOAN AMORITIZATION SCHEDULE";:PRINT TAB(50)"2"
130 PRINT:PRINT"ANNUITIES CALCULATIONS";:PRINT TAB(50)"3"
140 PRINT:PRINT"HOME OWNER'S COST CALCULATIONS";:PRINT TAB(50)"4"
150 PRINT:PRINT"DEPRECIATIONS SCHEDULES";:PRINT TAB(50)"5"
153 PRINT:PRINT" To EXIT program ";:PRINT TAB(50)"6"
156 GOTO 160
158 RUN"MENU.BAT
160 PRINT:INPUT"WHICH PROGRAM :";X:IF X<1 OR X>6 THEN 100
180 ON X GOTO 2000,2600,3000,1000,4000,158
1000 CLS:PRINT TAB(14)"HOME OWNER'S REAL MONTHLY COST ESTIMATE"
1010 PRINT:INPUT"YOUR MONTHLY PAYMENT (WITH PROPERTY TAX) :$";A1
1025 X=A1*12:PRINT"ANNUALLY THIS AMOUNTS TO : $";X
1030 PRINT:INPUT"YOUR MORTGAGE IS : $";A2
1035 INPUT"YOUR ANNUAL INTEREST RATE IS : %";A3
1040 Q=(A3/100)*A2:GOSUB 2850:V=Q
1045 PRINT"FIRST YEAR'S INTEREST WILL BE : $";V
1050 PRINT:INPUT"ANNUAL PROPERTY TAXES ARE : $";A4
1055 D=V+A4:PRINT"DEDUCTIBLE INTEREST & TAXES TOTAL : $";D
1060 PRINT:INPUT"YOU ESTIMATE YOU ARE IN WHAT TAX BRACKET : %";A5
1065 A5=A5/100:Q=A5*D:F=Q
1070 PRINT"YOUR DEDUCTIONS WILL SAVE YOU : ";USINGG$;F
1075 INPUT"ESTIMATE YOUR PROPERTY VALUE INCREASE NEXT YEAR : %";A6:PRINT:PRINT:PRINT:PRINT
1080 A6=A6/100:Q=A6*A2:S=Q
1085 PRINT"YOUR PROPERTY WILL INCREASE IN VALUE : ";USINGG$;S
1090 M=ABS(X-D):PRINT"YOUR MORTAGE REDUCTION WILL AMOUNT TO : $";M
1095 N=F+S+M:PRINT"YOUR TOTAL BENEFITS NEXT YEAR WILL AMOUNT TO : $";N
1100 Q=N/12:O=Q:J=A1-O
1105 PRINT:PRINT"MONTHLY PAYMENT IS :";TAB(5) USING G$;A1
1110 PRINT"YOUR MONTHLY BENEFITS ARE :";TAB(35) USING G$;O
1115 PRINT"YOUR REAL MONTHLY COST IS :";TAB(35) USING G$;J
1120 PRINT:PRINT"THE ABOVE RESULTS ARE ESTIMATES ONLY"
1125 INPUT"PRESS ENTER TO RETURN TO MENU ";X$:GOTO 10
2000 CLS:PRINT TAB(15)"LOAN AMORITIZATION CALCULATION"
2010 PRINT:PRINT A1$;:INPUT A1
2015 GOSUB 5000:PRINT:PRINT A2$;:INPUT V
2020 A2=A2/V/100:X=1+A2:Y=V*A3/12:P=X^Y:B=1/P:C=A1*A2/(1-B):R=C*A3:K=R-A1
2060 PRINT STRING$(45,"=")
2065 PRINT O1$;TAB(35) USING E$;C
2070 PRINT O2$;TAB(35) USING E$;R
2075 PRINT O3$;TAB(35) USING E$;K
2080 PRINT:INPUT"CONTINUE (Y/N) ";C$:IF C$="Y" GOTO 2000 ELSE IF C$="N" GOTO 10
2083 GOTO 2080
2600 CLS:PRINT TAB(18)"LOAN AMORTIZATION SCHEDULE"
2615 PRINT:PRINT:I=0:R=0:H=0:S=0:X=0:A1=0:A4=0:A3=0
2620 INPUT"BEGINNING BALANCE : $";H:A(0)=H
2630 INPUT"ANNUAL INTEREST RATE : %";A1:L=(A1/12)/100
2640 INPUT"LOAN TERM (YRS,MONTHS) :";N,A6:N=N*12+A6
2645 INPUT"# OF MONTH OF FIRST PAYMENT :";A7:IF A7=0 THEN A7=1
2646 PRINT"ENTER 0 FOR COMPUTER CALCULATION OF PAYMENT"
2648 INPUT"MONTHLY PAYMENT :$";X:IF X>0 THEN 2665
2655 X=(1+L):Y=-N:P=X^Y:X=H*(L/(1-P)):X=(INT(100*X))/100
2665 GOSUB 2670:GOTO 2685
2670 CLS:PRINT"BAL";USING E$;A(0)
2673 PRINT"INTEREST %";A1
2675 PRINT"MONTHLY PAYMENT";USING G$;X
2680 PRINT"MONTH PRINCIPLE INTEREST INT TO DATE BALANCE"
2682 RETURN
2685 A3=A7:N=N+A7-1
2687 A9=0:A(10)=0:FOR Z=A3 TO A3+12-A7
2690 PRINT Z;
2695 I=H*L:I=(INT(100*I))/100:S=S+I:A4=X-I:H=H-A4
2703 R=R+A4:A9=A9+I:A(10)=A(10)+A4:IF Z=-1 THEN PRINT"LAST";
2704 PRINT TAB(8) USING G$;A4;:PRINT TAB(23) USING G$;I;:PRINT TAB(35) USING E$;S;:PRINT TAB(49) USING E$;H
2712 IF Z=-1 THEN 2720
2713 IF H<=X THEN I=(INT(100*H*L))/100:S=S+I:A4=H:Z=-1:H=0:GOTO 2703
2714 IF Z=N THEN Z=-1:GOTO 2720
2715 NEXT Z:A3=A3+13-A7:A7=1
2720 PRINT"TOTALS";:PRINT TAB(8) USING G$;A(10);:PRINT TAB(23) USING G$;A9;
2725 INPUT" CONTINUE (Y/N)";C$:IF C$<>"Y" THEN 2800
2727 IF (C$="Y") AND (Z=-1) THEN 2800
2730 GOSUB 2670:GOTO 2687
2800 CLS:PRINT"TOTAL PRINCIPLE PAID ";USING E$;R
2810 PRINT"TOTAL INTEREST PAID ";USING E$;S
2815 G=H*L/30
2818 PRINT
2820 IF H=0 THEN 2830
2823 PRINT"FINAL PAYMENT IS ";USING E$;H
2824 PRINT"INTEREST PER DAY IS ";USING D$;G
2830 INPUT"AGAIN ";C$:IF C$="Y" THEN 2600
2845 IF C$="N" THEN 10 ELSE 2830
2850 RETURN
3000 '
3001 CLS:PRINT TAB(18)"ANNUITIES CALCULATIONS"
3005 PRINT:PRINT:PRINT"FUTURE VALUE OF A SINGLE DEPOSIT";TAB(55)"1"
3010 PRINT:PRINT"PRESENT VALUE REQUIRED FOR A FUTURE VALUE";TAB(55)"2"
3015 PRINT:PRINT"FUTURE VALUE OF REGULAR DEPOSITS";TAB(55)"3"
3020 PRINT:PRINT"REGULAR DEPOSITS REQUIRED TO ACHIEVE A FUTURE VALUE";TAB(55)"4"
3030 PRINT:PRINT"EXIT THIS PROGRAM";TAB(55)"5"
3035 PRINT:INPUT"WHICH PROGRAM : ";X:IF X<1 OR X>5 THEN 3000
3050 ON X GOTO 3100,3200,3300,3400,10
3100 CLS:PRINT TAB(10)"FUTURE VALUE OF A DEPOSIT"
3105 INPUT"INITIAL INVESTMENT : $";A1
3110 GOSUB 5000
3115 PRINT:INPUT"NUMBER OF COMPOUNDING PERIODS/YR :";V
3120 A2=A2/V/100:X=1+A2:Y=(A3/12)*V:P=X^Y:Q=P*A1:W=Q-A1:GOSUB 5100
3130 GOSUB 9500:GOTO 3000
3200 CLS:PRINT TAB(12)"PRESENT VALUE REQUIRED FOR A FUTURE VALUE"
3210 INPUT"FUTURE VALUE EXPECTED : $";A1
3220 GOSUB 5000:PRINT:INPUT"NUMBER OF COMPOUNDING PERIODS/YR ; ";V
3225 A2=A2/V/100:X=1+A2:Y=-A3/12*V:P=X^Y
3230 Q=P*A1:W=A1-Q:D=A1:A1=Q:Q=D:PRINT:GOSUB5100
3235 GOTO 3130
3300 CLS:PRINT TAB(20)"FUTURE VALUE OF REGULAR DEPOSITS"
3310 INPUT"DEPOSIT : $";A1
3313 GOSUB 3315:GOTO 3320
3315 GOSUB 5000:PRINT:INPUT"NUMBER OF DEPOSITS PER YEAR : ";V
3317 PRINT:INPUT"NUMBER OF COMPOUNDING PERIODS PER YEAR : ";T:S=V/T
3319 RETURN
3320 A2=A2/T/100:X=1+A2:Y=A3/12*T:P=X^Y:Q=(A1*V/T)*((P-1)/A2):A1=A1*A3/12*V
3330 W=Q-A1:PRINT:GOSUB 5100:GOTO 3130
3400 CLS:PRINT TAB(5)"REGULAR DEPOSITS REQUIRED TO ACHIEVE A FUTURE VALUE"
3410 INPUT"FUTURE VALUE : $";A1:GOSUB 3315:A2=A2/T/100:X=1+A2:Y=A3/12*T:P=X^Y:Q=A1*(A2/(P-1)):Q=Q*T/V:C=Q*V*A3/12
3430 PRINT STRING$(50,"=")
3435 PRINT"REGULAR DEPOSIT REQUIRED"TAB(35) USING G$;Q
3440 W=A1-C:Q=A1:A1=C:GOSUB 5105:GOTO 3130
4000 CLS:PRINT TAB(25)"DEPRECIATION SCHEDULES"
4010 PRINT:PRINT"STRAIGHT LINE METHOD";TAB(50)"1"
4020 PRINT:PRINT"SUM OF THE YEARS DIGITS METHOD";TAB(50)"2"
4030 PRINT:PRINT"DECLINING BALANCE METHOD";TAB(50)"3"
4040 PRINT:PRINT" RETURN TO MENU ";TAB(50)"4"
4050 PRINT:INPUT"WHICH PROGRAM";X:IF X=5 THEN 100
4060 IF X<1 OR X>5 THEN 4000
4062 GOTO 4065
4065 A(20)=X
4070 ON X GOTO 4100,4200,4300,10
4072 PRINT:PRINT"EXIT THE PROGRAM";TAB(50)"4"
4100 CLS:A$="STRAIGHT LINE":B$=" METHOD":PRINT TAB(23)A$;B$:PRINT:GOSUB 4900
4105 I=18:X=A3/A4:GOSUB 4500:GOSUB 4550:GOTO 4000
4200 CLS:A$="SUM OF THE YEARS":B$=" DIGITS METHOD"
4205 PRINT TAB(13)A$;B$:PRINT:GOSUB 4900
4210 E=0:FOR Z=1 TO A4:E=E+Z:NEXT
4220 I=18:GOSUB 4500:GOSUB 4550:GOTO 4000
4300 CLS:A$="DECLINING":B$=" BALANCE METHOD"
4307 PRINT TAB(22)A$;B$:I=22
4310 GOSUB 4950
4340 A3=A3/100/A4:GOSUB 4500:GOSUB 4550:GOTO 4000
4500 CLS:PRINT TAB(I)A$;B$:PRINT TAB(3)"YEARS";TAB(25)"DEPRECIATION";
4506 PRINT TAB(48)"DEPRECIATED":PRINT TAB(28)"VALUE";TAB(52)"VALUE"
4510 RETURN
4550 A7=0:V=0:U=A1
4555 FOR Z=A7 TO (A7+11)
4560 GOSUB 4600
4563 IF Z=0 THEN X=0
4565 PRINT TAB(4)Z;
4566 PRINT TAB(24) USING G$;X;
4567 PRINT TAB(46) USING E$;V
4570 IF Z=>A4 THEN 4590
4575 NEXT Z:A7=A7+12
4580 INPUT"CONTINUE (Y/N) ";C$:IF C$<>"Y" THEN 4000+A(20)*100
4585 CLS:GOSUB 4500:GOTO 4555
4590 GOSUB 9500:GOTO 4000
4600 W=A(20):ON W GOTO 4670,4680,4690
4670 X=A3/A4:V=U:U=A1-X:A1=U:RETURN
4680 IF V<>0 THEN X=(A4+1-Z)/E*A3:U=A1-X:A1=U:V=U:RETURN
4685 V=U:RETURN
4690 IF V<>0 THEN X=U*A3:U=A1-X:A1=U:V=U:RETURN
4695 V=U:RETURN
4900 PRINT"PURCHASE PRICE";TAB(30)"$";:INPUT A1
4910 PRINT"RESALE PRICE";TAB(30)"$";:INPUT A2
4920 A3=A1-A2
4930 PRINT"TERM OF DEPRECIATION (YRS)"TAB(30);:INPUT A4:RETURN
4950 PRINT"PURCHASE PRICE"TAB(30)"$";:INPUT A1
4960 PRINT"DECLINING BALANCE FACTOR"TAB(30)"%";:INPUT A3
4970 PRINT"TERM OF DEPRECIATION (YRS)"TAB(30);:INPUT A4
4980 RETURN
5000 PRINT:INPUT"ANNUAL INTEREST RATE : %";A2
5010 PRINT:INPUT"TERM (YRS,MONTHS) : ";A3,A4:PD=A3:A3=A3*12+A4
5015 RETURN
5100 PRINT STRING$(50,"=")
5105 PRINT H1$;TAB(35) USING E$;A1
5110 PRINT H2$;TAB(35) USING E$;W
5115 PRINT H3$;TAB(35) USING E$;Q
5120 RETURN
9500 FOR Z=1 TO 6000:NEXT:RETURN
FINPGM.BAS
1 KEY(10) ON:ON KEY(10) GOSUB 3
2 GOTO 5
3 RUN"MENU.BAT"+CHR$(13)
5 CLS
6 LOCATE 23,24:PRINT "Press F10 to EXIT program.
100 REM ------------------------------
110 N$= "FINANCIAL PROGRAMS"
120 REM ------------------------------
130 GOSUB 6200 'INITIALIZE
140 REM SET UP MENU ARRAY
150 X$(1)="FUTURE VALUE OF DEPOSIT"
160 X$(2)="FUTURE VALUE OF SERIES"
170 X$(3)="PRESENT VALUE OF AMOUNT"
180 X$(4)="PRESENT VALUE OF SERIES"
190 X$(5)="PAYMENT REQD FOR FUTURE SUM"
200 X$(6)="WITHDRAWL OF FUNDS"
210 X$(7)="INTEREST RATE EARNED"
220 X$(8)="NET PRESENT VALUE, UNEVEN CASH FLOWS"
230 X$(9)="TIME TO DOUBLE"
240 X$(10)="EQUIVALENT INTEREST RATE"
250 N=10: GOSUB 7000
260 ON X GOSUB 280,490,690,860,1050,1240,1480,1660,2020,2180
270 GOTO 100
280 REM -------------------------------
290 N$= "FUTURE VALUE OF DEPOSIT"
300 REM -------------------------------
310 GOSUB 6200 : K=1 'INITIALIZE
320 REM ASK FOR PARAMETERS
330 Q1$="ENTER DATA" : Q2$=""
340 Q3$="INITIAL DEPOSIT ($)" :GOSUB 6600
350 Q3$="PERIODS PER YEAR" :GOSUB 6600
360 Q3$="ANNUAL INT RATE (%)" :GOSUB 6600
370 Q3$="NUMBER OF YEARS" :GOSUB 6600
380 REM DO THE COMPUTATION
390 PRINT
400 PRINT "FUTURE VALUE"; TAB(22)
410 A=PAR(1)
420 FOR I=1 TO PAR(2)*PAR(4)
430 A=A+A*PAR(3)/100/PAR(2)
440 NEXT I
450 A=INT(A*100+0.5)/100
460 PRINT USING "$$######,.##" ; A
470 Q2$="COMPUTE" : GOSUB 3400 'ASK FOR ANOTHER
480 IF YN$="N" THEN RETURN ELSE GOTO 280
490 REM ------------------------------
500 N$= "FUTURE VALUE OF SERIES"
510 REM ------------------------------
520 GOSUB 6200 : K=1 'INITIALIZE
530 REM ASK FOR PARAMETERS
540 Q1$="ENTER DATA" : Q2$=""
550 Q3$="PAYMENT ($)" :GOSUB 6600
560 Q3$="PAYMENTS PER YEAR" :GOSUB 6600
570 Q3$="ANNUAL INT RATE (%)" :GOSUB 6600
580 Q3$="NUMBER OF YEARS" :GOSUB 6600
590 REM COMPUTE RESULT
600 PRINT : PRINT "FUTURE VALUE"; TAB(22)
610 A=0
620 FOR I = 1 TO PAR(2)*PAR(4)
630 A=PAR(1)+A +A*PAR(3)/100/PAR(2)
640 NEXT I
650 A= INT(A*100+0.5)/100
660 PRINT USING "$$######,.##"; A
670 Q2$="COMPUTE" : GOSUB 3400 'ASK FOR ANOTHER
680 IF YN$="N" THEN RETURN ELSE 520
690 REM ------------------------------
700 N$= "PRESENT VALUE OF AMOUNT"
710 REM ------------------------------
720 GOSUB 6200 : K=1 'INITIALIZE
730 REM ASK FOR PARAMETERS
740 Q1$="ENTER DATA" : Q2$=""
750 Q3$="FUTURE VALUE ($)" :GOSUB 6600
760 Q3$="PERIODS PER YEAR" :GOSUB 6600
770 Q3$="ANNUAL INT RATE (%)" :GOSUB 6600
780 Q3$="NUMBER OF YEARS" :GOSUB 6600
790 REM DO THE COMPUTATION
800 PRINT : PRINT "PRESENT VALUE";TAB(22)
810 A=PAR(1)/(1+PAR(3)/100/PAR(2))^(PAR(2)*PAR(4))
820 A=INT(A*100+0.5)/100
830 PRINT USING "$$######,.##"; A
840 Q2$="COMPUTE" : GOSUB 3400
850 IF YN$="N" THEN RETURN ELSE GOTO 690
860 REM ------------------------------
870 N$= "PRESENT VALUE OF SERIES"
880 REM ------------------------------
890 GOSUB 6200 : K=1 'INITIALIZE
900 REM ASK FOR PARAMETERS
910 Q3$="PAYMENT ($)" :GOSUB 6600
920 Q3$="PAYMENTS PER YEAR" :GOSUB 6600
930 Q3$="ANNUAL INT RATE (%)" :GOSUB 6600
940 Q3$="NUMBER OF YEARS" :GOSUB 6600
950 REM DO THE COMPUTATION
960 PRINT : PRINT "PRESENT VALUE";TAB(22)
970 A=0
980 FOR I = 1 TO PAR(2)*PAR(4)
990 A=A+PAR(1)/((1+PAR(3)/100/PAR(2))^I)
1000 NEXT I
1010 A=INT(A*100+0.5)/100
1020 PRINT USING "$$######,.##"; A
1030 Q2$="COMPUTE" : GOSUB 3400 'ASK FOR ANOTHER
1040 IF YN$="N" THEN RETURN ELSE GOTO 860
1050 REM ------------------------------
1060 N$= "PAYMENT REQD FOR FUTURE SUM"
1070 REM ------------------------------
1080 GOSUB 6200 : K=1 'INITIALIZE
1090 REM ASK FOR PARAMETERS
1100 Q1$="ENTER DATA" :Q2$=""
1110 Q3$="FUTURE VALUE ($)" :GOSUB 6600
1120 Q3$="PAYMENTS PER YEAR" :GOSUB 6600
1130 Q3$="ANNUAL INT RATE (%)" :GOSUB 6600
1140 Q3$="NUMBER OF YEARS" :GOSUB 6600
1150 REM DO THE COMPUTATION
1160 PRINT : PRINT "PAYMENT";TAB(22)
1170 I=PAR(3)/100/PAR(2)
1180 Q=PAR(2)*PAR(4)
1190 A=PAR(1)*I/((1+I)^Q-1)
1200 A=INT(A*100+0.5)/100
1210 PRINT USING "$$######,.##"; A
1220 Q2$="COMPUTE" : GOSUB 3400 'ASK FOR ANOTHER
1230 IF YN$="N" THEN RETURN ELSE GOTO 1050
1240 REM ------------------------------
1250 N$= "WITHDRAWAL OF FUNDS"
1260 REM ------------------------------
1270 GOSUB 6200 : K=1 'INITIALIZE
1280 REM ASK FOR PARAMETERS
1290 Q1$="ENTER DATA" :Q2$=""
1300 Q3$="INITIAL DEPOSIT ($)" :GOSUB 6600
1310 Q3$="WITHDWLS PER YEAR" :GOSUB 6600
1320 Q3$="ANNUAL INT RATE (%)" :GOSUB 6600
1330 Q3$="PAYMENT ($)" :GOSUB 6600
1340 REM DO THE COMPUTATION
1350 PRINT : PRINT "PAYMENTS";TAB(25)
1360 A=PAR(1) : N=1
1370 A=A+A*PAR(3)/100/PAR(2)-PAR(4)
1380 IF A < PAR(1) THEN 1400
1390 PRINT: PRINT "BANK BALANCE IS GROWING"
1395 SOUND 500,9 :GOTO 1460
1400 IF A < PAR(4) THEN 1430
1410 N=N+1
1420 GOTO 1370
1430 PRINT USING "######.##"; N
1440 PRINT "YEARS OF PAYMENTS";TAB(25)
1450 PRINT USING "######.##"; N/12
1460 Q2$="COMPUTE" : GOSUB 3400 'ASK FOR ANOTHER
1470 IF YN$="N" THEN RETURN ELSE GOTO 1240
1480 REM ------------------------------
1490 N$= "INTEREST RATE EARNED"
1500 REM ------------------------------
1510 GOSUB 6200 : K=1 'INITIALIZE
1520 REM ASK FOR PARAMETERS
1530 Q1$="ENTER DATA" :Q2$=""
1540 Q3$="AMOUNT INVESTED ($)" :GOSUB 6600
1550 Q3$="AMOUNT RETURNED ($)" :GOSUB 6600
1560 Q3$="PERIODS PER YEAR" :GOSUB 6600
1570 Q3$="NUMBER OR YEARS" :GOSUB 6600
1580 REM DO THE COMPUTATION
1590 PRINT : PRINT "ANNUAL INT RATE (%)";TAB(24)
1600 Q=PAR(3)*PAR(4)
1610 I=((PAR(2)/PAR(1))^(1/Q)-1)*100*PAR(3)
1620 I=INT(I*100+0.5)/100
1630 PRINT USING "######,.##"; I
1640 Q2$="COMPUTE" : GOSUB 3400 'ASK FOR ANOTHER
1650 IF YN$="N" THEN RETURN ELSE GOTO 1480
1660 REM --------------------------------------
1670 N$= "NET PRESENT VALUE, UNEVEN CASH FLOWS"
1680 REM --------------------------------------
1690 DIM PV(100) 'INITIALIZE
1700 GOSUB 6200 :K=1
1710 REM ASK FOR PARAMETERS
1720 Q1$="ENTER DATA" :Q2$=""
1730 Q3$="AMOUNT INVESTED ($)" :GOSUB 6600
1740 Q3$="ANNUAL INT RATE (%)" :GOSUB 6600
1750 Q1$="ENTER ANNUAL CASH FLOWS"
1760 Q2$="IN ORDER RECEIVED"
1770 Q3$="STRIKE RETURN WHEN DONE"
1780 GOSUB 5000 'ASK QUESTIONS
1790 J=10
1800 FOR I=1 TO 100
1810 LOCATE J,1
1820 PRINT "CASH FLOW "+STR$(I);" ";
1830 LOCATE J,14
1840 INPUT PV(I) 'GET DATA & STORE
1850 IF PV(I)=0 THEN 1890
1860 J=J+1
1870 IF J=16 THEN J=10 'RESET POINTER
1880 NEXT I
1890 NPV=-PAR(1)
1900 FOR I=1 TO 100
1910 NPV= NPV+PV(I)/(1+PAR(2)/100)^I
1920 NEXT I
1930 LOCATE 6,1
1940 PRINT : PRINT "NET PRESENT VALUE";TAB(22)
1950 A=INT(NPV*100+0.5)/100
1960 PRINT USING "$$######,.##"; A
1970 FOR I= 1 TO 100
1980 PV(I)=0
1990 NEXT I
2000 Q2$="COMPUTE" : GOSUB 3400 'ASK FOR ANOTHER
2010 IF YN$="N" THEN RETURN ELSE GOTO 1700
2020 REM ------------------------------
2030 N$= "TIME TO DOUBLE"
2040 REM ------------------------------
2050 GOSUB 6200 : K=1 'INITIALIZE
2060 REM ASK FOR PARAMETERS
2070 Q1$="ENTER DATA" :Q2$=""
2080 Q3$="PERIODS PER YEAR" :GOSUB 6600
2090 Q3$="ANNUAL INT RATE (%)" :GOSUB 6600
2100 REM DO THE COMPUTATION
2110 PRINT : PRINT "TIME TO DOUBLE (YRS)";TAB(25)
2120 I=PAR(2)/100/PAR(1)
2130 Y=LOG(2)/(PAR(1)*LOG(1+I))
2140 Y=INT(Y*100+0.5)/100
2150 PRINT USING "######.##"; Y
2160 Q2$="COMPUTE" : GOSUB 3400 'ASK FOR ANOTHER
2170 IF YN$="N" THEN RETURN ELSE GOTO 2050
2180 REM ------------------------------
2190 N$= "EQUIVALENT INTEREST RATE"
2200 REM ------------------------------
2210 GOSUB 6200 : K=1 'INITIALIZE
2220 REM ASK FOR PARAMETERS
2230 Q1$="ENTER DATA" :Q2$=""
2240 Q3$="ANNUAL INT RATE (%)" :GOSUB 6600
2250 Q3$="AVAILABLE PERIODS " :GOSUB 6600
2260 Q3$="DESIRED PERIODS " :GOSUB 6600
2270 I=PAR(1) : Q2=PAR(2) : Q1=PAR(3)
2280 IEQ=Q1*(1+I/100/Q2)^(Q2/Q1)-Q1
2290 PRINT : PRINT "EQUIV INT RATE";TAB(25)
2300 PRINT USING "######.##";IEQ*100
2310 Q2$="COMPUTE" : GOSUB 3400
2320 IF YN$="N" THEN RETURN ELSE GOTO 2210
3400 REM "ANOTH"
3401 ' --------------------------------
3402 ' ASK FOR ANOTHER RUN
3403 '
3404 'THIS ROUTINE ASKS THE USER WHETHER TO CONTINUE
3405 '
3406 'CALLING PARAMETERS:
3407 ' Q2$= STRING TO SPECIFY WHAT OPERATION TO DO
3408 '
3409 'RETURNED PARAMETERS:
3410 ' YN$= A "Y" OR "N" FOR YES OR NO
3411 '
3412 ' --------------------------------
3420 Q1$="WOULD YOU LIKE TO "
3430 Q3$="AGAIN Y OR N ?"
3440 GOSUB 5000 'PRESENT DIALOG
3450 GOSUB 7800 'ASK YES OR NO
3460 RETURN
5000 REM "DIALOG"
5001 ' -------------------------------
5002 ' DIALOGUE
5003 '
5004 'CALLING PARAMETERS:
5005 ' Q1$,Q2$,Q3$, = QUESTIONS TO DISPLAY
5006 '
5007 'RETURNED PARAMETERS:
5008 ' NONE
5009 '
5010 'COMMENT: UNUSED QUESTION STRINGS SHOULD BE SET
5011 ' TO NULL ("")
5012 '
5013 ' -------------------------------
5020 FOR I= 20 TO 23
5030 LOCATE I,1
5040 IF I > 20 THEN 5080
5050 FOR J= 1 TO 40 'DRAW A BORDER
5060 PRINT "-";
5070 NEXT J
5080 IF I = 21 THEN PRINT Q1$; 'FIRST QUESTION
5090 IF I = 22 THEN PRINT Q2$; 'SECOND QUESTION
5100 IF I = 23 THEN PRINT Q3$; 'THIRD QUESTION
5109 REM RESTORE CURSOR HERE AFTER 3RD QUEST
5110 CP1=POS(N)
5120 CP=POS(N) 'CURSOR COLUMN POSITION
5130 IF CP>40 THEN 5150
5140 PRINT " "; : GOTO 5120 'ERASE ANY PRIOR INFO
5149 REM RESTORE CURSOR FOR USER RESPONSE
5150 LOCATE I,CP1
5160 NEXT I
5170 RETURN
5400 REM "INCH"
5401 ' ------------------------------
5402 ' INPUT CHARACTER
5403 '
5404 'CALLING PARAMETERS:
5405 ' NONE
5406 '
5407 'RETURNED PARAMETERS:
5408 ' CH$=INPUT CHARACTER
5409 '
5410 ' ------------------------------
5420 REM WAIT FOR INPUT CHARACTER
5430 CH$= INKEY$ : IF CH$="" THEN 5430
5440 Z=ASC(CH$)
5450 IF Z < 97 OR Z > 122 THEN 5470
5460 Z=Z-32
5470 CH$=CHR$(Z)
5480 RETURN
6200 REM "INIT"
6201 '----------------------------------
6202 ' INITIALIZE DISPLAY
6203 '
6204 'THIS ROUTINE CLEARS THE SCREEN
6205 ' AND PRINTS THE PROGRAM TITLE
6206 'CALLING PARAMETERS:
6207 ' N$=TITLE OF PROGRAM
6208 '
6209 'RETURNED PARAMETERS:
6210 ' NONE
6211 '
6212 ' ----------------------------------
6220 CLS 'CLEAR SCREEN
6230 PRINT N$ : PRINT 'TITLE
6240 KEY OFF
6250 RETURN
6600 REM "INPAR"
6601 ' --------------------------------
6602 ' INPUT PARAMETERS
6603 '
6604 'CALLING PARAMETERS:
6605 ' Q1$,Q2$=USER INSTRUCTIONS
6606 ' Q3$=NAME OF DATA ITEM
6607 '
6608 'RETURNED PARAMETERS:
6609 ' PAR(K)=THE DATA ITEM OBTAINED
6610 '
6611 'COMMENT: CALL WITH K=1 FOR FIRST DATA ITEM
6612 ' K AUTOMATICALLY UPDATED
6613 '
6614 ' -------------------------------
6620 GOSUB 5000 'ASK QUESTIONS
6630 INPUT PAR(K) 'GET VALUE
6640 REM ECHO QUESTION AND ANSWER
6650 LOCATE K+2,3
6660 PRINT Q3$; TAB(24);
6670 PRINT USING "######,.##"; PAR(K)
6680 K=K+1
6690 RETURN
7000 REM "MENU"
7001 ' ------------------------------
7002 ' MENU PROGRAM
7003 '
7004 'THIS PROGRAM DISPLAYS A MENUE
7005 ' AND CHOOSES A PROGRAM
7006 'CALLING PARAMETERS:
7007 ' N= NO. OF MENU ITEMS
7008 ' X$(I)= ARRAY OF PROGRAM NAMES
7009 '
7010 'RETURNED PARAMETERS:
7011 ' X=PROGRAM NUMBER CHOSEN
7012 '
7013 ' ------------------------------
7020 CLS
7030 FOR I = 1 TO N 'DISPLAY MENU
7040 IF I=10 THEN PRINT 0; ELSE PRINT I;
7050 PRINT "= " ; X$(I)
7060 NEXT I
7070 Q1$="" : Q2$=""
7080 Q3$="CHOOSE PROGRAM :"
7085 PRINT:PRINT" F10 to EXIT program
7090 GOSUB 5000 'ASK QUESTIONS
7100 GOSUB 5400 'INPUT CHAR
7110 X= VAL(CH$)
7119 REM SEE IF CHAR IN RANGE
7120 IF X>=1 AND X<=N THEN RETURN
7130 IF X=0 AND N=10 THEN 7140 ELSE 7150
7140 X=10 : RETURN
7150 Q1$="ILLEGAL CHOICE, CHOOSE AGAIN"
7160 GOSUB 5000
7170 GOTO 7100
7800 REM "YESNO"
7801 ' -------------------------------
7802 ' YES-NO
7803 '
7804 'CALLING PARAMETERS:
7805 ' NONE
7806 '
7807 'RETURNED PARAMETERS:
7808 ' YN$= CONTAINS A Y OR N
7809 '
7810 ' -------------------------------
7815 LOCATE 24,40:PRINT" F6 or F10 to EXIT program
7820 REM WAIT FOR KEY TO BE STRUCK
7830 YN$=INKEY$ : IF YN$="" THEN 7830
7840 IF YN$="y" THEN YN$="Y"
7850 IF YN$="n" THEN YN$="N"
7860 IF YN$ = "Y" OR YN$ = "N" THEN 7890
7870 REM NOT YES OR NO TRY AGAIN
7880 GOTO 7830
7890 PRINT YN$ : RETURN
KALK.BAS
1 KEY(10) ON:ON KEY(10) GOSUB 3
2 GOTO 5
3 RUN"MENU.BAT"+CHR$(13)
5 CLS
6 LOCATE 24,24:PRINT "Press F10 to return to menu>
100 DIM CF#(60)
110 DIM PV#(60)
120 CLS
130 PRINT:PRINT:PRINT
140 PRINT:PRINT:PRINT:PRINT
150 PRINT " \\\\\\\\\\\\\\\\\\\\\\\\\\\\"
160 PRINT " \$$$$$$$$$$$$$$$$$$$$$$$$$$$"
170 PRINT " \$$$$$ $$$$$"
180 PRINT " \$$$$ K-A-L-K $$$$"
190 PRINT " \$$$$$ $$$$$"
200 PRINT " \$$$$$$$$$$$$$$$$$$$$$$$$$$$"
210 FOR X = 1 TO 6:PRINT:NEXT X
220 PRINT " A Compound Interest Calculation Program"
230 FOR COUNT = 1 TO 2000
240 NEXT COUNT
250 CLS
260 FOR X = 1 TO 5:PRINT:NEXT X
270 PRINT " \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\"
280 PRINT " \$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$"
290 PRINT " \$ $"
300 PRINT " \$ This is a public domain program $"
310 PRINT " \$ $"
320 PRINT " \$ by Paul Buchanan $"
330 PRINT " \$ $"
340 PRINT " \$ Peoria, Illinois $"
350 PRINT " \$ $"
360 PRINT " \$ and may be distributed freely. $"
370 PRINT " \$ $"
380 PRINT " \$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$"
390 FOR COUNT = 1 TO 2000
400 NEXT COUNT
410 CLS
420 FOR X = 1 TO 5:PRINT:NEXT X
430 PRINT " \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\"
440 PRINT " \$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$"
450 PRINT " \$ $"
460 PRINT " \$ The Author $"
470 PRINT " \$ $"
480 PRINT " \$ assumes no responsibility $"
490 PRINT " \$ $"
500 PRINT " \$ resulting from the use $"
510 PRINT " \$ $"
520 PRINT " \$ of this material. $"
530 PRINT " \$ $"
540 PRINT " \$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$"
550 FOR COUNT = 1 TO 2500
560 NEXT COUNT
570 CLS:FOR COUNT = 1 TO 10:PRINT:NEXT COUNT
580 PRINT " *** PROGRAM ACCEPTS ONLY CAPITAL LETTERS ***"
590 PRINT
600 PRINT " PLEASE TURN >>> CAPLOCK <<< ON
610 FOR COUNT = 1 TO 2500:NEXT COUNT
620 CLS
630 LET A$=""
640 PRINT
650 PRINT " $$$$ MAIN MENU $$$$"
660 PRINT:PRINT
670 PRINT " I. Typical Compound Interest Calculations"
680 PRINT:PRINT " SOLVE FOR:"
690 PRINT:PRINT " (A) NUMBER OF PERIODS (N)
700 PRINT " (B) INTEREST RATE (I)
710 PRINT " (C) PRESENT VALUE (PV)
720 PRINT " (D) PAYMENT (PMT)
730 PRINT " (E) FUTURE VALUE (or BALLOON)
740 PRINT
750 PRINT " II. Compound Interest Utility Calculations"
760 PRINT:PRINT " SOLVE FOR:
770 PRINT:PRINT " (G) INTERNAL RATE OF RETURN (IRR)"
780 PRINT " (H) NET PRESENT VALUE (NPV)"
783 PRINT " (X) To EXIT to SYSTEM
786 PRINT " F1O To Return to Main MENU
790 PRINT:PRINT
800 BEEP:BEEP:BEEP
810 PRINT " WHICH CALCULATION?
820 A$=INKEY$ : IF A$ ="" THEN 820
830 IF A$ = "A" THEN 940
840 IF A$ = "B" THEN 1340
850 IF A$ = "C" THEN 1830
860 IF A$ = "D" THEN 2240
870 IF A$ = "E" THEN 2640
880 IF A$ = "F" THEN 6220
890 IF A$ = "G" THEN 4010
900 IF A$ = "H" THEN 5080
910 IF A$ = "X" THEN SYSTEM
920 GOTO 620
930 REM ****************** NUMBER OF PERIODS **********************
940 CLS
950 PRINT " SOLVING FOR 'NUMBER OF PERIODS':"
960 PRINT : PRINT
970 PRINT " WHAT IS THE ANNUAL INTEREST RATE"
980 INPUT " (I.E., 14.3) ";I#
990 PRINT
1000 INPUT " WHAT IS THE PRESENT VALUE ";PV#
1010 PRINT
1020 INPUT " WHAT IS THE PAYMENT AMOUNT ";PMT#
1030 PRINT
1040 INPUT " HOW MANY PAYMENTS EACH YEAR ";MO#
1050 PRINT
1060 INPUT " PAYMENTS IN ADVANCE (Y/N) ";T$
1070 IF T$ = "N" THEN S = 0 :ELSE S = 1
1080 PRINT
1090 PRINT " AMOUNT OF RESIDUAL OR BALLOON"
1100 INPUT " AT END OF LAST PERIOD ";FV#
1110 TST# = I#*PV#*PMT#*MO#
1120 IF TST# = 0 THEN GOSUB 6080
1130 IF TST# = 0 GOTO 940
1140 I# = I#/100/MO#
1150 N1# = I#*FV#-(1 +I#*S)*PMT#
1160 N2# = I#*PV#-(1 + I#*S)*PMT#
1170 N1# = N1#/N2#
1180 N1# = LOG(N1#)
1190 D# = LOG(1 + I#)
1200 N# = N1#/D#
1210 REM ***** RESET INTEREST
1220 I# = I#*MO#*100
1230 PRINT
1240 BEEP
1250 PRINT USING " THE TERM IS >>> ###.## <<< MONTHS";N#/MO#*12
1260 PRINT:PRINT:PRINT
1270 PRINT " HIT 'R' FOR RECOMPUTE OR 'M' FOR MAIN MENU"
1280 C$ = INKEY$:IF C$ = "" THEN 1280
1290 IF C$ = "H" THEN 3050
1300 IF C$ = "R" THEN 940
1310 IF C$ = "M" THEN 620
1320 GOTO 620
1330 REM ****************** INTEREST RATE **************************
1340 CLS
1350 PRINT
1360 PRINT " SOLVING FOR 'INTEREST RATE':"
1370 PRINT : PRINT
1380 INPUT " WHAT IS THE TERM (IN MONTHS) ";N#
1390 PRINT
1400 INPUT " WHAT IS THE PRESENT VALUE ";PV#
1410 PRINT
1420 INPUT " WHAT IS THE PAYMENT AMOUNT ";PMT#
1430 PRINT
1440 INPUT " HOW MANY PAYMENTS EACH YEAR ";MO#
1450 PRINT
1460 INPUT " PAYMENTS IN ADVANCE (Y/N) ";T$
1470 IF T$ = "N" THEN S = 0 ELSE S = 1
1480 PRINT
1490 PRINT " AMOUNT OF RESIDUAL OR BALLOON
1500 INPUT " AT END OF LAST PERIOD ";FV#
1510 TST# = N#*PV#*PMT#*MO#
1520 IF TST# = 0 THEN GOSUB 6080
1530 IF TST# = 0 THEN 1340
1540 I# = 0.15/MO#
1550 N# =((-N#/12)*MO#)
1560 V# = -PV#+PMT#*(1+I#*S)*(1 -(1+I#)^N#)/I#+FV#*(1+I#)^N#
1570 IF S = 1 GOTO 1600
1580 V1# = (PMT#*(-N#*I#*((1+I#)^(N#-1))-1+(1+I#)^N#)/(I#*I#))+N#*FV#*((1+I#)^(N#-1))
1590 GOTO 1610
1600 V1# = PMT#*(1+I#)/I#*((-N#*I#*(1+I#)^(N#-1)-1+(1+I#)^N#)/I#)+((1-(1+I#)^N#)/I#)+N#*FV#*(1+I#)^(N#-1)
1610 I2# = I#-(V#/V1#)
1620 IF ABS(I#-I2#) <=1.000000e-8 THEN 1650
1630 I# = I2#
1640 GOTO 1560
1650 I# = I2#
1660 I# = I#*MO#
1670 REM ***** RESET INTEREST AND NUMBER
1680 I# = I#*100
1690 PRINT
1700 BEEP
1710 PRINT USING " THE ANNUAL INTEREST RATE IS >>> ###.##% <<<";((INT((I#*1000)*100+0.5))/100)/1000
1720 PRINT:PRINT:PRINT
1730 REM ****** RESET INTEREST AND NUMBER *******
1740 N# = ((N#/MO#)*-12)
1750 PRINT " HIT 'H' FOR HARDCOPY, 'R' FOR RECOMPUTE,"
1760 PRINT " OR 'M' FOR MAIN MENU."
1770 C$ = INKEY$:IF C$ = "" THEN 1770
1780 IF C$ = "H" THEN 3050
1790 IF C$ = "R" THEN 1340
1800 IF C$ = "M" THEN 620
1810 GOTO 620
1820 REM ************************* SOLVING FOR PRESENT VALUE *******************
1830 CLS
1840 PRINT
1850 PRINT " SOLVING FOR 'PRESENT VALUE':"
1860 PRINT : PRINT
1870 INPUT " WHAT IS THE TERM (IN MONTHS) ";N#
1880 PRINT
1890 PRINT " WHAT IS THE ANNUAL INTEREST"
1900 INPUT " RATE (I.E., 14.3) ";I#
1910 PRINT
1920 INPUT " WHAT IS THE PAYMENT AMOUNT ";PMT#
1930 PRINT
1940 INPUT " HOW MANY PAYMENTS EACH YEAR ";MO#
1950 PRINT
1960 INPUT " PAYMENTS IN ADVANCE (Y/N) ";T$
1970 PRINT
1980 PRINT " AMOUNT OF RESIDUAL OR BALLOON"
1990 INPUT " AT END OF LAST PERIOD ";FV#
2000 PRINT
2010 TST# = N#*I#*PMT#*MO#
2020 IF TST# = 0 THEN GOSUB 6080
2030 IF TST# = 0 THEN 1820
2040 IF T$ = "N" THEN S = 0 ELSE S = 1
2050 N# = MO#*N#/12
2060 N# = -N#
2070 I# = I#/100/MO#
2080 PV# = PMT#*(1+I#*S)*((1-(1+I#)^N#)/I#)+FV#*(1+I#)^N#
2090 PV# = INT(PV#*100+0.5)/100
2100 BEEP
2110 PRINT USING " THE PRESENT VALUE IS >>> $#,###,###.## <<<";PV#
2120 REM ***** RESET INTEREST AND NUMBER
2130 N# = N#/MO#*-12
2140 I# = I#*100*MO#
2150 PRINT:PRINT:PRINT
2160 PRINT " HIT 'H' FOR HARDCOPY, 'R' FOR RECOMPUTE,"
2170 PRINT " OR 'M' FOR MAIN MENU."
2180 C$ = INKEY$:IF C$ = "" THEN 2180
2190 IF C$ = "H" THEN 3050
2200 IF C$ = "R" THEN 1830
2210 IF C$ = "M" THEN 620
2220 GOTO 620
2230 REM ****************** PAYMENT ********************************
2240 CLS
2250 PRINT
2260 PRINT " SOLVING FOR 'PAYMENT':"
2270 PRINT : PRINT
2280 INPUT " WHAT IS THE TERM IN MONTHS ";N#
2290 PRINT
2300 PRINT " WHAT IS THE ANNUAL INTEREST"
2310 INPUT " RATE (I.E., 14.3) ";I#
2320 PRINT
2330 INPUT " WHAT IS THE PRESENT VALUE ";PV#
2340 PRINT
2350 INPUT " HOW MANY PAYMENTS EACH YEAR ";MO#
2360 PRINT
2370 INPUT " PAYMENTS IN ADVANCE (Y/N) ";T$
2380 PRINT
2390 PRINT " AMOUNT OF RESIDUAL OR BALLOON"
2400 INPUT " AT END OF LAST PERIOD ";FV#
2410 PRINT
2420 TST# = N#*I#*PV#*MO#
2430 IF TST# =0 THEN GOSUB 6080
2440 IF TST# =0 THEN 2230
2450 IF T$ ="N" THEN S =0 ELSE S=1
2460 N# =-MO#*N#/12
2470 I# = I#/100/MO#
2480 PMT# =(PV#-(FV#*(1+I#)^N#))/((1+I#*S)*(1-(1+I#)^N#)/I#)
2490 PMT# =INT(PMT#*100+0.5)/100
2500 REM ***** RESET INTEREST AND NUMBER
2510 N# =N#/MO#*-12
2520 I# = I#*MO#*100
2530 BEEP
2540 PRINT USING " THE PAYMENT PER PERIOD IS >>> $#,###,###.## <<<";PMT#
2550 PRINT:PRINT
2560 PRINT " HIT 'H' FOR HARDCOPY, 'R' FOR RECOMPUTE,"
2570 PRINT " OR 'M' FOR MAIN MENU."
2580 C$ = INKEY$:IF C$ = "" THEN 2580
2590 IF C$ = "H" THEN 3050
2600 IF C$ = "R" THEN 2240
2610 IF C$ = "M" THEN 620
2620 GOTO 620
2630 REM ****************** FUTURE VALUE ***************************
2640 CLS
2650 PRINT
2660 PRINT " SOLVING FOR 'FUTURE VALUE':"
2670 PRINT : PRINT
2680 INPUT " WHAT IS THE TERM IN MONTHS ";N#
2690 PRINT
2700 PRINT " WHAT IS THE ANNUAL INTEREST"
2710 INPUT " RATE (I.E., 14.3) ";I#
2720 PRINT
2730 INPUT " WHAT IS THE PRESENT VALUE ";PV#
2740 PRINT
2750 INPUT " WHAT IS THE PAYMENT AMOUNT ";PMT#
2760 PRINT
2770 INPUT " HOW MANY PAYMENTS EACH YEAR ";MO#
2780 PRINT
2790 INPUT " PAYMENTS IN ADVANCE (Y/N) ";T$
2800 PRINT
2810 TST# = N#*I#*PMT#*MO#*PV#
2820 IF TST# = 0 THEN GOSUB 6080
2830 IF TST# =0 THEN 2630
2840 IF T$ = "N" THEN S = 0 ELSE S = 1
2850 I# = I#/100/MO#
2860 N# =-N#*MO#/12
2870 F1# =PV#-(1+I#*S)*PMT#*((1-(1+I#)^N#)/I#)
2880 F2# =(1+I#)^N#
2890 FV# =F1#/F2#
2900 FV# =INT(FV#*100+0.5)/100
2910 BEEP
2920 PRINT USING " THE FUTURE VALUE IS >>> $#,###,###.## <<<";FV#
2930 PRINT
2940 REM ***** RESET INTEREST AND NUMBER
2950 N# = N#/MO#*(-12)
2960 I# =I#*MO#*100
2970 PRINT " HIT 'H' FOR HARDCOPY, 'R' FOR RECOMPUTE,"
2980 PRINT " OR 'M' FOR MAIN MENU."
2990 C$ =INKEY$:IF C$ = "" THEN 2990
3000 IF C$ ="H" THEN 3050
3010 IF C$ = "R" THEN 2640
3020 IF C$ ="M" THEN 620
3030 GOTO 620
3040 REM ****************** A-E HARDCOPY PROCEDURE *********
3050 CLS
3060 PRINT:PRINT:PRINT:PRINT:PRINT
3070 LINE INPUT "ENTER TODAY'S DATE: ";D$
3100 PRINT : PRINT : PRINT
3110 CLS
3120 PRINT:PRINT:PRINT:PRINT:PRINT
3130 LINE INPUT "REFERENCE NAME: ";CN$
3150 CLS
3160 PRINT:PRINT:PRINT:PRINT:PRINT
3170 PRINT " PERCENT TO INCREASE TERMINATION VALUE"
3180 PRINT:PRINT " TO COVER ADMINISTRATIVE EXPENSE"
3190 PRINT
3200 INPUT " ON TERMINATION (I.E., 5% = 5.0) : ";A%
3210 CLS:PRINT:PRINT:PRINT:PRINT:PRINT
3220 INPUT "HOW MANY COPIES WOULD YOU LIKE";CC
3223 CLS:PRINT:PRINT:PRINT:PRINT
3225 INPUT "DO YOU WANT COMPUTATION PARAMETERS AT BOTTOM (Y/N) ";BOT$
3240 CLS
3250 FOR X=1 TO 10:PRINT:NEXT X
3260 PRINT " $$$$$$$$$$$$$$$$$$$$$$$$$"
3270 PRINT " $$$$ P R I N T I N G $$$$"
3280 PRINT " $$$$$$$$$$$$$$$$$$$$$$$$$"
3290 LPRINT
3300 LPRINT" BOB TOLSON"
3310 LPRINT" 552 E IDLEWOOD"
3320 LPRINT" MORTON,ILLINOIS"
3330 LPRINT" 61550"
3340 LPRINT
3350 LPRINT " DATE: ";D$
3360 LPRINT
3370 LPRINT " REFERENCE: ";CN$
3380 LPRINT : LPRINT
3390 LPRINT " BEGINNING ENDING TERMINATION"
3400 LPRINT " PERIOD BALANCE PAYMENT INTEREST BALANCE VALUE (*)"
3410 LPRINT " ------ ---------- ---------- ----------- ---------- ----------"
3420 LPRINT
3430 LET PER# = 0
3435 IF PMT# = 0 THEN PMT# = PMT2#
3440 LET I2# = 0
3450 LET BBAL# =PV#
3460 LET ITOT# = 0
3470 LET PMTTOT# = 0
3480 LET PTOT# = 0
3485 LET TEMP$ = T$
3490 IF TEMP$ = "Y" THEN K = 0 ELSE K =1
3500 E = (N#/12)*MO#
3510 FOR J=K TO E
3520 PMT1# = PMT#
3525 LET PMT2# = PMT#
3530 IF K = 0 AND J = E THEN PMT# = 0
3540 I2# = BBAL#*(I#/MO#/100)
3550 I2# = INT(I2#*100+0.5)/100
3560 IF J = E THEN I2# =-BBAL#+PMT#+FV#
3570 IF TEMP$ = "Y" THEN GOSUB 3940
3580 ITOT# = ITOT# + I2#
3590 PMTTOT# = PMTTOT# + PMT#
3600 PTOT# = PTOT# + PMT# - I2#
3610 LET PER# = J
3620 EBAL# = BBAL# - PMT# + I2#
3630 IF J = E THEN TEV# = EBAL# ELSE TEV# = EBAL# + (EBAL# * A% / 100)
3640 GOSUB 3920
3650 IF J = 45 THEN GOSUB 3970
3660 BBAL# = EBAL#
3670 I2# = 0
3680 NEXT J
3690 LPRINT
3700 LPRINT USING " TOTALS #,###,###.## #,###,###.##";PMTTOT#,ITOT#
3710 LPRINT
3720 LPRINT : LPRINT " (*) END OF PERIOD"
3730 LPRINT : LPRINT
3733 IF BOT$ <> "Y" THEN GOTO 3880
3740 IF K = 0 THEN STORT$ = "IN ADVANCE" ELSE STORT$ = "IN ARREARS"
3750 LPRINT " >>>>>>><<<<<<<"
3760 LPRINT
3770 LPRINT " THIS AMORTIZATION AND TERMINATION VALUE SCHEDULE WAS CONSTRUCTED"
3780 LPRINT
3790 LPRINT USING "WITH A PRESENT VALUE OF $ #,###,###.##, AN ANNUAL INTEREST RATE OF ###.##%";PV#,I#
3800 LPRINT
3810 LPRINT "AND PAYMENTS OF $ ";PMT1#;" MADE ";MO#;" TIMES EACH YEAR (";STORT$;") "
3820 LPRINT
3830 LPRINT USING "OVER A PERIOD OF ### MONTHS, AND A FUTURE VALUE OF $ #,###,###.##.";N#,FV#
3840 LPRINT
3850 LPRINT " THE TERMINATION VALUE WAS CALCULATED BY INCREASING THE PERIOD"
3860 LPRINT
3870 LPRINT "ENDING BALANCE ";A%;"% TO COVER ADMINISTRATIVE COSTS OF EARLY TERMINATION."
3880 LPRINT CHR$(12)
3890 LET CC = CC - 1
3900 IF CC > 0 THEN 3290
3910 GOTO 620
3920 LPRINT USING " ### #,###,###.## #,###,###.## #,###,###.## #,###,###.## #,###,###.##";PER#,BBAL# ,PMT# ,I2# ,EBAL# ,TEV#
3930 RETURN
3940 I2# = 0
3945 LET TEMP$ = "N"
3960 RETURN
3970 FOR B=1 TO 7
3980 LPRINT
3990 NEXT B
4000 RETURN
4010 REM ****************** I.R.R. *********************************
4020 FOR X = 1 TO 60:CF#(X) = 0:NEXT X
4030 TE# = 0:PE# = 0:PF# = 0:IR# = 0:FV# = 0:CFTOT = 0
4040 CLS
4050 PRINT " *** I.R.R. CALCULATOR ***
4060 PRINT : PRINT
4070 PRINT " WHAT IS THE AMOUNT OF THE INVESTMENT"
4080 INPUT " AT POINT '0' ";PV#
4090 PRINT
4100 PRINT " WHAT IS THE VALUE OF THE INVESTMENT,"
4110 INPUT " IF ANY, AT END OF LAST PERIOD ";FV#
4120 CFTOT = FV#
4130 PRINT
4140 INPUT " HOW MANY PERIODS PER YEAR ";MO#
4150 PRINT
4160 INPUT " HOW MANY PERIODS IN TOTAL (MAX. = 60) ";N#
4170 TST# = PV#*MO#*N#
4180 IF TST# = 0 THEN GOSUB 6070: GOTO 4010
4190 IF N# > 60 THEN GOSUB 6070: GOTO 4010
4200 IF N# < MO# THEN GOSUB 6070: GOTO 4010
4210 PRINT
4220 CLS
4230 PRINT : PRINT
4240 FOR X = 1 TO N#:PRINT " FLOW FOR PERIOD # ";X;:INPUT S$
4250 IF S$ = "S" OR S$ = "s" THEN CF#(X) = CF#(X-1) ELSE CF#(X) = VAL(S$)
4260 CFTOT = CFTOT+CF#(X)
4270 NEXT X
4280 IF CFTOT =< PV# THEN GOSUB 6070
4290 IF CFTOT =< PV# THEN 4010
4300 CLS
4310 FOR X = 1 TO 10:PRINT:NEXT X
4320 PRINT " $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$"
4330 PRINT " $$$ PLEASE STAND-BY WHILE I THINK THIS THROUGH $$$"
4340 PRINT " $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$"
4350 BEEP
4360 IR# = 0.15/MO#:I1# = 0.25
4370 PF# = FV#/(1+IR#)^N#
4380 TE# = 0
4390 FOR X = 1 TO N#
4400 PE# = CF#(X)/(1+IR#)^X
4410 TE# = TE#+PE#
4420 NEXT X
4430 I1# = IR#*(PF#+TE#)/PV#
4440 IF ABS(IR#-I1#) < 9.999999e-8 THEN IR# = IR#*MO#*100:GOTO 4460
4450 IR# = I1#:GOTO 4370
4460 CLS:PRINT:PRINT
4470 PRINT " THE INTERNAL RATE OF RETURN"
4480 PRINT
4490 PRINT " >>> PER ANNUM <<<"
4500 PRINT
4510 PRINT " FOR THIS SERIES OF CASH FLOWS"
4520 PRINT
4530 PRINT " IS"
4540 PRINT:PRINT
4550 BEEP
4560 PRINT USING " >>>>> ###.##% <<<<<";IR#
4570 PRINT:PRINT:PRINT:PRINT:PRINT
4580 PRINT " HIT 'H' FOR HARDCOPY, 'R' FOR RECOMPUTE,"
4590 PRINT " OR 'M' FOR MAIN MENU."
4600 C$ = INKEY$:IF C$ = "" THEN 4600
4610 IF C$ = "H" GOTO 4640
4620 IF C$ = "R" THEN 4040
4630 GOTO 620
4640 REM ****************** I.R.R. HARDCOPY *************************
4650 CLS
4660 FOR X = 1 TO 10:PRINT:NEXT X
4670 PRINT " $$$$$$$$$$$$$$$$$$$$$$$$$"
4680 PRINT " $$$$ P R I N T I N G $$$$"
4690 PRINT " $$$$$$$$$$$$$$$$$$$$$$$$$"
4700 LPRINT:LPRINT
4710 LPRINT " YOUR NAME HERE"
4720 LPRINT " YOUR ADDRESS HERE"
4730 LPRINT " PEORIA, ILLINOIS
4740 LPRINT " 616xx"
4750 LPRINT:LPRINT
4760 LPRINT " $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$"
4770 LPRINT " $$$ INTERNAL RATE OF RETURN CALCULATION $$$"
4780 LPRINT " $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$"
4790 LPRINT:LPRINT:LPRINT
4800 LPRINT " THIS I.R.R. CALCULATION WAS BASED ON:"
4810 LPRINT
4820 LPRINT USING " AN INVESTMENT AT POINT '0' OF $ #,###,###.##";PV#
4830 LPRINT
4840 LPRINT USING " A VALUE AT TERMINATION OF $ #,###,###.##";FV#
4850 LPRINT
4860 LPRINT USING " ## PERIODS PER YEAR";MO#
4870 LPRINT
4880 LPRINT USING " A TOTAL OF ### PERIODS";N#
4890 LPRINT
4900 LPRINT " AND THE FOLLOWING CASH FLOWS FOR THE PERIODS INDICATED;"
4910 LPRINT:LPRINT
4920 FOR X = 1 TO N#
4930 LPRINT USING " CASH FLOW IN PERIOD ### = $ #,###,###.##";X,CF#(X)
4940 LPRINT
4950 NEXT X
4960 LPRINT:LPRINT
4970 LPRINT " THE INTERNAL RATE OF RETURN"
4980 LPRINT
4990 LPRINT " >>> PER ANNUM <<<"
5000 LPRINT
5010 LPRINT " FOR THIS SERIES OF CASH FLOWS "
5020 LPRINT
5030 LPRINT " IS"
5040 LPRINT
5050 LPRINT USING " >>>>> ###.##% <<<<<";IR#
5060 LPRINT CHR$(12)
5070 GOTO 620
5080 REM ******************* PV# OF CASH FLOW SERIES *****************
5090 FOR X = 1 TO 60:CF#(X) = 0:PV#(X) = 0:NEXT X
5100 LET PVTOT# = 0
5110 CLS
5120 PRINT
5130 PRINT " *** NPV CALCULATOR ***"
5140 PRINT : PRINT
5150 PRINT " WHAT IS THE VALUE, IF ANY, AT "
5160 INPUT " THE END OF THE LAST PERIOD ";FV#
5170 PRINT
5180 INPUT " HOW MANY PERIODS PER YEAR ";MO#
5190 PRINT
5200 INPUT " HOW MANY PERIODS IN TOTAL (MAX. = 60) ";N#
5210 IF N# > 60 THEN GOSUB 6070: GOTO 5080
5220 IF N# < MO# THEN GOSUB 6070: GOTO 5080
5230 PRINT
5240 PRINT " AT WHAT ANNUAL INTEREST RATE SHOULD"
5250 INPUT " THE CASH FLOWS BE DISCOUNTED ";I#
5260 TST# = MO#*N#*I#
5270 IF TST# = 0 THEN GOSUB 6070: GOTO 5080
5280 I# = I#/MO#/100
5290 PRINT
5300 CLS
5310 FOR X = 1 TO N#
5320 PRINT " WHAT IS THE FLOW IN PERIOD ";X;:INPUT S$
5330 IF S$ = "S" THEN CF#(X) = CF#(X-1) ELSE CF#(X) = VAL(S$)
5340 PV#(X) = CF#(X)*((1+I#)^-X)
5350 PVTOT# = PVTOT#+PV#(X)
5360 NEXT X
5370 TV# = FV#*((1+I#)^-N#)
5380 PVTOT# = PVTOT#+TV#
5390 PVTOT# = ABS(PVTOT#)
5400 CLS
5410 PRINT : PRINT
5420 PRINT " THE NET PRESENT VALUE OF"
5430 PRINT
5440 PRINT " THE GIVEN CASH FLOWS"
5450 PRINT
5460 PRINT " IS"
5470 PRINT
5480 BEEP
5490 PRINT USING " >>>>> $ #,###,###.## <<<<<";PVTOT#
5500 PRINT:PRINT:PRINT:PRINT:PRINT:PRINT:PRINT
5510 PRINT " HIT 'H' FOR HARDCOPY, 'R' FOR RECOMPUTE,"
5520 PRINT " OR 'M' FOR MAIN MENU."
5530 C$ =INKEY$:IF C$ = "" THEN 5530
5540 IF C$ = "H" THEN 5580
5550 IF C$ = "R" THEN 5080
5560 GOTO 620
5570 REM ****************** N.P.V. HARDCOPY ************************
5580 LPRINT:LPRINT
5590 CLS
5600 FOR X = 1 TO 10:PRINT:NEXT X
5610 PRINT " $$$$$$$$$$$$$$$$$$$$$$$$$"
5620 PRINT " $$$$ P R I N T I N G $$$$"
5630 PRINT " $$$$$$$$$$$$$$$$$$$$$$$$$"
5640 BEEP
5650 LPRINT " YOUR NAME HERE"
5660 LPRINT " YOUR STREET ADDRESS HERE"
5670 LPRINT " PEORIA, ILLINOIS"
5680 LPRINT " 616xx"
5690 LPRINT:LPRINT
5700 LPRINT " $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$"
5710 LPRINT " $$$ NET PRESENT VALUE CALCULATION $$$"
5720 LPRINT " $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$"
5730 LPRINT:LPRINT
5740 LPRINT " THIS NET PRESENT VALUE CALCULATION WAS BASED ON:"
5750 LPRINT
5760 LPRINT USING " A TERMINATION VALUE OF $ #,###,###.## (INCLUDED IN";FV#
5770 LPRINT " THE LAST CASH FLOW)"
5780 LPRINT
5790 LPRINT USING " ## PERIOD(S) PER YEAR";MO#
5800 LPRINT
5810 LPRINT USING " A TOTAL OF ## PERIODS";N#
5820 LPRINT
5830 LPRINT USING " AN ANNUAL DISCOUNT RATE OF ###.##%";I#*MO#*100
5840 LPRINT
5850 LPRINT " AND THE FOLLOWING CASH FLOWS FOR THE PERIODS INDICATED:"
5860 LPRINT:LPRINT
5870 LPRINT " CASH PRESENT"
5880 LPRINT " PERIOD FLOW VALUE"
5890 LPRINT " ------ --------- ---------"
5900 LPRINT
5910 FOR X = 1 TO N#
5920 IF X = N# THEN CF#(N#) = CF#(N#)+FV#
5930 IF X = N# THEN PV#(N#) = PV#(N#)+TV#
5940 LPRINT USING " ## #,###,###.## #,###,###.##" ;X,CF#(X),PV#(X)
5950 NEXT X
5960 LPRINT:LPRINT:LPRINT
5970 LPRINT " THE NET PRESENT VALUE"
5980 LPRINT
5990 LPRINT " OF THE GIVEN CASH FLOWS"
6000 LPRINT
6010 LPRINT " IS"
6020 LPRINT
6030 LPRINT USING " >>>>> $$#,###,###.## <<<<<";PVTOT#
6040 GOTO 620
6050 LPRINT CHR$(12)
6060 END
6070 REM ****************** DIVISION BY ZERO ***********************
6080 CLS
6090 PRINT:PRINT:PRINT:PRINT
6100 PRINT " $$$$$$$$$$$$$":PRINT
6110 PRINT " $$$ ERROR $$$":PRINT
6120 PRINT " $$$$$$$$$$$$$":PRINT:PRINT:PRINT
6130 BEEP
6140 PRINT " >>> PLEASE TRY AGAIN! <<<"
6150 PRINT:PRINT:PRINT
6160 PRINT " HIT: 'S' FOR SAME COMPUTATION"
6170 PRINT " 'M' FOR MAIN MENU"
6180 C$ =INKEY$:IF C$ = "" THEN 6180
6190 IF C$ = "M" THEN 620
6200 RETURN
6210 REM ****************** ON ERROR PROCESSING *******************
6220 CLS
6230 PRINT:PRINT:PRINT:PRINT
6240 PRINT " $$$$$$$$$$$$$":PRINT
6250 PRINT " $$$ ERROR $$$":PRINT
6260 PRINT " $$$$$$$$$$$$$"
6270 PRINT:PRINT:PRINT
6280 BEEP
6290 PRINT " PLEASE TRY AGAIN!"
6300 FOR COUNT=1 TO 1500:NEXT COUNT
6310 GOTO 620
LOANS.BAS
10 ' LOAN ANALYZER Copyright (c) 1983 Zyncon Inc.
20 DIM F(6,3),P$(5),PARSET(5),PARERR(6),TABLE1(60,3), TABLE2(60,5):KEY OFF:RESTORE
30 DATA 9,34,10,13,38,6,15,39,5,17,42,1,19,34,10,11,34,10
75 FALSE=0: TRUE=1
80 FOR I=1 TO 6 : READ F(I,1),F(I,2),F(I,3): NEXT I
92 GOSUB 30200
95 FOR I=1 TO 10 : KEY I,"": NEXT I: KEY OFF:WIDTH 80
97 ON ERROR GOTO 40000
100 ON KEY(1) GOSUB 12000: ON KEY(2) GOSUB 13000: ON KEY(3) GOSUB 13050: ON KEY(4) GOSUB 13080:ON KEY(5) GOSUB 13140:ON KEY(6) GOSUB 13170:ON KEY(7) GOSUB 13200
160 KEY(1) OFF:KEY(2) OFF:KEY(3) OFF:KEY(4) OFF:KEY(5) OFF:KEY(6) OFF:KEY(7) OFF
1000 '
1005 GOSUB 10000
1010 GOSUB 9000
1020 GOSUB 8000
1030 GOSUB 6000
1040 GOSUB 4000
1050 GOSUB 7000
1200 '
1210 KEY(1) ON:KEY(2) ON: KEY(6) ON
1230 T$=INKEY$
1235 LOCATE 19,75 : PRINT "W";: LOCATE 19,75: GOSUB 5240
1240 IF T$="" OR LEN(T$)=2 THEN 1230
1250 IF T$=CHR$(13) THEN KEY(1) OFF: KEY(2) OFF:LOCATE 22,1: PRINT SPC(79);:LOCATE 19,75: PRINT " ";:GOTO 1040
4000 '
4005 SOUND 1046.5,1:PARLINE=1
4040 GOSUB 30140: GOSUB 5000
4050 IF F$="" THEN 4070
4060 P$(PARLINE)=F$: GOTO 4085
4070 LOCATE F(PARLINE,1),F(PARLINE,2):PRINT TEMP$;
4085 IF PARLINE=1 THEN GOSUB 9300
4090 PARLINE = PARLINE+1:SOUND 1046.5,1
4110 IF PARLINE=6 THEN RETURN
4120 GOTO 4040
5000 '
5010 F$="":ROW= F(PARLINE,1) : BC= F(PARLINE,2): FL= F(PARLINE,3): FP= BC:
5040 LOCATE ROW,FP
5050 GOSUB 5240
5060 T$= INKEY$
5070 IF T$="" OR LEN(T$)=2 THEN 5050
5080 IF ASC(T$)= 13 THEN 5220
5090 IF ASC(T$)=8 THEN 5160
5100 IF FP=BC+FL THEN 5040
5110 PRINT T$;: F$=F$+T$
5130 IF FP=BC THEN PRINT SPC(FL-1);
5140 FP=FP+1:GOTO 5040
5160 IF FP=BC THEN 5040
5170 IF FP=BC+1 THEN F$="": PRINT " "; : FP=BC: GOTO 5040
5180 PRINT " ";:FP=FP-1
5200 -5300
5220 PRINT " ";
5230 RETURN
5235 REM ***** CURSOR GENERATION *****
5240 Y= CSRLIN:X= POS(0):IF Y=YL AND X=XL THEN 5280
5270 C= SCREEN(Y,X):
5280 PRINT CHR$(C);:LOCATE Y,X:PRINT CHR$(95);:LOCATE Y,X:XL=X:YL=Y
5330 RETURN
6000 LOCATE 7,1
6005 PRINT STRING$(80,95):LOCATE F(1,1),1: PRINT "(1) Amount to Borrow: $ ";:LOCATE F(1,1),F(1,2): PRINT SPC(F(1,3));:LOCATE F(1,1),F(1,2) :PRINT USING "#######.##";VAL( P$(1));
6025 LOCATE 11,9: PRINT "Final Balloon Payment: $ ";: PRINT USING "#######.##";FBALL;
6030 LOCATE F(2,1),1: PRINT "(2) Annual Interest Rate: ";:LOCATE F(2,1),F(2,2):PRINT SPC(F(2,3));: LOCATE F(2,1),F(2,2): PRINT USING "##.###";VAL(P$(2));: LOCATE F(2,1),46: PRINT "%";
6050 LOCATE F(3,1),1: PRINT "(3) Duration of Borrowing: ";:LOCATE F(3,1),F(3,2): PRINT SPC(F(3,3));: LOCATE F(3,1),F(3,2):PRINT P$(3);: LOCATE F(3,1),46 : PRINT "YY,MM";
6070 LOCATE F(4,1),13: PRINT "Payment Frequency: ";:LOCATE F(4,1),F(4,2):PRINT SPC(F(4,3));: LOCATE F(4,1),F(4,2): PRINT P$(4);: LOCATE F(4,1),46: PRINT "(Monthly, Quarterly, Yearly)";
6082 LOCATE F(5,1),1: PRINT "(4) Payment per Period: $ ";: LOCATE F(5,1),F(5,2): PRINT SPC(F(5,3));: LOCATE F(5,1),F(5,2) :PRINT USING "#######.##";VAL(P$(5));
6110 LOCATE 21,1:PRINT "Please fill in 3 of 4 key parameters above."
6125 LOCATE 24,1:PRINT "F1 to calculate, F2 to clear, F6 to quit.";
6130 RETURN
7000 REM CHECK PARAMETERS ROUTINE
7010 FOR I=1 TO 6 : PARERR(I)=0: NEXT I
7015 FOR I=1 TO 5:PARSET(I)=0 : NEXT I
7020 GOOD=TRUE:NUMPAR = 0
7040 A=VAL(P$(1)):IF A<= 0 OR A>9999999.99# THEN GOOD= FALSE: PARERR(1)=1 :GOTO 7072
7060 PARSET(1)=1:NUMPAR= NUMPAR+1
7072 FBALL=VAL(FBALL$) :IF FBALL<0 OR FBALL>9999999.99# THEN FBALL=0
7080 ANINT= VAL(P$(2)):IF ANINT<=0 OR ANINT>99.99901 THEN GOOD= FALSE : PARERR(2)=1: GOTO 7120
7100 PARSET(2)=1:NUMPAR= NUMPAR+1
7120 GOSUB 7800
7125 IF VAL(YY$)<>INT(VAL(YY$)) OR VAL(MM$)<> INT(VAL(MM$)) THEN GOOD=FALSE: PARERR(3)=1: GOTO 7160
7127 DUR= VAL(YY$)+ VAL(MM$)/12:IF DUR<=0 THEN GOOD= FALSE: PARERR(3)=1: GOTO 7160
7135 GOSUB 30050:PARSET(3)=1: NUMPAR= NUMPAR +1
7160 PFQ$= P$(4):IF ASC(PFQ$)>90 THEN PFQ$=CHR$(ASC(PFQ$)-32): P$(4)=PFQ$
7170 IF PFQ$ <> "M" AND PFQ$ <> "Q" AND PFQ$ <> "Y" THEN PFQ$="M":P$(4)="M"
7180 IF PFQ$= "M" THEN PFQ= 12 :GOTO 7200
7190 IF PFQ$= "Q" THEN PFQ= 4 ELSE PFQ = 1
7200 PARSET(4)=1: NUMPAR= NUMPAR+1
7220 P= VAL (P$(5))
7230 IF P<= 0 OR P>9999999.99# THEN GOOD= FALSE: PARERR(5)=1 : GOTO 7260
7240 PARSET(5)=1: NUMPAR=NUMPAR+1
7260 IF NUMPAR<4 THEN GOOD= FALSE: PARERR(6)=1
7300 IF GOOD= TRUE THEN ER$="PARAMETERS OK ": GOTO 7390
7310 ER$="ERROR(S) IN PARAMETERS ":TOTER = 0
7330 FOR I=1 TO 5: IF PARERR(I)=0 THEN 7370
7350 TOTER=TOTER+1:IF I=5 THEN ER$=ER$+"/"+STR$(I-1)+" ":ELSE ER$=ER$+"/"+STR$(I)+" "
7370 NEXT I
7380 IF TOTER=1 AND PARERR(4)<>1 THEN GOOD=TRUE: GOTO 7300
7390 LOCATE 22,1:PRINT SPC(79);:LOCATE 22,1: PRINT ER$;
7430 A=FNCN(A):DUR= FNCN(DUR):P=FNCN(P)
7470 IF GOOD= FALSE THEN 7700
7480 MISS=0
7490 FOR I=1 TO 5:IF PARSET(I)=0 THEN MISS=I : P$(I)="?":GOTO 7520
7510 NEXT I
7520 IF MISS<>3 THEN N= -INT(-DUR*PFQ)
7540 R=ANINT/PFQ/100
7700 GOSUB 6000:RETURN
7800 CMPO= INSTR(P$(3),","):IF CMPO=0 THEN YY$=P$(3) : MM$="": GOTO 7850
7820 IF CMPO=1 THEN YY$="": MM$= MID$(P$(3),2,LEN(P$(3))-1) : GOTO 7850
7825 YY$= MID$(P$(3),1,CMPO-1):IF CMPO= 4 THEN MM$="" : GOTO 7850
7840 MM$=MID$(P$(3),CMPO+1,LEN(P$(3))-CMPO)
7850 RETURN
8000 P$(1)=" 0.00":P$(2)=" 0.000":P$(3)="00,00":P$(4)="M":P$(5)=" 0.00": FBALL=0:RETURN
9000 KEY(1) OFF: KEY(2) OFF: LOCATE 5,1:PRINT "Installment Loan or Mortgage : (I/M)";:LOCATE 5,42
9040 TYPE$=INKEY$:GOSUB 5240
9050 IF TYPE$<>"I" AND TYPE$<>"M" AND TYPE$<>"i" AND TYPE$<>"m" THEN 9040
9055 IF TYPE$="i" THEN TYPE$="I" ELSE IF TYPE$="m" THEN TYPE$="M"
9060 PRINT TYPE$;
9140 RETURN 1020
9150 LOCATE 5,1:PRINT "Installment Loan or Mortgage : ";:LOCATE 5,42: PRINT TYPE$;" (I/M)";:RETURN
9300 PARLINE=6 : SOUND 1046.5,1 :GOSUB 30140:GOSUB 5000
9310 IF F$="" THEN 9330
9320 FBALL$=F$: GOTO 9350
9330 LOCATE F(PARLINE,1),F(PARLINE,2): PRINT TEMP$;
9350 PARLINE=1:RETURN
10000 CLS: LOCATE 2,18:PRINT "L O A N A N A L Y Z E R -- SPECIFICATION": LOCATE 3,18: PRINT STRING$(44,"=");: RETURN
11000 IF TYPE$= "M" THEN 11300
11120 ON MISS GOTO 11130,11160,11190,11500,11240
11130 A=FNIA(FBALL,N,P,R): A= FNCN(A): GOTO 11500
11160 R= FNIR(A,FBALL,N,P): ANINT=100*R*PFQ:GOTO 11500
11190 N= FNIN(A,FBALL,P,R): N=FNCN(N): DUR=N:DUR= N/PFQ : DUR= FNCN(DUR):GOSUB 30050:GOTO 11500
11240 P= FNIP(A,FBALL,N,R):P= FNCN(P):GOTO 11500
11300 ON MISS GOTO 11310,11340,11380,11500,11430
11310 A= FNMA(FBALL,N,P,R):A= FNCN(A):GOTO 11500
11340 GOSUB 30300:ANINT=100*R*PFQ:GOTO 11500
11380 N= FNMN(A,FBALL,P,R):N=FNCN(N):DUR=N:DUR=DUR/PFQ : DUR= FNCN(DUR):GOTO 11500
11430 P= FNMP(A,FBALL,N,R):P= FNCN(P)
11500 IF MISS=1 THEN P$(1) = STR$(A): P$(1)=MID$(P$(1),2,LEN(P$(1))-1)
11520 IF MISS=2 THEN P$(2)= STR$(ANINT): P$(2)=MID$(P$(2),2,LEN(P$(2))-1)
11530 IF MISS=3 THEN GOSUB 30050
11540 IF MISS=4 THEN P$(4)= PFQ$
11550 IF MISS=5 THEN P$(5)= STR$(P): P$(5)= MID$(P$(5),2,LEN(P$(5))-1)
11560 PARSET(MISS)=1
11700 RETURN
12000 KEY(1) OFF:KEY(2) OFF:KEY(6) OFF:LOCATE 19,75 :PRINT " ";:IF GOOD=FALSE OR MISS=0 THEN RETURN 1200
12030 GOSUB 11000:GOSUB 6000:LOCATE 23,1:CONS=0
12060 PRINT "Detailed Payback Schedule (Y/N) ? ";
12070 GOSUB 5240:T$=INKEY$:IF T$="" GOTO 12070
12085 IF ASC(T$)>90 THEN T$=CHR$(ASC(T$)-32)
12090 IF T$<>"N" AND T$<>"Y" THEN 12070 ELSE PRINT T$;
12091 IF T$="N" THEN LOCATE 23,1:PRINT SPC(79);:RETURN 1200
12092 IF N/PFQ<=60 THEN 12098
12093 LOCATE 23,1:PRINT "Too many periods, ...hit a key ";
12095 T$=INKEY$:IF T$="" THEN 12095
12096 LOCATE 23,1:PRINT SPC(79);:RETURN 1200
12098 IF PFQ=1 THEN 12120
12099 IF N<=60 THEN 12120
12100 CONS=1
12120 IF TYPE$="M" THEN GOSUB 15400 ELSE GOSUB 19000
12125 IF TYPE$="I" THEN ERASE PTABLE1 ELSE ERASE PTABLE2
12130 CLS: GOSUB 10000: GOSUB 9150:GOSUB 6000:RETURN 1200
13000 KEY(1) OFF:KEY(2) OFF:KEY(6) OFF:LOCATE 19,75:PRINT " ";:GOSUB 10000:GOSUB 9000:RETURN 1030
13050 KEY(3) OFF:KEY(4) OFF:KEY(5) OFF:KEY(7) OFF:IF (I=TABLESIZE AND TYPE$="M") THEN RETURN 15630 ELSE IF I=TABLESIZE THEN RETURN 19152
13070 IF TYPE$="M" THEN RETURN 15640 ELSE RETURN 19160
13080 KEY(3) OFF:KEY(4) OFF:KEY(5) OFF:KEY(7) OFF:IF (I<=12 AND TYPE$="M") THEN RETURN 15630 ELSE IF I<=12 THEN RETURN 19152
13100 GOSUB 30000
13120 IF TYPE$ = "M" THEN RETURN 15640 ELSE RETURN 19160
13140 KEY(3) OFF:KEY(4) OFF:KEY(5) OFF:KEY(7) OFF:RETURN 12125
13170 KEY(1) OFF:KEY(2) OFF:KEY(6) OFF:CLS
13180 KEY 1,"LIST ":KEY 2,"RUN"+CHR$(13): KEY 3,"LOAD"+CHR$(34): KEY 4,"SAVE"+CHR$(34): KEY 5,"CONT"+CHR$(13): KEY 6,"RUN"+CHR$(34)+"MENU.BAT"+CHR$(13):KEY 7,"TRON"+CHR$(13): KEY 8,"TROFF"+CHR$(13): KEY 9,"KEY ": KEY 10,"SCREEN 0,0,0"+CHR$(13): KEY ON: E
13200 KEY(3) OFF:KEY(4) OFF:KEY(5) OFF:KEY(7) OFF:IF TYPE$="I" THEN GOSUB 25000:RETURN 19140
13230 GOSUB 26000 : RETURN 15615
14000 CLS: LOCATE 1,12: PRINT "L O A N A N A L Y Z E R -- MORTGAGE PAYBACK SCHEDULE";: LOCATE 2,12:PRINT STRING$(56,"=")
14510 LOCATE 4,16: PRINT "Amount: $ ";: PRINT USING "#######.##";A;:LOCATE 5,2 : PRINT "Final Balloon Payment: $ ";: PRINT USING "#######.##";FBALL;
14520 LOCATE 6,5 : PRINT "Payment per Period: $ ";: PRINT USING "#######.##";P;:LOCATE 4,44 : PRINT "Annual Interest Rate: ";: PRINT USING "##.###";ANINT;: LOCATE 4,74: PRINT "%";
14530 LOCATE 5,43 : PRINT "Duration of Borrowing: ";P$(3);: LOCATE 5,74: PRINT "YY,MM";:LOCATE 6,47: PRINT "Payment Frequency: ";
14536 IF PFQ$="Y" THEN PRINT "Yearly"; : GOTO 14600
14537 IF PFQ$="Q" THEN PRINT "Quarterly";: GOTO 14600
14538 PRINT "Monthly";
14600 LOCATE 8,8
14700 PRINT " | Current | Current | Cumul. | Cumul. | Unpaid"
14800 REM
14810 IF PFQ$="Y" OR CONS=1 THEN PD$="Year ": GOTO 14840
14820 IF PFQ$="Q" THEN PD$="Quarter ": GOTO 14840
14830 PD$="Month "
14840 LOCATE 9,3 : PRINT PD$;
14890 LOCATE 9,11
14900 PRINT "| Principal | Interest | Principal | Interest | Principal"
15000 LOCATE 10, 3: PRINT STRING$(76,"_"):RETURN
15400 GOSUB 14000: GOSUB 17000:IF CONS=1 THEN LOCATE 7,21: PRINT "Periods represent annual consolidation";
15450 FOR I= 1 TO TABLESIZE
15480 LOCATE 11+(I-1) MOD 12,5: PRINT I;: LOCATE 11+(I-1) MOD 12,11: PRINT "|";
15500 LOCATE 11+(I-1) MOD 12,13: IF I= TABLESIZE THEN TABLE2(I,1)=A-FBALL-TABLE2(I-1,3)
15510 PRINT USING "#######.##";TABLE2(I,1);:LOCATE 11+ (I-1) MOD 12,25: PRINT "|";:LOCATE 11+(I-1) MOD 12,27
15525 IF I=TABLESIZE THEN TABLE2(I,2)=N*P-A+FBALL-TABLE2(I-1,4)
15530 PRINT USING "#######.##";TABLE2(I,2);:LOCATE 11+(I-1) MOD 12,39: PRINT "|";:LOCATE 11+(I-1) MOD 12 ,41
15565 IF I=TABLESIZE THEN TABLE2(I,3)=A-FBALL
15570 PRINT USING "#######.##"; TABLE2(I,3);:LOCATE 11+(I-1) MOD 12,53: PRINT "|";: LOCATE 11+(I-1) MOD 12,55:IF I=TABLESIZE THEN TABLE2(I,4)=TABLE2(I-1,4)+TABLE2(I,2)
15575 PRINT USING "#######.##";TABLE2(I,4);
15601 LOCATE 11+(I-1) MOD 12,67: PRINT "|";
15602 LOCATE 11+(I-1) MOD 12,69
15603 IF I=TABLESIZE THEN PRINT USING "#######.##";FBALL;:GOTO 15610
15605 PRINT USING "#######.##";TABLE2(I,5);
15610 IF I/12<>INT(I/12) THEN 15676
15615 LOCATE 23,1: PRINT "F3 - next 12 periods. F4 - previous 12 periods. PrtSc - print. F5 - return.": PRINT "F7 - detail report.";
15630 KEY(3) ON:KEY(4) ON:KEY(5) ON:KEY(7) ON
15632 FOR K=1 TO 20: NEXT K: GOTO 15632
15640 FOR K=11 TO 22: LOCATE K,1:PRINT SPC(79);:NEXT K
15676 IF I=TABLESIZE THEN 15615
15700 NEXT I
16000 DIM PTABLE1(N+1,3): CUMPRIN=0:CUMINT=0: N1=N: LIM=N/PFQ: A1=A: T= N*(N+1)/2: LIN=0
16075 IF N/T*(N*P-A) >P THEN LIN=1
16080 FOR J= 1 TO N1
16090 IF LIN=0 THEN CURINT=(N*P-A+FBALL)*(N+1-J)/T ELSE CURINT=(N*P-A+FBALL)/N
16120 CURPRIN=P-CURINT:CUMPRIN=CUMPRIN+CURPRIN:CUMINT=CUMINT+CURINT:CURPRIN=FNCN(CURPRIN):CURINT=FNCN(CURINT):CUMPRIN=FNCN(CUMPRIN):CUMINT=FNCN(CUMINT):PAYOFF=A+FBALL-CUMPRIN:PAYOFF=FNCN(PAYOFF)
16265 IF CONS<>1 THEN 16400
16270 IF J/PFQ<>INT(J/PFQ) AND J/PFQ<LIM THEN 16450
16275 TABLE1(J/PFQ,1)=CUMPRIN: TABLE1(J/PFQ,2)=CUMINT:TABLE1(J/PFQ,3)=PAYOFF:GOTO 16450
16400 TABLE1(J,1)= CUMPRIN:TABLE1(J,2)= CUMINT: TABLE1(J,3)= PAYOFF
16450 PTABLE1(J,1)= CUMPRIN :PTABLE1(J,2)= CUMINT: PTABLE1(J,3)= PAYOFF
16500 NEXT J
16520 IF CONS=0 THEN TABLESIZE=N: GOTO 16535
16530 IF LIM<>INT(LIM) THEN TABLESIZE=INT(LIM+1) ELSE TABLESIZE=LIM
16535 IF TABLESIZE<>INT(TABLESIZE) THEN TABLESIZE=INT(TABLESIZE+1)
16540 PTABLESIZE=N
16545 IF PTABLESIZE<>INT(PTABLESIZE) THEN PTABLESIZE=INT(PTABLESIZE+1)
16700 RETURN
17000 DIM PTABLE2(N+1,5): CUMPRIN= 0: CUMINT= 0: A1=A:N1=N : LIM =N/PFQ: T=0
17030 FOR J= 1 TO N
17050 CURINT=A1*R: CURPRIN= P- CURINT:CUMPRIN=CUMPRIN+ CURPRIN: CUMINT=CUMINT+CURINT: A1=A1-CURPRIN: CURPRIN= FNCN(CURPRIN): CURINT=FNCN(CURINT):CUMPRIN=FNCN(CUMPRIN): CUMINT=FNCN(CUMINT)
17210 IF CONS<>1 THEN 17300
17220 IF J/PFQ<>INT(J/PFQ) AND J/PFQ<LIM THEN 17350
17222 T=T+1: TABLE2(J/PFQ,1)=CUMPRIN- TABLE2(T-1,3):TABLE2(J/PFQ,2)=CUMINT-TABLE2(T-1,4): TABLE2(J/PFQ,3)=CUMPRIN: TABLE2(J/PFQ,4)=CUMINT:TABLE2(J/PFQ,5)= A- CUMPRIN: GOTO 17350
17300 TABLE2(J,1)= CURPRIN: TABLE2(J,2)= CURINT:TABLE2(J,3)= CUMPRIN:TABLE2(J,4)= CUMINT: TABLE2(J,5)=A- CUMPRIN
17350 PTABLE2(J,1)=CURPRIN: PTABLE2(J,2)=CURINT: PTABLE2(J,3)= CUMPRIN:PTABLE2(J,4)= CUMINT: PTABLE2(J,5)=A- CUMPRIN
17500 NEXT J
17510 IF CONS=0 THEN TABLESIZE=N: GOTO 17525
17520 IF LIM<>INT(LIM) THEN TABLESIZE=INT(LIM+1) ELSE TABLESIZE=LIM
17525 IF TABLESIZE<>INT(TABLESIZE) THEN TABLESIZE=INT(TABLESIZE+1)
17530 PTABLESIZE=N
17540 IF PTABLESIZE<>INT(PTABLESIZE) THEN PTABLESIZE=INT(PTABLESIZE+1)
17600 RETURN
18000 CLS: LOCATE 1,9:PRINT "L O A N A N A L Y Z E R -- INSTALLMENT LOAN PAYBACK SCHEDULE";:LOCATE 2,9:PRINT STRING$(64,"=");
18060 LOCATE 4,17 : PRINT "Amount: $ ";: PRINT USING "#######.##";A;:LOCATE 5,2 : PRINT "Final Balloon Payment: $ ";: PRINT USING "#######.##";FBALL;
18080 LOCATE 6,5 : PRINT "Payment per Period: $ ";: PRINT USING "#######.##";P;:LOCATE 4,45: PRINT "Annual Interest Rate: ";:PRINT USING "##.###";ANINT;: LOCATE 4,74 : PRINT "%";
18100 LOCATE 5,44 : PRINT "Duration of Borrowing: ";P$(3);: LOCATE 5,74: PRINT "YY,MM";: LOCATE 6,48: PRINT "Payment Frequency: ";
18111 IF PFQ$="Y" THEN PRINT "Yearly";: GOTO 18120
18112 IF PFQ$="Q" THEN PRINT "Quarterly";: GOTO 18120
18113 PRINT "Monthly";
18120 LOCATE 8,17
18130 PRINT " | Cumul. | Cumul. | Pay-Off ";
18131 IF PFQ$="Y" OR CONS=1 THEN PD$="Year ": GOTO 18137
18132 IF PFQ$="Q" THEN PD$="Quarter ": GOTO 18137
18133 PD$="Month "
18137 LOCATE 9,12
18138 PRINT PD$;
18140 LOCATE 9,20
18150 PRINT "| Principal | Interest | Amount ";: LOCATE 10,11
18170 PRINT "--------------------------------------------------";: RETURN
19000 GOSUB 18000: GOSUB 16000
19027 IF CONS=1 THEN LOCATE 7,20: PRINT "Periods represent annual consolidation";
19028 IF LIN=1 THEN LOCATE 7,60: PRINT " ( Linear Decline )";
19030 FOR I=1 TO TABLESIZE
19040 LOCATE 11+(I-1) MOD 12,13: PRINT I;: LOCATE 11+(I-1) MOD 12,20 : PRINT "|";
19060 LOCATE 11+(I-1) MOD 12,22: IF I=TABLESIZE THEN TABLE1(I,1)=A-FBALL
19070 PRINT USING "#######.##";TABLE1(I,1);
19080 LOCATE 11+(I-1) MOD 12,34 : PRINT "|";: LOCATE 11+(I-1) MOD 12,36
19095 IF I=TABLESIZE THEN TABLE1(I,2)=P*N-A+FBALL
19100 PRINT USING "#######.##";TABLE1(I,2);: LOCATE 11+(I-1) MOD 12,48 : PRINT "|";
19120 LOCATE 11+(I-1) MOD 12,50:IF I=TABLESIZE THEN PRINT USING "#######.##";FBALL:GOTO 19135
19130 PRINT USING "#######.##";TABLE1(I,3);
19135 IF I/12<>INT(I/12) THEN 19195
19140 LOCATE 23,1:PRINT "F3 - next 12 periods. F4 - previous 12 periods. PrtSc - print. F5 - return.":PRINT "F7 - detail report.";
19152 KEY(3) ON:KEY(4) ON:KEY(5) ON:KEY(7) ON
19153 FOR K=1 TO 20: NEXT K: GOTO 19153
19160 FOR K=11 TO 22: LOCATE K,1: PRINT SPC(79);: NEXT K
19195 IF I=TABLESIZE THEN 19140
19700 NEXT I
20000 LPRINT CHR$(12);:LPRINT " L O A N A N A L Y Z E R -- INSTALLMENT LOAN PAYBACK SCHEDULE"
20030 LPRINT " ";STRING$(64,"="): LPRINT:LPRINT: RETURN
20060 LPRINT CHR$(12);: LPRINT SPC(12);"L O A N A N A L Y Z E R -- MORTGAGE PAYBACK SCHEDULE"
20080 LPRINT SPC(12);STRING$(56,"="):LPRINT:LPRINT:RETURN
20090 LPRINT SPC(17);"Amount: $ ";: LPRINT USING "#######.##";A;
20100 LPRINT SPC(9);"Annual Interest Rate: ";: LPRINT USING "##.###";ANINT;: LPRINT " %":LPRINT SPC(2);"Final Balloon Payment: $ ";: LPRINT USING "#######.##";FBALL;
20120 LPRINT SPC(8);"Duration of Borrowing: ";: LPRINT P$(3);" ";"YY,MM":LPRINT SPC(5);"Payment per Period: $ ";:LPRINT USING "#######.##";P;:LPRINT SPC(12);"Payment Frequency: ";
20141 IF PFQ$="Y" THEN LPRINT "Yearly": GOTO 20145
20142 IF PFQ$="Q" THEN LPRINT "Quarterly": GOTO 20145
20143 LPRINT "Monthly"
20145 IF TYPE$="I" AND LIN=1 THEN LPRINT SPC(33);"(Linear Decline)": GOTO 20160
20150 LPRINT
20160 LPRINT
20165 RETURN
20170 LPRINT SPC(22);" | Cumul. | Cumul. | Pay-Off "
20190 IF PFQ$="Y" THEN PD$="Year ": GOTO 20230
20200 IF PFQ$="Q" THEN PD$="Quarter ": GOTO 20230
20210 PD$="Month "
20230 LPRINT SPC(17);PD$;
20240 LPRINT "| Principal | Interest | Amount ":LPRINT SPC(16);STRING$(51,"_"): RETURN
20280 LPRINT SPC(7);" | Current | Current | Cumul. | Cumul. | Unpaid"
20290 IF PFQ$="Y" THEN PD$="Year ": GOTO 20320
20300 IF PFQ$="Q" THEN PD$="Quarter ": GOTO 20320
20310 PD$="Month "
20320 LPRINT SPC(2);PD$;
20330 LPRINT "| Principal | Interest | Principal | Interest | Principal"
20340 LPRINT SPC(2);STRING$(76,"_"): RETURN
25000 GOSUB 20000: GOSUB 20090: GOSUB 20170
25100 FOR K=1 TO PTABLESIZE
25110 LPRINT SPC(18);: LPRINT USING "####";K;: LPRINT SPC(3);"|";: LPRINT " ";
25140 IF K= PTABLESIZE THEN PTABLE1(K,1)=A-FBALL
25150 LPRINT USING "#######.##";PTABLE1(K,1);: LPRINT SPC(2);"|";:LPRINT " ";
25180 IF K=PTABLESIZE THEN PTABLE1(K,2)=P*N-A+FBALL
25190 LPRINT USING "#######.##";PTABLE1(K,2);:LPRINT SPC(2);"|";: LPRINT " ";
25220 IF K=PTABLESIZE THEN LPRINT USING "#######.##";FBALL:GOTO 25240
25230 LPRINT USING "#######.##";PTABLE1(K,3)
25240 IF K/48<>INT(K/48) THEN 25260
25245 IF K=N THEN 25260
25250 LPRINT CHR$(12); : LPRINT :LPRINT :LPRINT : GOSUB 20170
25260 NEXT K
25999 RETURN
26000 GOSUB 20060:GOSUB 20090:GOSUB 20280
26050 FOR K=1 TO PTABLESIZE
26060 LPRINT SPC(3);: LPRINT USING "####";K;:LPRINT SPC(3);: LPRINT "|";:LPRINT " ";
26110 IF K=PTABLESIZE THEN PTABLE2(K,1)=A-FBALL-PTABLE2(K-1,3)
26120 LPRINT USING "#######.##";PTABLE2(K,1);: LPRINT SPC(2);"|";:LPRINT " ";
26150 IF K=PTABLESIZE THEN PTABLE2(K,2)=N*P-A+FBALL-PTABLE2(K-1,4)
26160 LPRINT USING "#######.##";PTABLE2(K,2);: LPRINT SPC(2);"|";: LPRINT " ";
26190 IF K=PTABLESIZE THEN PTABLE2(K,3)=A-FBALL
26200 LPRINT USING "#######.##";PTABLE2(K,3);:LPRINT SPC(2);"|";:LPRINT " ";
26230 IF K=PTABLESIZE THEN PTABLE2(K,4)= PTABLE2(K-1,4)+ PTABLE2(K,2)
26240 LPRINT USING "#######.##";PTABLE2(K,4);:LPRINT SPC(2);"|";
26255 IF K=PTABLESIZE THEN LPRINT USING "#######.##";FBALL:GOTO 26270
26260 LPRINT USING "#######.##";PTABLE2(K,5)
26270 IF K/48<>INT(K/48) THEN 26500
26275 IF K=N THEN 26500
26280 LPRINT CHR$(12): LPRINT : LPRINT :LPRINT :GOSUB 20280
26500 NEXT K
26999 RETURN
30000 IF I<=12 THEN RETURN
30020 IF I/12<> INT(I/12) THEN I= INT(I/12)*12-12: GOTO 30040
30030 I=I-24
30040 RETURN
30050 YY$=STR$(INT(DUR)): MM$=STR$(CINT((DUR-INT(DUR))*12)):YY$=MID$(YY$,2,LEN(YY$)): MM$=MID$(MM$,2,LEN(MM$))
30100 IF LEN(YY$)<2 THEN YY$="0"+YY$
30110 IF LEN(MM$)<2 THEN MM$="0"+MM$
30120 P$(3)=YY$++"," +MM$
30130 RETURN
30140 X=F(PARLINE,2): Y=F(PARLINE,1): FL=F(PARLINE,3): TEMP$=""
30160 FOR K=X TO X+FL-1
30170 TEMP$=TEMP$+CHR$(SCREEN(Y,K))
30180 NEXT K
30190 RETURN
30200 DEF FNCN(X)=FIX(100*X+0.5)/100
30210 DEF FNMAN(B,N,P,R) = P+ (B*R*(1+R)^N) / ((1+R)^N-1) -R*B: DEF FNMAD(B,N,P,R) = R*(1+R)^N / ((1+R)^N-1) : DEF FNMA(B,N,P,R)= FNMAN(B,N,P,R)/ FNMAD(B,N,P,R)
30260 REM NEWTON ROUTINE
30270 DEF FNF(S)=A*S^(N+1)-(A+P)*S^N-FBALL*S+FBALL+P: DEF FNG(S)=A*(N+1)*S^N-(A+P)*N*S^(N-1)-FBALL
30290 GOTO 30340
30300 S=1.1
30310 IF FNF(S)<=0.01 THEN R= S-1 : RETURN
30320 S=S- FNF(S)/FNG(S)
30330 GOTO 30310
30340 DEF FNMN(A,B,P,R) = LOG( R*(A-B)/(P-R*B-R*(A-B)) +1)/ LOG (1+R): DEF FNMP(A,B,N,R) = (A-B)*R*(1+R)^N/ ((1+R)^N-1)+R*B
30390 DEF FNIA(B,N,P,R)= (P*N+B)/(1+R*N):DEF FNIR(A,B,N,P)= (P*N+B-A)/(N*A): DEF FNIN(A,B,P,R)= (A-B)/(P-R*A): DEF FNIP(A,B,N,R)= (A-B+R*N*A)/N
30430 RETURN
40000 CHAIN "MENU.BAT"
40010 LOCATE 24,25: PRINT "Printer problem, please check , hit a key to re-try";
40020 T$=INKEY$: IF T$="" THEN 40020
40030 LOCATE 24,25: PRINT SPC(52);: RESUME
MORTGAGE.BAS
10 '1/20/84 12:30 PM
20 KEY OFF:CLEAR ,36000!:WIDTH 80:SCREEN 0,0,0:ON ERROR GOTO 410
30 KEY(10) ON:ON KEY(10) GOSUB 35
33 GOTO 40
35 RUN'MENU.BAT
40 KEY(10) ON:LA$="╔":FOR I=1 TO 37:LA$=LA$+"═":NEXT
50 LA$=LA$+"╤╤":FOR I=1 TO 37:LA$=LA$+"═":NEXT:LA$=LA$+"╗"
60 LB$="╚":FOR I=1 TO 37:LB$=LB$+"═":NEXT
70 LB$=LB$+"╧╧":FOR I=1 TO 37:LB$=LB$+"═":NEXT:LB$=LB$+"╝"
80 CLS:DEF SEG:POKE 106,0
90 COLOR 15,0:FOR I=1 TO 3 STEP 2:FOR J=20 TO 62:LOCATE I,J,0:PRINT "─":NEXT:NEXT
110 LOCATE 2,19:PRINT"│"SPC(43)"│"
120 COLOR 0,7:LOCATE 2,29:PRINT" B O B T O L S O N ":COLOR 3,0
170 LOCATE 9,27:COLOR 0,7:PRINT" A ";:COLOR 3,0:PRINT" Present / Future Value"
180 LOCATE 12,27:COLOR 0,7:PRINT" B ";:COLOR 3,0:PRINT" Amortization Analysis"
190 LOCATE 15,27:COLOR 0,7:PRINT" C ";:COLOR 3,0:PRINT" EXIT to Main Menu "
230 LOCATE 19,13:COLOR 15,0:PRINT"*****";:COLOR 3:PRINT" Strike Key Corresponding To Function Desired ";:COLOR 15:PRINT"*****":COLOR 3
290 POKE 106,0
300 RS$=INKEY$:IF RS$="" THEN 300
330 IF RS$="B" OR RS$="b" THEN 450
370 IF RS$="A" OR RS$="a" THEN 3480
390 IF RS$="C" OR RS$="c" THEN RUN"MENU.BAT
400 GOTO 300
410 IF ERR=53 THEN RUN"menu
420 IF ERR=6 THEN RESUME NEXT
430 ON ERROR GOTO 0
440 RETURN
450 GOTO 500
460 POKE 106,0
470 IF INKEY$<>"" THEN 460
480 RS$=INKEY$:IF RS$="" THEN 480
490 RETURN
500 AMNT#=0:IST#=0:TNT#=0:TMT#=0:MD=0:PYMT#=0:NB=0:YS=0:PF#=0
510 GOSUB 640
520 GOSUB 700
530 GOSUB 460
540 IF (RS$<"a" OR RS$>"e") AND (RS$<"A" OR RS$>"E") THEN 530
550 IF RS$="A" OR RS$="a" THEN HD$="Calculate Interest Rate ":GOTO 600
560 IF RS$="B" OR RS$="b" THEN HD$="Calculate Payment Amount":GOTO 610
570 IF RS$="C" OR RS$="c" THEN HD$=" Calculate Loan Amount ":GOTO 620
580 IF RS$="D" OR RS$="d" THEN HD$=" Calculate Loan Payoff ":GOTO 630
590 IF RS$="E" OR RS$="e" THEN 40
600 GOSUB 640:GOSUB 790:GOSUB 930:GOSUB 950:GOSUB 970:GOSUB 990:GOSUB 1150:GOSUB 1050:GOSUB 780:GOSUB 460:GOTO 500
610 GOSUB 640:GOSUB 790:GOSUB 930:GOSUB 970:GOSUB 990:GOSUB 1010:GOSUB 1300:GOSUB 1050:GOSUB 780:GOSUB 460:GOTO 500
620 GOSUB 640:GOSUB 790:GOSUB 950:GOSUB 970:GOSUB 990:GOSUB 1010:GOSUB 1380:GOSUB 1050:GOSUB 780:GOSUB 460:GOTO 500
630 GOSUB 640:GOSUB 790:GOSUB 930:GOSUB 950:GOSUB 990:GOSUB 1010:GOSUB 1030:GOSUB 1460:GOSUB 1050:GOSUB 780:GOSUB 460:GOTO 500
640 CLS:PRINT:COLOR 0,7:PRINT" F10 ";:COLOR 7,0:PRINT" To Menu":COLOR 11,0
650 FOR I=1 TO 3 STEP 2:FOR J=20 TO 62:LOCATE I,J,0:PRINT"─":NEXT:NEXT
660 LOCATE 1,19:PRINT"┌":LOCATE 1,63:PRINT"┐":LOCATE 3,63:PRINT"┘":LOCATE 3,19:PRINT"└"
670 LOCATE 2,19:PRINT"│"SPC(43)"│"
680 COLOR 0,7
690 LOCATE 2,29:PRINT" A M O R T I Z A T I O N ":COLOR 7,0:RETURN
700 COLOR 11,0:LOCATE 5,30:PRINT"Functions Available"
710 PRINT;TAB(30);"--------------------"
720 LOCATE 8,26:COLOR 0,7:PRINT" A ";:COLOR 7,0:PRINT" Calculate interest rate"
730 LOCATE 10,26:COLOR 0,7:PRINT" B ";:COLOR 7,0:PRINT" Calculate payment amount"
740 LOCATE 12,26:COLOR 0,7:PRINT" C ";:COLOR 7,0:PRINT" Calculate loan amount"
750 LOCATE 14,26:COLOR 0,7:PRINT" D ";:COLOR 7,0:PRINT" Calculate loan payoff"
760 LOCATE 16,26:COLOR 0,7:PRINT" E ";:COLOR 7,0:PRINT" Return to main menu"
770 COLOR 11,0:LOCATE 23,12,0:PRINT"***** Strike Key Corresponding To Function Desired *****":COLOR 7,0:RETURN
780 LOCATE 25,22,0:PRINT"***** Strike Key To Return To Menu *****";:COLOR 7,0:RETURN
790 COLOR 11,0:LOCATE 4,30:PRINT HD$:COLOR 7,0
800 LOCATE 5,11:PRINT"╔";:FOR I=1 TO 58:PRINT"═";:NEXT:PRINT"╗"
810 FOR J=6 TO 23:LOCATE J,70:PRINT"║":NEXT:LOCATE J,70:PRINT"╝";
820 FOR J=69 TO 12 STEP -1:LOCATE 24,J:PRINT"═";:NEXT:LOCATE 24,11:PRINT"╚";
830 FOR J=23 TO 6 STEP -1:LOCATE J,11:PRINT"║":NEXT
840 LOCATE 6,16:PRINT"Loan Amount"
850 LOCATE 8,16:PRINT"Payment Amount"
860 LOCATE 10,16:PRINT"Number Of Years"
870 LOCATE 12,16:PRINT"No. Payments Per Year"
880 LOCATE 14,16:PRINT"Interest Rate"
890 LOCATE 16,16:PRINT"No. Payments made"
900 LOCATE 18,16:PRINT"Payoff Amount"
910 LOCATE 20,16:PRINT"Total Interest Paid"
920 LOCATE 22,16:PRINT"Total Amount To Pay":RETURN
930 LOCATE 6,16,1:COLOR 11,0:PRINT"Loan Amount ";
940 GOSUB 1550:AMNT#=VAL(ZA):IF AMNT#=0 THEN 930 ELSE RETURN
950 LOCATE 8,16,1:COLOR 11,0:PRINT"Payment Amount ";
960 GOSUB 1550:PYMT#=VAL(ZA):IF PYMT#=0 THEN 950 ELSE RETURN
970 LOCATE 10,16,1:COLOR 11,0:PRINT"Number Of Years ";
980 GOSUB 6350:YS=VAL(ZA):IF YS=0 THEN 970 ELSE RETURN
990 LOCATE 12,16,1:COLOR 11,0:PRINT"No. Payments Per Year ";
1000 GOSUB 6350:NB=VAL(ZA):IF NB=0 THEN 990 ELSE RETURN
1010 LOCATE 14,16,1:COLOR 11,0:PRINT"Interest Rate ";
1020 DEC=3:GOSUB 1550:IST#=VAL(ZA):IF IST#=0 THEN 1010 ELSE RETURN
1030 LOCATE 16,16,1:COLOR 11,0:PRINT"No. Payments Made ";
1040 GOSUB 6350:MD=VAL(ZA):RETURN
1050 LOCATE 6,16:PRINT USING"Loan Amount $$################,.##";AMNT#
1060 LOCATE 8,16:PRINT USING"Payment Amount $$################,.##";PYMT#
1070 LOCATE 10,16:PRINT USING"Number Of Years ################,.#";YS
1080 LOCATE 12,16:PRINT USING"No. Payments Per Year #############,###";NB
1090 LOCATE 14,16:PRINT USING"Interest Rate ################,.##%";IST#;
1100 IF SW THEN PRINT" +":SW=0
1110 LOCATE 16,16:PRINT USING"No. Payments made ############,####";MD
1120 LOCATE 18,16:PRINT USING"Payoff Amount $$#################,.##";PF#
1130 LOCATE 20,16:PRINT USING"Total Interest Paid $$#################,.##";TNT#
1140 LOCATE 22,16:PRINT USING"Total Amount To Pay $$#################,.##";TMT#:RETURN
1150 X1#=0:X2#=1:IST#=0.5
1160 I#=(AMNT#*IST#)/(PYMT#*NB)-1+(1/((1+(IST#/NB))^(YS*NB)))
1170 IF ABS(ABS(I#)-1.000000e-10)<5.000000e-10 GOTO 1250
1180 IF I#>0 THEN 1230
1190 IF HH#=I# THEN IST#=1:SW=1:GOTO 1250 ELSE HH#=I#
1200 X1#=IST#
1210 IST#=(X1#+X2#)/2
1220 GOTO 1160
1230 X2#=IST#
1240 GOTO 1210
1250 TMT#=YS*PYMT#*NB
1260 TNT#=TMT#-AMNT#
1270 PF#=AMNT#
1280 IST#=(INT(IST#*10000+0.5))/100
1290 RETURN
1300 IST#=IST#/100
1310 PYMT#=((AMNT#*IST#)/NB)/(1-(1/(((1+(IST#/NB))^(YS*NB)))))
1320 PYMT#=(INT(PYMT#*100+0.5))/100
1330 TMT#=YS*PYMT#*NB
1340 IST#=IST#*100
1350 TNT#=TMT#-AMNT#
1360 PF#=AMNT#
1370 RETURN
1380 IST#=IST#/100
1390 AMNT#=PYMT#*((1-(1/((1+(IST#/NB))^(YS*NB))))/(IST#/NB))
1400 AMNT#=(INT(AMNT#*100+0.5))/100
1410 TMT#=YS*PYMT#*NB
1420 PF#=AMNT#
1430 TNT#=TMT#-AMNT#
1440 IST#=IST#*100
1450 RETURN
1460 IST#=IST#/100
1470 PF#=AMNT#*((1+(IST#/NB))^MD)-PYMT#*((1-((1+(IST#/NB))^MD))/(-(IST#/NB)))
1480 PF#=(INT(PF#*100+0.5))/100
1490 IST#=IST#*100
1500 TMT#=PF#
1510 TNT#=PF#-(AMNT#-PYMT#*MD)
1520 TNT#=(INT(TNT#*100+0.5))/100
1530 RETURN
1540 COLOR 7,0:GOTO 40
1550 GOTO 6040
1560 GOTO 1570
1570 GOSUB 1580:GOSUB 1690:GOSUB 1680:GOSUB 460:GOTO 1570
1580 CLS:PRINT:COLOR 0,7:PRINT" F10 ";:COLOR 7,0:PRINT" To Menu":COLOR 11,0
1590 FOR I=1 TO 3 STEP 2:FOR J=20 TO 62:LOCATE I,J,0:PRINT"─":NEXT:NEXT
3480 GOTO 3490
3490 AMNT#=0:IST#=0:TNT#=0:TMT#=0:MD=0:PYMT#=0:NB=0:YS=0:PRS#=0
3500 GOSUB 3630
3510 GOSUB 3680
3520 GOSUB 460
3530 IF (RS$<"a" OR RS$>"e") AND (RS$<"A" OR RS$>"E") THEN 3520
3540 IF RS$="A" OR RS$="a" THEN HD$="Calculate Present Value ":GOTO 3590
3550 IF RS$="B" OR RS$="b" THEN HD$="Calculate Future Value ":GOTO 3600
3560 IF RS$="C" OR RS$="c" THEN HD$=" Calculate Interest Rate":GOTO 3610
3570 IF RS$="D" OR RS$="d" THEN HD$="Calculate No. Of Years ":GOTO 3620
3580 IF RS$="E" OR RS$="e" THEN 40
3590 GOSUB 3630:GOSUB 3770:GOSUB 3890:GOSUB 3930:GOSUB 3950:GOSUB 4040:GOSUB 3990:GOSUB 3760:GOSUB 460:GOTO 3490
3600 GOSUB 3630:GOSUB 3770:GOSUB 3870:GOSUB 3930:GOSUB 3950:GOSUB 4070:GOSUB 3990:GOSUB 3760:GOSUB 460:GOTO 3490
3610 GOSUB 3630:GOSUB 3770:GOSUB 3870:GOSUB 3890:GOSUB 3930:GOSUB 4100:GOSUB 3990:GOSUB 3760:GOSUB 460:GOTO 3490
3620 GOSUB 3630:GOSUB 3770:GOSUB 3870:GOSUB 3890:GOSUB 3950:GOSUB 4490:GOSUB 3990:GOSUB 3760:GOSUB 460:GOTO 3490
3630 CLS
3640 FOR I=1 TO 3 STEP 2:FOR J=20 TO 62:LOCATE I,J,0:PRINT "─":NEXT:NEXT
3650 LOCATE 1,19:PRINT"┌":LOCATE 1,63:PRINT"┐":LOCATE 3,63:PRINT"┘":LOCATE 3,19:PRINT "└"
3660 LOCATE 2,19:PRINT"│"SPC(43)"│":COLOR 0,7
3670 LOCATE 2,21:PRINT" P R E S E N T / F U T U R E V A L U E ":COLOR 7,0:RETURN
3680 COLOR 11,0:LOCATE 5,30,0:PRINT"Functions Available"
3690 PRINT TAB(30)"--------------------"
3700 LOCATE 8,26:COLOR 0,7:PRINT" A ";:COLOR 7,0:PRINT" Calculate Present Value"
3710 LOCATE 10,26:COLOR 0,7:PRINT" B ";:COLOR 7,0:PRINT" Calculate Future Value"
3720 LOCATE 12,26:COLOR 0,7:PRINT" C ";:COLOR 7,0:PRINT" Calculate Interest Rate
3730 LOCATE 14,26:COLOR 0,7:PRINT" D ";:COLOR 7,0:PRINT" Calculate Number Of Years"
3740 LOCATE 16,26:COLOR 0,7:PRINT" E ";:COLOR 7,0:PRINT" Return to main menu"
3750 COLOR 11,0:LOCATE 23,12,0:PRINT"***** Strike Key Corresponding To Function Desired *****":COLOR 7,0:RETURN
3760 LOCATE 25,22,0:PRINT"***** Strike Key To Return To Menu *****";:COLOR 7,0:RETURN
3770 COLOR 11,0:LOCATE 4,30:PRINT HD$:COLOR 7,0
3780 LOCATE 5,11:PRINT"╔";:FOR I=1 TO 58:PRINT"═";:NEXT:PRINT "╗"
3790 FOR J=6 TO 23:LOCATE J,70:PRINT"║":NEXT:LOCATE ,70:PRINT"╝";
3800 FOR J=69 TO 12 STEP -1:LOCATE 24,J:PRINT"═";:NEXT:LOCATE 24,11:PRINT"╚";
3810 FOR J=23 TO 6 STEP -1:LOCATE J,11:PRINT"║":NEXT
3820 LOCATE 8,22:PRINT"Present Value"
3830 LOCATE 11,22:PRINT"Future Value"
3840 LOCATE 14,22:PRINT"Number Of Years"
3850 LOCATE 17,22:PRINT"Interest Rate"
3860 LOCATE 20,22:PRINT"Return on Investment":RETURN
3870 LOCATE 8,22,1:COLOR 11,0:PRINT"Present Value ";
3880 GOSUB 4760:PRS#=VAL(ZA):IF PRS#=0 THEN 3870 ELSE RETURN
3890 LOCATE 11,22,1:COLOR 11,0:PRINT"Future Value ";
3900 GOSUB 4760:FT#=VAL(ZA):IF FT#=0 THEN 3890
3910 IF FT#<=PRS# THEN LOCATE 23,13:PRINT"Future Value Must Be Greater Than Present Value - Retry":FOR I=1 TO 2500:NEXT:LOCATE 23,13:PRINT SPC(55):LOCATE 11,46:PRINT SPC(20):GOTO 3890
3920 RETURN
3930 LOCATE 14,22,1:COLOR 11,0:PRINT"Number Of Years ";
3940 DEC=2:GOSUB 4760:YS=VAL(ZA):IF YS=0 THEN 3930 ELSE RETURN
3950 LOCATE 17,22,1:COLOR 11,0:PRINT"Interest Rate ";
3960 DEC=3:GOSUB 4760:IST#=VAL(ZA):IF IST#=0 THEN 3950 ELSE RETURN
3970 LOCATE 20,22,1:COLOR 11,0:PRINT"Return On Investment ";
3980 GOSUB 4760:RETRN#=VAL(ZA):IF RETRN#=0 THEN 3970 ELSE RETURN
3990 LOCATE 8,22:PRINT USING"Present Value $$############,.##";PRS#
4000 LOCATE 11,22:PRINT USING"Future Value $$############,.##";FT#
4010 LOCATE 14,22:PRINT USING"Number Of Years ###############.##";YS
4020 LOCATE 17,22:PRINT USING"Interest Rate ##############.##%";IST#
4030 LOCATE 20,22:PRINT USING"Return On Investment $$###########,.##";RETRN#:RETURN
4040 PRS#=INT((FT#/((1+IST#/100)^YS)+0.005000001)*100)/100
4050 RETRN#=FT#-PRS#
4060 RETURN
4070 FT#=INT((PRS#*((1+IST#/100)^YS)+0.005000001)*100)/100
4080 RETRN#=FT#-PRS#
4090 RETURN
4100 IST#=5.1:BT#=INT((FT#-FT#*0.0001)*100):TP#=INT((FT#+FT#*0.0001)*100)
4110 GS#=INT((PRS#*((1+IST#/100)^YS)+0.005000001)*100)/100
4120 GS#=INT(GS#*100)
4130 IF GS#>BT# AND GS#<TP# THEN 4470
4140 IF GS#>TP# THEN IST#=IST#-5:GOTO 4170
4150 IST#=IST#+5
4160 GOTO 4110
4170 GS#=INT((PRS#*((1+IST#/100)^YS)+0.005000001)*100)/100
4180 GS#=INT(GS#*100)
4190 IF GS#>BT# AND GS#<TP# THEN 4470
4200 IF GS#>TP# THEN IST#=IST#-1:GOTO 4230
4210 IST#=IST#+1
4220 GOTO 4170
4230 GS#=INT((PRS#*((1+IST#/100)^YS)+0.005000001)*100)/100
4240 GS#=INT(GS#*100)
4250 IF GS#>BT# AND GS#<TP# THEN 4470
4260 IF GS#>TP# THEN IST#=IST#-0.1:GOTO 4290
4270 IST#=IST#+0.1
4280 GOTO 4230
4290 GS#=INT((PRS#*((1+IST#/100)^YS)+0.005000001)*100)/100
4300 GS#=INT(GS#*100)
4310 IF GS#>BT# AND GS#<TP# THEN 4470
4320 IF GS#>TP# THEN IST#=IST#-0.01:GOTO 4350
4330 IST#=IST#+0.01
4340 GOTO 4290
4350 GS#=INT((PRS#*((1+IST#/100)^YS)+0.005000001)*100)/100
4360 GS#=INT(GS#*100)
4370 IF GS#>BT# AND GS#<TP# THEN 4470
4380 IF GS#>TP# THEN IST#=IST#-0.001:GOTO 4410
4390 IST#=IST#+0.001
4400 GOTO 4350
4410 GS#=INT((PRS#*((1+IST#/100)^YS)+0.005000001)*100)/100
4420 GS#=INT(GS#*100)
4430 IF GS#>BT# AND GS#<TP# THEN 4470
4440 IF GS#>TP# THEN 4470
4450 IST#=IST#+0.0001
4460 GOTO 4410
4470 RETRN#=FT#-PRS#
4480 RETURN
4490 YS=1.1
4500 BT#=INT((FT#-FT#*0.005000001)*100)
4510 TP#=INT((FT#+FT#*0.005000001)*100)
4520 GS#=INT((PRS#*((1+IST#/100)^YS)+0.005000001)*100)/100
4530 GS#=INT(GS#*100)
4540 IF GS#>TP# THEN YS=YS-10:GOTO 4570
4550 YS=YS+10
4560 GOTO 4520
4570 GS#=INT((PRS#*((1+IST#/100)^YS)+0.005000001)*100)/100
4580 GS#=INT(GS#*100)
4590 IF GS#>TP# THEN YS=YS-1:GOTO 4620
4600 YS=YS+1
4610 GOTO 4570
4620 GS#=INT((PRS#*((1+IST#/100)^YS)+0.005000001)*100)/100
4630 GS#=INT(GS#*100)
4640 IF GS#>TP# THEN YS=YS-0.5:GOTO 4670
4650 YS=YS+0.5
4660 GOTO 4620
4670 GS#=INT((PRS#*((1+IST#/100)^YS)+0.005000001)*100)/100
4680 GS#=INT(GS#*100)
4690 IF GS#>BT# AND GS#<TP# THEN 4730
4700 IF GS#>TP# THEN 4730
4710 YS=YS+0.05
4720 GOTO 4670
4730 RETRN#=FT#-PRS#
4740 RETURN
4750 GOTO 40
4760 GOTO 6040
4770 GOTO 4780
4780 GOSUB 4790:GOSUB 4900:GOSUB 4890:GOSUB 460:GOTO 4780
4790 CLS:PRINT:COLOR 0,7:PRINT" F10 ";:COLOR 7,0:PRINT" To Menu":COLOR 11,0
4800 FOR I=1 TO 3 STEP 2:FOR J=20 TO 62:LOCATE I,J,0:PRINT "─":NEXT:NEXT
4810 LOCATE 1,19:PRINT"┌":LOCATE 1,63:PRINT"┐":LOCATE 3,63:PRINT"┘":LOCATE 3,19:PRINT"└"
4820 LOCATE 2,19:PRINT"│"SPC(43)"│":COLOR 0,7
4830 LOCATE 2,27:PRINT" R E - O R D E R P O I N T ":COLOR 7,0
4840 COLOR 11,0:LOCATE 4,29:PRINT"Inventory Re-order Point":COLOR 7,0
4850 LOCATE 5,11:PRINT"╔";:FOR I=1 TO 58:PRINT"═";:NEXT:PRINT"╗"
4860 FOR J=6 TO 23:LOCATE J,70:PRINT"║":NEXT:LOCATE ,70:PRINT"╝";
4870 FOR J=69 TO 12 STEP-1:LOCATE 24,J:PRINT"═";:NEXT:LOCATE 24,11:PRINT"╚";
4880 FOR J=23 TO 6 STEP-1:LOCATE J,11:PRINT"║":NEXT:RETURN
4890 COLOR 11,0:LOCATE 25,17,0:PRINT"***** Strike Any Key For Additional Analysis *****";:COLOR 7,0:RETURN
4900 LOCATE 7,18,0:PRINT"Units Used Daily"
4910 LOCATE 9,18:PRINT"Delivery Days Required"
4920 COLOR 11,0:LOCATE 7,18,1:PRINT"Units Used Daily ";
4930 GOSUB 6350
4940 UNITS#=VAL(ZA)
4950 IF UNITS#=0 THEN 4920
4960 LOCATE 9,18,1:PRINT"Delivery Days Required ";
4970 GOSUB 6350:TIME#=VAL(ZA):IF TIME#=0 THEN 4960
4980 LOCATE 7,18,0:PRINT USING"Units Used Daily ##########,##";UNITS#
4990 LOCATE 9,18:PRINT USING"Delivery Days Required ##########,##";TIME#
5000 LOCATE 11,13:PRINT"Safety Margin Minimum Quantity Re-order Point"
5010 MA#=0
5020 MN#=INT(UNITS#*TIME#+0.5)
5030 FOR I=13 TO 21
5040 RO#=INT(MA#*MN#+MN#+0.5)
5050 MA#=INT(MA#*100)
5060 LOCATE I,18:PRINT USING"##% ########,## ########,##";MA#;MN#;RO#
5070 IF I=13 THEN COLOR 7,0
5080 MA#=INT((MA#/100+0.05500001)*100)/100
5090 NEXT
5100 RETURN
5110 GOTO 6040
5120 GOTO 5130
5130 GOSUB 5140:GOSUB 5190:GOTO 5240
5140 CLS:PRINT:COLOR 0,7:PRINT" F10 ";:COLOR 7,0:PRINT" To Menu":COLOR 11,0
5150 FOR I=1 TO 3 STEP 2:FOR J=20 TO 62:LOCATE I,J,0:PRINT"─":NEXT:NEXT
5160 LOCATE 1,19:PRINT"┌":LOCATE 1,63:PRINT"┐":LOCATE 3,63:PRINT"┘":LOCATE 3,19:PRINT"└"
5170 LOCATE 2,19:PRINT"│" SPC(43) "│":COLOR 0,7
5180 LOCATE 2,29:PRINT" S T O C K R A T I O S ":COLOR 7,0:RETURN
5190 COLOR 11,0:LOCATE 4,30,0:PRINT"Enter Known Information"
5200 LOCATE 5,11:PRINT"╔";:FOR I=1 TO 58:PRINT"═";:NEXT:PRINT"╗"
5210 FOR J=6 TO 22:LOCATE J,70:PRINT"║":NEXT:LOCATE ,70:PRINT"╝";
5220 FOR J=69 TO 12 STEP -1:LOCATE 23,J:PRINT"═";:NEXT:LOCATE 23,11:PRINT"╚";
5230 FOR J=22 TO 6 STEP -1:LOCATE J,11:PRINT"║":NEXT:COLOR 7,0:RETURN
5240 LOCATE 6,16:PRINT"Average Inventory"
5250 LOCATE 7,16:PRINT"Current Assets"
5260 LOCATE 8,16:PRINT"Fixed and Long-Term Assets"
5270 LOCATE 9,33:PRINT"Total Assets"
5280 LOCATE 11,16:PRINT"Current Liabilities"
5290 LOCATE 12,16:PRINT"Long-Term Liabilities"
5300 LOCATE 13,28:PRINT"Total Liabilities"
5310 LOCATE 15,16:PRINT"Net Sales"
5320 LOCATE 16,16:PRINT"Cost of Goods Sold"
5330 LOCATE 17,16:PRINT"Total Operating Expenses"
5340 LOCATE 18,35:PRINT"Net Income"
5350 LOCATE 20,16:PRINT"Shareholders Equity"
5360 LOCATE 21,16:PRINT"Shares Outstanding"
5370 LOCATE 22,16:PRINT"Price Per Share
5380 CR#=0:QR#=0:IU#=0:ITR#=0:FAU#=0:TAU#=0:DTE#=0:OP#=0:PWR#=0:NPNS#=0:ROIA#=0:PER#=0:EPS#=0
5390 LOCATE 6,16,1:COLOR 11,0:PRINT"Average Inventory ";
5400 GOSUB 6030:I#=VAL(ZA)
5410 LOCATE 7,16,1:COLOR 11,0:PRINT"Current Assets ";
5420 GOSUB 6030:CA#=VAL(ZA)
5430 LOCATE 8,16,1:COLOR 11,0:PRINT"Fixed And Long Term Assets ";
5440 GOSUB 6030:NFA#=VAL(ZA)
5450 LOCATE 9,33,1:COLOR 11,0:PRINT"Total Assets ";
5460 TA#=CA#+NFA#
5470 PRINT USING"$$###########,.##";TA#
5480 LOCATE 11,16,1:COLOR 11,0:PRINT"Current Liabilities ";
5490 GOSUB 6030:CL#=VAL(ZA)
5500 LOCATE 12,16,1:COLOR 11,0:PRINT"Long Term Liabilities ";
5510 GOSUB 6030:LTD#=VAL(ZA)
5520 LOCATE 13,28,1:COLOR 11,0:PRINT"Total Liabilities ";
5530 TD#=CL#+LTD#
5540 PRINT USING"$$###########,.##";TD#
5550 LOCATE 15,16,1:COLOR 11,0:PRINT"Net Sales ";
5560 GOSUB 6030:S#=VAL(ZA)
5570 LOCATE 16,16,1:COLOR 11,0:PRINT"Cost of Goods Sold ";
5580 GOSUB 6030:COG#=VAL(ZA)
5590 LOCATE 17,16,1:COLOR 11,0:PRINT"Total Operating Expenses ";
5600 GOSUB 6030:OE#=VAL(ZA)
5610 LOCATE 18,35,1:COLOR 11,0:PRINT"Net Income ";
5620 NI#=S#-COG#-OE#
5630 PRINT USING"$$###########,.##";NI#
5640 LOCATE 20,16,1:COLOR 11,0:PRINT"Shareholders Equity ";
5650 GOSUB 6030:SE#=VAL(ZA)
5660 LOCATE 21,16,1:COLOR 11,0:PRINT"Shares Outstanding ";
5670 GOSUB 6350:SO#=VAL(ZA)
5680 LOCATE 22,16,1:COLOR 11,0:PRINT"Price Per Share ";
5690 GOSUB 6030:PPS#=VAL(ZA)
5700 LOCATE 24,18:PRINT"***** Strike Any Key To Calculate Ratios *****";:GOSUB 460:GOSUB 5140:COLOR 11,0:LOCATE 4,31,0:PRINT"These Are Your Ratios":GOSUB 5200
5710 IF CA#>0 AND CL#>0 THEN CR#=CA#/CL#
5720 TA#=CA#+NFA#
5730 IF CL#<>0 AND CA#<>I# THEN QR#=(CA#-I#)/CL#
5740 IF S#>0 AND I#>0 THEN IU#=S#/I#
5750 IF COG#>0 AND I#>0 THEN ITR#=COG#/I#
5760 IF S#>0 AND NFA#<>0 THEN FAU#=S#/NFA#
5770 IF S#>0 AND TA#>0 THEN TAU#=S#/TA#
5780 X1#=(TD#-CL#+SE#)
5790 IF X1#<0.01 THEN ELSE DTE#=(TD#-CL#)/X1#
5800 IF OE#>0 AND S#>0 THEN OP#=OE#/S#
5810 IF SE#<>0 THEN PWR#=NI#/SE#
5820 IF S#<>0 THEN NPNS#=NI#/S#
5830 IF TA#<>0 THEN ROIA#=NI#/TA#
5840 IF SO#<>0 THEN EPS#=NI#/SO#
5850 IF EPS#<>0 THEN PER#=PPS#/EPS#
5860 LOCATE 6,58,0:PRINT"Averages"
5870 LOCATE 8,15,0:PRINT USING"Current Ratio #####.##";CR#;:PRINT;" 2.5 x"
5880 LOCATE 9,15:PRINT USING"Quick Ratio #####.##";QR#;:PRINT;" 1.0 x"
5890 LOCATE 10,15:PRINT USING"Inventory Utilization #####.##";IU#;:PRINT;" 9 x"
5900 LOCATE 11,15:PRINT USING"Inventory Turnover Ratio #####.##";ITR#;:PRINT;" .17 x "
5910 LOCATE 12,15:PRINT USING"Fixed Asset Utilization #####.##";FAU#;:PRINT;" 3.0 x"
5920 LOCATE 13,15:PRINT USING"Total Asset Utilization #####.##";TAU#;:PRINT;" 1.8 x"
5930 LOCATE 14,15:PRINT USING"Debt to Equity Ratio ####.##";DTE#;:PRINT;" Variable"
5940 LOCATE 15,15:PRINT USING"Operating Ratio #####.##";OP#;:PRINT;" .60 x"
5950 LOCATE 16,15:PRINT USING"Profits-Worth Ratio ####.##";PWR#;:PRINT;" .18 x"
5960 LOCATE 17,15:PRINT USING"N.Profits-N.Sales Ratio ####.##";NPNS#;:PRINT;" .05 x"
5970 LOCATE 18,15:PRINT USING"ROI in Assets Ratio ####.##";ROIA#;:PRINT;" Variable"
5980 LOCATE 19,15:PRINT USING"Price Earnings Ratio #####.##";PER#;:PRINT;" 9.0 x"
5990 LOCATE 20,15:PRINT USING"Earnings Per Share $###.##";EPS#;:PRINT;" Variable"
6000 COLOR 11,0:LOCATE 24,16,0:PRINT"***** Strike Any Key To Try Another Analysis *****";
6010 GOSUB 460:GOTO 5130
6020 COLOR 7,0:GOTO 40
6030 GOTO 6040
6040 LENGTH=12:DEFSTR Z:FIRSTONE=1:DEF SEG=&H40:POKE &H17,(PEEK(&H17) OR 96)
6050 IF DEC=1 THEN MASK$=" #############,.#":DEC=0:GOTO 6090
6060 IF DEC=2 THEN MASK$=" ############,.##":DEC=0:GOTO 6090
6070 IF DEC=3 THEN MASK$=" ###########,.##%":DEC=0:GOTO 6090
6080 MASK$="$$"+STRING$(11,"#")+",.##"
6090 ZH="000":XLIN=CSRLIN:XPOS=POS(0)-1:ZR=SPACE$(LENGTH):FLAG=0:PERIOD=0
6100 RSET ZR=ZH:LOCATE XLIN,XPOS,1:PRINT USING MASK$;VAL(ZR)/100;:LOCATE ,POS(0)-1
6110 DEF SEG:POKE 106,0:IF INKEY$<>"" THEN 6110
6120 ZI=INKEY$:IF ZI="" THEN 6120
6130 IF ZI="0" AND FIRSTONE THEN 6120 ELSE FIRSTONE=0
6140 IF ZI=CHR$(13) THEN ZA=SPACE$(LENGTH+2):ZH=STR$(VAL(ZH)/100):RSET ZA=ZH:RETURN
6150 IF ZI="." AND PERIOD=0 THEN PERIOD=1:GOTO 6120
6160 IF LEN(ZI)>1 THEN IF RIGHT$(ZI,1)=CHR$(75) THEN 6270 ELSE 6120
6170 IF ZI=CHR$(8) THEN 6270
6180 IF FLAG OR ZI<"0" OR ZI>"9" THEN 6120
6190 IF PERIOD=1 THEN MID$(ZH,LEN(ZH)-1,1)=ZI:GOTO 6230
6200 IF PERIOD=2 THEN MID$(ZH,LEN(ZH),1)=ZI:GOTO 6230
6210 IF LEN(ZH)>LENGTH-1 THEN 6120
6220 ZH=ZH+"0":MID$(ZH,LEN(ZH)-2)=ZI
6230 RSET ZR=ZH:LOCATE XLIN,XPOS,1:PRINT USING MASK$;VAL(ZR)/100;:LOCATE ,POS(0)-1
6240 IF PERIOD=2 THEN FLAG=1
6250 IF PERIOD=1 THEN PERIOD=2
6260 GOTO 6120
6270 IF LEN(ZH)<3 THEN ZH="0"+ZH
6280 IF LEN(ZH)<3 THEN 6120
6290 IF PERIOD=1 THEN PERIOD=0:MID$(ZH,LEN(ZH)-1,1)="0":GOTO 6330
6300 IF PERIOD=2 AND FLAG THEN FLAG=0:PERIOD=1:MID$(ZH,LEN(ZH),1)="0":GOTO 6330
6310 IF PERIOD=2 THEN PERIOD=0:MID$(ZH,LEN(ZH)-1)="0":GOTO 6330
6320 MID$(ZH,LEN(ZH)-2,1)="0":ZH=LEFT$(ZH,LEN(ZH)-1)
6330 LOCATE XLIN,XPOS:PRINT SPC(LENGTH);
6340 LOCATE XLIN,XPOS,1:RSET ZR=ZH:PRINT USING MASK$;VAL(ZR)/100;:LOCATE ,POS(0)-1:GOTO 6120
6350 DEFSTR Z:MASK$="############,### ":ZA=SPACE$(10)
6360 XLIN=CSRLIN:XPOS=POS(0):PRINT USING MASK$;0;
6370 ZH="":DEF SEG:POKE 106,0:IF INKEY$<>"" THEN 6370
6380 ZI=INKEY$:IF ZI="" THEN 6380
6390 IF ZI=CHR$(13) THEN LSET ZA=ZH:RETURN
6400 IF ZI=CHR$(8) OR RIGHT$(ZI,1)=CHR$(75) THEN 6450
6410 IF LEN(ZI)>1 THEN 6370
6420 IF ZI<"0" OR ZI>"9" THEN 6380
6430 IF LEN(ZH)>9 THEN 6380
6440 ZH=ZH+ZI:RSET ZA=ZH:LOCATE XLIN,XPOS:PRINT USING MASK$;VAL(ZA);:GOTO 6380
6450 IF LEN(ZH)<1 THEN 6380
6460 ZH=LEFT$(ZH,LEN(ZH)-1):RSET ZA=ZH:LOCATE XLIN,XPOS:PRINT USING MASK$;VAL(ZA);:GOTO 6380
6470 GOTO 40
PC-PAD.BAS
10 'PC\PAD: an MS-BASIC editor/spreadsheet/printing routine; 4/07/83
20 SCREEN 0,0,0:WIDTH 80:CLS:KEY OFF:LOCATE 5,1:Q$=SPACE$(20)
30 PRINT Q$;" PC\PAD (ver. 1.3)"
40 PRINT Q$;"an editor/spreadsheet/printing program"
50 PRINT: PRINT
60 PRINT Q$;" If you are using this program"
70 PRINT Q$;" and find it of value,"
80 PRINT Q$;" a $20 contribution is suggested."
90 PRINT
100 PRINT Q$;" (c) 1983"
110 PRINT Q$;" P. Fraundorf"
120 PRINT Q$;" P.O. Box 11394"
130 PRINT Q$;" St. Louis MO 63105"
140 PRINT
150 PRINT Q$;" You are encouraged to copy and"
160 PRINT Q$;" share this program with others."
170 LOCATE 24,1: PRINT "any key to continue...";
180 Q$=INKEY$: IF Q$="" THEN 180
190 DEFINT I-N: LMX=400: HCW=8: CC$="\" 'set max lines,col width, & cc$
200 DIM A$(LMX+1),M$(50),CSUM(16),RSUM(25): IMX=LMX-22: JMX=IMX-20
210 LCW=2*HCW: LCM=LCW-1: DEF FNV(I,J)=VAL(MID$(A$(I),LCW*J+1,LCW))
220 DEF SEG=0: IF (PEEK(1040) AND 48)=48 THEN LD=13 ELSE LD=7 'mono/color
230 '-----------------------initialize function keys--------------------
240 KEY ON
250 KEY 1,CC$+"view "+CHR$(13) 'relist
260 KEY 2,CC$+"compute"+CHR$(13) 'update computed entries
270 KEY 3,CC$+"up "+CHR$(13) 'look up
280 KEY 4,CC$+"down "+CHR$(13) 'look down
290 KEY 5,CC$+"left "+CHR$(13) 'look left
300 KEY 6,CC$+"right "+CHR$(13) 'look right
310 KEY 7,CC$+"yank "+CHR$(13) 'yank line to memory
320 KEY 8,CC$+"put "+CHR$(13) 'put line in text
330 KEY 9,CC$+"justify"+CHR$(13) 'right justify line
340 KEY 10,CC$+"save "+CHR$(13) 'save + offer restart
350 '---------------------------open source file-----------------------
360 FOR I=0 TO LMX: A$(I)="": NEXT: CLS: ON ERROR GOTO 5000
370 PRINT "disk files:": FILES: PRINT
380 INPUT "disk file name (rtn=none)";F$
390 IF F$<>"" THEN GOSUB 1260 ELSE NLINE=0
400 '------------------------set up editing session--------------------
410 INPUT "working file name (rtn=disk file name)";G$
420 IF G$="" THEN G$=F$ 'if no working name, use disk file name
430 IF G$="" THEN END 'if still no working name, then exit program
440 IP=1: JP=0: IX=1: JY=1 'zero pointers
450 '-------------------------primary operating loop--------------------
460 J0=JP: J1=JP+22: GOSUB 890: LOCATE JY,1 'list lines jp,jp+22
470 COLOR 13,0: LINE INPUT "",X$ 'give control to BASIC screen editor
480 COLOR 10,0: JY=CSRLIN-1
490 XX=INSTR(X$,CC$): IF XX=0 THEN 770 'store new line
500 '-----------------------menu of command primitives------------------
510 Y$=MID$(X$,XX+1,1)
520 IF Y$="v" THEN 460 'view window
530 IF Y$="c" THEN 9990 'update computed entries
540 IF Y$="u" THEN IF JP>0 THEN JP=JP-1:GOTO 460 ELSE 460 'up 1
550 IF Y$="d" THEN IF JP<IMX THEN JP=JP+1:GOTO 460 ELSE 460 'down 1
560 IF Y$="l" THEN IF IP>HCW THEN IP=IP-HCW:GOTO 460 ELSE 460 'left 1
570 IF Y$="r" THEN IF IP<178-HCW THEN IP=IP+HCW:GOTO 460 ELSE 460 'right 1
580 IF Y$="y" THEN GOSUB 1382:GOTO 460 'yank line to memory
590 IF Y$="p" THEN GOSUB 1420:GOTO 460 'put line in text
600 IF Y$="j" THEN GOSUB 2060: GOTO 460 'justify line
610 IF Y$="s" THEN GOSUB 1340: GOTO 460 'save working file
620 IF Y$=CC$ THEN Y$=MID$(X$,XX+2,1) ELSE 770
630 '-------------------------- 2-key functions ----------------------
640 IF Y$="v" THEN GOSUB 980: GOTO 460 'help file
650 IF Y$="c" THEN GOSUB 1190: GOTO 460 'reset filenames
660 IF Y$="u" THEN IF JP>19 THEN JP=JP-20:GOTO 460 ELSE JP=0 :GOTO 460
670 IF Y$="d" THEN IF JP<JMX THEN JP=JP+20:GOTO 460 ELSE JP=IMX:GOTO 460
680 IF Y$="l" THEN IF IP>64 THEN IP=IP-64:GOTO 460 ELSE IP=1 :GOTO 460
690 IF Y$="r" THEN IF IP<113 THEN IP=IP+64:GOTO 460 ELSE IP=177:GOTO 460
700 IF Y$="y" THEN GOSUB 1382:GOSUB 1410:GOTO 460 'remove line
710 IF Y$="p" THEN 1450 'goto insert loop
720 IF Y$="j" THEN GOSUB 2010: GOTO 460 'reset linewidth
730 IF Y$="s" THEN GOSUB 1570: GOTO 460 'print file
740 IF Y$="q" THEN GOTO 360 'quit/new file prompt
750 '-----------------------store previous screen line------------------
760 'it would be nice to use L$=X$, but alas X$ reflects complex i/o logic
770 L$="": II=0
780 JX=JP+JY-1: Y$=A$(JX): LA=LEN(Y$): IF LA>IP+79 THEN II=1
790 FOR I=79 TO 1 STEP -1
800 X$=CHR$(SCREEN(JY,I))
810 IF II=1 THEN L$=X$+L$ ELSE IF X$<>" " THEN II=1: GOTO 810
820 NEXT
830 LX=IP-1: LL=LEN(L$): IF JX+1>NLINE THEN NLINE=JX+1
840 IF LX>LA THEN A$(JX)=A$(JX)+STRING$(LX-LA," ")+L$: GOTO 870
850 IF LX>LA-79 THEN A$(JX)=LEFT$(A$(JX),LX)+L$: GOTO 870
860 A$(JX)=LEFT$(A$(JX),LX)+L$+STRING$(79-LL," ")+RIGHT$(A$(JX),LA-LX-79)
870 IF JY<23 THEN 470 ELSE IF JP<IMX THEN JP=JP+1:GOTO 460 ELSE 460
880 '-----------------------print lines from j0 to j1-------------------
890 CLS: LOCATE 24,1
900 COLOR 0,7:PRINT "^ ";G$;":";TAB(17);"^line";J0;"-";J1;TAB(33);"^col.";IP\LCW;"-";(IP+78)\LCW;TAB(49);"^for HELP:\[F1] ^keylist below:";
910 LOCATE 1,1,1,LD-1,LD
920 COLOR 6,0
930 FOR I=J0 TO J1
940 PRINT MID$(A$(I),IP,79)
950 NEXT
960 RETURN
970 '============================print help file===========================
980 CLS:Q$=SPACE$(6):LOCATE 4,1
990 PRINT Q$;" *** available functions ***": PRINT
1000 PRINT Q$;"[F1] view file window \[F1] print help file"
1010 PRINT Q$;" -------------spreadsheet computation key--------------"
1020 PRINT Q$;"[F2] update computations \[F2] reset filenames"
1030 PRINT Q$;" -----------------window movement keys-----------------"
1040 PRINT Q$;"[F3] move up 1 line \[F3] move up 20 lines"
1050 PRINT Q$;"[F4] move down 1 line \[F4] move down 20 lines"
1060 PRINT Q$;"[F5] move left 1/2 column \[F5] move left 4 columns"
1070 PRINT Q$;"[F6] move right 1/2 column \[F6] move right 4 columns"
1080 PRINT Q$;" -----------------text processing keys-----------------"
1090 PRINT Q$;"[F7] yank line into memory \[F7] yank and delete line"
1100 PRINT Q$;"[F8] put yanked line in text \[F8] sequential line insert"
1110 PRINT Q$;"[F9] right justify line \[F9] reset j-options"
1120 PRINT Q$;" -------------------file output key--------------------"
1130 PRINT Q$;"[F10] save file to disk \[F10] print file":PRINT
1140 PRINT Q$;" \\q quit file
1150 LOCATE 24,1: PRINT "except for F# keys, any key to continue...";
1160 Q$=INKEY$: IF Q$="" THEN 1160
1170 RETURN
1180 '============================reset filenames==========================
1190 CLS
1200 PRINT "working filename (rtn=";G$;:INPUT")";X$:IF X$<>"" THEN G$=X$
1210 PRINT "instruction filename (rtn=";H$;:INPUT")";X$:IF X$<>"" THEN H$=X$
1220 INPUT "switch displays (rtn=no)";I$
1230 IF I$="" THEN RETURN
1240 IF LD=13 THEN DEF SEG=0:POKE &H410,(PEEK(&H410) AND &HCF) OR &H10:SCREEN 1,0,0,0:SCREEN 0:WIDTH 40:WIDTH 80:LOCATE ,,1,6,7:LD=7 ELSE IF LD=7 THEN DEF SEG=0:POKE &H410,(PEEK(&H410) OR &H30):SCREEN 0:WIDTH 40:WIDTH 80:LOCATE ,,1,12,13:LD=13
1250 RETURN
1260 '=============================load disk file===========================
1270 OPEN F$ FOR INPUT AS #1
1280 FOR NLINE=0 TO LMX
1290 LINE INPUT #1,A$(NLINE)
1300 IF EOF(1) THEN CLOSE #1: RETURN
1310 NEXT
1320 CLOSE #1: RETURN
1330 '=============================save file on disk=========================
1340 OPEN G$ FOR OUTPUT AS #1
1350 FOR I=0 TO NLINE
1360 PRINT #1,A$(I)
1370 NEXT
1380 CLOSE #1: RETURN
1381 '================================yank===================================
1382 LOCATE 24,1:INPUT;"# of lines (rtn=1) ";NM:IF NM<1 THEN NM=1
1383 IX=JP+JY-1
1384 FOR I=0 TO NM-1
1385 M$(I)=A$(IX+I)
1386 NEXT
1387 RETURN
1390 '===============================delete==================================
1400 IF NLINE>NM THEN NLINE=NLINE-NM ELSE NLINE=0
1410 FOR I=IX TO NLINE
1411 A$(I)=A$(I+NM)
1412 NEXT
1413 FOR I=NLINE+1 TO NLINE+NM+1
1414 A$(I)=""
1415 NEXT
1416 RETURN
1419 '=================================put===================================
1420 IX=JP+JY
1430 FOR J=NM-1 TO 0 STEP -1
1440 X$=M$(J):GOSUB 1520
1445 NEXT
1446 RETURN
1450 '============================insertion loop=============================
1460 CLS:J0=JP:J1=JP+JY-1:GOSUB 920:J0=J1+1:J1=JP+21:LOCATE JY+2,1:GOSUB 920
1470 COLOR 11,0: LOCATE JY+1,1,1,LD,0 'display split cursor
1480 LINE INPUT "",X$: X$=STRING$(IP-1," ")+X$: XX=INSTR(X$,CC$)
1490 IF XX<>0 THEN 460 ELSE IF CSRLIN<>JY+2 THEN BEEP: GOTO 1460
1500 IX=JP+JY:GOSUB 1520:JP=JP+1:GOTO 1460
1510 '--------------------------insert x$ at line ix------------------------
1520 FOR I=IX TO NLINE
1530 SWAP X$,A$(I)
1540 NEXT
1550 NLINE=NLINE+1: IF NLINE>LMX THEN NLINE=LMX: BEEP: RETURN
1560 A$(NLINE)=X$: RETURN
1570 '========================file printing routine==========================
1580 '------------------------set new printer options------------------------
1590 CLS: GOSUB 1940: LW=80: W$="" 'reset printer and initialize
1600 INPUT "top/bottom margins, in inches (rtn=0)";TBM
1610 INPUT "linespacing (d=double; t=triple; h=1/2; s=1/3; rtn=normal)";D$
1620 IF D$="" THEN LX=6 ELSE IF D$="d" THEN LX=3 ELSE IF D$="t" THEN LX=2
1630 IF D$="h" THEN LX=12 ELSE IF D$="s" THEN LX=18
1640 LM=TBM*LX: LPRINT CHR$(27);"A";CHR$(72/LX);CHR$(27);"2";'set linespace
1650 INPUT "characters/inch (s=16.5; m=8.25; l=5; rtn=10) ",C$
1660 IF C$="s" OR C$="m" THEN LPRINT CHR$(15);: LW=132 'set compressed width
1670 IF C$="l" OR C$="m" THEN W$=CHR$(14): LW=LW/2 'set double-width flag
1680 WIDTH "lpt1:",LW
1690 INPUT "intensity (d=double, e=emphasized, b=both, rtn=light) ",I$
1700 IF I$="d" OR I$="b" THEN LPRINT CHR$(27)+"G";'set doublestrike mode
1710 IF I$="e" OR I$="b" THEN LPRINT CHR$(27)+"E";'set emphasized intensity
1720 LPRINT CHR$(27);"D"; 'lines 100-120 set horiz. tabs (10,8,8,8...)
1730 FOR I=18 TO 74 STEP 8: LPRINT CHR$(I);: NEXT
1740 LPRINT CHR$(0);
1750 INPUT;"from row: ",I0
1760 INPUT;" to: ",I1:IF I1=0 THEN I1=NLINE:PRINT I1 ELSE PRINT
1770 INPUT;"from column: ",J0
1780 INPUT;" to: ",J1:IF J1=0 THEN J1=J0+7:PRINT J1 ELSE PRINT
1790 INPUT "indentation (rtn=0 spaces) ";INDENT
1800 IX=I0:J1=(J1-J0+1)*LCW:J0=J0*LCW+1:IF J1+INDENT>=LW THEN J1=LW-INDENT-1
1810 ' -------------------------------print file------------------------------
1820 FOR I=1 TO LM 'begin page
1830 LPRINT
1840 NEXT
1850 FOR I=1 TO 11*LX-2*LM
1860 LPRINT SPC(INDENT);W$+MID$(A$(IX),J0,J1)
1870 IF IX<I1 THEN IX=IX+1 ELSE GOSUB 1940: RETURN
1880 NEXT
1890 FOR I=1 TO LM
1900 LPRINT
1910 NEXT
1920 GOTO 1820
1930 ' -----------------------------reset printer----------------------------
1940 LPRINT CHR$(27);"A";CHR$(12);'set default line-spacing to 12/72=1/6"
1950 LPRINT CHR$(27);"2"; 'invoke default line-spacing
1960 LPRINT CHR$(18); 'compressed width off
1970 LPRINT CHR$(20); 'double-width off (optional)
1980 LPRINT CHR$(27)+"F"; 'emphasized intensity off
1990 LPRINT CHR$(27)+"H"; 'double-strike intensity off
2000 WIDTH "lpt1:",80: RETURN
2010 '=====================set linewidth for justification==================
2020 LOCATE 24,1: INPUT;"line width (rtn=60)";LWIDTH
2030 IF LWIDTH=0 THEN LWIDTH=60
2040 INPUT;" how many lines at once (rtn=1)";JL: IF JL=0 THEN JL=1
2050 RETURN
2060 '---------------------------Justify Function--------------------------
2070 IF LWIDTH=0 THEN GOSUB 2020 'reset linewidth
2080 J0=JY+JP-1: J1=J0+JL-1: IF J1>NLINE THEN J1=NLINE
2090 FOR IX=J0 TO J1
2100 GOSUB 2140
2110 NEXT
2120 RETURN
2130 '----------------------------justify line------------------------------
2140 Y$=A$(IX)
2150 '-------------------------remove rightmost spaces----------------------
2160 YL=LEN(Y$):IF RIGHT$(Y$,1)=" " THEN Y$=LEFT$(Y$,YL-1):GOTO 2160
2170 '----------------------replace indentations with nulls-----------------
2180 IF LEFT$(Y$,1)=CHR$(9) THEN Y$=" "+RIGHT$(Y$,YL-1): YL=YL+7
2190 IF YL=0 OR YL=LWIDTH THEN RETURN
2200 Z$="": M=1
2210 WHILE LEFT$(Y$,1)=" ":Z$=Z$+CHR$(0):Y$=RIGHT$(Y$,YL-M):M=M+1:WEND
2220 Y$=Z$+Y$
2230 '------------------------optimize content of line----------------------
2240 IF YL<LWIDTH THEN GOSUB 2420 ELSE GOSUB 2590
2250 '---------------------right justify line if appropriate----------------
2260 YL=LEN(Y$): NEEDED=LWIDTH-YL
2270 IF INSTR(Y$," ")=0 THEN NEEDED=0
2280 C$=LEFT$(A$(IX+1),1)
2290 IF C$="" OR C$=" " OR C$=CHR$(0) OR C$=CHR$(9) THEN NEEDED=0
2300 Z$=""
2310 FOR I=1 TO NEEDED
2320 M=INSTR(Y$," ")
2330 IF M=0 THEN Y$=Z$+Y$: YL=LEN(Y$): Z$="": GOTO 2320
2340 IF M=1 THEN Z$=Z$+" ": Y$=RIGHT$(Y$,YL-1): YL=YL-1: GOTO 2320
2350 Z$=Z$+LEFT$(Y$,M)+" ": Y$=RIGHT$(Y$,YL-M): YL=YL-M
2360 NEXT
2370 Y$=Z$+Y$: YL=LEN(Y$)
2380 '---------------------replace initial nulls with spaces----------------
2390 Z$="": M=1
2400 WHILE LEFT$(Y$,1)=CHR$(0):Z$=Z$+" ":Y$=RIGHT$(Y$,YL-M):M=M+1:WEND
2410 A$(IX)=Z$+Y$: RETURN
2420 '---------------------line is too short..can we add some?--------------
2430 J=IX+1
2440 WHILE NLINE>=J
2450 C$=LEFT$(A$(J),1)
2460 IF C$="" OR C$=" " OR C$=CHR$(9) OR C$=CHR$(0) THEN RETURN
2470 WHILE A$(J)<>""
2480 ZL=LEN(A$(J))
2490 M=INSTR(A$(J)," "): IF M=0 THEN ZL=ZL+1: M=ZL
2500 IF YL+M>LWIDTH THEN RETURN
2510 YL=YL+M: Y$=Y$+" ": IF M>1 THEN Y$=Y$+LEFT$(A$(J),M-1)
2520 A$(J)=RIGHT$(A$(J),ZL-M)
2530 WEND
2540 Z$=""
2550 FOR I=NLINE TO J STEP -1: SWAP Z$,A$(I): NEXT
2560 NLINE=NLINE-1
2570 WEND
2580 RETURN
2590 '---------------------line is too long..take something off------------
2600 Z$=RIGHT$(Y$,YL-LWIDTH): YL=LWIDTH: Y$=LEFT$(Y$,LWIDTH)
2610 C$=RIGHT$(Y$,1): YL=YL-1: Y$=LEFT$(Y$,YL)
2620 IF C$<>" " THEN Z$=C$+Z$: GOTO 2610
2630 FOR I=IX+1 TO NLINE: SWAP Z$,A$(I): NEXT
2640 NLINE=NLINE+1: IF NLINE>LMX THEN NLINE=LMX: BEEP: RETURN
2650 A$(NLINE)=Z$: RETURN
5000 '======================error trapping (line 5000)==================
5010 Q$=" ...File not found... "
5020 IF ERR=53 AND ERL=1270 THEN PRINT Q$: RESUME 370
5030 IF ERR=53 AND ERL=9990 THEN PRINT Q$;: H$="": RESUME 9990
5040 IF ERR=61 AND ERL=1360 THEN PRINT "Disk Full:make room before saving"
5050 IF ERR=25 AND ERL=1940 THEN PRINT "Printer not On-line"
5060 IF ERR=27 THEN PRINT "Out of Paper or Printer Off"
5070 PRINT: PRINT "error #";ERR;" at line ";ERL;"; type CONT to resume..."
5080 STOP: RESUME 460
9610 '===============spread sheet subroutines (line 9610)==============
9620 '---------------------------form column sums-------------------------
9630 IF NROW<2 THEN GOTO 9770
9640 FOR J=0 TO NCOL-1
9650 CSUM(J)=0
9660 FOR I=0 TO NROW-1
9670 CSUM(J)=CSUM(J)+FNV(I+NROW0,J+NCOL0)
9680 NEXT
9690 NEXT
9700 I=NROW0+NROW: TSUM=0
9710 FOR J=NCOL0 TO NCOL0+NCOL-1
9720 X=CSUM(J-NCOL0): GOSUB 9900
9730 TSUM=TSUM+CSUM(J-NCOL0)
9740 NEXT
9750 J=NCOL0+NCOL: X=TSUM: GOSUB 9900
9760 '---------------------------form row sums----------------------------
9770 IF NCOL<2 THEN RETURN
9780 FOR I=0 TO NROW-1
9790 RSUM(I)=0
9800 FOR J=0 TO NCOL-1
9810 RSUM(I)=RSUM(I)+FNV(I+NROW0,J+NCOL0)
9820 NEXT
9830 NEXT
9840 J=NCOL0+NCOL
9850 FOR I=NROW0 TO NROW0+NROW-1
9860 X=RSUM(I-NROW0): GOSUB 9900
9870 NEXT
9880 RETURN
9890 '-----------------replace row i, column j entry with x---------------
9900 X$=STR$(X)
9910 '-----------------replace row i, column j entry with x$--------------
9920 LX=LEN(X$)
9930 IF LX<LCM THEN X$=STRING$(LCM-LX," ")+X$ ELSE X$=LEFT$(X$,LCM)
9940 LA=LEN(A$(I)): LX=LCW*J
9950 IF LX>LA THEN A$(I)=A$(I)+STRING$(LX-LA," ")+X$: RETURN
9960 IF LX>LA-LCM THEN A$(I)=LEFT$(A$(I),LX)+X$: RETURN
9970 A$(I)=LEFT$(A$(I),LX)+X$+RIGHT$(A$(I),LA-LX-LCM): RETURN
9980 '----------------------update computed quantities--------------------
9990 IF H$="" THEN LOCATE 24,1: INPUT;"instruction filename";H$: IF H$="" THEN 460 ELSE CHAIN MERGE H$,10000,ALL
10000 '----------ROWCOL.BAS - sample row-column sum instructions-----------
10010 ON ERROR GOTO 5000 'this prevents disabling of error trapping
10020 NROW0=FNV(2,6):NCOL0=FNV(3,6):NROW=FNV(4,6):NCOL=FNV(5,6) 'read table
10030 GOSUB 9630 'form sums
10040 I=NROW0+NROW: J=NCOL0-1: X$="Column Totals" : GOSUB 9920 'label row
10050 I=NROW0-2: J=NCOL0+NCOL: X$="Row Totals" : GOSUB 9920 'label col
10060 GOTO 460 'this exits to the View Function
PERPCAL.BAS
100 ' THE PERPETUAL CALENDAR Copyright (c) 1983 Morris Effron
140 OPTION BASE 1:DEFINT A-Z:DEFSNG T:KEY OFF:CLS:GOSUB 1000
160 LOCATE 1,37,0:PRINT "T H E":GOSUB 9000:LOCATE 3,23:PRINT "P E R P E T U A L":GOSUB 9000:LOCATE 3,43:PRINT "C A L E N D A R":GOSUB 9000
220 COLOR 0,7:LOCATE 1,37:PRINT "T H E":LOCATE 3,23:PRINT "P E R P E T U A L C A L E N D A R":GOSUB 9000
240 COLOR 7,0:LOCATE 7,23:PRINT "1. NUMBER OF DAYS BETWEEN TWO DATES."
250 LOCATE 9,23:PRINT "2. WEEKDAY OF ANY DATE."
260 LOCATE 11,23:PRINT "3. CALENDAR FOR ANY MONTH."
270 LOCATE 13,23:PRINT "4. EXIT"
280 LOCATE 15,28:PRINT "ENTER CHOICE:":LOCATE 15,43,1:PRINT " ":LOCATE 15,43,1
300 A$=INKEY$:IF A$="" GOTO 300
310 IF A$="1" OR A$="2" OR A$="3" OR A$="4" THEN LOCATE 15,43,0:PRINT A$:ON VAL(A$) GOSUB 2000,3000,4000,5000:GOTO 280 ELSE LOCATE 16,35,0:PRINT "1, 2, 3 OR 4 PLEASE.":FOR I=1 TO 1000:NEXT I:LOCATE 16,35:PRINT SPACE$(20):GOTO 280
1000 ' initialization routine
1005 DIM DS$(7),MS$(12),DS(12),NLP(7)
1010 DATA "SUNDAY","MONDAY","TUESDAY","WEDNESDAY","THURSDAY","FRIDAY","SATURDAY","JANUARY",31,"FEBRUARY",28,"MARCH",31,"APRIL",30,"MAY",31,"JUNE",30,"JULY",31,"AUGUST",31,"SEPTEMBER",30,"OCTOBER",31,"NOVEMBER",30,"DECEMBER",31
1020 DATA 1900,2100,2200,2300,2500,2600,2700
1030 FOR I=1 TO 7:READ DS$(I):NEXT:FOR I=1 TO 12:READ MS$(I):READ DS(I):NEXT:FOR I=1 TO 7:READ NLP(I):NEXT:RETURN
2000 ' # days between two dates
2010 LOCATE 18,23:AD$="":INPUT "FIRST DATE (MM/DD/YYYY): ",AD$:IF AD$="" THEN LOCATE 18,23:PRINT SPACE$(30):RETURN ELSE GOSUB 9100
2020 IF OKD THEN 2040
2030 LOCATE 19,30:PRINT "BAD DATE. PLEASE REENTER.":FOR I=1 TO 1000:NEXT I:LOCATE 19,30:PRINT SPACE$(25):LOCATE 18,48:PRINT SPACE$(20):GOTO 2010
2040 Y1=Y:M1=M:D1=D
2050 LOCATE 20,22:AD$="":INPUT "SECOND DATE (MM/DD/YYYY): ",AD$:GOSUB 9100
2060 IF OKD THEN 2080
2070 LOCATE 21,30:PRINT "BAD DATE. PLEASE REENTER.":FOR I=1 TO 1000:NEXT I:LOCATE 21,30:PRINT SPACE$(25):LOCATE 20,48:PRINT SPACE$(20):GOTO 2050
2080 Y2=Y:M2=M:D2=D:GOSUB 9200
2100 LOCATE 22,9:PRINT "NUMBER OF DAYS BETWEEN THESE DATES IS: ":COLOR 15,0:LOCATE 22,47:PRINT USING "###,###";TDS:COLOR 7,0:LOCATE 23,15:PRINT "(PRESS ANY KEY TO CONTINUE)"
2120 A$=INKEY$:IF A$="" GOTO 2120
2130 LOCATE 18,20:PRINT SPACE$(55):LOCATE 20,20:PRINT SPACE$(55):LOCATE 22,9:PRINT SPACE$(50):LOCATE 23,15:PRINT SPACE$(30):GOTO 2010
3000 ' weekday determination routine
3010 Y1=1983:M1=1:D1=1
3020 LOCATE 18,26:AD$="":INPUT "DATE (MM/DD/YYYY): ",AD$:IF AD$="" THEN LOCATE 18,26:PRINT SPACE$(30):RETURN ELSE GOSUB 9100
3030 IF OKD THEN 3050
3040 LOCATE 19,32:PRINT "BAD DATE. PLEASE REENTER.":FOR I=1 TO 1000:NEXT I:LOCATE 19,32:PRINT SPACE$(25):LOCATE 18,45:PRINT SPACE$(15):GOTO 3020
3050 Y2=Y:M2=M:D2=D:GOSUB 9200:WHILE TDS>32767:TDS=TDS-32767:WEND:WD=TDS MOD 7:IF PRE THEN IF WD>0 THEN WD$=DS$(WD) ELSE WD$=DS$(7) ELSE WD$=DS$(7-WD)
3070 LOCATE 20,29:PRINT "THIS DATE IS A":COLOR 15,0:LOCATE 20,44:PRINT WD$:COLOR 7,0:LOCATE 22,26:PRINT "(PRESS ANY KEY TO CONTINUE)"
3080 A$=INKEY$:IF A$="" GOTO 3080
3090 LOCATE 18,26:PRINT SPACE$(45):LOCATE 20,29:PRINT SPACE$(30):LOCATE 22,26:PRINT SPACE$(30):GOTO 3020
4000 ' calendar print routine
4010 Y1=1983:M1=1:D1=1:DIM CAL$(5,7)
4020 LOCATE 18,29:AD$="":INPUT "DATE (MM/YYYY): ",AD$:IF AD$="" THEN LOCATE 18,29:PRINT SPACE$(30):ERASE CAL$:RETURN
4030 V1=INSTR(1,AD$,"/"):IF V1=0 THEN 4050 ELSE AD$=LEFT$(AD$,V1)+"1"+MID$(AD$,V1):GOSUB 9100
4040 IF OKD THEN 4060
4050 LOCATE 19,32:PRINT "BAD DATE. PLEASE REENTER.":FOR I=1 TO 1000:NEXT I:LOCATE 19,32:PRINT SPACE$(25):LOCATE 18,45:PRINT SPACE$(15):GOTO 4020
4060 Y2=Y:M2=M:D2=D:GOSUB 9200:WHILE TDS>32767:TDS=TDS-32767:WEND:WD=TDS MOD 7:IF NOT PRE THEN WD=7-WD ELSE IF WD=0 THEN WD=7
4070 LOCATE 20,29:PRINT "PRESS ANY KEY TO PRINT"
4090 A$=INKEY$:IF A$="" GOTO 4090
4091 IF M2=2 AND LP2 THEN MX=29 ELSE MX=DS(M2)
4092 DUM=0:FOR I=1 TO 5:FOR J=1 TO 7
4094 IF ((I-1)*7)+J<WD OR DUM+1>MX THEN CAL$(I,J)=CHR$(179)+" " ELSE DUM=DUM+1:CAL$(I,J)=CHR$(179)+STR$(DUM)+SPACE$(10-LEN(STR$(DUM)))
4095 NEXT J:NEXT I
4096 ST=0:FOR I=DUM+1 TO MX:ST=ST+1:CAL$(5,ST)=LEFT$(CAL$(5,ST),4)+"/"+MID$(STR$(I),2)+SPACE$(4)::NEXT
4100 LPRINT:LPRINT CHR$(14);:LPRINT SPACE$(17-LEN(MS$(M2))/2)+MS$(M2)+STR$(Y2):LPRINT:LPRINT " "+CHR$(218);:FOR I=1 TO 6:LPRINT STRING$(10,196)+CHR$(194);:NEXT:LPRINT STRING$(10,196)+CHR$(191):GOSUB 9510
4160 LPRINT " ";:FOR I=1 TO 7:LPRINT CHR$(179)+SPACE$((10-LEN(DS$(I)))/2)+DS$(I)+SPACE$(10-LEN(DS$(I))-(10-LEN(DS$(I)))/2-0.5);:NEXT:LPRINT CHR$(179):GOSUB 9510:GOSUB 9520
4189 FOR I=1 TO 5:LPRINT " ";:FOR J=1 TO 7:LPRINT CAL$(I,J);:NEXT J:LPRINT CHR$(179):FOR J=1 TO 5:GOSUB 9510:NEXT J:IF I<5 THEN GOSUB 9520:NEXT I
4200 LPRINT " "+CHR$(192);:FOR I=1 TO 6:LPRINT STRING$(10,196)+CHR$(193);:NEXT:LPRINT STRING$(10,196)+CHR$(217)
4205 LOCATE 22,27:PRINT "(PRESS ANY KEY TO CONTINUE)"
4206 A$=INKEY$:IF A$="" GOTO 4206
4210 LOCATE 18,20:PRINT SPACE$(50):LOCATE 20,20:PRINT SPACE$(50):LOCATE 22,27:PRINT SPACE$(30):GOTO 4020
5000 RUN"MENU.BAT
5010 KEY 1,"LIST ":KEY 2,"RUN"+CHR$(13):KEY 3,"LOAD"+CHR$(34):KEY 4,"SAVE"+CHR$(34):KEY 5,"CONT"+CHR$(13):KEY 6,","+CHR$(34)+"LPT1:"+CHR$(34)+CHR$(13):KEY 7,"TRON"+CHR$(13):KEY 8,"TROFF"+CHR$(13):KEY 9,"KEY "
5020 KEY 10,"SCREEN "+CHR$(0)+","+CHR$(0)+","+CHR$(0)+CHR$(13):CLS:KEY ON:END
9000 ' twilight zone music
9010 SOUND 600,4.5:SOUND 640,4.5:SOUND 600,4.5:SOUND 500,4.5:RETURN
9100 ' date validation
9110 OKD=0
9120 V1=INSTR(1,AD$,"/"):IF V1<1 OR V1>3 THEN RETURN
9130 V2=INSTR(V1+1,AD$,"/"):IF V2-V1<1 OR V2-V1>3 THEN RETURN
9140 IF VAL(MID$(AD$,V2+1))<1800 OR VAL(MID$(AD$,V2+1))>2800 THEN RETURN ELSE Y=VAL(MID$(AD$,V2+1))
9150 IF Y/100<>INT(Y/100) THEN IF Y/4=INT(Y/4) THEN LP=-1 ELSE LP=0 ELSE IF Y=2000 OR Y=2400 OR Y=2800 THEN LP=-1 ELSE LP=0
9160 IF VAL(MID$(AD$,1,V1-1))<1 OR VAL(MID$(AD$,1,V1-1))>12 THEN RETURN ELSE M=VAL(MID$(AD$,1,V1-1))
9170 IF M=2 AND LP THEN MX=29 ELSE MX=DS(M)
9180 IF VAL(MID$(AD$,V1+1,V2-V1-1))<1 OR VAL(MID$(AD$,V1+1,V2-V1-1))>MX THEN RETURN ELSE D=VAL(MID$(AD$,V1+1,V2-V1-1))
9190 OKD=-1:RETURN
9200 ' compute # days between date1 and date2
9210 PRE=0:TDS=0
9220 IF Y1<Y2 THEN PRE=-1
9230 IF Y1=Y2 AND M1<M2 THEN PRE=-1
9240 IF Y1=Y2 AND M1=M2 AND D1<D2 THEN PRE=-1
9242 IF Y1/100<>INT(Y1/100) THEN IF Y1/4=INT(Y1/4) THEN LP1=-1 ELSE LP1=0 ELSE IF Y1=2000 OR Y1=2400 OR Y1=2800 THEN LP1=-1 ELSE LP1=0
9243 IF Y2/100<>INT(Y2/100) THEN IF Y2/4=INT(Y2/4) THEN LP2=-1 ELSE LP2=0 ELSE IF Y2=2000 OR Y2=2400 OR Y2=2800 THEN LP2=-1 ELSE LP2=0
9245 IF PRE THEN FY=Y1:FM=M1:FD=D1:FLP=LP1:LY=Y2:LM=M2:LD=D2:LLP=LP2 ELSE FY=Y2:FM=M2:FD=D2:FLP=LP2:LY=Y1:LM=M1:LD=D1:LLP=LP1
9260 NY=LY-FY:IF NY>0 THEN TDS=INT(NY*365.25)-365
9270 FOR I=1 TO 7:IF NLP(I)>FY AND NLP(I)<LY THEN TDS=TDS-1
9280 NEXT I
9290 FOR I=1 TO LM-1:TDS=TDS+DS(I):NEXT:IF LLP AND LM>2 THEN TDS=TDS+1
9300 TDS=TDS+LD:FOR I=FM+1 TO 12:TDS=TDS+DS(I):NEXT:TDS=TDS+DS(FM)-FD:IF FLP AND FM<3 THEN TDS=TDS+1
9330 IF FY=LY THEN IF LLP THEN TDS=TDS-366 ELSE TDS=TDS-365
9340 RETURN
9500 ' calendar print subroutines
9510 LPRINT " ";:FOR K=1 TO 7:LPRINT CHR$(179)+SPACE$(10);:NEXT:LPRINT CHR$(179):RETURN
9520 LPRINT " "+CHR$(195);:FOR K=1 TO 6:LPRINT STRING$(10,196)+CHR$(197);:NEXT:LPRINT STRING$(10,196)+CHR$(180):RETURN
PERS.BAS
"SMITH","JOHN","555-5555","1234 MAIN STREET","YOUR TOWN","YOUR STATE","12345",""
PERSONAL.BAS
100 REM ------------------------------
110 N$= "PERSONAL FILE"
120 REM ------------------------------
130 GOSUB 6200 'INITIALIZE
140 X$(1)="ADD RECORD"
150 X$(2)="LIST FILE"
160 X$(3)="DELETE RECORD"
170 X$(4)="SEARCH FILE"
171 X$(5)="TERMINATE PROGRAM"
180 REM DECLARE NO. OF FIELDS AND NAMES
190 F$(1)="LAST NAME"
200 F$(2)="FIRST NAME"
210 F$(3)="TELEPHONE"
220 F$(4)="STREET ADDRESS"
230 F$(5)="CITY"
240 F$(6)="STATE"
250 F$(7)="ZIP"
260 NF=7 : F$="PERS.BAS" : FB$="PERS.BAK"
270 N=5 : GOSUB 7000 'DISPLAY MENU
271 IF X = 5 THEN RUN"MENU.BAT"
280 ON X GOSUB 690,470,750,830
290 GOTO 100
300 REM ------------------------------
310 REM LIST RECORD ON PRINTER
320 REM ------------------------------
330 LPRINT L;". ",P1$;", ";P2$
340 LPRINT, P3$
350 LPRINT, P4$
360 LPRINT, P5$; ", ";P6$;" " P7$
370 LPRINT
380 RETURN
390 REM ------------------------------
400 REM LIST RECORD ON SCREEN
410 REM ------------------------------
420 PRINT L;". ";,P1$;". ";P2$
430 PRINT, P3$
440 PRINT, P4$
450 PRINT, P5$; ", ";P6$;" " P7$
460 PRINT : RETURN
470 REM ------------------------------
480 N$= "LIST FILE"
490 REM ------------------------------
500 GOSUB 6200 'INITIALIZE
510 Q1$="OUTPUT TO PRINTER"
520 Q2$="" : Q3$="YES OR NO"
530 GOSUB 5000 'PRINT DIALOG
540 GOSUB 7800 'YESNO
550 CLS
560 OPEN F$ FOR INPUT AS #1
570 L=1
580 IF EOF(1) THEN 660
590 INPUT#1,P1$,P2$,P3$,P4$,P5$,P6$,P7$,P8$
600 IF YN$="Y" THEN GOSUB 300 ELSE GOSUB 400
610 IF YN$="Y" THEN GOTO 640
620 FOR I1= 1 TO 100 'DELAY TO READ ON SCREEN
630 NEXT I1
640 L=L+1
650 GOTO 580
660 PRINT :PRINT : PRINT
670 GOSUB 7400 'PAUSE
680 CLOSE: RETURN
690 REM ------------------------------
700 N$= "ADD RECORD"
710 REM ------------------------------
720 REM CALL ADD RECORD SUBROUTINE
730 GOSUB 3000
740 RETURN
750 REM ------------------------------
760 N$= "DELETE RECORD"
770 REM ------------------------------
780 GOSUB 4600 'DELETE RECORD
790 IF L <> -1 THEN GOTO 810
800 LOCATE 19,1 : PRINT "RECORD NOT FOUND"
810 Q2$="DELETE" : GOSUB 3400 'ASK FOR ANOTHER
820 IF YN$="N" THEN RETURN ELSE 780
830 REM -------------------------------
840 N$= "SEARCH FILE"
850 REM -------------------------------
860 GOSUB 6200 : F=0 :L=0
870 Q1$="SEARCH FOR LAST NAME"
880 Q2$="" : Q3$="LAST NAME :"
890 GOSUB 5000
900 INPUT NA$
910 OPEN F$ FOR INPUT AS #1
920 L=L+1 : IF EOF(1) THEN 990
930 INPUT#1,P1$,P2$,P3$,P4$,P5$,P6$,P7$,P8$
940 IF P1$ <> NA$ THEN GOTO 920 'NO MATCH TRY AGAIN
950 F=1 'SET FOUND FLAG
960 LOCATE 5,1 : CLS : GOSUB 400 'DISPLAY REC ON SCRN
970 GOSUB 7400 'WAIT FOR KEY
980 GOTO 920 'LOOK FOR NEXT MATCH
990 REM OUT OF RECORDS
1000 CLOSE
1010 LOCATE 19,1
1020 IF F=0 THEN PRINT "NO MATCHES FOUND"
1030 Q2$="SEARCH" : GOSUB 3400 'ASK FOR ANOTHER
1040 IF YN$="N" THEN RETURN ELSE 830
3000 REM "ADREC"
3001 ' -------------------------------
3002 ' ADD RECORDS TO FILE
3003 '
3004 'THIS ROUTINE ADDS RECORDS TO A FILE
3005 '
3006 'CALLING PARAMETERS:
3007 ' NF= NUMBER OF FIELDS IN RECORD (MAX=8)
3008 ' F$(L)=NAMES OF FIELDS
3009 ' F$=NAME OF FILE TO ADD TO
3010 '
3011 'RETURNED PARAMETERS:
3012 ' NONE
3013 '
3014 'COMMENT: ADDS RECORDS TILL TERMINATED BY USER
3015 ' & FIELDS ARE CREATED EVEN IF BLANK
3016 '
3017 ' -------------------------------
3020 OPEN F$ FOR APPEND AS #1
3030 K=1 : GOSUB 6200 'INITIALIZE
3040 Q1$="ENTER DATA"
3050 Q2$=""
3060 FOR L= 1 TO NF
3070 Q3$=F$(L) : GOSUB 5800 'ASK FOR DATA
3080 NEXT L
3090 WRITE#1,P$(1),P$(2),P$(3),P$(4),P$(5),P$(6),P$(7),P$(8)
3100 REM SEE IF MORE RECORDS TO BE ADDED
3110 Q1$="ADD ANOTHER RECORD ? "
3120 Q2$="" : Q3$="YES OR NO"
3130 GOSUB 5000 'PRESENT DIALOG
3140 GOSUB 7800 'YESNO
3150 IF YN$="Y" GOTO 3030
3160 CLOSE : RETURN
3400 REM "ANOTH"
3401 ' --------------------------------
3402 ' ASK FOR ANOTHER RUN
3403 '
3404 'THIS ROUTINE ASKS THE USER WHETHER TO CONTINUE
3405 '
3406 'CALLING PARAMETERS:
3407 ' Q2$= STRING TO SPECIFY WHAT OPERATION TO DO
3408 '
3409 'RETURNED PARAMETERS:
3410 ' YN$= A "Y" OR "N" FOR YES OR NO
3411 '
3412 ' --------------------------------
3420 Q1$="WOULD YOU LIKE TO "
3430 Q3$="AGAIN Y OR N ?"
3440 GOSUB 5000 'PRESENT DIALOG
3450 GOSUB 7800 'ASK YES OR NO
3460 RETURN
3800 REM "BAKFIL"
3801 ' -------------------------------
3802 ' BACK UP A FILE
3803 '
3804 'THIS ROUTINE CREATES A BACKUP COPY OF A FILE
3805 '
3806 'CALLING PARAMETERS:
3807 ' F$= NAME OF FILE TO BACKUP
3808 ' FB$=NAME OF BACKUP FILE
3809 '
3810 ' -------------------------------
3820 OPEN F$ FOR INPUT AS #1
3830 OPEN FB$ FOR OUTPUT AS #2
3840 'READ A RECORD, THEN WRITE IT
3850 FOR I= 1 TO 4000
3860 IF EOF(1) THEN GOTO 3900 'TILL END OF FILE
3870 INPUT#1,P1$,P2$,P3$,P4$,P5$,P6$,P7$,P8$
3880 WRITE#2,P1$,P2$,P3$,P4$,P5$,P6$,P7$,P8$
3890 NEXT I
3900 CLOSE
3910 RETURN
4600 REM "DELREC"
4601 ' -------------------------------
4602 ' DELETE RECORC
4603 '
4604 'THIS ROUTINE DELETES A RECORD FROM A FILE
4605 '
4606 'CALLING PARAMETERS:
4607 ' FB$= NAME OF BACKUP FILE TO CREATE
4608 ' F$=NAME OF FILE TO DELETE FROM
4609 '
4610 'RETURNED PARAMETERS:
4611 ' L=-1 IF RECORD NOT FOUND
4612 '
4613 'COMMENT-USER IS ASKED FOR RECORD NUMBER
4614 ' BACKUP FILE IS CREATED
4615 '
4616 ' -------------------------------
4620 N$="DELETE RECORD" : GOSUB 6200 'INITIALIZE
4630 Q1$="NUMBER OF RECORD TO DELETE"
4640 Q2$="" : Q3$=""
4650 GOSUB 5000 'ASK QUESTION
4660 INPUT L 'GET REC NUMBER
4670 GOSUB 3800 'CREATE BACKUP
4680 OPEN FB$ FOR INPUT AS #1
4690 OPEN F$ FOR OUTPUT AS #2
4700 FOR I = 1 TO L-1
4710 IF EOF(1) THEN GOTO 4860 'REC NOT FOUND
4720 INPUT#1,P1$,P2$,P3$,P4$,P5$,P6$,P7$,P8$
4730 WRITE#2,P1$,P2$,P3$,P4$,P5$,P6$,P7$,P8$
4740 NEXT I
4750 REM READ BUT DON'T WRITE RECORD TO DELETE
4760 INPUT#1,P1$,P2$,P3$,P4$,P5$,P6$,P7$,P8$
4770 REM READ AND WRITE TILL END OF FILE
4780 FOR I= 1 TO 4000
4790 IF EOF(1) THEN GOTO 4840
4800 INPUT#1,P1$,P2$,P3$,P4$,P5$,P6$,P7$,P8$
4810 WRITE#2,P1$,P2$,P3$,P4$,P5$,P6$,P7$,P8$
4820 NEXT I
4830 REM NORMAL RETURN
4840 CLOSE : RETURN
4850 REM ERROR RETURN
4860 CLOSE
4870 L=-1 'SET ERROR FLAG
4880 RETURN
5000 REM "DIALOG"
5001 ' -------------------------------
5002 ' DIALOGUE
5003 '
5004 'CALLING PARAMETERS:
5005 ' Q1$,Q2$,Q3$, = QUESTIONS TO DISPLAY
5006 '
5007 'RETURNED PARAMETERS:
5008 ' NONE
5009 '
5010 'COMMENT: UNUSED QUESTION STRINGS SHOULD BE SET
5011 ' TO NULL ("")
5012 '
5013 ' -------------------------------
5020 FOR I= 20 TO 23
5030 LOCATE I,1
5040 IF I > 20 THEN 5080
5050 FOR J= 1 TO 40 'DRAW A BORDER
5060 PRINT "-";
5070 NEXT J
5080 IF I = 21 THEN PRINT Q1$; 'FIRST QUESTION
5090 IF I = 22 THEN PRINT Q2$; 'SECOND QUESTION
5100 IF I = 23 THEN PRINT Q3$; 'THIRD QUESTION
5109 REM RESTORE CURSOR HERE AFTER 3RD QUEST
5110 CP1=POS(N)
5120 CP=POS(N) 'CURSOR COLUMN POSITION
5130 IF CP>40 THEN 5150
5140 PRINT " "; : GOTO 5120 'ERASE ANY PRIOR INFO
5149 REM RESTORE CURSOR FOR USER RESPONSE
5150 LOCATE I,CP1
5160 NEXT I
5170 RETURN
5400 REM "INCH"
5401 ' ------------------------------
5402 ' INPUT CHARACTER
5403 '
5404 'CALLING PARAMETERS:
5405 ' NONE
5406 '
5407 'RETURNED PARAMETERS:
5408 ' CH$=INPUT CHARACTER
5409 '
5410 ' ------------------------------
5420 REM WAIT FOR INPUT CHARACTER
5430 CH$= INKEY$ : IF CH$="" THEN 5430
5440 Z=ASC(CH$)
5450 IF Z < 97 OR Z > 122 THEN 5470
5460 Z=Z-32
5470 CH$=CHR$(Z)
5480 RETURN
5800 REM "INDAT"
5801 ' -------------------------------
5802 ' INPUT DATA
5803 '
5804 'CALLING PARAMETERS:
5805 ' Q1$,Q2$= USER INSTRUCTIONS
5806 ' Q3$=NAME OF DATA ITEM
5807 '
5808 'RETURNED PARAMETERS:
5809 ' P$(K)=ARRAY OF DATA ITEMS
5810 '
5811 'COMMENT:ONE ITEM AT A TIME IS INPUT
5812 ' FIRST CALL IS WITH K=1
5813 ' K UPDATED AUTOMATICALLY
5814 '
5815 '---------------------------------
5820 GOSUB 5000 'ASK QUESTIONS
5830 INPUT P$(K) 'GET DATA
5840 REM ECHO QUESTION AND ANSWER
5850 LOCATE K+2,3
5860 PRINT Q3$;TAB(25);P$(K)
5870 K=K+1 'UPDATE INDEX
5880 RETURN
6200 REM "INIT"
6201 '----------------------------------
6202 ' INITIALIZE DISPLAY
6203 '
6204 'THIS ROUTINE CLEARS THE SCREEN
6205 ' AND PRINTS THE PROGRAM TITLE
6206 'CALLING PARAMETERS:
6207 ' N$=TITLE OF PROGRAM
6208 '
6209 'RETURNED PARAMETERS:
6210 ' NONE
6211 '
6212 ' ----------------------------------
6220 CLS 'CLEAR SCREEN
6230 PRINT N$ : PRINT 'TITLE
6240 KEY OFF
6250 RETURN
7000 REM "MENU"
7001 ' ------------------------------
7002 ' MENU PROGRAM
7003 '
7004 'THIS PROGRAM DISPLAYS A MENUE
7005 ' AND CHOOSES A PROGRAM
7006 'CALLING PARAMETERS:
7007 ' N= NO. OF MENU ITEMS
7008 ' X$(I)= ARRAY OF PROGRAM NAMES
7009 '
7010 'RETURNED PARAMETERS:
7011 ' X=PROGRAM NUMBER CHOSEN
7012 '
7013 ' ------------------------------
7020 CLS
7030 FOR I = 1 TO N 'DISPLAY MENU
7040 IF I=10 THEN PRINT 0; ELSE PRINT I;
7050 PRINT "= " ; X$(I)
7060 NEXT I
7070 Q1$="" : Q2$=""
7080 Q3$="CHOOSE PROGRAM :"
7090 GOSUB 5000 'ASK QUESTIONS
7100 GOSUB 5400 'INPUT CHAR
7110 X= VAL(CH$)
7119 REM SEE IF CHAR IN RANGE
7120 IF X>=1 AND X<=N THEN RETURN
7130 IF X=0 AND N=10 THEN 7140 ELSE 7150
7140 X=10 : RETURN
7150 Q1$="ILLEGAL CHOICE, CHOOSE AGAIN"
7160 GOSUB 5000
7170 GOTO 7100
7400 REM "PAUSE"
7401 ' -------------------------------
7402 ' WAIT FOR ANY KEY
7403 '
7404 'THIS ROUTINE WAITS FOR USER TO STRIKE KEY
7405 '
7406 'CALLING PARAMETERS:
7407 ' NONE
7408 '
7409 'RETURNED PARAMETERS
7410 ' NONE
7411 '
7412 ' -------------------------------
7420 Q1$="STRIKE ANY KEY TO CONTINUE"
7430 Q2$="" : Q3$=""
7440 GOSUB 5000 'CALL DIALOG
7450 X$=INKEY$ : IF X$ = "" THEN 7450 'WAIT FOR KEY
7460 RETURN
7800 REM "YESNO"
7801 ' -------------------------------
7802 ' YES-NO
7803 '
7804 'CALLING PARAMETERS:
7805 ' NONE
7806 '
7807 'RETURNED PARAMETERS:
7808 ' YN$= CONTAINS A Y OR N
7809 '
7810 ' -------------------------------
7815 LOCATE 24,24:PRINT "F10 to EXIT program.
7820 REM WAIT FOR KEY TO BE STRUCK
7830 YN$=INKEY$ : IF YN$="" THEN 7830
7840 IF YN$="y" THEN YN$="Y"
7850 IF YN$="n" THEN YN$="N"
7860 IF YN$ = "Y" OR YN$ = "N" THEN 7890
7870 REM NOT YES OR NO TRY AGAIN
7880 GOTO 7830
7890 PRINT YN$ : RETURN
PRINTCON.BAS
100 ' IBM MATRIX PRINTER CONTROL Copyright (c) 1983 Roxanne Katt
140 OPTION BASE 1:DEFINT A-Z:CLS:KEY OFF:DIM VL$(8),VL(8),LN(8,2),LIM(3,2)
160 KEY 1,"1":KEY 2,"2":KEY 3,"3":KEY 4,"4":KEY 5,"5":KEY 6,"6":KEY 7,"7":KEY 8,"8":KEY 9,"9":KEY 10,"0":GOSUB 1000:GOSUB 2000
180 GOSUB 3000
190 LOCATE 23,27:PRINT "SETTINGS O.K.?":LOCATE 23,43,1
200 A$=INKEY$:IF A$="" GOTO 200
210 IF A$<>"Y" AND A$<>"y" THEN LOCATE 23,27:PRINT SPACE$(20):GOTO 180
211 GOSUB 4000:LOCATE 23,23:PRINT "PRINT TEST PATTERN?":LOCATE 23,43,1
212 A$=INKEY$:IF A$="" GOTO 212
213 IF A$<>"Y" AND A$<>"y" GOTO 216
214 LPRINT "TEST LINE ONE":LPRINT "TEST LINE TWO":LPRINT "TEST LINE THREE":LPRINT CHR$(VL(1));:LOCATE 23,23,0:PRINT SPACE$(20):GOTO 190
216 CLS:LOCATE 19,8:PRINT CHR$(201)+STRING$(57,205)+CHR$(187):LOCATE 20,8:PRINT CHR$(186)+SPACE$(57)+CHR$(186):LOCATE 21,8:PRINT CHR$(186)+" CONTROL CODES SET. E N D O F P R O G R A M. "+CHR$(186)
219 LOCATE 22,8:PRINT CHR$(186)+SPACE$(57)+CHR$(186):LOCATE 23,8:PRINT CHR$(200)+STRING$(57,205)+CHR$(188):LOCATE 23,1,0:FOR I=1 TO 4000:NEXT I
230 KEY 1,"LIST ":KEY 2,"RUN"+CHR$(13):KEY 3,"LOAD"+CHR$(34):KEY 4,"SAVE"+CHR$(34):KEY 5,"CONT"+CHR$(13):KEY 6,","+CHR$(34)+"LPT1:"+CHR$(34)+CHR$(13):KEY 7,"TRON"+CHR$(13):KEY 8,"TROFF"+CHR$(13):KEY 9,"KEY "
240 KEY 10,"SCREEN "+CHR$(0)+","+CHR$(0)+","+CHR$(0)+CHR$(13):CLS:KEY ON:RUN"MENU.BAT
1000 ' initialize variables
1010 DATA 7,29,7,63,11,29,11,63,15,29,15,62,19,28,19,62,"N","N","N","N","N","66 ","12 ","8 ",1,127,1,85,1,80
1040 FOR I=1 TO 8:FOR J=1 TO 2:READ LN(I,J):NEXT J:NEXT I:FOR I=1 TO 8:READ VL$(I):NEXT:FOR I=1 TO 3:FOR J=1 TO 2:READ LIM(I,J):NEXT J:NEXT I:RETURN
1100 -240
2000 ' put up specification screen
2010 LOCATE 1,8:PRINT CHR$(201)+STRING$(57,205)+CHR$(187):LOCATE 2,8:PRINT CHR$(186)+" I B M M A T R I X P R I N T E R C O N T R O L "+CHR$(186):LOCATE 3,8:PRINT CHR$(200)+STRING$(57,205)+CHR$(188)
2031 LOCATE 7,15,0:COLOR 0,7:PRINT "I N I T I A L I Z I N G P R I N T E R"
2032 LPRINT CHR$(20);CHR$(18);CHR$(27);CHR$(70);CHR$(27);CHR$(72);CHR$(27);CHR$(57);CHR$(27);CHR$(67);CHR$(60);CHR$(27);CHR$(65);CHR$(12);CHR$(27);CHR$(50);
2033 LPRINT CHR$(27);CHR$(68);:FOR I=8 TO 79 STEP 8:LPRINT CHR$(I);:NEXT:LPRINT CHR$(0);
2034 FOR I=1 TO 2000:NEXT I:LOCATE 7,10:COLOR 7,0:PRINT SPACE$(35):LOCATE 7,1:PRINT "Double Width First Line?":LOCATE 7,43:PRINT "Compressed Print?":LOCATE 8,1:PRINT STRING$(23,196):LOCATE 8,43:PRINT STRING$(16,196)
2080 LOCATE 11,8:PRINT "Emphasized Print?":LOCATE 11,40:PRINT "Double Strike Print?":LOCATE 12, 8:PRINT STRING$(16,196):LOCATE 12,40:PRINT STRING$(19,196):LOCATE 15, 8:PRINT "Form Feed Defeat?"
2130 LOCATE 15,47:PRINT "Lines / Page?":LOCATE 16,8:PRINT STRING$(16,196):LOCATE 16,47:PRINT STRING$(12,196):LOCATE 19, 8:PRINT "Vertical Spacing?":LOCATE 19,37:PRINT "Horizontal Tab Spacing?":LOCATE 20,8:PRINT STRING$(16,196)
2140 LOCATE 20,37:PRINT STRING$(22,196)
2200 ' put up default control values
2210 FOR I=1 TO 5:LOCATE LN(I,1),LN(I,2):PRINT VL$(I):NEXT:FOR I=6 TO 8:LOCATE LN(I,1),LN(I,2)+1:PRINT VL$(I):NEXT:RETURN
3000 'get control specs
3010 FOR I=1 TO 5:COLOR 15,0:LOCATE LN(I,1),LN(I,2):PRINT VL$(I):LOCATE LN(I,1),LN(I,2),1:A$=""
3040 A$=INKEY$:IF A$="" GOTO 3040
3050 IF ASC(A$)<>13 THEN IF A$="Y" OR A$="y" THEN VL$(I)="Y" ELSE VL$(I)="N"
3060 COLOR 7,0:LOCATE LN(I,1),LN(I,2):PRINT VL$(I):NEXT
3080 IF VL$(2)="Y" THEN LIM(3,2)=132
3090 FOR I=6 TO 8:IF I=7 THEN SP=2 ELSE SP=3
3120 FOR J=1 TO 4
3130 COLOR 15,0:LOCATE LN(I,1),LN(I,2)+1:PRINT VL$(I):LOCATE LN(I,1),LN(I,2)+J,1:A$=""
3140 A$=INKEY$:IF A$="" GOTO 3140
3150 IF ASC(A$)=13 GOTO 3200
3160 IF A$>="0" AND A$<="9" THEN MID$(VL$(I),J,5-J)=A$+SPACE$(4-J):GOTO 3190
3170 IF ASC(A$)=8 AND J>1 THEN J=J-1:MID$(VL$(I),J,5-J)=SPACE$(4-J)
3180 GOTO 3130
3190 NEXT J
3200 COLOR 7,0:LOCATE LN(I,1),LN(I,2)+1:PRINT VL$(I):IF VAL(VL$(I))<LIM(I-5,1) OR VAL(VL$(I))>LIM(I-5,2) GOTO 3120
3240 NEXT I:RETURN
4000 ' send control codes to printer
4010 IF VL$(1)="Y" THEN VL(1)=14 ELSE VL(1)=20
4020 IF VL$(2)="Y" THEN VL(2)=15 ELSE VL(2)=18
4030 IF VL$(3)="Y" THEN VL(3)=69 ELSE VL(3)=70
4040 IF VL$(4)="Y" THEN VL(4)=71 ELSE VL(4)=72
4050 IF VL$(5)="Y" THEN VL(5)=56 ELSE VL(5)=57
4060 FOR I=6 TO 8:VL(I)=VAL(VL$(I)):NEXT
4090 LPRINT CHR$(VL(1));CHR$(VL(2));CHR$(27);CHR$(VL(3));CHR$(27);CHR$(VL(4));CHR$(27);CHR$(VL(5));CHR$(27);CHR$(67);CHR$(VL(6));CHR$(27);CHR$(65);CHR$(VL(7));CHR$(27);CHR$(50);CHR$(27);CHR$(68);
4120 FOR I=VL(8) TO LIM(3,2)-1 STEP VL(8):LPRINT CHR$(I);:NEXT:LPRINT CHR$(0);:RETURN
REALPGM.BAS
1 KEY(10) ON:ON KEY(10) GOSUB 3
2 GOTO 5
3 RUN"MENU.BAT"+CHR$(13)
5 CLS
6 LOCATE 23,24:PRINT "Press F10 to EXIT game.
100 REM ------------------------------
110 N$= "REAL ESTATE PROGRAMS"
120 REM ------------------------------
130 GOSUB 6200 'INITIALIZE
140 X$(1)="MONTHLY PAYMENT"
150 X$(2)="MORTGAGE SCHEDULE"
160 X$(3)="REMAINING BALANCE OF LOAN"
170 X$(4)="EFFECT OF ACCELERATED PAYMENTS"
180 X$(5)="BALLOON PAYMENT CALCULATION"
190 X$(6)="AFFORDABLE HOUSE PRICE"
200 X$(7)="MORTGAGE WITH SECOND"
210 X$(8)="RENTAL PROPERTY"
220 N=8 : GOSUB 7000 'DISPLAY MENU
230 ON X GOSUB 590,700,880,1040,1430,1600,1830,2110
240 Q2$="RUN" : GOSUB 3400
241 IF YN$="N" THEN END ELSE 100
250 REM ------------------------------
260 REM ROUTINE TO CALCULATE PAYMENT
270 REM ------------------------------
280 REM CALLING PARAMETERS
290 REM IN=ANNUAL INTEREST RATE
300 REM YR=NO OF YEARS
310 REM AM=ANOUNT OF LOAN
320 REM
330 N1=12*YR :I1=IN/100/12 : V=1/(1+I1) :
340 P=AM*I1/(1-V^N1)
350 RETURN
360 REM ------------------------------
370 REM GET INPUT FOR PAYMENT CALC
380 REM ------------------------------
390 Q1$="SPECIFY PARAMETERS" : Q2$=""
400 Q3$="AMOUNT BORROWED ($)" :GOSUB 6600
410 Q3$="ANNUAL INT RATE (%) " :GOSUB 6600
420 Q3$="TERM OF LOAN (YRS)" :GOSUB 6600
430 AM=PAR(1)
440 IN=PAR(2)
450 YR=PAR(3)
460 RETURN
470 REM ------------------------------
480 REM CALCULATE REMAINING BALANCE
490 REM ------------------------------
500 REM CALLING PARAMETERS
510 REM P=PAYMENT
520 REM IN=ANNUAL INTEREST RATE
530 REM N=PAYMENT NUMBER
540 REM AM = AMOUNT OF LOAN
550 FOR I= 1 TO N
560 AM= AM-P+IN/12/100*AM
570 NEXT I
580 RETURN
590 REM -----------------------------------
600 N$= "MONTHLY PAYMENT CALCULATION"
610 REM -----------------------------------
620 GOSUB 6200 : K=1 'INITIALIZE
630 GOSUB 360 'GET PARAMETERS
640 GOSUB 250 'CALCULATE PYMT
650 PRINT
660 PRINT "MONTHLY PAYMENT IS";TAB(22)
670 PRINT USING "$$######,.##"; P
680 Q2$="COMPUTE" : GOSUB 3400 'ASK FOR ANOTHER
690 IF YN$="N" THEN RETURN ELSE 620
700 REM ------------------------------
710 N$= "MORTGAGE SCHEDULE"
720 REM ------------------------------
730 GOSUB 6200 : K=1 'INITIALIZE
740 GOSUB 360 'GET LOAN PARAMETERS
750 Q3$="YEAR"
760 GOSUB 6600 :N=PAR(4) 'GET YEAR
770 GOSUB 250 'CALCULATE PAYMENT
780 N=12*N-12 'COMPUTE FIRST MONTH
790 GOSUB 470 'GET BEGINNING BALANCE
800 PRINT " MONTH PRINCIPAL INTEREST BALANCE"
810 FOR J=1 TO 12
820 I1=IN/12/100*AM : P1=P-I1 :AM=AM-P1 'COMPUTE P & I
830 PRINT USING "########,.##";N+1,P1,I1,AM
840 N=N+1
850 NEXT J
860 Q2$="COMPUTE" : GOSUB 3400
870 IF YN$="N" THEN RETURN ELSE 700
880 REM ------------------------------
890 N$= "REMAINING BALANCE"
900 REM ------------------------------
910 GOSUB 6200 : K=1 'INITIALIZE
920 GOSUB 360 'GET LOAN PARAMETERS
930 Q3$="PAYMENT NUMBER"
940 GOSUB 6600 :N=PAR(4) 'GET PAYMENT NO.
950 GOSUB 250 'CALCULATE PAYMENT
960 GOSUB 470 'COMPUTE BALANCE
970 PRINT
980 PRINT "MONTHLY PAYMENT";TAB(22);
990 PRINT USING "$$######,.##";P
1000 PRINT "BAL AFTER ";N; " PMTS"; TAB(22);
1010 PRINT USING "$$######,.##";AM
1020 Q2$="COMPUTE" : GOSUB 3400 'ASK FOR ANOTHER
1030 IF YN$="N" THEN RETURN ELSE 880
1040 REM ------------------------------
1050 N$= "ACCELERATED PAYMENTS"
1060 REM ------------------------------
1070 GOSUB 6200 : K=1 'INITIALIZE
1080 GOSUB 360 'GET LOAN PARAMETERS
1090 Q3$="YEAR OF INCREASE "
1100 GOSUB 6600 :N=PAR(4) 'GET YEAR
1110 GOSUB 250 'CALCULATE PAYMENT
1120 N=12*N-12 'COMPUTE FIRST MONTH
1130 Q3$="EXTRA AMOUNT PAID ($)"
1140 GOSUB 6600 : EX=PAR(5) 'GET EXTRA
1150 REM COMPUTE PRIN INT AND BAL TO DATE
1160 TI=0 : BAL=0 : TP=0
1170 FOR J=1 TO N
1180 I1=IN/12/100*AM : P1=P-I1 : AM=AM-P1
1190 TI=TI+I1 : TP=TP+P1
1200 NEXT J
1210 REM COMPUTE INTEREST WITH NO INCREASE
1220 TI2=0 : AM2=PAR(1)
1230 FOR J=1 TO 12*YR
1240 I2=IN/12/100*AM2 : P2=P-I2 :AM2=AM2-P2
1250 TI2=TI2+I2
1260 NEXT J
1270 REM COMPUTE WITH XTRA PAYMENT
1280 J=0
1290 I1=IN/12/100*AM: TI=TI+I1
1300 P1=P+EX-I1 : TP=TP+P1
1310 AM=AM-P1
1320 J=J+1
1330 IF AM >0 THEN 1290
1340 PRINT
1350 PRINT "YEARS TO PAY OFF";TAB(25);
1360 PRINT USING "######,.##";PAR(4)+J/12-1
1370 PRINT "TOTAL INTEREST PAID";TAB(22);
1380 PRINT USING "$$######,.##";TI
1390 PRINT "INTEREST SAVED";TAB(22)
1400 PRINT USING "$$######,.##";TI2-TI
1410 Q2$="COMPUTE" : GOSUB 3400
1420 IF YN$="N" THEN RETURN ELSE 1040
1430 REM ------------------------------
1440 N$= "BALLOON PAYMENT"
1450 REM ------------------------------
1460 GOSUB 6200 : K=1 'INITIALIZE
1470 GOSUB 360 'GET LOAN PARAMETERS
1480 Q3$="YEAR LOAN DUE"
1490 GOSUB 6600 :N=12*PAR(4) 'GET YEAR DUE
1500 GOSUB 250 'CALCULATE PAYMENT
1510 GOSUB 470 'COMPUTE BALANCE
1520 PRINT
1530 PRINT "MONTHLY PAYMENT";TAB(22);
1540 PRINT USING "$$######,.##";P
1550 PRINT : PRINT "BALLOON PAYMENT"
1560 PRINT "AFTER ";N/12; " YEARS"; TAB(22);
1570 PRINT USING "$$######,.##";AM
1580 Q2$="COMPUTE" : GOSUB 3400 'ASK FOR ANOTHER
1590 IF YN$="N" THEN RETURN ELSE 1430
1600 REM -----------------------------
1610 N$= "AFFORDABLE HOUSE PRICE"
1620 REM -----------------------------
1630 GOSUB 6200 : K=1 'INITIALIZE
1640 Q1$="SPECIFY PARAMETERS" : Q2$=""
1650 Q3$="ANNUAL INT RATE (%) " : GOSUB 6600
1660 Q3$="TERM OF LOAN (YRS)" : GOSUB 6600
1670 Q3$="BUYERS ANNUAL INC" : GOSUB 6600
1680 Q3$="EST ANNUAL TAX & INS" : GOSUB 6600
1690 Q3$="% OF INC FOR PAYMENTS" : GOSUB 6600
1700 Q3$="% DOWN PAYMENT" : GOSUB 6600
1710 PRINT
1720 REM COMPUTE ALLOWABLE PAYMENT
1730 P=PAR(5)/100*PAR(3)/12 - PAR(4)/12
1740 REM COMPUTE AMOUNT FINANCED
1750 IN=PAR(1)/100/12 :N1=12*PAR(2) : V=1/(1+IN)
1760 AM=P*(1-V^N1)/IN
1770 PRINT "AMOUNT FINANCED";TAB(22);
1780 PRINT USING "$$######,.##";AM
1790 PRINT "AFFORDABLE HOUSE"; TAB(22);
1800 PRINT USING "$$######,.##";AM/(1-PAR(6)/100)
1810 Q2$="COMPUTE" : GOSUB 3400
1820 IF YN$="N" THEN RETURN ELSE 1600
1830 REM -----------------------------
1840 N$= "MORTGAGE WITH SECOND"
1850 REM -----------------------------
1860 GOSUB 6200 : K=1
1870 Q1$="SPECIFY PARAMETERS" : Q2$=""
1880 Q3$="PURCHASE PRICE ($)" : GOSUB 6600
1890 Q3$="CASH AVAILABLE ($)" : GOSUB 6600
1900 Q3$="FIRST MORT ($)" : GOSUB 6600
1910 Q3$="FIRST RATE (%)" : GOSUB 6600
1920 Q3$="FIRST TERM (YRS)" : GOSUB 6600
1930 Q3$="SECOND RATE (%)" : GOSUB 6600
1940 PRINT
1950 AM=PAR(3) : IN=PAR(4) : YR=PAR(5)
1960 REM COMPUTE FIRST PAYMENT
1970 GOSUB 250
1980 PRINT "PAYMENT (FIRST)";TAB(22);
1990 PRINT USING "$$######,.##";P
2000 REM COMPUTE 2ND PAYMENT
2010 IF PAR(2) < PAR(1)-PAR(3) THEN GOTO 2040
2020 PRINT "SECOND MORTGAGE NOT REQUIRED"
2030 GOTO 2090
2040 PRINT "PAYMENT (SECOND)";TAB(22)
2050 P2=(PAR(1)-PAR(2)-PAR(3))*PAR(6)/100/12
2060 PRINT USING "$$######,.##";P2
2070 PRINT "TOTAL PAYMENTS";TAB(22);
2080 PRINT USING "$$######,.##";P+P2
2090 Q2$="COMPUTE" : GOSUB 3400
2100 IF YN$="N" THEN RETURN ELSE 1830
2110 REM -----------------------------
2120 N$= "RENTAL PROPERTY ANALYSIS"
2130 REM -----------------------------
2140 GOSUB 6200 : K=1
2150 REM GET PARAMETERS
2160 GOSUB 360
2170 Q3$="ANNUAL INSURANCE ($)" : GOSUB 6600
2180 Q3$="ANNUAL TAXES ($)" : GOSUB 6600
2190 Q3$="ANNUAL MAINT ($)" : GOSUB 6600
2200 Q3$="MONTHLY INCOME ($)" : GOSUB 6600
2210 GOSUB 250 'CALCULATE PYMT
2220 PRINT
2230 PRINT "MONTHLY PAYMENT IS";TAB(22);
2240 PRINT USING "$$######,.##";P
2250 PRINT "MONTHLY CASH FLOW";TAB(22);
2260 CF=PAR(7)-P-(PAR(4)+PAR(5)+PAR(6))/12
2270 PRINT USING "$$######,.##";CF
2280 Q2$="COMPUTE" : GOSUB 3400
2290 IF YN$="N" THEN RETURN ELSE 2110
3400 REM "ANOTH"
3401 ' --------------------------------
3402 ' ASK FOR ANOTHER RUN
3403 '
3404 'THIS ROUTINE ASKS THE USER WHETHER TO CONTINUE
3405 '
3406 'CALLING PARAMETERS:
3407 ' Q2$= STRING TO SPECIFY WHAT OPERATION TO DO
3408 '
3409 'RETURNED PARAMETERS:
3410 ' YN$= A "Y" OR "N" FOR YES OR NO
3411 '
3412 ' --------------------------------
3420 Q1$="WOULD YOU LIKE TO "
3430 Q3$="AGAIN Y OR N ?"
3440 GOSUB 5000 'PRESENT DIALOG
3450 GOSUB 7800 'ASK YES OR NO
3460 RETURN
5000 REM "DIALOG"
5001 ' -------------------------------
5002 ' DIALOGUE
5003 '
5004 'CALLING PARAMETERS:
5005 ' Q1$,Q2$,Q3$, = QUESTIONS TO DISPLAY
5006 '
5007 'RETURNED PARAMETERS:
5008 ' NONE
5009 '
5010 'COMMENT: UNUSED QUESTION STRINGS SHOULD BE SET
5011 ' TO NULL ("")
5012 '
5013 ' -------------------------------
5020 FOR I= 20 TO 23
5030 LOCATE I,1
5040 IF I > 20 THEN 5080
5050 FOR J= 1 TO 40 'DRAW A BORDER
5060 PRINT "-";
5070 NEXT J
5080 IF I = 21 THEN PRINT Q1$; 'FIRST QUESTION
5090 IF I = 22 THEN PRINT Q2$; 'SECOND QUESTION
5100 IF I = 23 THEN PRINT Q3$; 'THIRD QUESTION
5109 REM RESTORE CURSOR HERE AFTER 3RD QUEST
5110 CP1=POS(N)
5120 CP=POS(N) 'CURSOR COLUMN POSITION
5130 IF CP>40 THEN 5150
5140 PRINT " "; : GOTO 5120 'ERASE ANY PRIOR INFO
5149 REM RESTORE CURSOR FOR USER RESPONSE
5150 LOCATE I,CP1
5160 NEXT I
5170 RETURN
5400 REM "INCH"
5401 ' ------------------------------
5402 ' INPUT CHARACTER
5403 '
5404 'CALLING PARAMETERS:
5405 ' NONE
5406 '
5407 'RETURNED PARAMETERS:
5408 ' CH$=INPUT CHARACTER
5409 '
5410 ' ------------------------------
5420 REM WAIT FOR INPUT CHARACTER
5430 CH$= INKEY$ : IF CH$="" THEN 5430
5440 Z=ASC(CH$)
5450 IF Z < 97 OR Z > 122 THEN 5470
5460 Z=Z-32
5470 CH$=CHR$(Z)
5480 RETURN
6200 REM "INIT"
6201 '----------------------------------
6202 ' INITIALIZE DISPLAY
6203 '
6204 'THIS ROUTINE CLEARS THE SCREEN
6205 ' AND PRINTS THE PROGRAM TITLE
6206 'CALLING PARAMETERS:
6207 ' N$=TITLE OF PROGRAM
6208 '
6209 'RETURNED PARAMETERS:
6210 ' NONE
6211 '
6212 ' ----------------------------------
6220 CLS 'CLEAR SCREEN
6230 PRINT N$ : PRINT 'TITLE
6240 KEY OFF
6250 RETURN
6600 REM "INPAR"
6601 ' --------------------------------
6602 ' INPUT PARAMETERS
6603 '
6604 'CALLING PARAMETERS:
6605 ' Q1$,Q2$=USER INSTRUCTIONS
6606 ' Q3$=NAME OF DATA ITEM
6607 '
6608 'RETURNED PARAMETERS:
6609 ' PAR(K)=THE DATA ITEM OBTAINED
6610 '
6611 'COMMENT: CALL WITH K=1 FOR FIRST DATA ITEM
6612 ' K AUTOMATICALLY UPDATED
6613 '
6614 ' -------------------------------
6620 GOSUB 5000 'ASK QUESTIONS
6630 INPUT PAR(K) 'GET VALUE
6640 REM ECHO QUESTION AND ANSWER
6650 LOCATE K+2,3
6660 PRINT Q3$; TAB(24);
6670 PRINT USING "######,.##"; PAR(K)
6680 K=K+1
6690 RETURN
7000 REM "MENU"
7001 ' ------------------------------
7002 ' MENU PROGRAM
7003 '
7004 'THIS PROGRAM DISPLAYS A MENUE
7005 ' AND CHOOSES A PROGRAM
7006 'CALLING PARAMETERS:
7007 ' N= NO. OF MENU ITEMS
7008 ' X$(I)= ARRAY OF PROGRAM NAMES
7009 '
7010 'RETURNED PARAMETERS:
7011 ' X=PROGRAM NUMBER CHOSEN
7012 '
7013 ' ------------------------------
7020 CLS
7030 FOR I = 1 TO N 'DISPLAY MENU
7040 IF I=10 THEN PRINT 0; ELSE PRINT I;
7050 PRINT "= " ; X$(I)
7060 NEXT I
7070 Q1$="" : Q2$=""
7080 Q3$="CHOOSE PROGRAM :"
7085 PRINT:PRINT " F10 to EXIT"
7090 GOSUB 5000 'ASK QUESTIONS
7100 GOSUB 5400 'INPUT CHAR
7110 X= VAL(CH$)
7119 REM SEE IF CHAR IN RANGE
7120 IF X>=1 AND X<=N THEN RETURN
7130 IF X=0 AND N=10 THEN 7140 ELSE 7150
7140 X=10 : RETURN
7150 Q1$="ILLEGAL CHOICE, CHOOSE AGAIN"
7160 GOSUB 5000
7170 GOTO 7100
7800 REM "YESNO"
7801 ' -------------------------------
7802 ' YES-NO
7803 '
7804 'CALLING PARAMETERS:
7805 ' NONE
7806 '
7807 'RETURNED PARAMETERS:
7808 ' YN$= CONTAINS A Y OR N
7809 '
7810 ' -------------------------------
7815 LOCATE 23,24:PRINT "Press F10 to EXIT program.
7820 REM WAIT FOR KEY TO BE STRUCK
7830 YN$=INKEY$ : IF YN$="" THEN 7830
7840 IF YN$="y" THEN YN$="Y"
7850 IF YN$="n" THEN YN$="N"
7860 IF YN$ = "Y" OR YN$ = "N" THEN 7890
7870 REM NOT YES OR NO TRY AGAIN
7880 GOTO 7830
7890 GOTO 110
STOCK.BAS
4 BLANK$=" "
5 DIM PQ$(50)
60 DIM MON$(12):DATA JANUARY,FEBRUARY,MARCH,APRIL,MAY,JUNE,JULY,AUGUST,SEPTEMBER,OCTOBER,NOVEMBER,DECEMBER:FOR I=1 TO 12:READ MON$(I):NEXT I
70 DEF SEG:POKE 106,0:DIM P$(100):N1=1:N2=13:KEY OFF
90 REM
100 REM=========== Prompt for menu in P$
110 P$(100)="Enter Your Selection:_":P$(99)="Wrong choice..Try again.."
120 DATA Master Menu,Add Data,Print Summary,Review Data,Get File Information,Print History,Evaluate Portfolio,Quit
130 DATA Review Menu,Review Entire Data,Review By Selected Stock,Review By Month,End Review
140 REM=============================================================
150 FMAT1$="###.####":FMAT2$="\ \":FMAT3$="####":FMAT4$="##.##"
160 FMAT5$="####.## ":FMAT6$="######.##":FMAT7$="\ \"
170 REM
180 REM
190 FOR I=N1 TO N2:READ P$(I):NEXT
195 FOR I=1 TO 14:READ PQ$(I):NEXT I
197 DIM Q$(11),QQ$(20):FOR I=1 TO 11:READ Q$(I):NEXT I
200 NUMBER=0
210 GOSUB 430
230 GOTO 360
240 REM
250 REM
260 REM===================================================================
270 REM===== Menu Writing
280 REM==================================================================
290 L=LEN(P$(BEG)):COL=INT((80-L)/2):CLS:K=1:KK=1
300 LOCATE 3,COL:PRINT P$(BEG):LOCATE 4,COL:FOR I=1 TO L:PRINT"=";:NEXT I
310 FOR I=(BEG+1) TO IEND:LOCATE K+6,COL-5:PRINT KK") ";:PRINT P$(I):K=K+2:KK=KK+1:NEXT:RETURN
320 L=LEN(P$(BEG)):COL=INT((80-L)/2):CLS:K=1:KK=1
330 LOCATE 3,COL:PRINT P$(BEG):LOCATE 4,COL:FOR I=1 TO L:PRINT"=";:NEXT I
340 FOR I=(BEG+1) TO IEND:LOCATE K+6,5:PRINT KK") ";:PRINT P$(I):K=K+2:KK=KK+1:NEXT:RETURN
350 REM=================================================================
360 REM Call Master Menu
370 BEG=1:IEND=8:GOSUB 260
380 LOCATE 24,COL+5:PRINT P$(100);:IN$=INKEY$
390 IF VAL(IN$)<1 OR VAL(IN$)>7 THEN 380
400 ON VAL(IN$) GOSUB 590,1190,1530,2180,2220,5000,2110
410 GOTO 360
420 REM ========================================================================
430 REM ..... Obtain file information
435 CLS
440 LOCATE 10,10:PRINT"DATA FILE: ";:INPUT"",FILE$:IF LEN(FILE$)=0 THEN 440
441 LOCATE 12,10:INPUT "IS THIS A NEW FILE PRINT: ",ANS$:IF ANS$="y" OR ANS$="Y" THEN KNOWN=0 ELSE KNOWN=1
442 IF KNOWN=0 THEN 450
445 OPEN "R",1,FILE$,128
447 FIELD #1,20 AS A1$,6 AS A2$, 6 AS A3$, 10 AS A4$, 10 AS A5$ ,10 AS A6$,1 AS A7$, 1 AS A8$, 1 AS A9$, 10 AS A10$
448 GET #1,1:ACNT=CVI(A1$):KN=CVI(A2$)
450 GOTO 360
550 IF ERR=53 THEN PRINT"There is no such data file on current disk drive!"
560 LOCATE 24,1:INPUT"Hit return to continue..",ANY$ :IF ERR=53 THEN RESUME 210 ELSE GOTO 360
570 REM
580 REM
590 CLS
592 LIN$="--------------------------------------------------------------------------": COD1$="Transaction Code: Buy=1, Sell=2, Short=3, Short Cov=4":COD2$="Exchange Code: NYSE=1, ASE=2, OTC=3":COD3$="
600 P$="Data Entry":L=LEN(P$):COL=INT((80-L)/2):LOCATE 1,COL:PRINT P$:LOCATE 2,COL:FOR I=1 TO LEN(P$):PRINT"=";:NEXT I
605 LOCATE 20,1:PRINT LIN$:LOCATE 21,1:PRINT COD1$:LOCATE 23,1:PRINT COD2$
610 LOCATE 4,2:PRINT"1. Stock Name : ";:GOSUB 1080
620 LOCATE 6,2:PRINT"2. Symbol : ";:GOSUB 1080
630 LOCATE 8,2:PRINT"3. No of Shares : ";:GOSUB 1080
640 LOCATE 10,2:PRINT"4. Price : ";:GOSUB 1080
650 LOCATE 12,2:PRINT"5. Commision : ";:GOSUB 1080
660 LOCATE 4,42:PRINT"6. Date : ";:GOSUB 1080
662 LOCATE 6,42:PRINT"7. Exchange Code : ";:GOSUB 1080
664 LOCATE 8,42:PRINT"8. Account Number : ";:GOSUB 1080
666 LOCATE 10,42:PRINT"9. Transaction Code : ";:GOSUB 1080
668 LOCATE 12,41:PRINT"10. Option Exp. Date : ";:GOSUB 1080
670 GOSUB 780: GOSUB 800: GOSUB 830: GOSUB 860: GOSUB 940: GOSUB 980
672 GOSUB 890: GOSUB 896: GOSUB 900 :GOSUB 882
680 LOCATE 15,4:PRINT"Entries OK? (Y/N) :";:INPUT"",ANS$
685 IF LEN(ANS$)=0 THEN 730
690 IF ANS$="Y" OR ANS$="y" THEN 730
700 LOCATE 15,4:PRINT"Change which entry (1-10)? :";:INPUT"",ANS$
710 ON VAL(ANS$) GOSUB 780,800,830,860,940,980,890,896,900,882
720 GOTO 680
730 KN=KN+1:IREC=KN+ACNT+5
731 LSET A1$=A$:LSET A2$=B$:LSET A3$=C$:LSET A4$=D$:LSET A5$=E$:LSET A6$=F$:LSET A7$=G$:LSET A8$=H$:LSET A9$=J$:LSET A10$=K$
733 PUT #1,IREC
740 LOCATE 17,4:PRINT"More data ? (Y/N) :";:INPUT" ",ANS$:IF ANS$="" OR ANS$="y" OR ANS$="Y" THEN GOTO 745 ELSE 750
745 LOCATE 15,4:PRINT BLANK$;:LOCATE 17,4:PRINT BLANK$ :GOTO 610
750 RETURN
760 REM
770 REM
780 LOCATE 4,26:INPUT"",A$:IF A$="X" OR A$="x" THEN 360
790 IF LEN(A$)=0 THEN 780 ELSE RETURN
800 LOCATE 6,26:INPUT"",B$ :IF B$="X" OR B$="x" THEN 360
820 IF LEN(B$)=0 THEN 800 ELSE RETURN
830 LOCATE 8,26:INPUT"",C$:IF C$="X" OR C$="x" THEN 360
840 X$=C$:GOSUB 1010:IF ER=1 THEN 830
850 IF LEN(C$)=0 THEN 830 ELSE RETURN
860 LOCATE 10,26:INPUT"",D$ :IF D$="X" OR D$="x" THEN 360
865 X$=D$:GOSUB 1010:IF ER=1 THEN 860
870 IF LEN(D$)=0 THEN 860
880 RETURN
882 LOCATE 12,66:INPUT"",K$ :IF K$="X" OR K$="x" THEN 360
884 IF LEN(K$)=0 THEN 882 ELSE RETURN
890 LOCATE 6,66:INPUT"",G$ :IF G$="X" OR G$="x" THEN 360
891 X$=G$:GOSUB 1010:IF ER=1 THEN 890
892 IF LEN(G$)=0 THEN 890
894 RETURN
896 LOCATE 8,66:INPUT"",H$ :IF H$="X" OR H$="x" THEN 360
897 IF LEN(H$)=0 THEN 896
898 X$=H$:GOSUB 1010:IF ER=1 THEN 896
899 RETURN
900 LOCATE 10,66:INPUT"",J$ :IF J$="X" OR J$="x" THEN 360
905 IF LEN(J$)=0 THEN 900
907 RETURN
940 LOCATE 12,26:INPUT"",E$ :IF E$="x" OR E$="X" THEN 360
945 X$=E$:GOSUB 1010:IF ER=1 THEN 940
950 IF LEN(E$)=0 THEN 940
970 RETURN
980 LOCATE 4,66:INPUT"",F$ :IF F$="x" OR F$="X" THEN 360
990 IF LEN(F$)=0 THEN 980
1000 RETURN
1010 ER=0:L=LEN(X$):FOR I=1 TO L:Q$=MID$(X$,I,1):IF Q$<"." OR Q$>"9" THEN ER=1:NEXT I
1020 IF ER=0 THEN 1040
1030 LOCATE 24,1:PRINT"No alphabetic input for this entry..";:FOR I=1 TO 1200:NEXT I:LOCATE 24,1:PRINT" ";:
1040 RETURN
1050 ER=1:L=LEN(X$):FOR I=1 TO L:Q$=MID$(X$,I,1):IF Q$ =CHR$(45) THEN ER=0:NEXT I:PRINT ER
1060 ER=1:L=LEN(X$):FOR I=1 TO L:Q$=MID$(X$,I,1):IF Q$ =CHR$(47) THEN ER=0:NEXT I:PRINT ER
1070 RETURN
1080 FOR I=1 TO 10:PRINT".";:NEXT I:RETURN
1090 REM
1100 REM
1110 N3=LEN(B$):N1=45:GOSUB 1130:NH=N2:N1=47:GOSUB 1130:NS=N2:A1=VAL(MID$(B$,1,NH-1)) :A2=VAL(MID$(B$,NH+1,N3-NH)):A3=VAL(MID$(B$,NS+1,N3-NS))
1120 PR=A1+A2/A3:RETURN
1130 N2=0:FOR I=1 TO N3
1140 IF MID$(B$,I,1)<> CHR$(N1) THEN 1160
1150 N2=I
1160 NEXT I
1170 RETURN
1180 REM
1190 CLS:SCREEN 2:PROMT$="Please wait ... data being sorted..":L=LEN(PROMT$):COL=INT((80-L)/2):LOCATE 12,COL:PRINT PROMT$
1195 GOSUB 1200:GOSUB 1390:SCREEN 0 :RETURN
1200 FOR I=1 TO KN:INDEX(I)=1:NEXT I:Q=1
1205 FOR II=1 TO KN:I=II
1210 KZ=0:STOK$=STOCK$(I)
1220 IF INDEX(I)=0 THEN 1370
1230 SHAR(Q)=SHARE(I):NAM$(Q)=STOCK$(I):IF TRANS$(I)="B" THEN 1240 ELSE 1250
1240 BPR(Q)=PRICE(I):DB$(Q)=DAT$(I):COMB(Q)=COMM(I) :GOTO 1260
1250 SPR(Q)=PRICE(I):DS$(Q)=DAT$(I):COMS(Q)=COMM(I)
1260 FOR J=(I+1) TO KN
1270 IF KZ=1 THEN 1350
1280 IF STOK$<>STOCK$(J) THEN 1350
1290 IF TRANS$(I)=TRANS$(J) THEN 1350
1300 IF TRANS$(J)="B" THEN 1310 ELSE 1320
1310 BPR(Q)=PRICE(J):DB$(Q)=DAT$(J):COMB(Q)=COMM(J) :GOTO 1330
1320 SPR(Q)=PRICE(J):DS$(Q)=DAT$(J):COMS(Q)=COMM(J)
1330 REM
1340 INDEX(J)=0:KZ=1
1350 NEXT J
1360 Q=Q+1
1370 NEXT II
1380 FOR I=1 TO Q:N$(I)=NAM$(I):IND(I)=I:NEXT I:E=Q:GOSUB 2360
1385 RETURN
1390 WIDTH "lpt1:",125:FT1$="\ \":FT2$=" #####":FT3$="\ \":FT4$=" ###.## ":FT5$="#####.##":FT6$=" ####.##"
1400 SUM3=0:SUM4=0:NPAGE=1:GOSUB 2830
1410 KL=1:FOR II=2 TO Q:I=IND(II) :TT=SHAR(I)*BPR(I):PROF=0
1420 IF DS$(I)<>"" THEN PROF=SHAR(I)*(SPR(I)-BPR(I)) -COMB(I)-COMS(I)
1421 SUM3=SUM3+PROF
1425 LPRINT TAB(1) NAM$(I);:
1430 LPRINT TAB(10) USING FT2$;SHAR(I);:
1435 IF LEN(DB$(I))=0 THEN 1450
1440 LPRINT TAB(20) USING FT3$;DB$(I);:LPRINT TAB(30) USING FT4$;BPR(I);:LPRINT TAB(40) USING FT4$;COMB(I);:
1450 IF LEN(DS$(I))=0 THEN 1465
1460 LPRINT TAB(55) USING FT3$;DS$(I);:LPRINT TAB(65) USING FT4$;SPR(I);:LPRINT TAB(75) USING FT4$;COMS(I);:
1465 IF SPR(I)=0 THEN LPRINT TAB(90) USING FT5$;TT;
1470 IF SPR(I)<>0 THEN LPRINT TAB(100) USING FT6$;PROF; ELSE LPRINT TAB(100) " ";:
1475 IF SPR(I)=0 THEN SUM4=SUM4+SHAR(I)*BPR(I)
1476 LPRINT:LPRINT:KL=KL+2
1477 IF KL>50 THEN 1478 ELSE 1480
1478 LPRINT:LPRINT:KL=1:LPRINT CHR$(140);:GOSUB 2830:NPAGE=NPAGE+1
1480 NEXT II
1485 LPRINT TAB(90) "____________________";:LPRINT TAB(75) "Total==>";:LPRINT TAB(90) USING "######.##";SUM4;:LPRINT TAB(100) USING FT5$;SUM3:
1490 RETURN
1500 REM
1510 REM
1520 REM
1530 BEG=9:IEND=13:GOSUB 260
1540 LOCATE 24,COL+5:PRINT P$(100);:IN$=INKEY$
1550 IF VAL(IN$)<1 OR VAL(IN$)>4 THEN 1540
1560 ON VAL(IN$) GOSUB 1610,1770,1930,360
1570 GOTO 1530
1580 RETURN
1590 REM
1600 REM
1610 CLS:SUM3=0:SUM4=0
1620 GOSUB 2640:E=KN:GOSUB 2360
1630 KNUM=6:FOR II=1 TO KN:I=IND(II)
1640 SUM3=SUM3+COMM(I)
1650 IF TRANS$(I)="b" OR TRANS$(I)="B" THEN SUM4=SUM4-TOT(I) ELSE SUM4=SUM4+TOT(I)
1660 IF KNUM=6 THEN GOSUB 2150
1670 LOCATE KNUM,1:PRINT USING FMAT2$; DAT$(I);:LOCATE KNUM,10:PRINT USING FMAT2$; STOCK$(I);:
1680 LOCATE KNUM,20:PRINT USING FMAT3$; SHARE(I);:LOCATE KNUM,30:PRINT USING FMAT4$; PRICE(I);:LOCATE KNUM,40:PRINT USING FMAT2$; TRANS$(I);:LOCATE KNUM,55:PRINT USING FMAT5$; COMM(I);:LOCATE KNUM,70:PRINT USING FMAT6$; TOT(I);:
1690 KNUM=KNUM+2
1700 IF KNUM<18 THEN 1720
1710 LOCATE 24,1:PRINT"Hit RETURN to continue..";:INPUT"",ANY$:KNUM=6:GOTO 1720
1720 NEXT II
1730 LOCATE 23,35:PRINT"Total ==>";:LOCATE 21,55:PRINT"__________________________";:LOCATE 23,55:PRINT USING FMAT5$;SUM3;:LOCATE 23,70:PRINT USING FMAT6$;SUM4;:
1740 LOCATE 23,1:PRINT"Hit RETURN to continue..";:INPUT"",ANY$:RETURN
1750 REM
1760 REM
1770 SUM1=0:SUM2=0:KNUM=6:CLS:LOCATE 1,20:INPUT"Enter Stock Name For Review: ",STOK$
1780 CLS:LOCATE 1,30:PRINT"Review of: ";STOK$
1790 IF KNUM=6 THEN GOSUB 2160
1800 FOR I=1 TO KN
1810 IF STOK$<> STOCK$(I) THEN GOTO 1910
1820 SUM1=SUM1+COMM(I)
1830 IF TRANS$(I)="b" OR TRANS$(I)="B" THEN SUM2=SUM2-TOT(I) ELSE SUM2=SUM2+TOT(I)
1840 LOCATE KNUM,1:PRINT USING FMAT2$; DAT$(I);:LOCATE KNUM,10:PRINT USING FMAT2$; STOCK$(I);:
1850 LOCATE KNUM,20:PRINT USING FMAT3$; SHARE(I);:LOCATE KNUM,30:PRINT USING FMAT4$; PRICE(I);:LOCATE KNUM,40:PRINT USING FMAT2$; TRANS$(I);:LOCATE KNUM,55:PRINT USING FMAT5$; COMM(I);:LOCATE KNUM,70:PRINT USING FMAT6$; TOT(I);:
1860 KNUM=KNUM+2
1870 LOCATE 23,35:PRINT"Total ==>";:LOCATE 21,55:PRINT"__________________________";:LOCATE 23,55:PRINT USING FMAT5$;SUM1;:LOCATE 23,70:PRINT USING FMAT6$;SUM2;:
1880 IF KNUM<18 THEN 1910
1890 LOCATE 21,55:PRINT"_________________________________":LOCATE 22,55:PRINT USING FMAT5$;SUM1:LOCATE 22,70:PRINT USING FMAT6$;SUM2
1900 LOCATE 24,1:PRINT"Hit RETURN to continue..";:INPUT"",ANY$:KNUM=6:GOTO 1780
1910 NEXT I
1920 LOCATE 24,1:PRINT"Hit RETURN to continue..";:INPUT"",ANY$:RETURN
1930 CLS:SUM1=0:SUM2=0:KNUM=6:LOCATE 1,20:INPUT"Enter Month Number(1-12) : ",MONTH$
1940 IF VAL(MONTH$)<1 OR VAL(MONTH$)>12 THEN 1930
1950 GOSUB 2550 :E=K1:GOSUB 2360
1960 GOSUB 2350:GOSUB 2160:FOR II=1 TO K1:I=IND(II)
1970 IF VAL(MONTH$) <> VAL(LEFT$(DAT$(I),2)) THEN GOTO 2050
1980 SUM1=SUM1+COMM(I)
1990 IF TRANS$(I)="b" OR TRANS$(I)="B" THEN SUM2=SUM2-TOT(I) ELSE SUM2=SUM2+TOT(I)
2000 LOCATE KNUM,1:PRINT USING FMAT2$; DAT$(I);:LOCATE KNUM,10:PRINT USING FMAT2$; STOCK$(I);:
2010 LOCATE KNUM,20:PRINT USING FMAT3$; SHARE(I);:LOCATE KNUM,30:PRINT USING FMAT4$; PRICE(I);:LOCATE KNUM,40:PRINT USING FMAT2$; TRANS$(I);:LOCATE KNUM,55:PRINT USING FMAT5$; COMM(I);:LOCATE KNUM,70:PRINT USING FMAT6$; TOT(I);:
2020 KNUM=KNUM+2
2030 IF KNUM>18 THEN 2040 ELSE 2050
2040 LOCATE 24,1:PRINT"Hit RETURN to continue..";:INPUT"",ANY$:GOSUB 2350:GOSUB 2160:KNUM=6
2050 NEXT II
2060 LOCATE 23,35:PRINT"Total ==>";:LOCATE 21,55:PRINT"__________________________";:LOCATE 23,55:PRINT USING FMAT5$;SUM1;:LOCATE 23,70:PRINT USING FMAT6$;SUM2;:
2070 LOCATE 24,1:PRINT"Hit RETURN to continue..";:INPUT"",ANY$:RETURN
2080 RETURN
2090 RETURN
2100 RETURN
2110 LSET A1$=MKI$(ACNT):LSET A2$=MKI$(KN):PUT #1,1
2130 CLS:PRINT"Program Terminated...":RUN"MENU.BAT"
2140 REM
2150 CLS:LOCATE 1,30:PRINT"Review of Stocks on File";:
2160 LOCATE 4,1:PRINT"Date";:LOCATE 4,10:PRINT"Company";:LOCATE 4,20:PRINT"Shares";:LOCATE 4,30:PRINT"Price";:LOCATE 4,40:PRINT"Bot/Sold";:LOCATE 4,55:PRINT"Commision";:LOCATE 4,73:PRINT"Cost";: RETURN
2170 REM
2180 GOSUB 20000
2190 RETURN
2210 REM
2220 CLS:INPUT"Please set your printer and hit RETURN...",ANY$:GOSUB 2640:E=KN:GOSUB 2360
2230 SUM3=0:SUM4=0:GOSUB 2660:NPAGE=1
2240 KL=1:FOR II=1 TO KN:I=IND(II)
2250 SUM3=SUM3+COMM(I)
2260 IF TRANS$(I)="b" OR TRANS$(I)="B" THEN SUM4=SUM4-TOT(I) ELSE SUM4=SUM4+TOT(I)
2270 LPRINT TAB(1) USING FMAT2$; DAT$(I);:LPRINT TAB(13) USING FMAT2$; STOCK$(I);:
2280 LPRINT TAB(25) USING FMAT3$; SHARE(I);:LPRINT TAB(35) USING FMAT4$; PRICE(I);:LPRINT TAB(45) USING FMAT7$; TRANS$(I);:LPRINT TAB(55) USING FMAT5$; COMM(I);:LPRINT TAB(70) USING FMAT6$; TOT(I):LPRINT:KL=KL+2
2290 IF KL>50 THEN 2300 ELSE 2310
2300 LPRINT:LPRINT:KL=1:LPRINT CHR$(140);:GOSUB 2660:NPAGE=NPAGE+1
2310 NEXT II
2320 LPRINT TAB(55) "__________________________";:LPRINT TAB(45) "Total==>";:LPRINT TAB(55) USING FMAT5$;SUM3;:LPRINT TAB(70) USING FMAT6$;SUM4:
2330 RETURN
2340 REM
2350 CLS:LOCATE 1,25:PRINT"Review of ";MON$(VAL(MONTH$));" Transactions";:RETURN
2360 REM Sorting Routine
2370 M=E-1 :T3=0
2380 T3=0
2390 IF T3=1 THEN 2530
2400 S2=1 :T3=1
2410 IF S2> M THEN 2510
2420 IF N$(S2)>N$(S2+1) THEN 2440
2430 GOTO 2490
2440 H$=N$(S2):H1=IND(S2)
2450 N$(S2)=N$(S2+1) :IND(S2)=IND(S2+1)
2460 N$(S2+1)=H$ :IND(S2+1)=H1
2470 T3=S2
2480 GOTO 2490
2490 S2=S2+1
2500 GOTO 2410
2510 M=T3-1
2520 GOTO 2390
2530 RETURN
2540 REM
2550 K1=1
2560 FOR I=1 TO KN
2570 IF VAL(MONTH$)<>VAL(LEFT$(DAT$(I),2)) THEN 2590
2580 N$(K1)=DAT$(I):IND(K1)=I:K1=K1+1
2590 NEXT I
2600 RETURN
2610 REM
2620 FOR I=1 TO K1:PRINT N$(I),IND(I):NEXT I:INPUT"",ANY$:RETURN
2630 REM
2640 BEEP:PRINT"Please wait..data being sorted!";:FOR I=1 TO KN:X$=LEFT$(DAT$(I),2):Y$=MID$(DAT$(I),4,2):N$(I)=X$+Y$:IND(I)=I:NEXT I:RETURN
2650 REM
2660 LPRINT TAB(1) "Page ";NPAGE;:LPRINT TAB(60) "Date: ";DT$;:LPRINT:LPRINT:LPRINT TAB(30) "Transaction History"
2670 LPRINT TAB(30) "===================":LPRINT:LPRINT
2680 LPRINT TAB(1) "Date";:LPRINT TAB(13) "Company";:LPRINT TAB(25) "Shares";:LPRINT TAB(35) "Price";:LPRINT TAB(45) "B/S";:LPRINT TAB(55) "Commision";:LPRINT TAB(73) "Cost":LPRINT:RETURN
2690 CLS:FOR I=1 TO KN:INDEX(I)=1:NEXT I:Q=1
2700 FOR II=1 TO KN:SHR=0:I=II
2710 IF INDEX(I)=0 THEN 1370
2720 FOR J=I TO KN
2730 STOK$=STOCK$(I)
2740 IF STOK$<>STOCK$(J) THEN 1350
2750 IF TRANS$(J)="B" THEN SHR=SHR+SHARE(J) ELSE SHR=SHR-SHARE(J)
2760 REM
2770 INDEX(J)=0
2780 NEXT J
2790 STK$(Q)=STOK$:SHAR(Q)=SHR:Q=Q+1
2800 NEXT II
2810 FOR I=1 TO Q:PRINT STK$(I),SHAR(I):NEXT I:INPUT"ret ..",AY$
2820 RETURN
2830 LPRINT TAB(1) "Page ";NPAGE;:LPRINT TAB(92) "Date: ";DT$;:LPRINT:LPRINT
2835 LPRINT:LPRINT:LPRINT TAB(50)"Stock Summary":LPRINT TAB(50)"=============":LPRINT:LPRINT
2840 LPRINT TAB(1)"Stock";:LPRINT TAB(10)"NO Of";:LPRINT TAB(32)"Buy";:LPRINT TAB(67) "Sell";:LPRINT TAB(92)"Total";:LPRINT TAB(102) "Profit"
2850 LPRINT TAB(1)"Name";:LPRINT TAB(10)"Shares";:LPRINT TAB(20) "Date";:LPRINT TAB(32) "Price";:LPRINT TAB(42) "Comm.";:LPRINT TAB(55) "Date";:LPRINT TAB(67) "Price";:LPRINT TAB(77) "Comm.";:LPRINT TAB(92) "Cost";:LPRINT TAB(102) "or Loss"
2860 LPRINT TAB(1)"_____";:LPRINT TAB(10) "______";:LPRINT TAB(20)"____";:LPRINT TAB(32)"_____";:LPRINT TAB(42)"_____";:LPRINT TAB(55)"____";:LPRINT TAB(67)"_____";:LPRINT TAB(77)"_____";:LPRINT TAB(92)"____";:LPRINT TAB(102)"_____"
2870 LPRINT:LPRINT
2880 RETURN
5000 CLS:IF KSORT<>0 THEN 5050
5005 PRINT"Please wait..":GOSUB 1200:FOR I=1 TO Q:N$(I)=NAM$(I):IND(I)=I:NEXT I:E=Q:GOSUB 2360 :KSORT=Q
5010 L=0:FOR I=1 TO Q:
5020 IF SPR(I)<>0! THEN 5040
5030 L=L+1:POR$(L)=NAM$(I):SHR(L)=SHAR(I):PRIC(L)=BPR(I)
5040 NEXT I
5050 SUM=0:KNUM=6:FOR Z=1 TO L-1
5055 IF KNUM=6 THEN GOSUB 7000
5060 LOCATE KNUM,10:PRINT USING "\ \";POR$(Z);:LOCATE KNUM,20:PRINT USING "#####";SHR(Z);:LOCATE KNUM,30:PRINT USING " ###.##";PRIC(Z);:TT=SHR(Z)*PRIC(Z):LOCATE KNUM,40:PRINT USING " #####.##";TT;:SUM=SUM+TT
5061 LOCATE KNUM,55:INPUT"",X$:GOSUB 1010
5062 IF ER=1 THEN 5061:IF LEN(X$)=0 THEN 5061
5063 B$=X$:GOSUB 1110:PRICN(Z)=PR:GAIN=SHR(Z)*(PRICN(Z)-PRIC(Z))
5064 LOCATE KNUM,65:PRINT USING"#####.##";GAIN
5070 KNUM=KNUM+2:IF KNUM<21 THEN 5090
5080 LOCATE 24,1:PRINT"Hit RETURN to continue..";:INPUT"",ANY$:KNUM=6
5090 NEXT Z
5095 LOCATE 23,30:PRINT"Total ==>";:LOCATE 21,40:PRINT"__________";:LOCATE 23,40:PRINT USING "######.##";SUM;:
5100 LOCATE 23,1:PRINT"Hit RETURN to continue..";:INPUT"",ANY$
5500 RETURN
7000 CLS:LOCATE 1,35:PRINT"Portfolio";:LOCATE 2,35:PRINT"=========";:LOCATE 4,10:PRINT"Stock";:LOCATE 4,20:PRINT"Shares";:LOCATE 4,32:PRINT "Price";:LOCATE 4,43:PRINT "COST";:
7010 LOCATE 3,55:PRINT"Today's";:LOCATE 3,65:PRINT "Loss or";:LOCATE 4,55:PRINT"Price";:LOCATE 4,65:PRINT"Gain";:RETURN
20000 REM
20010 REM ...............................................................
20020 REM This is the control module for the STOCK program
20030 REM This program chains to the following programs depending
20040 REM on the choice made by the user:
20050 REM 1- FILE INFO : To provide information of different account
20060 REM and update the information if needed.
20070 REM 2- DATA ENTRY: To provide data entry to file
20080 REM 3- DATA EDIT: To provide data correction
20090 REM 4- DATA REVIEW: To provide review data on file
20100 REM 5- DATA PRINTING (SUMMARY)
20110 REM 6- DATA PRINTING (HISTORY)
20120 REM
20130 REM ...............................................................
20140 REM ...............................................................
20150 CLS:KEY OFF:REM Clear screen and erase key functions
20160 N=9:REM Change N if more prompts are added
20170 DATA MENU,FILE INFORMATION,RETURN,DATA EDIT,DATA REVIEW,SUMMARY PRINT,PRINT HISTORY,HELP,QUIT
20180 DATA FILE INFORMATION,INITIAL FILE SET-UP,REVIEW FILE INFO,EDIT FILE INFO,RETURN TO MENU
20190 DATA Account For -,ACCOUNT TYPE(JOINT/INDIVIDUAL) -,ACCOUNT NUMBER -,AMOUNT DEPOSITED -,AMOUNT WITHDRAWN -,ACCOUNT OPENED ON -,BROKERAGE HOUSE -,BROKER NAME -,BROKER ADDRESS -,BROKER PHONE -,ACCOUNT TYPE(CASH/MARGIN) -
20230 PP$="Enter your selection please.."
20240 REM End Reading prompts for menu.
20250 REM
20260 GOTO 20350
20270 REM
20280 REM===== Menu Writing
20290 REM
20300 L=LEN(PQ$(BEG)):COL=INT((80-L)/2):CLS:K=1:KK=1
20310 LOCATE 3,COL:PRINT PQ$(BEG):LOCATE 4,COL:FOR I=1 TO L:PRINT"=";:NEXT I
20320 FOR I=(BEG+1) TO IEND:LOCATE K+6,COL-5:PRINT KK"- ";:PRINT PQ$(I):K=K+2:KK=KK+1:NEXT:RETURN
20330 REM
20340 PQ$(20)="Enter your selection please.."
20350 BEG=1:IEND=3:GOSUB 20300
20360 LOCATE 24,COL:PRINT PP$;:IN$=INKEY$
20370 IF VAL(IN$)<1 OR VAL(IN$)>2 THEN 20360
20380 PRINT IN$;:GOSUB 21070
20390 ON VAL(IN$) GOSUB 20450,21060
20400 RETURN
20410 REM ========================================================================
20420 REM This subroutine is used to provide information about the file
20430 REM
20440 REM
20450 BEG=10:IEND=14:GOSUB 20300
20460 LOCATE 24,COL:PRINT PP$;:IN$=INKEY$: IF LEN(IN$)=0 THEN 20460
20470 PRINT IN$;:GOSUB 21070
20480 IF VAL(IN$)<1 OR VAL(IN$)>4 THEN 20460
20490 ON VAL(IN$) GOSUB 20520,20740,20920,20500
20500 RETURN
20510 REM ========================================================================
20520 REM This subroutine is for setting the file set-up
20530 REM It asks for :file name, and number of accounts first.Then for each
20540 REM account it asks account number,broker etc
20550 REM The data is then stored in random file given by the user.The first record will contain number of accounts.
20560 REM subsequent records will contain rest of the informations.
20570 CLS:LOCATE 12,30:INPUT"Enter the file name:",FILEINFO$:KNOWN=1:LOCATE 14,30:INPUT"Number of accounts :",ACNT
20572 IF FILE$=FILEINFO$ THEN 20575 ELSE GOTO 20580
20575 LOCATE 24,30:PRINT "FILE ALREADY OPEN!";:GOSUB 21070:RETURN
20580 OPEN "R",1,FILEINFO$ ,128
20590 FIELD #1,20 AS A1$,6 AS A2$, 6 AS A3$, 10 AS A4$, 10 AS A5$ ,10 AS A6$,1 AS A7$, 1 AS A8$, 1 AS A9$, 10 AS A10$
20600 LSET A1$=MKI$(ACNT): LSET A2$=MKI$(KN):PUT #1,1
20610 FOR KZ=1 TO ACNT
20620 CLS:K=3:LOCATE 1,20:PRINT"ACCOUNT INFORMATION ENTRY:";:PRINT "ACCOUNT NO. ";:PRINT KZ
20630 FOR I=1 TO 11
20640 LOCATE 2+K,15
20650 PRINT Q$(I);:
20660 INPUT"",IN$:IF LEN(IN$)=0 THEN 20640
20670 QQ$(I)=IN$:K=K+2: NEXT I
20680 LSET A1$=QQ$(1):LSET A2$=QQ$(2):LSET A3$=QQ$(3):LSET A4$=QQ$(4):LSET A5$=QQ$(5)
20690 LSET A6$=QQ$(6):LSET A7$=QQ$(7):LSET A8$=QQ$(8):LSET A9$=QQ$(9):LSET A5$=QQ$(9):LSET A10$=QQ$(10):LSET A11$=QQ$(11)
20700 PUT #1,KZ+1
20710 NEXT KZ
20720 CLS
20730 RETURN
20740 REM This subroutine is for reviewing the info for the file
20750 REM The data is read from the file, and displayed on the screen
20760 CLS:IF KNOWN=0 THEN LOCATE 12,30:INPUT"Enter the file name:",FILEINFO$
20770 IF KNOWN=0 THEN OPEN "R",1,FILEINFO$ ,128 :KNOWN=1
20780 FIELD #1,20 AS A1$,6 AS A2$, 6 AS A3$, 10 AS A4$, 10 AS A5$ ,10 AS A6$,1 AS A7$, 1 AS A8$, 1 AS A9$, 10 AS A10$
20790 GET #1,1:ACNT=CVI(A1$)
20800 FOR KZ=1 TO ACNT: GET #1,KZ+1
20810 QQ$(1)=A1$:QQ$(2)=A2$:QQ$(3)=A3$:QQ$(4)=A4$:QQ$(5)=A5$:QQ$(6)=A6$
20820 QQ$(7)=A7$:QQ$(8)=A8$:QQ$(9)=A9$:QQ$(10)=A10$:QQ$(11)=A11$
20830 CLS:K=3:LOCATE 1,20:PRINT" INFORMATION FOR :";:PRINT "ACCOUNT NO. ";:PRINT KZ
20840 K=1:FOR I=1 TO 11
20850 LOCATE 2+K,15
20860 PRINT Q$(I);:
20870 PRINT QQ$(I);:K=K+2:NEXT I
20880 LOCATE 25,40:INPUT"....Hit Return To Continue", IN$
20890 NEXT KZ
20900 REM CLOSE #1
20910 RETURN
20920 REM This subroutine is for editing the data on file
20930 CLS
20940 REM
20950 REM
20960 IF KNOWN<>0 THEN GOTO 21010
20970 LOCATE 12,30:INPUT"Enter the file name:",FILEINFO$
20980 IF KNOWN=0 THEN OPEN "R",1,FILEINFO$ ,128 :KNOWN=1
20990 FIELD #1,20 AS A1$,6 AS A2$, 6 AS A3$, 10 AS A4$, 10 AS A5$ ,10 AS A6$,1 AS A7$, 1 AS A8$, 1 AS A9$, 10 AS 10$
21000 GET #1,1:ACNT=CVI(A1$)
21010 CLS:LOCATE 1,10:PRINT"EDIT WHICH ACCOUNT ? ";:INPUT"", NUMBER
21020 IF NUMBER <1 OR NUMBER >ACNT THEN 21030 ELSE 21040
21030 LOCATE 25,1:PRINT "NO SUCH ACCOUNT ON FILE! PLEASE RE-ENTER.":GOSUB 21070:LOCATE 25,1:PRINT" ":GOTO 21010
21040 GET #1, NUMBER+1
21060 RETURN
21070 FOR LATE =1 TO 500:NEXT LATE:RETURN
Directory of PC-SIG Library Disk #0406
Volume in drive A has no label
Directory of A:\
KALK BAS 20864 3-30-85 10:29p
LOANS BAS 15872 3-30-85 9:55p
PERPCAL BAS 5504 1-01-80 12:04a
PERS BAS 83 7-29-85 9:43p
CHECK BAS 9600 3-30-85 11:14p
STOCK BAS 19328 3-30-85 11:23p
PC-PAD BAS 18432 9-25-83 8:32a
FINANCE BAS 6528 1-01-80 2:18a
MORTGAGE BAS 16896 3-30-85 1:09a
BUSPGM BAS 11648 1-01-80 12:13a
FINPGM BAS 11520 1-01-80 12:14a
DATAPGM BAS 9216 1-01-80 12:24a
PERSONAL BAS 10112 1-01-80 12:54a
REALPGM BAS 11392 1-01-80 12:29a
MENU1-1 BAT 768 3-30-85 2:32p
PCSIG 1792 7-31-85 5:38a
PRINTCON BAS 3456 3-31-85 1:21p
AUTO1-1 BAT 20 7-29-85 10:21p
RETIRE WKS 4480 12-13-84 9:31p
TX5J WKS 43520 2-12-84 9:02p
BUDGET WKS 5724 1-01-80 12:31a
DIVIDEND WKS 3489 1-01-80 12:31a
EDFNDWKS WKS 2700 1-01-80 12:32a
GROWTH WKS 1565 1-01-80 12:34a
INSURE WKS 2188 1-01-80 12:35a
INVEST WKS 8052 1-01-80 12:35a
PAYMENTS WKS 5157 1-01-80 12:36a
PROPERTY WKS 4287 1-01-80 12:36a
SECURITY WKS 7194 1-01-80 12:38a
WEALTH WKS 12747 1-01-80 12:39a
MENU2-1 BAT 722 7-29-85 10:20p
AUTO2-1 BAT 20 7-29-85 10:21p
FILES406 TXT 2017 10-04-85 11:31a
33 file(s) 276893 bytes
27648 bytes free