GRAFIEK ; Grafieken en regressie rechte [ 11/05/2001  3:38 PM ]
LINER(Y) ;Berekening regressie rechte
 ; Oproep via .Local
 ; Input is de array Y, met Y(X)=Value
 ; waar X een meetpunt is en Value de Y-waarde van het meetpunt
 
 New X,Sxy,Sx,Sy,Sx2,Cnt,Max,Min,m,b
 Set Cnt=0,X=""
 Set Min=999999999,Max=-999999999
 Set (Sxy,Sx,Sy,Sx2)=0
 For  Set X=$O(Y(X)) Quit:X=""  Do
 .Set Cnt=Cnt+1
 .Set:Max<Y(X) Max=Y(X)
 .Set:Min>Y(X) Min=Y(X)
 .Set Sxy=Sxy+(X*Y(X))
 .Set Sx=Sx+X
 .Set Sy=Sy+Y(X)
 .Set Sx2=Sx2+(X**2)
 If Cnt,(Cnt*Sx2-(Sx**2)) Do 
 .Set m=Cnt*Sxy-(Sx*Sy)/(Cnt*Sx2-(Sx**2))
 .Set b=Sy*Sx2-(Sx*Sxy)/(Cnt*Sx2-(Sx**2))
 Else  Set (m,b,Max,Min)=0
 Quit m_D_b_D_Max_D_Min_D_Cnt
 ; Waar de formule is Y = mX + b
 
	;Zelfde type array meegeven als bij LINER, echter de array Y die wo meegegeven
	;wordt overschreven met de punten van de regressierechte (berekend adhv Y = mX + b)
TRENDARRAY(Y,R)
	New TrendFormule,D,m,b,X
	Set D="\"
	Set TrendFormule=$$LINER(.Y)
	Set m=$P(TrendFormule,D,1)
	Set b=$P(TrendFormule,D,2)
	; opvullen van result array
	Set X=""
	For  Set X=$O(R(X)) Quit:(X="")  Do
	. Set R(X)=(m*X)+b
	Quit 
