vhLIST2 ;Lijst functies [ 03/25/2002  10:30 AM ]
 
INIT 
 New sI,sJ,sStr,sFetch
 Kill L
 For sI="F","N","CF","CS","CM" Set:$D(^RES(sGrp,"LD",sId,sI)) L(sI)=^(sI)
 For sI="B" Merge:$D(^RES(sGrp,"LD",sId,sI)) L(sI)=^(sI)
 Set L("SET")=$P(^RES(sGrp,"LD",sId),"`",5,99)
 Set L("POS")=$P(L("SET"),"`")
 If $P(L("POS"),";")="C" Set $P(L("POS"),";")=sScr("ROW")-$P(L("POS"),";",3)\2+1,$P(L("POS"),";",3)=$P(L("POS"),";")+$P(L("POS"),";",3)-1
 If $P(L("POS"),";",2)="C" Set $P(L("POS"),";",2)=sScr("KOL")-$P(L("POS"),";",4)\2+1,$P(L("POS"),";",4)=$P(L("POS"),";",2)+$P(L("POS"),";",4)-1
 Set L("SELECT")=$P(L("SET"),"`",7)
 Set L("ID")=sGrp_"`"_sId
 Set sFetch=""
 Do EXEC^vhRES($P(L("F"),"`"),$P(L("F"),"`",2),"sFetch")
 Set L("F")=sFetch
 Set sI=""
 For  Set sI=$O(^RES(sGrp,"LD",sId,"L",sI)) Quit:sI=""  Do
 .Set sGK=$P(^(sI),"`"),sDK=$P(^(sI),"`",2),sStr=""
 .For sJ=1:1:$O(^RES(sGK,"LK",sDK,""),-1) Do
 ..Set sStr=sStr_"§"_$P(^(sJ),"`",3,11)
 .Set L("FMT",sI,1)=$E(sStr,2,9999)
 Quit
 
RENUMBER New sKey,sCnt,sKill,sNRef
 If $D(L("F")) Set sNRef=L("F")
 Else  Set sNRef=L
 Set:'$L($G(sORef)) sORef=sNRef
 Set sKey="",sCnt=0
 Set sKill=$S(sORef=sNRef:1,$G(sNoKill):0,1:"")
 For  Set sKey=$O(@sORef@(sKey)) Quit:sKey=""  Set sCnt=sCnt+1,@sNRef@(sCnt)=@sORef@(sKey) Kill:sKill @sORef@(sKey)
 Kill:sKill="" @sORef
 Quit
 
REFRESH New sPos,sTop,sLeft,sBot,sRight,sRef,sCnt 
 Do INITPAR^vhLIST
 Set sRef=$$TXTREF(sType_"O")
 Set sCnt=$S(sRef="":0,1:$O(@sRef@(""),-1))
 Do WTXTS(sRef,sCnt,$S(sType="H":sTop-sCnt,1:sBot+1),0,$G(sLine))
 Quit
 
WCLEAR ;Do ERASE^vhTERMINA(sTop,sLeft,sBot,sRight)  
 Do FILL^vhTERMINA(sTop,sLeft,sTop,sRight,"",sBGAttr)
 Quit
 
