vhRES ;LowLevel Resource routines [ 10/16/2001   4:24 PM ]
 
 
 
 
 New
 Do INIT^vhTERMINA,DISPLAY^vhScherm("RES")
 Set sTyp=""
 Do FIELD^vhScherm("RES","TYPE")
 If $L(sTyp) Do
 .Set sRec=^RES("vhRES","PI","TYP","D",sTyp)
 .Do EXEC($P(sRec,"`",3),$P(sRec,"`",4),X,$P(sRec,"`",5))
 Quit
 
GetPI(ProgLbl,Groep,Item,Piece)
	Quit:ProgLbl="" ""
	Quit:Groep="" ""
	Quit:Item="" ""
	Quit $P(^RES(ProgLbl,"PI",Groep,"D",Item),"`",Piece)
 
GROEP(sTyp,sOGroep,sEditNiv) 
 New sPos,sGroep,sSubGr,sCnt,sLine,sColom,sTitel
 Set sOGroep=$G(sOGroep)
 Set sPos=$$POS^vhScherm("GROEP"),sLine=$P($P(sPos,D,2),";"),sColom=$P($P(sPos,D,2),";",2)
 Set sGroep="",sCnt=0
 For  Set sGroep=$O(^RES(sGroep)) Quit:sGroep=""  Do
 .Quit:'$D(^RES(sGroep,sTyp))
 .If sEditNiv Do  Quit:sSubGr=""
 ..Set sSubGr=""
 ..For  Set sSubGr=$O(^RES(sGroep,sTyp,sSubGr)) Quit:sSubGr=""  Quit:$P($G(^RES(sGroep,sTyp,sSubGr)),"`",19)'<sEditNiv
 .Set sCnt=sCnt+1,sGroep(sCnt)=sGroep,sGroep("G",sGroep)=""
 If sCnt Do
 .If $L(sOGroep),$D(sGroep("G",sOGroep)),$E($O(sGroep("G",sOGroep)),1,$L(sOGroep))'=sOGroep Set sGroep=sOGroep Quit
 .If $L(sOGroep),'$D(^RES(sOGroep,sTyp)) Do
 ..Set sGroep=sOGroep
 ..For  Set sGroep=$O(^RES(sGroep)) Quit:sGroep=""  Do  Quit:$D(^RES(sOGroep,sTyp))
 ...Quit:'$D(^RES(sGroep,sTyp))
 ...If $E(sGroep,1,$L(sOGroep))=sOGroep Set sOGroep=sGroep
 .Kill sGroep("G")
 .Set sTitel="Groep"
 .Set sGroep=sCnt,sGroep=$$WILD^vhPOPUP(sLine_";"_sColom,"K1-",sTitel,.sGroep,sOGroep)
 Quit sGroep
 
SUBGROEP(sTyp,sGroep,sOSubGr,sEditNiv) 
 New sPos,sSubGr,sCnt,sLine,sColom,Omschr,sTitel
 Set sOSubGr=$G(sOSubGr)
 If $L(sOSubGr),'$D(^RES(sGroep,sTyp,sOSubGr)) Set sOSubGr=$O(^RES(sGroep,sTyp,sOSubGr))
 Set sPos=$$POS^vhScherm("SUBGROEP"),sLine=$P($P(sPos,D,2),";"),sColom=$P($P(sPos,D,2),";",2)
 Set sSubGr="",sCnt=0
 For  Set sSubGr=$O(^RES(sGroep,sTyp,sSubGr)) Quit:sSubGr=""  Do
 .If sEditNiv,$P($G(^RES(sGroep,sTyp,sSubGr)),"`",19)<sEditNiv Quit
 .Set Omschr=$P(^RES(sGroep,sTyp,sSubGr),"`")
 .Set sCnt=sCnt+1,sSubGr(sCnt)=sSubGr_D_Omschr
 If sCnt Do
 .If sCnt=1 Set sSubGr=sSubGr(1) Quit
 .Set sTitel=$S(sTyp="PI":"PopUp",1:"SubGr")
 .Set sSubGr=sCnt,sSubGr=$$WILD^vhPOPUP(sLine_";"_sColom,"KO1-",sTitel,.sSubGr,sOSubGr)
 Quit $P(sSubGr,D)
 
