rem 12/13/86 common used for terminal characteristics
common today$,warm$,trmtyp$,clear$,bell$,clreol$
common escape$,poscmd$,posofs%,rowcol$
rem - program DECISION.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
%chain 100,10000,50,500
print clear$
chain "HANDYSYS.COM"
100 rem - housekeeping subroutine ****************
dim l(9)
dim p(9)
dim r(9)
dim s(9)
dim t(9)
return
200 rem - screen subroutine **********************
print clear$
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%
return
300 rem - input subroutine ***********************
print
ypos%=50-31:xpos%=36-31:gosub 15000
print "Enter decision consideration  , ";
print "or NONE to end"
ypos%=52-31:xpos%=43-31:gosub 15000
print "[";
ypos%=52-31:xpos%=71-31:gosub 15000
print "]"
for i%=1 to 9
read ltr$
ypos%=50-31:xpos%=65-31:gosub 15000
print ltr$
ypos%=52-31:xpos%=44-31:gosub 15000
for j%=1 to 27
print ".";
next j%
print
ypos%=52-31:xpos%=44-31:gosub 15000
input "";q1$
q1$=ucase$(q1$)
if q1$="NONE" then let i%=9
if q1$="NONE" then 390
let cons%=cons%+1
ypos%=i%+36-31:xpos%=37-31:gosub 15000
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
ypos%=49+j%-31:xpos%=33-31:gosub 14000
next j%
read ltr$
let ltr1$=ltr$
ypos%=50-31:xpos%=34-31:gosub 15000
print ltr$;"  ";mid$(cons$,p(i%),l(i%))
for j%=1 to cons%-i%
read ltr$
let ltr2$=ltr$
410 ypos%=51-31:xpos%=34-31:gosub 14000
ypos%=51-31:xpos%=34-31:gosub 15000
print ltr$;"  ";mid$(cons$,p(i%+j%),l(i%+j%))
ypos%=53-31:xpos%=33-31:gosub 14000
ypos%=53-31:xpos%=34-31:gosub 15000
print "Select greater of importance between ";
print ltr1$;" or ";ltr2$;
print " > ";
while not constat%:wend:q2$=ucase$(chr$(conchar%))
if q2$<>ltr1$ and q2$<>ltr2$ then print bell$;
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
ypos%=49+i%-31:xpos%=33-31:gosub 14000
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
ypos%=50-31:xpos%=33-31:gosub 14000
ypos%=50-31:xpos%=34-31:gosub 15000
print ltr1$;" ";mid$(cons$,p(i%),l(i%));" and"
ypos%=51-31:xpos%=33-31:gosub 14000
ypos%=51-31:xpos%=34-31:gosub 15000
print ltr2$;" ";mid$(cons$,p(j%+1),l(j%+1));
print " have equal rank ..."
515 ypos%=53-31:xpos%=33-31:gosub 14000
ypos%=53-31:xpos%=34-31:gosub 15000
print "Select greater of importance between ";
print ltr1$;" or ";ltr2$;
print " > ";
while not constat%:wend:q2$=ucase$(chr$(conchar%))
if q2$<>ltr1$ and q2$<>ltr2$ then print bell$;
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 ypos%=53-31:xpos%=40-31:gosub 15000
input "Press - RETURN - to view ranking >";line q$
gosub 700 : rem - sort
print clear$
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%
ypos%=52-31:xpos%=40-31:gosub 15000
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 ************************
ypos%=36+i%-31:xpos%=63+2*j%+2*i%-31:gosub 15000
print q2$
return
data "A","B","C","D","E","F","G","H","I"
14000 rem - rubout subroutine ********************
14010 gosub 15000
14020 print clreol$;:gosub 15000
14030 return
15000 rem - cursor subroutine ********************
15020 rem - variables to check
15030 rem   xpos% = horizontal cursor position (1-52, L to R)
15040 rem   ypos% = vertical cursor position (1-24, T to B)
15060 if rowcol$=chr$(01) then 15090
15070 print poscmd$+chr$(xpos%+posofs%-1)+chr$(ypos%+posofs%-1);
15080 go to 15100
15090 print poscmd$+chr$(ypos%+posofs%-1)+chr$(xpos%+posofs%-1);
15100 return