GRAF(Val,Label,sBGAttr,Optie,Pos) 
 ; sOptie : R = Rectangle
 ;        : C = Center on screen
 ;        : T = Trend lijn toevoegen
 ; Label bevat de labels voor de verschillende X waarden, maar 
 ; kan ook het volgende bevatten :
 ; Label("TITEL") = ExecType`Attrib`ExecTxt
 ; Label("HOOFD",n) = ExecType`Attrib`ExecTxt
 ; Label("FOOT",n) = ExecType`Attrib`ExecTxt
 ;New X,Sxy,Sx,Sy,Sx2,Cnt,Max,Min,sTop,sLeft,sRight,sBot,Y,XCnt,LabLen,I,m,b,YMax,YMin,Trend,ZeroB,ZeroL,YLabLen,Space,Char,sMemAttr
 Do STORE^vhTERMINA()
 Set Pos=$G(Pos)
 Set sTop=$P(Pos,";") Set:'sTop sTop=1
 Set sLeft=$P(Pos,";",2) Set:'sLeft sLeft=1
 Set sBot=$P(Pos,";",3) Set:'sBot sBot=sScr("ROW")
 Set sRight=$P(Pos,";",4) Set:'sRight sRight=sScr("KOL")
 Set Trend=$$LINER(.Val)
 Set m=$P(Trend,D,1)
 Set b=$P(Trend,D,2)
 Set Max=$P(Trend,D,3)
 Set Min=$P(Trend,D,4)
 For X=$O(Val("")),$O(Val(""),-1) Set Y=m*X+b Set:Max<Y Max=Y Set:Min>Y Min=Y
 Set XCnt=$P(Trend,D,5)
 Set LabLen=0
 Set X=""
 For  Set X=$O(Val(X)) Quit:X=""  Set:$L($G(Label(X)))>LabLen LabLen=$L(Label(X))
 Set HCnt=$O(Label("HOOFD",""),-1)
 Set FCnt=$O(Label("FOOT",""),-1)
 Set Scale=Max-Min/(sBot-sTop-LabLen-HCnt-FCnt-3)+.9999\1
 For Y=1,5,10,20,25,30,40,50,75,100,200,250,300,400,500,750,1000,2000,2500,3000,4000,5000,7500,10000 If Scale<Y Set Scale=Y Quit
 Set YMin=Min/Scale-.9999\1
 Set YMax=Max/Scale+.9999\1
 Set YLabLen=$L($J(Max,0,0)) Set:YLabLen<$L($J(Min,0,0)) YLabLen=$L($J(Min,0,0))
 Set Space=3 Set:XCnt Space=sRight-sLeft-YLabLen/XCnt\1 Set:Space>3 Space=3
 Set Rect=Optie["R"
 If Optie["C" Do  ;Centreren 
 .;New YTot,XTot
 .Set YTot=LabLen+HCnt+FCnt+YMax-YMin+(Rect*2)+1
 .Set sTop=sScr("ROW")\2-(YTot\2) Set:sTop<1 sTop=1
 .Set sBot=sTop+YTot-1
 .Set XTot=YLabLen+(XCnt*Space)+2+(Rect*2)
 .Set sLeft=sScr("KOL")\2-(XTot\2) Set:sLeft<1 sLeft=1
 .Set sRight=sLeft+XTot-1
 Do WRAND
 Set ZeroL=sLeft+YLabLen
 Set ZeroB=sBot-LabLen-FCnt+YMin
 Set FP=ZeroB-YMin+1*100+sLeft
 Do WATTR^vhRES("")
 For Y=YMin:1:YMax  Set FP=FP-100 Write @F,$J(Y*Scale,YLabLen,0)
 Set X=""
 Set Cnt=0
 Write @F7
 For  Set X=$O(Val(X)) Quit:X=""  Do
 .Set Cnt=Cnt+Space
 .Do WATTR^vhRES("I")
 .Do:Val(X)>0 FILL^vhTERMINA(ZeroB-$J(Val(X)/Scale,0,0),ZeroL+Cnt,ZeroB,ZeroL+Cnt)
 .Do:Val(X)<0 FILL^vhTERMINA(ZeroB,ZeroL+Cnt,ZeroB-$J(Val(X)/Scale,0,0),ZeroL+Cnt)
 .Quit:Optie'["T"
 .Set Y=m*X+b
 .;set FP=2201 write @F,@F1 zw Val(X),Y r K
 .Set Y=$J(Y/Scale*5,0,0)
 .Set Char=115-(Y+2#5)
 .Set Y=Y/5+.4999\1
 .Do:$J(Val(X)/Scale,0,0)<Y WATTR^vhRES("")
 .Set FP=ZeroB-Y*100+ZeroL+Cnt Write @F,*Char
 Write @F8
 Do WATTR^vhRES("")
 Set X=""
 Set Cnt=0
 For  Set X=$O(Val(X)) Quit:X=""  Do
 .Set Cnt=Cnt+Space
 .Set Label=$G(Label(X))
 .For I=1:1:$L(Label) Do
 ..Set FP=ZeroB-YMin+I*100+ZeroL+Cnt
 ..Write @F,$E(Label,I)
 Set X=$$IN^vhKEY()
 Do REFRESH^vhTERMINA()
 Write @FMTCL
 Quit
 
WRAND Write @FMTCL Write:sBGAttr="I" @FMTI
 If Rect Do
 .Do RECT^vhTERMINA(sTop,sLeft,sBot,sRight,sBGAttr)
 .Set sTop=sTop+1,sLeft=sLeft+1,sBot=sBot-1,sRight=sRight-1
 Else  Do
 .Write @FMTCL Write:sBGAttr="I" @FMTI
 .Do FILL^vhTERMINA(sTop,sLeft,sBot,sRight)
 If Rect,$L($G(Label("TITEL")))  Do WEXEC^vhRES(0,Label("TITEL"),1,0)
 For I=1:1:HCnt Do WEXEC^vhRES(I,Label("HOOFD",I),0,Rect)
 For I=1:1:FCnt Do WEXEC^vhRES(sBot-sTop+1-FCnt+I,Label("FOOT",I),0,Rect)
 Quit