WRAND New sHOCnt,sFOCnt,sBUTCnt,sHORef,sFORef
 Set sHORef=$$TXTREF("HO")
 Set sFORef=$$TXTREF("FO")
 Set sHOCnt=$S(sHORef="":0,1:$O(@sHORef@(""),-1))
 Set $P(L("POS"),"`",3,4)=""
 If $P(L("SET"),"`",3)["P" Do  ; Er is een scrollpositie display
 .Set:sHOCnt&'$P(L("SET"),"`",8) $P(L("POS"),"`",3,4)="P`"_(sTop-sHOCnt)_";;;"_sRight_"`"_$P(@sHORef@(1),"`",2)
 .Set:$P(L("SET"),"`",8) $P(L("POS"),"`",3,4)="S`;;;"_(sRight+$P(L("SET"),"`",8))_"`"_$P($G(L("SET")),"`",4)
 Set sFOCnt=$S(sFORef="":0,1:$O(@sFORef@(""),-1))
 Set sBUTCnt=$$BLDBUT()
 Do WRECT(sHOCnt,sFOCnt+sBUTCnt)
 Do WTITEL
 Do WHOOFD(sHORef,sHOCnt)
 Do WFOOT(sFORef,sFOCnt)
 Quit
 
WRECT(sHOCnt,sFOCnt) 
 New sTT,sBB,sAtrib,sRef,sI,sJ,sRect,sPos,sDB,sDL,sDR,sDT
 Set sTT=sTop-sHOCnt,sBB=sBot+sFOCnt
 Set sRect=$P(L("SET"),"`",8)
 Set sPos=sTT_";"_sLeft_";"_sBB_";"_sRight
 If 'sRect Set $P(L("POS"),"`",2)=sPos Quit
 Do WATTR^vhRES("")
 Write @F7
 Set (sDT,sDB,sDL,sDR)=0
 Set:sTT>1 sDT=-1
 Set:sBB<sScr("ROW") sDB=+1
 Set:sLeft'<sRect sDL=-sRect
 Set:sLeft'>(sScr("KOL")-sRect) sDR=sRect
 If sDR=0,$P(L("POS"),"`",3)="S" Set $P(L("POS"),"`",3)=""
 If sRect=2 Do FILL^vhTERMINA(sTT+sDT,sLeft+sDL,sBB+sDB,sRight+sDR,"",sBGAttr)
 If sDT Do HLIJN^vhTERMINA(sTT+sDT,sLeft+sDL,sRight+sDR,$S(sDL:"T",1:""),$S(sDR:"T",1:""),1)
 If sDB Do HLIJN^vhTERMINA(sBB+sDB,sLeft+sDL,sRight+sDR,$S(sDL:"B",1:""),$S(sDR:"B",1:""),1)
 If sDL Do VLIJN^vhTERMINA(sLeft+sDL,sTT,sBB,"","",1)
 If sDR Do VLIJN^vhTERMINA(sRight+sDR,sTT,sBB,"","",1)
 Set sPos=(sTT+sDT)_";"_(sLeft+sDL)_";"_(sBB+sDB)_";"_(sRight+sDR)
 Set $P(L("POS"),"`",2)=sPos
 Write @F8
 Quit
WTITEL 
 Quit:'$P(L("SET"),"`",8)
 Quit:sTop-sHOCnt-1<1
 Set sRef=$$TXTREF("TI")
 Quit:sRef=""
 Do WTXTS(sRef,1,sTop-sHOCnt-1,1)
 Quit
 
WHOOFD(sRef,sCnt) 
 Do WTXTS(sRef,sCnt,sTop-sCnt,0)
 Quit
 
WFOOT(sRef,sCnt) 
 Do WTXTS(sRef,sCnt,sBot+1,0,,1)
 Quit
 
WNOLINE New sCnt,sRef
 Quit:$D(@sFetch)>1
 Set sRef=$$TXTREF("NL")
 Set sCnt=$S(sRef="":0,1:$O(@sRef@(""),-1))
 Do WCLEAR
 Do:sCnt WTXTS(sRef,sCnt,sBot-sCnt,0)
 Quit
 
TXTREF(sTyp)  ; Ophalen van de TxtReferentie ofwel in local ofwel in ^RES
 New sRef,sGrp,sId
 I $D(L(sTyp)) Quit "L("""_sTyp_""")" 
 Set sGrp=$P($G(L("ID")),"`"),sId=$P($G(L("ID")),"`",2)
 Quit:sId="" ""
 Quit:'$D(^RES(sGrp,"LD",sId,sTyp)) ""
 Quit "^RES("""_sGrp_""",""LD"","""_sId_""","""_sTyp_""")"
 
WTXTS(sRef,sCnt,sDefPos,sNoClear,sLine,IsFooter) 
 New sPos,sRec,sAtrib,sI,sJ,sTxt,sTLen,sAlign,sLCnt
 Quit:'sCnt
 Set sPos=$P($G(@sRef),"`") Set:'sPos sPos=sDefPos
 Set sLCnt=0
 For sI=1:1:sCnt Do
 .Set sLCnt=sLCnt+1
 .If $G(sLine),sLine'=sI Quit
 .Set sRec=$G(@sRef@(sI))
 .Do WATTR^vhRES($P(sRec,"`",2))
 .Set FP=sPos-1+sLCnt
 .Do:'sNoClear FILL^vhTERMINA(FP,sLeft,FP,sRight,"",$S($G(IsFooter):sBGAttr,1:"IN"))
 .Set FP=FP*100+sLeft Write @F
 .Set sTxt=""
 .Do EXEC^vhRES($P(sRec,"`"),$P(sRec,"`",3),"sTxt","")
 .If $E(sTxt,1,2)="&S" Do WSEPAR(sPos+sLCnt-sTop,$E(sTxt,3,999),1) Quit
 .If $E(sTxt,1,2)="&B" Do WBUT(sPos+sLCnt-sTop,$P(sRec,"`",2)) Set sLCnt=sLCnt+sBUTCnt Quit
 .Do:$L(sTxt) WTXT(sPos+sLCnt-sTop,sTxt)
 Quit
 
WTXT(sPos,sTxt,sFromL) 
 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
 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^vhRES(sTxt)
 Quit
 
WSEPAR(sPos,sTxt,sFull) 
 New sRect
 Set sRect=$P(L("SET"),"`",8)
 If 'sFull!'sRect Do
 .Do HLIJN^vhTERMINA(sTop-1+sPos,sLeft,sRight,"","",0)
 Else  Do 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 WTXT(sPos,sTxt)
 Quit
 
WBUT(sPos,sAttribs) 
 New sI,sLen,sSpatie,sSelAtr,sKey
 Set sSpatie=$P(L("B"),"`",3)\2 Set:sSpatie<0 sSpatie=-sSpatie
 Do:sBUTCnt>0 FILL^vhTERMINA(sTop+sPos,sLeft,sTop+sPos-1+sBUTCnt,sRight)
 For sI=1:1:$O(L("B",""),-1) Do
 .Set sLen=$P(L("B",sI),"`",4)
 .Quit:'+sLen
 .Set:'$G(sNoMod) $P(sLen,";")=sPos+$P(sLen,";")-1,$P(L("B",sI),"`",4)=sLen
 .Set FP=sTop-1+$P(sLen,";")*100+sLeft+$P(sLen,";",2)-1+sSpatie
 .Set sLabel=$P(L("B",sI),"`")
 .Set sCharPos=$F(sLabel,"$") Set:'sCharPos sCharPos=1
 .Set sKey=$$UPCASE^vhRtn1($E(sLabel,sCharPos))
 .If ";"_$P(L("B",sI),"`",2)_";"'[(";"_sKey_";") Do
 ..If $P(L("B"),"`",4)["$" Set sCharPos=0,sLabel=$TR(sLabel,"$","")
 ..Else  Set $P(L("B",sI),"`",2)=$P(L("B",sI),"`",2)_";"_sKey 
 .Write @F,$E(sLabel,1,sCharPos-2),@FMTU,$E(sLabel,sCharPos,sCharPos),@FMTu,$E(sLabel,sCharPos+1,999)
 Set sSelAtr="" Set:sAttribs'["I" sAttribs=sAttribs_"I"
 For sI=1:1:$L(sAttribs) Set sSelAtr=sSelAtr_";"_($F("B  UK I",$E(sAttribs,sI))-1)
 Set $P(L("B"),"`",6)=sSelAtr ;$E(sSelAtr,2,99)
 Do SELBUT($P(L("B"),"`",5))
 Quit
 
MOVEBUT(sDir) 
 New sOldSel,sNewSel,sI
 Set sOldSel=$P(L("B"),"`",5)
 Set sNewSel=0
 For sI=(sOldSel+sDir):sDir:$S(sDir>0:$O(L("B",""),-1),1:1) Do  Quit:sNewSel
 .Quit:'+$P($G(L("B",sI)),"`",4)
 .Set sNewSel=sI
 Quit:'sNewSel
 Do SELBUT(sOldSel)
 Do SELBUT(sNewSel)
 Set $P(L("B"),"`",5)=sNewSel
 Quit
 
SELBUT(sBut) 
 New sLen,sAtr,sP,sL,sR
 Set sLen=$P(L("B",sBut),"`",4)
 Set sAtr=$P(L("B"),"`",6)
 Set sP=sTop-1+$P(sLen,";")
 Set sL=sLeft-1+$P(sLen,";",2)
 Set sR=sLeft-1+$P(sLen,";",4)
 Write $C(27,91),sP,";",sL,";",sP,";",sR,sAtr,"$t"
 Quit
 
BLDBUT() 
 New sPos,sLen,sI,sCnt,sMaxLen,sTotLen,sLijn,sHLen,sSpatie,sAantal
 Quit:'$D(L("B")) 0
 Set (sCnt,sMaxLen,sLijn)=0
 Set sTotLen=999,sHLen=sRight-sLeft+1
 Set sSpatie=$P(L("B"),"`",3) Set:'sSpatie sSpatie=2,$P(L("B"),"`",3)=sSpatie
 For sI=1:1:$O(L("B",""),-1) Do
 .Set sLen=$L($P(L("B",sI),"`"))-($P(L("B",sI),"`")["$")
 .If $P(L("B",sI),"`",3)["H"!($P(L("B",sI),"`",3)["D") Set sLen=0
 .Else  Set:'$P(L("B"),"`",5) $P(L("B"),"`",5)=sI
 .Set sPos=""
 .If sLen,sSpatie>0 Set:sMaxLen<sLen sMaxLen=sLen Set sPos=sLen
 .Else  If sLen Do
 ..Set:sTotLen-sSpatie+sLen>sHLen sTotLen=0,sLijn=sLijn+1
 ..Set sPos=sLijn_";"_(sTotLen-(sSpatie\2))_";;"_(sTotLen+sLen+1-(sSpatie\2))
 ..Set sTotLen=sTotLen+sLen-sSpatie
 .Set $P(L("B",sI),"`",4)=sPos
 Set:'$P(L("B"),"`",5) $P(L("B"),"`",5)=1
 If sSpatie>0 Do
 .Set sAantal=$P(L("B"),"`",1)
 .Set:'sAantal sAantal=sHLen\(sMaxLen+sSpatie+(sSpatie\2))
 .For sI=1:1:$O(L("B",""),-1) Do
 ..Set sLen=$P(L("B",sI),"`",4)
 ..Quit:'sLen
 ..Set sCnt=sCnt+1
 ..Set:sCnt#sAantal=1 sTotLen=0,sLijn=sLijn+1
 ..Set sPos=sLijn_";"_(sTotLen+(sSpatie\2))_";;"_(sTotLen+sMaxLen+1+(sSpatie\2))
 ..Set sTotLen=sTotLen+sMaxLen+sSpatie
 ..Set $P(L("B",sI),"`",4)=sPos
 Set $P(L("B"),"`",2)=sLijn
 Quit $S(sLijn:sLijn-1,1:0)
 
EXECBUT(sInp) 
 Quit:'$D(L("B")) 1
 New sI,sFound,sRec,sOptie,sOldSel
 Set sOptie=$P(L("B"),"`",4)
 Set (sI,sOldSel)=$P(L("B"),"`",5)
 Set sRec=""
 If sInp="ENTER",sOptie["E",sI Set sRec=L("B",sI),sActie=$P(sRec,"`",2)
 Else  For sI=1:1:$O(L("B",""),-1) Do  Quit:$L(sRec)
 .If $P($G(L("B",sI)),"`",3)'["D",";"_$P($G(L("B",sI)),"`",2)_";"[(";"_sActie_";") Set sRec=L("B",sI)
 If $L(sRec) Do
 .Do:sI'=sOldSel SELBUT(sOldSel),SELBUT(sI)
 .Set $P(L("B"),"`",5)=sI
 .Quit:$P(sRec,"`",5)=""
 .Do EXEC^vhRES($P(sRec,"`",5),$P(sRec,"`",6),"sActie","(sSelect,sInp)")
 If sRec="",sOptie["B" Quit 0
 Quit 1