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,sFmt,sCB
 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
 Set 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
 ;
 ; sOptie zie bovenaan
 ; + : Uitgebreide versie bij ISO (standaard beperkte versie)
 ;
 ;Tonen van een popup gedefinieerd ^ISO
ISO(sPos,sOptie,sTitel,sIso,sOldSel,sCB,sNoRefr) 
 New sI,sVal,sKey,sRec,sIncl
 Set sPos=$G(sPos),sOptie=$G(sOptie),sTitel=$G(sTitel),sOldSel=$G(sOldSel),sNoRefr=$G(sNoRefr)
 For sI=1:1:$L(sOldSel) Do
 .Set sKey=$P(sOldSel,";",sI)
 .Quit:sKey=""
 .Set sRec=$G(^ISO(0,"ISO."_sIso,sKey,0))
 .Quit:sRec=""
 .Set $P(sOldSel,";",sI)=$P(sRec,D)
 If sOptie'["+" Do
 .If sIso="MUNT" Do
 ..Set sIncl=""
 ..For  Set sIncl=$O(^KBA(11,sIncl)) Quit:sIncl=""  Do
 ...Set sRec=^KBA(11,sIncl),sKey=$P(sRec,D,13) Set:sKey sIncl(sKey)=""
 .If sIso="LAND" For sI="BE","NL","FR","DE","LU","GB" Set sIncl($$LAND^vhRtn1(sI,"I"))=""
 Set sKey=""
 For  Set sKey=$O(^ISO(0,"ISO."_sIso,sKey)) Quit:sKey=""  Do
 .If sOptie'["+",'$D(sIncl(sKey)) Quit
 .Set sRec=^ISO(0,"ISO."_sIso,sKey,0),sIso($P(sRec,D))=$TR($P(sRec,D,1,2),D,"`")_"`"_sKey
 Set sIso($C(15))="`"_$S(sOptie["+":"Beperkt",1:"Volledig")_" overzicht",sIso($C(15)_$C(15))="&S"
 Set sVal=$$WILD(sPos,sOptie,sTitel,.sIso,sOldSel,.sCB,sNoRefr)
 If sVal="",zb'="CANC" Do
 .If sOptie["+" Set sOptie=$TR(sOptie,"+","")
 .Else  Set sOptie=sOptie_"+"
 .Set sVal=$$ISO(sPos,sOptie,sTitel,sIso,sOldSel,.sCB,sNoRefr)
 For sI=1:1:$L(sVal) Do
 .Set sKey=$P(sVal,";",sI)
 .Quit:sKey=""
 .Set sRec=$G(sIso(sKey))
 .Quit:sRec=""
 .Set $P(sVal,";",sI)=$P(sRec,"`",3)
 Quit sVal
 ;