WATTR(Attr,sX,sY) ; Write Format attributes en positie
 New sI
 If $G(sX) Set FP=sTop+sX-1*100+sLeft+sY-1 Write @F
 Set Attr=$TR(Attr," ","")
 ;Quit:$G(sMemAttr,-1)=Attr
 If $L(sBGAttr),Attr[sBGAttr Set Attr=$P(Attr,sBGAttr)_$P(Attr,sBGAttr,2)
 Else  Set Attr=Attr_sBGAttr
 Write @FMTCL
 For sI=1:1:$L(Attr) Write @(@("FMT"_$E(Attr,sI)))
 ;Set:$D(sMemAttr) sMemAttr=Attr
 Quit
 ;
LOCK(sGroep,sTyp,sSubGr) 
 New %TC
 Do ADD^vhLock("^RES("""_sGroep_""","""_sTyp_""","""_sSubGr_""")")
 If '%TC Do LDISP^vhLock("^RES("""_sGroep_""","""_sTyp_""","""_sSubGr_""")",$P(^RES("vhRES","PI","TYP","D",sTyp),"`",2))
 Quit %TC
 
UNLOCK(sGroep,sTyp,sSubGr) 
 Do REMOVE^vhLock("^RES("""_sGroep_""","""_sTyp_""","""_sSubGr_""")")
 Quit
 
REMATTR ;Remove attribute
SETATTR ;Set attribute
 
EXECS(sTyp,sRet,sParList) 
 New sExecTxt
 Set sExecTxt=""
 Goto EXEC2
EXEC(sTyp,sExecTxt,sRet,sParList,RtnErrHandler)
EXEC2 Set:sExecTxt="" sExecTxt=$P(sTyp,"`",2,999),sTyp=$P(sTyp,"`")
 Set $ZTRAP=$S($D(RtnErrHandler):RtnErrHandler, 1:"ExecTrap^"_$ZN)
 If sTyp="" Set:$L(sRet) @sRet="" Quit
 If sTyp="T" Set:$L(sRet) @sRet=sExecTxt Quit
 If sTyp="@" X "S "_sRet_"="_sExecTxt Quit
 If sTyp="X" X sExecTxt Quit
 If sTyp="M" New sLoop For sLoop=1:1:$O(@sExecTxt@(""),-1)  X @sExecTxt@(sLoop)
 If sTyp="D" Do @(sExecTxt_sParList)
 If sTyp="F" X "S "_sRet_"=$$"_sExecTxt_sParList
 If sTyp="R" Do @sExecTxt
 If sTyp="CD" Do @("$zobjclassmethod("""_$P(sExecTxt,"`",1)_""","""_$P(sExecTxt,"`",2)_""","_$S(sParList="":")",1:$E(sParList,2,999)))
 ;d WL^vhDBG("S "_sRet_"=$zobjclassmethod("""_$P(sExecTxt,"`",1)_""","""_$P(sExecTxt,"`",2)_","_$S(sParList="":")",1:$E(sParList,2,999)))
 If sTyp="CF" X "S "_sRet_"=$zobjclassmethod("""_$P(sExecTxt,"`",1)_""","""_$P(sExecTxt,"`",2)_""","_$S(sParList="":")",1:$E(sParList,2,999))
 Quit
 
ExecTrap
 set $ztrap=""
 New msg,Exception
 set Exception = ##class(TECH.ExceptionHandler).Catch()
 Set msg="EXECUTE FOUT: "_sTyp_"`"_sExecTxt_"`"_$G(sParList)_$char(13,10)_Exception.ToString()_
 		 $C(13,10)_"VARIABELEN : "_$C(13,10)_$$GetVariabelen^BL.EC.Common()_$char(13,10)_$$GetJobInfo^vhLib.System()
 
 do ##class(vhLib.Logger).%New("ADMIN-ERROR").ErrorMail("ExecTrap^vhRES : "_Exception.GeefOmschrijving(),msg)
 Do:($D(MApplication)) MApplication.MessageBox(msg)   ; Foutmelding voor Makova
 Set:$L(sRet) @sRet=""
 Quit 1   ; Doorgeven errormelding
 
WEXEC(sPos,sExec,sNoClear,sRect) 
 ; sNoClear : of het achter liggend gebied moet gewist worden
 ; sRect : 0, 1 of 2 : 0 Geen rect, 1 op één char afstand, 2 op 2 char afstand.
 Do WATTR^vhRES($P(sExec,"`",2))
 Set FP=sTop+sPos-1
 Do:'sNoClear FILL^vhTERMINA(FP,sLeft,FP,sRight)
 Set FP=FP*100+sLeft Write @F
 Set sTxt=""
 Do EXEC($P(sExec,"`"),$P(sExec,"`",3),"sTxt","")
 Do:$L(sTxt) WALIGN(sPos,sTxt,sNoClear,sRect,0)
 Quit
 
WALIGN(sPos,sTxt,sNoClear,sRect,sFromL) 
 ; sFromL = Of de positie reeds bepaald is voor LEFT align
 New sAlign,sTLen
 Set sAlign=""
 If $E(sTxt,1)="&" Set sAlign=$E(sTxt,2) Set $E(sTxt,1,2)=""
 Quit:sTxt=""
 Set sTLen=$L(sTxt)-($L(sTxt,"ª")-1*2)
 Set FP=sTop-1+sPos*100+sLeft
 If sAlign="S" Do WSEPAR(sPos,sTxt,sRect) Quit
 Set:sAlign="R" sFromL=1,FP=sTop-1+sPos*100+sLeft+sRight-sLeft+1-sTLen
 Set:sAlign="C" sFromL=1,FP=sTop-1+sPos*100+sLeft+(sRight-sLeft-sTLen\2)
 Write:$G(sFromL) @F
 Set:$G(sNoClear) sTxt=" "_sTxt_" "
 Do WTXT(sTxt)
 Quit
 
WSEPAR(sPos,sTxt,sRect) 
 Do:'sRect HLIJN^vhTERMINA(sTop-1+sPos,sLeft,sRight,"","",0)
 Do:sRect HLIJN^vhTERMINA(sTop-1+sPos,sLeft-(sRect*(sLeft>sRect)),sRight+(sRect*(sRight<(sScr("KOL")-sRect+1))),$S(sLeft>sRect:"M",1:""),$S(sRight<(sScr("KOL")-sRect+1):"M",1:""),0)
 Quit:'$L(sTxt)
 Set FP=sTop-1+sPos*100+sLeft Write @F
 Do WALIGN(sPos,sTxt,0,1)
 Quit
 
WTXT(sLijn) 
 For  Quit:sLijn=""  Do
 .Write $P(sLijn,"ª")
 .Set $P(sLijn,"ª")=""
 .If $E(sLijn)="ª",$L($E(sLijn,2)),"BIKUbiku"[$E(sLijn,2) Write @(@("FMT"_$E(sLijn,2)))
 .Else  Write $E(sLijn,1,2)
 .Set $E(sLijn,1,2)=""
 Quit