rem - program LPT.BAS
rem - Loan Payment Tabulation
rem - Copyright 1982 by Peter C. Hawxhurst
rem - revised 06/13/1982
rem - variable tabulation ************************
rem   a   = amount of loan
rem   a$  = amount of loan
rem   d$  = loan description
rem   e1$ = description too long error
rem   e2  = no data in loan file index
rem   i   = total interest to be payed
rem   i1  = monthly payment of interest
rem   i2  = interest payed per year
rem   i%  = for/next loop counter
rem   l   = line counter
rem   l1  = line counter for file index
rem   m$  = month loan payments begin
rem   m1$ = month data
rem   n   = month counter
rem   n$  = input filename
rem   n1$ = filename
rem   n2$ = file description
rem   p   = monthly payment
rem   p1  = monthly payment of principle
rem   p2  = principal payment total
rem   p(1)= payment factor 1
rem   p(2)= payment factor 2
rem   p$  = date check conversion
rem   p1$ = date check month
rem   p2$ = date check day
rem   p3$ = date check year
rem   q$  = carriage return
rem   q1$ = existing file question
rem   q2$ = save data question
rem   q3$ = end or continue option
rem   q4$ = output device question
rem   q5$ = data check question
rem   q6$ = correct input or exit
rem   q7$ = continue with monthly breakdown
rem   r   = numeric interest rate
rem   r1  = annual interest rate
rem   r$  = interest rate on loan
rem   s1  = end switch
rem   s2  = first pass switch
rem   t   = total money outlay
rem   t1  = principal total
rem   t2  = interest total
rem   t3  = total of each payment
rem   w   = numeric check for decimal point
rem   x   = numeric check variable
rem   y   = period of loan
rem   y$  = period of loan
rem   z   = numeric check equivalent
rem - program structure **************************
gosub 100 : rem - housekeeping
10 if s1=1 then 90
gosub 200 : rem - process
goto 10
90 gosub 300 : rem - end of job
chain "SSPM"
100 rem - housekeeping subroutine ****************
dim d$(26)
dim p(2)
let s2=1
gosub 400 : rem - tone on
gosub 1500 : rem - date
110 gosub 500 : rem - cursor
print tab(10);" ";
input "Existing loan on file (y/n) >";q1$
let q1$=ucase$(q1$)
if q1$<>"Y" and q1$<>"N" then 110
if q1$="N" then 130
120 gosub 500 : rem - cursor
print tab(12);" ";
input "Filename or I for index >";n$
let n$=ucase$(n$)
if n$="I" then gosub 600 : rem - index
if n$="I" and e2=1 then 110
if n$="I" then 120
let e2=0
if len(n$)>14 then gosub 700 : rem - spec error
if e2=1 then 120
if left$(n$,2)<>"B:" then gosub 700
if e2=1 then 120
if right$(n$,4)<>".DAT" then gosub 700
if e2=1 then 120
let e2=0
gosub 800 : rem - file check
if e2=1 then 110
open n$ as 1
read #1;d$,a,r,y,m$
close 1
let r$=str$(r*100)
let y$=str$(y)
goto 140
130 gosub 900 : rem - interrogate
140 gosub 500 : rem - cursor
print tab(8);" ";
input "Enter (S)creen or (P)rinter output >";q4$
let q4$=ucase$(q4$)
if q4$<>"S" and q4$<>"P" then 140
if q4$="S" then 150
lprinter
150 gosub 1000 : rem - tone off
return
200 rem - process subroutine *********************
if s2=0 then 210
let s2=0
gosub 1300 : rem - calculate
gosub 1100 : rem - report 1
goto 290
210 gosub 1200 : rem - report 2
290 return
300 rem - end of job subroutine ******************
if q1$="Y" then 360
310 gosub 400 : rem - tone on
gosub 500 : rem - cursor
print tab(6);" ";
input "Do you wish to save loan data (y/n) >";q2$
gosub 1000 : rem - tone off
let q2$=ucase$(q2$)
if q2$<>"Y" and q2$<>"N" then 310
if q2$="N" then 360
gosub 400 : rem - tone on
320 gosub 500 : rem - cursor
print tab(12);" ";
input "Enter filename for data >";n$
let n$=ucase$(n$)
let e2=0
if len(n$)>14 then gosub 700 : rem - spec error
if e2=1 then 320
if left$(n$,2)<>"B" then gosub 700
if e2=1 then 320
if right$(n$,4)<>".DAT" then gosub 700
if e2=1 then 320
let e2=0
gosub 800 : rem - file check
if e2=0 then gosub 1400 : rem - file exists
if e2=0 then 320
gosub 1000 : rem - tone off
open "B:LPF.DAT" as 1
if end #1 then 350
340 read #1;n1$,n2$
if end #1 then 350
goto 340
350 print #1;n$,d$
close 1
create n$ as 1
print #1;d$,a,r,y,m$
close 1
360 gosub 400 : rem - tone on
gosub 500 : rem - cursor
print tab(7);" ";
input "Press - RETURN - to return to menu >";line q$
gosub 1000 : rem - tone off
return
400 rem - tone on subroutine *********************
print chr$(27)+")";
return
500 rem - cursor subroutine **********************
print chr$(27)+"="+chr$(51)+chr$(32);
print chr$(27)+"T";
print chr$(27)+"="+chr$(52)+chr$(32);
print chr$(27)+"T";
print chr$(27)+"="+chr$(53)+chr$(32);
print chr$(27)+"T";
print chr$(27)+"="+chr$(51)+chr$(32);
return
600 rem - index subroutine ***********************
610 let l1=0
print chr$(26)
gosub 1000 : rem - tone off
print "LOAN PAYMENT FILE INDEX"
print
print "FILENAME","DESCRIPTION"
print
let l1=l1+4
open "B:LPF.DAT" as 1
if end#1 then 620
goto 630
620 gosub 400 : rem - tone on
gosub 500 : rem - cursor
print tab(12);"Error - no file!!!"
print tab(11);" ";
input "Press - RETURN - to retry >";line q$
let e2=1
goto 650
630 read #1;n1$,n2$
print
print n1$,n2$
if end #1 then 640
let l1=l1+2
if l1<18 then 630
gosub 400 : rem - tone on
gosub 500 : rem - cursor
print tab(10);" ";
input "Press - RETURN - to continue >";line q$
goto 610
640 gosub 400 : rem - tone on
650 close 1
return
700 rem - spec error subroutine ******************
if q1$="N" then gosub 400 : rem - tone on
gosub 500 : rem - cursor
print tab(5);"Error - specify as B:filename:.DAT!!!"
print tab(4);" ";
input "Press - RETURN - to retry >";line q$
let e2=1
if q1$="N" then gosub 1000 : rem - tone off
return
800 rem - filecheck subroutine *******************
open "B:LPF.DAT" as 1
810 if end #1 then 820
read #1;n1$,n2$
if n$=n1$ then 830
goto 810
820 gosub 500 : rem - cursor
print tab(12);"Error - file not on line!!!"
print tab(11);" ";
input "Press - RETURN - to retry >";line q$
let e2=1
830 close 1
return
900 rem - interrogate subroutine *****************
910 gosub 500 : rem - cursor
print tab(1);" ";
input "Enter description of loan >";d$
d$=ucase$(d$)
if len(d$)<27 then 920
gosub 500 : rem - cursor
print tab(12);"Error - description too long!!!"
print tab(11);" ";
input "Press - return - to retry >";line q$
goto 910
920 let e2=0
gosub 500 : rem - cursor
print tab(14);" ";
input "Enter amount of loan >";a$
let x$=a$
gosub 1600 : rem - numeric check
if e1=1 then 920
let a=val(a$)
if a<=999999 then 930
gosub 500 : rem - cursor
print tab(12);"Error - amount too large!!!"
print tab(11);" ";
input "Press - RETURN - to retry >";line q$
goto 920
930 let e1=0
gosub 500 : rem - cursor
print tab(9);" ";
input "Enter interest rate as II% >";r$
let x$=r$
gosub 1700 : rem - percent check
if e1=1 then 930
let r=val(r$)/100
940 let e1=0
gosub 500 : rem - cursor
print tab(9);" ";
input "Enter period of loan in years >";y$
let x$=y$
gosub 1600 : rem - numeric check
if e1=1 then 940
let y=val(y$)
950 let e1=0
gosub 500 : rem - cursor
input "Enter date payments begin (MM/DD/YYYY) >";m$
let p$=m$
gosub 1800 : rem - date check
if e1=1 then 950
return
1000 rem - tone off subroutine ********************
print chr$(27)+"(";
return
1100 rem - report 1 subroutine ********************
if q4$="S" then print chr$(26)
print "MONTHLY LOAN PAYMENT CALCULATION"
print
print d$
print
print
print
print tab(6);"LOAN";tab(15);"LOAN";
print tab(23);"INTEREST";tab(35);"MONTHLY";
print tab(46);"ANNUAL"
print tab(5);"AMOUNT";tab(14);"PERIOD";
print tab(25);"RATE";tab(35);"PAYMENT";
print tab(47);"RATE"
print
print tab(1);" "; : print using "$$#####.##";a;
print tab(15-len(y$));y;"YRS";
print tab(28-len(r$));100*r;"%";
print tab(32);" "; : print using "$$####.##";p;
print tab(42);" "; : print using "#####.##";r1;
print "%"
let l=l+10
if q4$="S" then 1110
console
1110 if q1$="Y" then 1150
gosub 400 : rem - tone on
1120 gosub 500 : rem - cursor
print tab(7);" ";
input "Is above input data correct (y/n) >";q5$
let q5$=ucase$(q5$)
if q5$<>"Y" and q5$<>"N" then 1120
if q5$="Y" then 1140
1130 gosub 500 : rem - cursor
print tab(8);" ";
input "Enter C to correct of X to exit >";q6$
let q6$=ucase$(q6$)
if q6$<>"C" and q6$<>"X" then 1130
if q6$="C" then gosub 900 : rem - interrogate
if q6$="C" then 1100
gosub 1000 : rem - tone off
let s1=1
goto 1180
1140 gosub 1000 : rem - tone off
1150 gosub 400 : rem - tone on
1160 gosub 500 : rem - cursor
print tab(8);" ";
input "Display monthly breakdown (y/n) >";q7$
let q7$=ucase$(q7$)
if q7$<>"Y" and q7$<>"N" then 1160
if q7$="Y" then 1170
let s1=1
1170 gosub 1000 : rem - tone off
1180 if q4$="S" then 1190
lprinter
1190 return
1200 rem - report 2 subroutine *******************
if q4$="S" then print chr$(26)
if q4$="S" then let l=0
print tab(3);"PAYMENT SCHEDULE IS AS FOLLOWS:"
print 
let l=l+2
gosub 1900 : rem - heading
let c=(val(t3$)-val(m3$))*12-val(m1$)+val(t1$)
for i%=1 to 12*y
let p1=p-((a-p2)*r/12)
let p2=p2+p1
let i1=p-p1
let t1=t1+p1
let t2=t2+i1
let t3=t3+p1+i1
let i2=i2+i1
print tab(4);" "; : print using "###";i%;
if i%-1<>c then 1210
print "*";
1210 print tab(11);" "; : print using "######.##";p1;
print tab(21);" "; : print using "######.##";i1;
print tab(32);" "; : print using "######.##";a-t1;
if i%=y*12 then 1220
if n<12 then print
if n<12 then 1230
1220 print tab(42);" "; : print using "######.##";i2
let n=0
let i2=0
1230 let n=n+1
let l=l+1
if q4$="P" then 1250
if l<18 then 1260
1240 gosub 500 : rem - cursor
print tab(8);" ";
input "Enter C to continue or E to exit >";q3$
let q3$=ucase$(q3$)
if q3$<>"C" and q3$<>"E" then 1240
if q3$="E" then let i%=12*y
if q3$="E" then 1260
let l=0
print chr$(26)
gosub 1900
goto 1260
1250 if l<60 then 1260
for j%=1 to 66-l
print
next j%
print
print
let l=2
1260 next i%
if q3$="E" then 1270
print
print tab(11);" "; : print using "######.##";t1;
print tab(21);" "; : print using "######.##";t2;
print tab(31);" "; : print using "#######.##";t3
1270 let s1=1
return
1300 rem - calculate subroutine ******************
let m1$=left$(m$,2)
let m3$=right$(m$,4)
let n=val(m1$)
let t1$=left$(t$,2)
let t3$=right$(t$,4)
let p(1)=(a*(r/12)*(1+r/12)^(12*Y))
let p(2)=((1+r/12)^(12*y)-1)
let p=p(1)/p(2)
let i=t-a
let r1=(((1+r/12)^12)-1)*100
return
1400 rem - file exists subroutine ****************
gosub 400 : rem - tone on
gosub 500 : rem - cursor
print tab(12);"Error - file exists!!!"
print tab(11);" ";
input "Press - RETURN - to retry >";q$
gosub 1000 : rem tone off
return
1500 rem - date subroutine ***********************
1510 let e1=0
gosub 500 : rem - cursor
print tab(8);" ";
input "Enter today's date (MM/DD/YYYY) >";t$
let p$=t$
gosub 1800 : rem - date check
if e1=1 then 1510
return
1600 rem - numeric check subroutine **************
let e1=0
let x=0
let w=0
let z=0
let w=w+match(".",x$,1)
for i%=1 to len(x$)
let z=z+i%
next i%
if w=0 then 1610
let z=z+1
1610 for i%=1 to len(x$)
let x=x+match("#",x$,i%)
next i%
if x=z then 1620
let e1=1
gosub 500 : rem - cursor
print tab(12);"Error - non numeric input!!!"
print tab(11);" ";
input "Press - RETURN - to retry >";line q$
1620 return
1700 rem - percent check subroutine **************
let e1=0
let x=0
let x=match("%",r$,1)
if x=0 then 1710
let r$=left$(r$,len(r$)-1)
1710 let x$=r$
gosub 1600 : rem - numeric check
return
1800 rem - date check subroutine *****************
let e1=0
if len(p$)>10 then 1810
let x=0
for i%=1 to 10
let x=x+match("#",p$,i%)
next i%
if x<>57 then 1810
let p1$=left$(p$,2)
let p2$=mid$(p$,4,2)
let p3$=right$(p$,4)
if val(p1$)<1 then 1810
if val(p1$)>12 then 1810
if val(p2$)<1 then 1810
if val(p3$)<1 then 1810
if val(p1$)=9 and val(p2$)>30 then 1810
if val(p1$)=4 and val(p2$)>30 then 1810
if val(p1$)=6 and val(p2$)>30 then 1810
if val(p1$)=11 and val(p2$)>30 then 1810
if val(p1$)=2 and val(p2$)>29 then 1810
if val(p3$)/4=int(val(p3$)/4) then 1820
if val(p1$)=2 and val(p2$)>28 then 1810
goto 1820
1810 gosub 500 : rem - cursor
print tab (12);"Error - improper date!!!"
print tab(11);" ";
input "Press - RETURN - to retry >";line q$
let e1=1
1820 return
1900 rem - headings subroutine *******************
print tab(4);"MONTH";tab(13);"PRINCIPAL";
print tab(24);"INTEREST";tab(35);"BALANCE";
print tab(46);"INT/YR"
print
let l=l+2
return