Index: VHPOPUP.mac.rou
===================================================================
diff -u
--- VHPOPUP.mac.rou	(revision 0)
+++ VHPOPUP.mac.rou	(revision 1840)
@@ -0,0 +1,459 @@
+vhPOPUP  ;[ 12/10/2003  10:36 AM ]
+ 
+ ; sOptie : 
+ ; K : Kode zichtbaar 
+ ; O : Omschrijving zichtbaar
+ ; Z : Bijvoegen van item ZONDER
+ ; M : Multiple select (meerdere selecteerbaar)
+ ; V : Er moet minstens ��n geselecteerd zijn (niet in combinatie met Z)
+ ; S : Selecteer volgorde is belangrijk
+ ; 1 : Rectangle met 1 char afstand
+ ; 2 : Rectangle met 2 char afstand
+ ; B : Beginletter select
+ ; b : GEEN postionering dmv. Beginletter
+ ; A : Autoselect bij slechts ��n of geen item
+ ; E : Via extract ipv. met ";" gescheiden
+ ; - : Exit via "-" of "."
+ ; L : Formatering def opgeslagen in local
+ ; F : Formatering def. opgeslagen in ^RES 
+ ; R : Return full record ipv. alleen de eerste piece,
+ ;     niet in combinatie met optie E !
+ ; sCB : Callback struktuur
+ ; sCB("S") : bij (de)selectie van een item
+ ; sCB("A") : NA het ophalen van de sY en sX local
+ ; sCB("I") : voor elk item dat in de sY local geplaatst wordt
+ ; sCB("K") : van uit SCROLL^vhLIST voor het omvormen van een ingedrukte toets
+ 
+ ;Tonen van een popup in ^RES zonder speciale definitie
+PI(sPos,sOptie,sTitel,sGrp,sId,sOldSel,sKeys,sNoRefr) 
+ New D,sY,sLD,sI,sJ,sX,sVal,sFetch,sInput,sEdit,sBGAttr,sCB,sPopTyp
+ If $G(QW),$ZV["MSM" Do ZWINT^vhRtn2(1,$P(sPos,";"),$P(sPos,";",2))
+ Set sEdit=1,sBGAttr="I",sPopTyp="PI"
+ Merge sCB=^RES(sGrp,"PI",sId,"E")
+ Do INIT,CONV("P",sGrp_";"_sId,.sY)
+ Do INITFMT($P(sPIRef,";"),$P(sPIRef,";",2),sKLen,sOLen,"",sOptie,sFmt,sTitel)
+ If '$D(sY(1)) Set sVal="" Goto PIQ
+ If $$CHECKA() Goto PIQ
+ If $ZV["MSM"!'$D(QW) Do:'$G(sNoRefr) STORE^vhTERMINA() Do WRITE,SCROLL,VALUE
+ If $ZV'["MSM",$D(QW) Do DATAM
+ Do CLEAN
+PIQ If $G(QW),$ZV["MSM" Do
+ .New sVal
+ .Do ZWINT^vhRtn2(0)
+ Quit sVal
+ ;
+ ;Tonen van een popup gedefinieerd via sString
+STRING(sPos,sOptie,sTitel,sString,sOldSel) 
+ New sY,sLD,sI,sJ,sX,sVal,sFetch,sInput,sEdit,sBGAttr
+ If $G(QW),$ZV["MSM" Do ZWINT^vhRtn2(1,$P(sPos,";"),$P(sPos,";",2))
+ Set sEdit=1,sBGAttr="I"
+ Do INIT,CONV("S",sString,.sY)
+ Do INITFMT($P(sPIRef,";"),$P(sPIRef,";",2),sKLen,sOLen,"",sOptie,sFmt,sTitel)
+ If '$D(sY(1)) Set sVal="" Goto STRINGQ
+ If $$CHECKA() Goto STRINGQ
+ If $ZV["MSM"!'$D(QW) Do:'$G(sNoRefr) STORE^vhTERMINA() Do WRITE,SCROLL,VALUE
+ If $ZV'["MSM",$D(QW) Do DATAM
+ Do CLEAN
+STRINGQ If $G(QW),$ZV["MSM" Do
+ .New sVal
+ .Do ZWINT^vhRtn2(0)
+ Quit sVal
+ 
+ ;Tonen van een popup gedefinieerd in een global of local
+WILD(sPos,sOptie,sTitel,sTab,sOldSel,sCB,sNoRefr) 
+ New sLD,sI,sJ,sO,sX,sVal,sInput,sKLen,sOLen,sPIRef,sY,sEdit,sBGAttr
+ If $G(QW),$ZV["MSM" Do ZWINT^vhRtn2(1,$P(sPos,";"),$P(sPos,";",2))
+ Set sEdit=1,sBGAttr="I"
+ Do INIT,CONV("W","sTab",.sY)
+ Do INITFMT($P(sPIRef,";"),$P(sPIRef,";",2),sKLen,sOLen,"",sOptie,sFmt,sTitel)
+ If $$CHECKA() Goto WILDQ
+ If $ZV["MSM"!'$D(QW) Do:'$G(sNoRefr) STORE^vhTERMINA() Do WRITE,SCROLL,VALUE
+ If $ZV'["MSM",$D(QW) Do DATAM
+ Do CLEAN
+WILDQ If $G(QW),$ZV["MSM" Do
+ .New sVal
+ .Do ZWINT^vhRtn2(0)
+ Quit sVal
+ 
+EDIT(sPos,sType,sRef,sOldSel,sBGAttr,sOptie,sTitel,sFmt,sCB,sNoRefr) 
+ ; sCB oproepen via .Local
+ New sY,sX,sKLen,sOLen,sPIRef,sI,String,sFL,sLD,sEdit,sVal,sInput
+ If $G(QW),$ZV["MSM" Do ZWINT^vhRtn2(1,$P(sPos,";"),$P(sPos,";",2))
+ Set sEdit=1
+ Do INIT
+ Do CONV(sType,sRef,.sY)
+ Do INITFMT($P(sPIRef,";"),$P(sPIRef,";",2),sKLen,sOLen,"",sOptie,sFmt,sTitel)
+ If '$D(sY(1)) Set sVal="" Goto EDITQ
+ Do:'$G(sNoRefr) STORE^vhTERMINA()
+ If $ZV["MSM"!'$D(QW) Do WRITE,SCROLL,VALUE
+ If $ZV'["MSM",$D(QW) Do DATAM
+ Do CLEAN
+EDITQ If $G(QW),$ZV["MSM" Do
+ .New sVal
+ .Do ZWINT^vhRtn2(0)
+ Quit sVal
+ 
+DISP(sPos,sType,sRef,sOldSel,sBGAttr,sOptie,sFmt,sCB) 
+ New sY,sX,sKLen,sOLen,sPIRef,sI,String,sFL,sLD,sEdit
+ Set sEdit=0
+ Do INIT
+ Do CONV(sType,sRef,.sY)
+ Do INITFMT($P(sPIRef,";"),$P(sPIRef,";",2),sKLen,sOLen,$P(sPos,";",4)-$P(sPos,";",2)+1,sOptie,sFmt,"")
+ Set FP=$P(sPos,";")*100+$P(sPos,";",2)
+ Write @FMTCL For sI=1:1:$L(sBGAttr) Write @(@("FMT"_$E(sBGAttr,sI)))
+ Set sI=""
+ Merge sFmt=sLD("FMT",1)
+ Set:'$P(sPos,";",3) $P(sPos,";",3)=$P(sPos,";")
+ For  Set sI=$O(sX(sI)) Quit:sI=""  Do  Quit:FP\100>$P(sPos,";",3)
+ .Set sFL(1)=sY(sI),String=$$LIJN^vhFMT("sFmt")
+ .Write @F,$E(String,1,$P(sPos,";",4)-$P(sPos,";",2)+1)
+ .Set FP=FP+100
+ If FP\100'>$P(sPos,";",3) Do FILL^vhTERMINA(FP\100,$P(sPos,";",2),$P(sPos,";",3),$P(sPos,";",4))
+ Quit
+ 
+DISPSTR(sType,sRef,sOldSel,sOptie) ;,sFmt,sCB) 
+ ;Bij sOptie alleen Z,O en K toegelaten
+ New sY,sX,sKLen,sOLen,sPIRef,sI,String,sFL,sLD,sEdit,RetStr
+ Set sEdit=0
+ Do INIT
+ Do CONV(sType,sRef,.sY)
+ ;Do INITFMT($P(sPIRef,";"),$P(sPIRef,";",2),sKLen,sOLen,80,sOptie,$G(sFmt),"")
+ Set sI=""
+ Merge sFmt=sLD("FMT",1)
+ Set RetStr=""
+ For  Set sI=$O(sX(sI)) Quit:sI=""  Do 
+ .Set:$L(RetStr) RetStr=RetStr_"; "
+ .Set:sOptie["K" RetStr=RetStr_$P(sY(sI),"`")
+ .Set:sOptie["O"&(sOptie["K") RetStr=RetStr_":"
+ .Set:sOptie["O" RetStr=RetStr_$P(sY(sI),"`",2)
+ If RetStr="",sOptie["Z" Set RetStr="ZONDER"
+ Quit RetStr
+ 
+DISPLAY(sGrp,sId,sOldSel,sOptie) 
+ New sRec,RetStr
+ If $L(sGrp),$L(sId) Do
+ .Set sRec=$G(^RES(sGrp,"PI",sId,"D",sOldSel))
+ .Set:$L(RetStr) RetStr=RetStr_"; "
+ .Set:sOptie["K" RetStr=RetStr_$P(sY(sI),"`")
+ .Set:sOptie["O"&(sOptie["K") RetStr=RetStr_":"
+ .Set:sOptie["O" RetStr=RetStr_$P(sY(sI),"`",2)
+ If RetStr="",sOptie["Z" Set RetStr="ZONDER"
+ Quit RetStr
+ 
+ ; *** CALLBACK ***
+ 
+SEL(sSelect,sInput) ; Via callback aanpassen van selectie
+ If sOptie'["S"!($G(sInput)'?1N) Quit:$D(sX(sSelect))
+ Do CHANGE(sSelect,$G(sInput))
+ Quit
+ 
+DESEL(sSelect) ; Via callback aanpassen van selectie
+ Quit:'$D(sX(sSelect))
+ Do CHANGE(sSelect,"")
+ Quit
+ 
+ ; *** LOWLEVEL ***
+ 
+INIT ; Algemene initialisatie
+ New sCnt,sI
+ Set sCB("K")=$G(sCB("K"))
+ Set sCB("I")=$G(sCB("I"))
+ If sCB("K")="",sOptie["-" Set sCB("K")="X`Set zb=""""  Set:sActie=""-"" zb=""CANC"" Set:sActie=""."" zb=""CANC"" Set:sActie="" "" zb=""SEL"""
+ Set:sCB("K")="" sCB("K")="X`Set zb=$S(sActie="" "":""SEL"",""SAV;ESC;CANC;HELP;COM;SPEC""[zb:zb,1:"""")"
+ Set sCB("A")=$G(sCB("A"))
+ Set sCB("S")=$G(sCB("S"))
+ Set sFmt=$G(sFmt)
+ Set sOldSel=$TR($G(sOldSel),";\","``")
+ Set:sOptie["S"&(sOptie'["M") sOptie=sOptie_"M"
+ Set sCnt=0
+ If sOptie'["E" For sI=1:1:$L(sOldSel,"`") Set:$P(sOldSel,"`",sI)'="" sCnt=sCnt+1,sOldSel($P(sOldSel,"`",sI))=sCnt
+ If sOptie["E" For sI=1:1:$L(sOldSel) Set sCnt=sCnt+1,sOldSel($E(sOldSel,sI))=sCnt
+ Quit
+ 
+INITFMT(sGrp,sId,sKLen,sOLen,sTotLen,sOptie,sFmt,sTitel) 
+ ; Initialisatie via sY local of string
+ New sTLen,sF,sRec,sLen
+ Set:'sTotLen sTotLen=sScr("KOL")
+ Set sF="",sTLen=0
+ If sOptie["F" Do  ; Lijstdefinitie vervat in ^RES(...,"LD"
+ .Do INIT^vhLIST($P(sFmt,";"),$P(sFmt,";",2),.sLD)
+ Else  If sOptie["L" Do  ; Lijst definitie vervat in local
+ .Merge sLD("FMT",1)=@sFmt
+ Else  Do
+ .Set:sOptie["M"&(sOptie'["S")&sEdit sF=1,sF(1)="$G(sX(sSelect))`C`R`1`` | ``$S(X:""*"",1:"""")",sTLen=sTLen+4
+ .Set:sOptie["M"&(sOptie["S")&sEdit sF=1,sF(1)="$G(sX(sSelect))`N+`R`2`` | ",sTlen=sTLen+5
+ .If sId=""  Do  ; Formatering opbouwen uit sOLen en sKLen
+ ..Set:sOptie["K" sF=sF+1,sF(sF)="1`C`L`"_sKLen_"`` | ",sTLen=sTLen+sKLen+3
+ ..Set:sOptie["O" sF=sF+1,sF(sF)="2`C`L`"_sOLen_"`` | ",sTLen=sTLen+sOLen+3
+ .Else  Do  ; ^RES(...,"PI"
+ ..Do FMTPI("K",1):sOptie["K"&'$P(^RES(sGrp,"PI",sId),"`",7)
+ ..Do FMTPI("O",2):sOptie["O"
+ ..For sI=1:1:4 Do FMTPI(sI,sI+2)
+ .Set $P(sF(sF),"`",6)="",sTLen=sTLen-3 ; Laatste geen separator
+ .If sTLen>sTotLen For sI=1:1:sF-1 Set $P(sF(sF),"`",6)="|",sTLen=sTLen-2 ; Indien te lang inkorten separator
+ .If sTLen<sTotLen,sTotLen'=sScr("KOL") Set $P(sF(sF),"`",6)=$J("",sTotLen-sTLen)
+ .Set sF="" Merge sLD("FMT",1)=sF
+ Set sTLen=$$LEN^vhFMT("sLD(""FMT"",1)")
+ Set sLD("FMT",1)=$A("`")
+ Set sLD("F")="sY"
+ Set sLD("SELECT")=0
+ Set sLD("MAX")=$O(sY(""),-1)
+ Set:$L(sTitel) sLD("TI",1)="T``"_$S($E(sTitel)="&":"",1:"&C")_sTitel
+ Set sLD("CF")="@`$S($E(sRec,1,2)=""&F"":sRec,$E(sRec,1,2)=""&S"":sRec,$E(sRec,1,4)=""&F&S"":sRec,$E(sRec,1,4)=""&S&F"":sRec,1:"""")"
+ Set sLD("CS")="@`$S($E(sRec,1,2)=""&F"":0,$E(sRec,1,2)=""&S"":0,$E(sRec,1,4)=""&F&S"":0,$E(sRec,1,4)=""&S&F"":0,1:1)"
+ Set sLD("SET")="`"_$A("`")_"`PL`"_sBGAttr_"`"_$S(sBGAttr["I":"I",1:"I")_"``1`"_$S(sOptie["1":1,sOptie["2":2,1:"")
+ Set sLen=$L(sTitel)-($L(sTitel,"�")-1*2)-($L(sTitel,"&")-1*2)+2
+ Set:sTLen<sLen sTLen=sLen
+ For sI=1:1:$O(sY(""),-1) Do
+ .Set sF=sY(sI)
+ .If $E(sF,1,2)'="&F",$E(sF,1,2)'="&S",$E(sF,1,4)'="&F&S",$E(sF,1,4)'="&S&F" Quit
+ .Set:sF["&F" sF=$P(sF,"&F",2) Set:sF["&S" sF=$P(sF,"&S",2)
+ .Set sLen=$L(sF)-($L(sF,"�")-1*2)-($L(sF,"&")-1*2)
+ .Set:sTLen<sLen sTLen=sLen
+ Do INITPOS(sPos,sLD("MAX"),sTLen)
+ Quit
+  
+FMTPI(sKey,sPiece) ; Opbouw van de formatering
+ Set sRec=$G(^RES(sGrp,"PI",sId,"P",sKey))
+ Quit:sRec=""  Quit:$P(sRec,"`")'["V"
+ Set sTLen=sTLen+$P(sRec,"`",4)+3
+ Set sF=sF+1
+ Set sF(sF)=sPiece_"`"_$P(sRec,"`",2,5)_"` | ``"_$P(sRec,"`",7)
+ Quit
+ 
+CONV(sType,sRef,sY)  ; sY oproepen via .Local
+ New sRec,sGaten
+ Set (sKLen,sOLen)=0,(sY,sPIRef)=""
+ If sOptie["Z" Set sRec="`ZONDER" Do CONVONE Set sRec="&S" Do CONVONE
+ If sType="P" Do  
+ .Do FETCH($P(sRef,";"),$P(sRef,";",2),+sY)
+ Set:"L@"[sType sRef=@sRef
+ If "L@TS"[sType For sI=1:1:$L(sRef,"\") Set sRec=$TR($P(sRef,"\",sI),";,","``") Do CONVONE
+ If sType="W" Set sI="" For  Set sI=$O(@sRef@(sI)) Quit:sI=""  Set sRec=$TR(@sRef@(sI),"\;","``") Do CONVONE
+ Do:$G(sGaten) GATEN
+ Quit:'$L(sCB("A"))
+ Do EXECS^vhRES(sCB("A"),"","(.sY)")
+ Quit
+ 
+GATEN ; Aflopen sY om gaten weg te werken
+ Set sCnt=0
+ For sI=1:1:$O(sY(""),-1) If $D(sY(sI)) Set sCnt=sCnt+1 If sCnt'=sI Set sY(sCnt)=sY(sI) Kill sY(sI) If $D(sX(sI)) Set sX(sCnt)=sX(sI) Kill sX(sI)
+ Quit
+ 
+CONVONE If $P(sRec,"`")="&I" Do  Quit 
+ .Set $E(sRec,1,2)=""
+ .Do FETCH($P(sRec,";"),$P(sRec,";",2),sY)
+ .Set sY=$O(sY(""),-1)
+ If $L(sCB("I")) Do EXECS^vhRES(sCB("I"),"X","(sRec)") Quit:'X
+ Set sY=sY+1,sY(sY)=sRec
+ If $E(sRec,1,2)="&F"!($E(sRec,1,2)="&S")!($E(sRec,1,4)="&F&S")!($E(sRec,1,4)="&S&F") Quit
+ Set:$L($P(sRec,"`"))>sKLen sKLen=$L($P(sRec,"`"))
+ Set:$L($P(sRec,"`",2))>sOLen sOLen=$L($P(sRec,"`",2))
+ If $L($P(sRec,"`")),$D(sOldSel($P(sRec,"`"))) Set sX(sY)=sOldSel($P(sRec,"`"))
+ Quit
+ 
+INITPOS(sPos,sCnt,sLen) ; Bepalen optimale positie
+ New sTop,sLeft,sRight,sBot
+ Set sTop=$P(sPos,U,1) Set:sTop="C" sTop=sScr("ROW")-sCnt\2
+ Set:sTop<(1+(sOptie[1)+(sOptie[2)) sTop=1+(sOptie[1)+(sOptie[2)
+ Set sBot=sTop+sCnt-1
+ Set:sTop+sCnt>sScr("ROW") sBot=sScr("ROW")-1,sTop=sBot-sCnt+1
+ Set:sTop<2 sTop=2
+ Set sLeft=$P(sPos,U,2) Set:sLeft="C" sLeft=sScr("KOL")-sLen\2
+ Set:sLeft<(1+(sOptie[1)+(sOptie[2*2)) sLeft=1+(sOptie[1)+(sOptie[2*2)
+ Set sRight=sLeft+sLen-1
+ Set:sLeft+sLen+1>sScr("KOL") sRight=sScr("KOL")-2,sLeft=sRight-sLen+1
+ Set $P(sLD("POS"),"`")=sTop_";"_sLeft_";"_sBot_";"_sRight
+ Quit
+ 
+FETCH(sGrp,sId,sOff) ; Ophalen van waarden uit ^RES
+ New sKey,sYY,sXX,sI,sRec
+ Quit:sGrp=""!(sId="")
+ Set sPIRef=sGrp_";"_sId
+ ; Tijdelijk opslaan van achterliggende items    
+ For sI=sOff+2:1:$O(sY(""),-1) Set sYY(sI-sOff-1)=sY(sI) Set:$D(sX(sI)) sXX(sI-sOff-1)=sX(sI)
+ ; Ophalen van de items in ^RES
+ Set sKey=""
+ For  Set sKey=$O(^RES(sGrp,"PI",sId,"D",sKey)) Quit:sKey=""  Do
+ .Set sRec=sKey_"`"_$P(^RES(sGrp,"PI",sId,"D",sKey),"`",2,99)
+ .If $L(sCB("I")) Do EXECS^vhRES(sCB("I"),"X","(sRec)") If 'X Set sGaten=1 Quit
+ .Set sY($P(^RES(sGrp,"PI",sId,"D",sKey),"`")+sOff)=sRec
+ .Set:$L(sKey)>sKLen sKLen=$L(sKey)
+ .Set:$L($P(^RES(sGrp,"PI",sId,"D",sKey),"`",2))>sOLen sOLen=$L($P(^RES(sGrp,"PI",sId,"D",sKey),"`",2))
+ .Set:$D(sOldSel(sKey)) sX($P(^RES(sGrp,"PI",sId,"D",sKey),"`")+sOff)=sOldSel(sKey)
+ ; Terugsetten van de achterliggende items
+ Set sOff=$O(sY(""),-1)-1
+ For sI=1:1:$O(sYY(""),-1) Set sY(sI+sOff)=sYY(sI) Set:$D(sXX(sI)) sX(sI+sOff)=sXX(sI)
+ Set sY=$O(sY(""),-1)
+ Quit
+ 
+WRITE ; Schrijven van de popup op het scherm
+ If $D(sX) Set sLD("SELECT")=$O(sX(""))
+ Else  Do
+ .New sI
+ .For sI=1:1 Quit:'$D(sY(sI))  Quit:"\&F\&S\"'[("\"_$E(sY(sI),1,2)_"\")
+ .Set:$D(sY(sI)) sLD("SELECT")=sI
+ Do WRITE^vhLIST(.sLD)
+ Quit
+ 
+SCROLL ; Cursorbesturing door de lijst
+ New sExit,sSelect
+ For  Do  Do CTRLEXIT Quit:sExit'="" 
+ .Set sInput=$$SCROLL^vhLIST(.sLD,sCB("K"),"",1)
+ .If $G(sPopTyp)="PI" Do
+ ..New D
+ ..Set D="\"
+ ..Quit:$E(sId,1,4)="DEMO"
+ ..If sInput'="SPEC",sInput'="SF17" Quit
+ ..If sInput="SF17",'$$ASK^vhWACHTW("SYSTEM",,,0) Quit
+ ..If sInput="SPEC",sOptie'["y",sOptie'["Y" Quit
+ ..If sInput="SPEC",sOptie["y",'$$ASK^vhWACHTW("MANAGER",,,0) Quit
+ ..Do LAYGO(sGrp,sId,$S(sInput="SF17":0,1:$S(sOptie["y":1,1:2)))
+ .If zb=-1 Set sExit=1 Quit  ; TimeOut
+ .Set sExit=""
+ .Kill sO,sSelect
+ .Merge sO=sX
+ .If sOptie'["M",sInput="ENTER"!(sInput="SEL") Set sSelect=sLD("SELECT") 
+ .If sOptie["M",(sInput="SEL") Set sSelect=sLD("SELECT") 
+ .If sInput="ENTER" Set zb="ENTER"
+ .If sOptie'["b",sInput?1A!(sInput?1N&sInput&(sOptie'["S")) Do
+ ..New sPiece,Temp
+ ..Set sPiece=$S(sOptie["K":1,sOptie["O":2,1:0)
+ ..Do SEARCH(sInput,sLD("SELECT")+1),SEARCH(sInput,1):'$G(sSelect)
+ ..Set Temp=$$UPCASE^vhRtn1(sInput) ; Ook eens proberen met hoofdletter
+ ..Set:Temp=sInput Temp=$$LOCASE^vhRtn1(sInput) ; of kleine letter
+ ..Do:Temp'=sInput&'$G(sSelect) SEARCH(Temp,sLD("SELECT")+1),SEARCH(Temp,1):'$G(sSelect)
+ ..If $G(sSelect),sOptie'["B" Do ENABLE^vhLIST(.sLD,sSelect) Kill sSelect
+ .If sInput?1N,sInput,(sOptie["S") Set sSelect=sLD("SELECT")
+ .If '$D(sSelect) Do  Quit
+ ..If $L(zb) Set sExit=1
+ ..; Functietoets returnchars
+ .If sOptie["Z",sSelect=1 Kill sX Set sExit=1 Quit
+ .Set zb=""
+ .Do CHANGE(sSelect,sInput),CBPOP
+ .Set:$L(zb) sExit=1   
+ .If sSelect,sOptie'["M" Set sExit=1
+ .Do:'sExit!$G(sNoRefr) WCHANGE
+ Quit
+ 
+CTRLEXIT
+ If zb'="CANC",sOptie["V",($D(sX)<10) Write *7 Set sExit=""
+ Quit
+ 
+SEARCH(Key,From) 
+ For sI=From:1:sLD("MAX") If Key=$E($P(sY(sI),"`",sPiece)) Set sSelect=sI Quit
+ Quit
+ 
+CHANGE(sSelect,sInput) ; Aanpassen van sX volgens sSelect
+ If sOptie'["M" Kill sX Set sX(sSelect)="" Quit
+ If sOptie'["S" Do  Quit
+ .If $D(sX(sSelect)) Kill sX(sSelect)
+ .Else  Set sX(sSelect)=1
+ ; sOptie["S"
+ If $D(sX(sSelect)) Do  Quit:sInput'?1N  ;Verwijder indien geselekteerd
+ .Set sKey=sX(sSelect),sI=""
+ .Kill sX(sSelect)
+ .For  Set sI=$O(sX(sI)) Quit:sI=""  Set:sX(sI)>sKey sX(sI)=sX(sI)-1 
+ Set sKey=9999
+ Set:sInput?1N sKey=sInput
+ Set sI="",sMax=0
+ For  Set sI=$O(sX(sI)) Quit:sI=""  Set:sX(sI)>sMax sMax=sX(sI) Set:sX(sI)'<sKey sX(sI)=sX(sI)+1 
+ Set sX(sSelect)=$S(sKey>(sMax+1):sMax+1,1:sKey)
+ Quit
+ 
+CBPOP ; Oproep van de callback
+ New sRec,sOld,sNew
+ Quit:sCB("S")=""
+ Set sRec=sY(sSelect)
+ Set sOld=$G(sO(sSelect))
+ Set sNew=$G(sX(sSelect))
+ Do EXECS^vhRES(sCB("S"),"sSelect","(sSelect,sOld,sNew,sRec)")
+ Quit:sSelect
+ ; Oude waarde terugzetten
+ Kill sX 
+ Merge sX=sO
+ Quit
+ 
+WCHANGE ; Wegschrijven van de verandering in selectie
+ New sI
+ For sI=1:1:sLD("MAX") Do:$G(sO(sI))'=$G(sX(sI))
+ .Do LINE^vhLIST(.sLD,sI)
+ Quit
+ 
+VALUE ; Omvormen van sX naar een ";" delimited string of $E(string)
+ New sTemp
+ Set (sI,sVal)=""
+ If sOptie["S" Merge sTemp=sX Kill sX For  Set sI=$O(sTemp(sI)) Quit:sI=""  Set:sTemp(sI) sX(sTemp(sI))=sI ; Op volgorde brengen van gesorteerde multiple select
+ For  Set sI=$O(sX(sI)) Quit:sI=""  Set sVal=sVal_$S(sOptie["E":"",1:";")_$P(sY($S(sOptie["S":sX(sI),1:sI)),"`",1,$S(sOptie["R":99,1:1))
+ Set:sOptie'["E" sVal=$E(sVal,2,999)
+ If sOptie["S" Kill sX Merge sX=sTemp ; Terug oude waarde
+ Quit
+ 
+CHECKA() ; Nakijken of er autmatisch kan geselecteerd worden
+ Set sVal=""
+ Quit:'$D(sY(1)) 1
+ If sOptie["A",'$D(sY(2)) Set sX(1)=1 Do VALUE Quit 1
+ Quit 0
+ 
+CLEAN ; Opkuis van de gebruikte data en herstellen van het scherm
+ If $ZV["MSM"!'$D(QW) Do
+ .Do:$G(sNoRefr) ADD^vhScherm($P($P(sLD("POS"),"`",2),";",1),$P($P(sLD("POS"),"`",2),";",3))
+ .Do:'$G(sNoRefr) REFRESH^vhTERMINA($P($P(sLD("POS"),"`",2),";",1),$P($P(sLD("POS"),"`",2),";",3))
+ .Write @FCS
+ Quit
+ 
+LAYGO(sGrp,sId,sEditNiv) 
+ New sOldSel
+ Set sOldSel=""
+ If $O(sX("")) For sX=1:1:$O(sX(""),-1) If $D(sX(sX)) Set sOldSel=sOldSel_";"_$P(sY(sX),"`")
+ Set $E(sOldSel)=""
+ Do
+ .New sPos,sOptie,sTitel,sOldSel,sKeys,sNoRefr 
+ .New zb,D,sY,sLD,sI,sJ,sX,sVal,sFetch,sInput,sEdit,sBGAttr,sCB,sPopTyp
+ .Do STORE^vhTERMINA()
+ .Do LAYGO^vhPOPEDIT(sGrp,sId,$G(sEditNiv))
+ .Do REFRESH^vhTERMINA()
+ Do:'$G(sNoRefr) CLEAN
+ Kill sX,sY,sCB
+ Merge sCB=^RES(sGrp,"PI",sId,"E")
+ Do INIT,CONV("P",sGrp_";"_sId,.sY)
+ Do INITFMT($P(sPIRef,";"),$P(sPIRef,";",2),sKLen,sOLen,"",sOptie,sFmt,sTitel)
+ Do:'$G(sNoRefr) STORE^vhTERMINA()
+ Do WRITE
+ Quit
+ 
+DATAM 
+ New D,POPUP,sZ,sI,sC,%J
+ Set D="\",sC=0,%J=$$%J^vhRtn1(),sVal=""
+ Kill ^DMC("LVH",%J),^DPAR(0,"PAR.DMS",%J,QU)
+ Merge ^DMC("LVH",%J)=^DMC("LVH","POPUP")
+ Kill ^DMC("LVH",%J,"SYN")
+ Set ^DMC("LVH",%J,"SYN",0)=1
+ If sOptie["K",sOptie["O" Do
+ .Set ^DMC("LVH",%J,"SYN",1,1,"B")=100
+ .Set ^DMC("LVH",%J,"SYN",1,1,"TAAL","N")="Code\"_sKLen_"\Via code\"
+ .Set ^DMC("LVH",%J,"SYN",1,"LAY",1)="101\1\"_sKLen_"\1\\"
+ .Set ^DMC("LVH",%J,"SYN",1,2,"B")=101
+ .Set ^DMC("LVH",%J,"SYN",1,2,"TAAL","N")=sTitel_D_sOLen_"\en "_$$LOCASE^vhRtn1(sTitel)_D
+ .Set ^DMC("LVH",%J,"SYN",1,"LAY",2)="102\"_(sKLen+2)_D_sOLen_"\\\"
+ Else  If sOptie["K" Do
+ .Set ^DMC("LVH",%J,"SYN",1,1,"B")=100
+ .Set ^DMC("LVH",%J,"SYN",1,1,"TAAL","N")="Code\"_sKLen_"\Via code\"
+ .Set ^DMC("LVH",%J,"SYN",1,"LAY",1)="101\1\"_sKLen_"\\\"
+ Else  Do
+ .Set ^DMC("LVH",%J,"SYN",1,1,"B")=100
+ .Set ^DMC("LVH",%J,"SYN",1,1,"TAAL","N")=sTitel_D_sOLen_"\Via "_$$LOCASE^vhRtn1(sTitel)_D
+ .Set ^DMC("LVH",%J,"SYN",1,"LAY",1)="102\1\"_sOLen_"\\\"
+ For sI=1:1 Quit:'$D(sY(sI))  Do
+ .Set sR=$TR(sY(sI),"`",D)
+ .Quit:$P(sR,D)=""  Quit:$E(sR)="&"
+ .Set sC=sC+1,POPUP("D",sC)=sR
+ For sI=1:1 Quit:'$D(POPUP("D",sI))  Quit:$P(POPUP("D",sI),D)=sOldSel
+ If $D(POPUP("D",sI))
+ Else  Set sI=""
+ Set sR=$$^cANSYN(%J,"",sI,sOptie["Z","","","",$S(sOptie'["O":sTitel,1:""))
+ Set zb=""
+ If sR Set sR=POPUP("D",sR),sVal=$P(sR,D)
+ Else  Set:sR="-" zb="CANC"
+ Kill ^DMC("LVH",%J),^DPAR(0,"PAR.DMS",%J,QU)
+ Quit
\ No newline at end of file