rem - program DST.BAS
rem - Decision Support Tool
rem - copyright 1982, by Peter C. Hawxhurst
rem - revised 07/29/1982
rem - variable tabulation ************************
rem   cons$ = compact consideration storage
rem   cons% = considerations counter
rem   i%    = for next loop counter
rem   j%    = for next sub loop counter
rem   l(x)  = length of each consideration input
rem   ltr$  = consideration screen designation
rem   ltr1$ = first consideration choice
rem   ltr2$ = second consideration choice
rem   p(x)  = position in cons$ of each consid
rem   q1$   = considerations input
rem   q2$   = analysis input
rem   r(x)  = rank counter
rem   s(x)  = tie between rank and p,l
rem   t(x)  = total priority per consideration
rem - program structure **************************
gosub 100 : rem - housekeeping
gosub 200 : rem - screen
gosub 300 : rem - input
gosub 400 : rem - analysis
gosub 500 : rem - end of job
initialize
stop
100 rem - housekeeping subroutine ****************
dim cons$(232)
dim l(9)
dim p(9)
dim q1$(26)
dim r(9)
dim s(9)
dim t(9)
return
200 rem - screen subroutine **********************
print chr$(26)
print chr$(27)+")";
print tab(16);"DECISION SUPPORT ANALYSIS"
print
print tab(5);"CONSIDERATIONS";
print tab(34);"A ";"B ";"C ";"D ";"E ";"F ";"G ";
print "H ";"I"
print
for i%=1 to 9
read ltr$
print tab(2);ltr$
next i%
restore
print
print
print tab(1);" ";
for i%=1 to 49
print "-";
next i%
print chr$(27)+"("
return
300 rem - input subroutine ***********************
print chr$(27)+")"
print chr$(27)+"="+chr$(50)+chr$(36);
print "Enter decision consideration  , ";
print "or NONE to end"
print chr$(27)+"="+chr$(52)+chr$(43);
print "[";
print chr$(27)+"="+chr$(52)+chr$(71);
print "]"
print chr$(27)+"(";
for i%=1 to 9
read ltr$
print chr$(27)+"="+chr$(50)+chr$(65);
print ltr$
print chr$(27)+"="+chr$(52)+chr$(44);
for j%=1 to 27
print ".";
next j%
print
print chr$(27)+"="+chr$(52)+chr$(44);
input "";q1$
q1$=ucase$(q1$)
if q1$="NONE" then let i%=9
if q1$="NONE" then 390
let cons%=cons%+1
print chr$(27)+"="+chr$(i%+36)+chr$(37);
print q1$
let p(i%)=len(cons$)+1
let l(i%)=len(q1$)
let cons$=cons$+q1$
390 next i%
restore
return
400 rem - analysis subroutine ********************
for i%=1 to cons%-1
for j%=1 to 4
print chr$(27)+"="+chr$(49+j%)+chr$(33);
print chr$(27)+"T";
next j%
read ltr$
let ltr1$=ltr$
print chr$(27)+"="+chr$(50)+chr$(34);
print ltr$;"  ";mid$(cons$,p(i%),l(i%))
for j%=1 to cons%-i%
read ltr$
let ltr2$=ltr$
410 print chr$(27)+"="+chr$(51)+chr$(34);
print chr$(27)+"T";
print chr$(27)+"="+chr$(51)+chr$(34);
print ltr$;"  ";mid$(cons$,p(i%+j%),l(i%+j%))
print chr$(27)+"="+chr$(53)+chr$(33);
print chr$(27)+"T";
print chr$(27)+"="+chr$(53)+chr$(34);
print "Select greater of importance between ";
print ltr1$;" or ";ltr2$;
input " >";q2$
q2$=ucase$(q2$)
if q2$<>ltr1$ and q2$<>ltr2$ then print chr$(7);
if q2$<>ltr1$ and q2$<>ltr$ then 410
gosub 600 : rem - total
gosub 800 : rem - plot
next j%
restore
for j%=1 to i%
read ltr$
next j%
next i%
restore
return
500 rem - end of job subroutine ******************
510 for i%=1 to 5
print chr$(27)+"="+chr$(49+i%)+chr$(33);
print chr$(27)+"T";
next i%
if s1=1 then 530
for i%=1 to cons%
for j%=1 to cons%-1
if i%=j%+1 then 520
if t(i%)<>t(j%+1) then 520
for k%=1 to i%
read ltr1$
next k%
restore
for k%=1 to j%+1
read ltr2$
next k%
restore
print chr$(27)+"="+chr$(50)+chr$(33);
print chr$(27)+"T";
print chr$(27)+"="+chr$(50)+chr$(34);
print ltr1$;" ";mid$(cons$,p(i%),l(i%));" and"
print chr$(27)+"="+chr$(51)+chr$(33);
print chr$(27)+"T";
print chr$(27)+"="+chr$(51)+chr$(34);
print ltr2$;" ";mid$(cons$,p(j%+1),l(j%+1));
print " have equal rank ..."
515 print chr$(27)+"="+chr$(53)+chr$(33);
print chr$(27)+"T";
print chr$(27)+"="+chr$(53)+chr$(34);
print "Select greater of importance between ";
print ltr1$;" or ";ltr2$;
input " >";q2$
q2$=ucase$(q2$)
if q2$<>ltr1$ and q2$<>ltr2$ then print chr$(7);
if q2$<>ltr1$ and q2$<>ltr2$ then 515
gosub 600 : rem - total
let s2=s2+1
520 next j%
next i%
if s2=0 then let s1=1
let s2=0
goto 510
530 print chr$(27)+"="+chr$(53)+chr$(40);
input "Press - RETURN - to view ranking >";line q$
gosub 700 : rem - sort
print chr$(26)
print tab(8);"Considerations in order of importance"
print tab(8);"from highest to lowest are as follows"
print
for i%=1 to cons%
print tab(13); mid$(cons$,p(s(i%)),l(s(i%)))
next i%
print chr$(27)+"="+chr$(52)+chr$(40);
input "Press - RETURN - to return to menu >";line q$
return
600 rem - total subroutine ***********************
if q2$="A" then let t(1)=t(1)+1
if q2$="B" then let t(2)=t(2)+1
if q2$="C" then let t(3)=t(3)+1
if q2$="D" then let t(4)=t(4)+1
if q2$="E" then let t(5)=t(5)+1
if q2$="F" then let t(6)=t(6)+1
if q2$="G" then let t(7)=t(7)+1
if q2$="H" then let t(8)=t(8)+1
if q2$="I" then let t(9)=t(9)+1
return
700 rem - sort subroutine ************************
let r(1)=t(1)
for i%=1 to cons%
if t(i%)>=r(1) then let s(1)=i%
if t(i%)>=r(1) then let r(1)=t(i%)
next i%
for i%=1 to cons%-1
for j%=1 to cons%
if t(j%)<=r(i%) and j%<>s(i%) then 710
goto 720
710 if t(j%)>=r(i%+1) then let s(i%+1)=j%
if t(j%)>=r(i%+1) then let r(i%+1)=t(j%)
720 next j%
next i%
return
800 rem - plot subroutine ************************
print chr$(27)+"="+chr$(36+i%)+chr$(63+2*j%+2*i%);
print q2$
return
data "A","B","C","D","E","F","G","H","I"
