vhUSER ;Gebruikers [ 11/04/2003  12:22 PM ]
 ;
 Goto ^vhUSER1
 ;
 ;CUserId  = Het Id van de huidige user om deze eventueel te elimineren
 ;Titel    = De titel van de popup
 ;Device   = Select voor bepaald device
 ;Groep    = Select voor bepaalde groep(en) ";" gescheiden "&S" voor scheidingslijn groepen
 ;QValue   = Select voor bepaalde Q-waarde
 ;All      = Select alle gebruikers opgeslsplitst per firma
 ;Multiple = Mogelijkheid om meerdere gebruikers te selekteren
 ;OUserId  = De reeds geselekteerde gebruikers
 ;Sorted   = Gesorteerd volgens belangrijkheid der gebruikers
 ;Display  = Plaats waar de popup te tonen, leeg is default C;C
 ;           0 popup niet tonen
 ;Modified = 1 %SC opzetten indien selektie gewijzigd
 ;Proxy    = Volmacht "M" voor mail, "T" voor tijdsregistratie -planning
 ;Other    = Geeft de mogelijkheid om andere gebruikers te selekteren
 ;CB       = Uit te voeren call back (Indien niet doorgegeven CB^vhUSER)
 ;CB("X")  = Extra uit te voeren call back (doorgegeven als .Local)
 ;Option   = Extra opties voor vhPOPUP (standaard 'O1-" + eventueel multiple)
 ;
 ; Selekteer gebruikers
 ; $$USELECT^vhUSER("","","",Groep,"","","","",1,0)
 ; 
USELECT(CUserId,Titel,Device,Groep,QValue,All,Multiple,OUserId,Sorted,Display,Modified,Proxy,Other,CB,Option) 
 New User,TUserId,OwnPKey,Count
 Set Titel=$G(Titel),Device=$G(Device),Groep=$G(Groep),QValue=$G(QValue),All=$G(All)
 Set Multiple=$G(Multiple),OUserId=$G(OUserId),Modified=$G(Modified),Proxy=$G(Proxy),Other=$G(Other)
 Set:Titel="" Titel="Gebruikers" Set:'$D(Sorted) Sorted=1
 Set:'$D(Display) Display="C;C" Set:Display="C;C" Display="1;C;C"
 Set:Proxy Proxy="M"
 Set OwnPKey=$S($L(Proxy):$P($G(^vhUSER("D",CUserId,Proxy)),D,10),1:-1)
 If Device Do  ; Voor een bepaald device
 .Do UDSELECT
 Else  If $L(Groep) Do  ; Voor een bepaalde groep
 .Do UGSELECT
 Else  If All Do  ; Alle gebruikers
 .Do UASELECT
 Else  If $L(QValue) Do  ; Voor een bepaalde 'Q'-waarde
 .Do UQSELECT
 Else  If $L(CUserId) Do  ; Voor de huidige gebruiker
 .Do UUSELECT
 Do OTHER
 Set Option=$G(Option)_"O1-"_$P("M\MS",D,Multiple)
 Set TUserId=""
 If $O(User(""))  Do
 .If $G(Option)["d" Do
 ..Set Option=$TR(Option,"Zd","")
 ..For Count=$O(User(""),-1):-1:1 Set User(Count+2)=User(Count)
 ..Set User(Count)="`DEFAULT"
 ..Set Count=Count+1,User(Count)="&S"
 .If Display Do  Quit
 ..If Other Set User($O(User(""),-1)+1)="&S",User($O(User(""),-1)+1)="?`Andere"
 ..If '$D(CB("S")) Do
 ...If $L($G(CB)) Set CB("S")=CB
 ...Else  Set CB("S")="D`CB^vhUSER"
 ..Set TUserId=$$WILD^vhPOPUP($P(Display,";",2,3),Option,Titel,.User,OUserId,.CB,"")
 .Set User=""
 .For  Set User=$O(User(User)) Quit:User=""  If $P(User(User),"`")?.N Set TUserId=TUserId_";"_$P(User(User),"`")
 .Set $E(TUserId)=""
 Set TUserId=$$MERGEGRP(CUserId,TUserId,Sorted)
 If Modified,TUserId'=OUserId Set %SC=1
 Quit TUserId
 ;
 ; Voor een bepaald device
UDSELECT 
 New D,I,R,UserId,USortNr,Count,QValue,Name,Devices
 Set D="\",UserId="",Count=0
 If Sorted Do
 .For  Set UserId=$O(^vhUSER("ID",Device,UserId)) Quit:UserId=""  Do
 ..Set R=^vhUSER("D",UserId),USortNr=$P(R,D),Name=$P(R,D,2)
 ..Set R=$G(^vhUSER("D",UserId,"M")),QValue=$P($P(R,D),";") Quit:QValue=""
 ..Set:USortNr="" USortNr="~" Set:Name="" Name="~"
 ..Set User(USortNr,Name)=UserId
 .Kill R
 .Merge R=User
 .Kill User
 .Set USortNr=""
 .For  Set USortNr=$O(R(USortNr)) Quit:USortNr=""  Do
 ..Set Name=""
 ..For  Set Name=$O(R(USortNr,Name)) Quit:Name=""  Do
 ...Set UserId=R(USortNr,Name)
 ...Quit:'$$CHKPROXY(OwnPKey,UserId,Proxy)
 ...Set Count=Count+1,User(Count)=UserId_"`"_$P(^vhUSER("D",UserId),D,2)
 Else  Do
 .For  Set UserId=$O(^vhUSER("ID",Device,UserId)) Quit:UserId=""  Do
 ..Quit:$P($G(^vhUSER("D",UserId,"M")),D)=""
 ..Quit:'$$CHKPROXY(OwnPKey,UserId,Proxy)
 ..Set Name=$P(^vhUSER("D",UserId),D,2),Devices=$G(^vhUSER("D",UserId,"D"))
 ..If D_Devices_D[(D_Device_D) Set User("M",Name)=UserId
 ..Else  Set User("S",Name)=UserId
 .Set Name=""
 .For  Set Name=$O(User("M",Name)) Quit:Name=""  Do
 ..Set UserId=User("M",Name),Count=Count+1,User(Count)=UserId_"`"_Name
 .For  Set Name=$O(User("S",Name)) Quit:Name=""  Do
 ..Set UserId=User("S",Name),Count=Count+1,User(Count)=UserId_"`"_Name
 .Kill User("M"),User("S")
 Quit
 ;
 ; Voor een bepaalde groep
UGSELECT 
 New R,UserId,Count
 Set R=$$MERGEGRP(CUserId,Groep,Sorted)
 For Count=1:1 Set UserId=$P(R,";",Count) Quit:UserId=""  Do
 .If $E(UserId,1,2)="&S" Set User(Count)=UserId Quit
 .Quit:'$$CHKPROXY(OwnPKey,UserId,Proxy)
 .Set User(Count)=UserId_"`"_$P(^vhUSER("D",UserId),D,2)
 Quit
 ;
 ; Alle gebruikers
UASELECT 
 New I,R,UserId,USortNr,GSortNr,Count,Quit,SepLine,QValue,Name,Groep
 Set UserId="",Count=0
 If Sorted Do
 .Set Groep=""
 .For  Set Groep=$O(^vhUSER("S",Groep)) Quit:Groep=""  Do
 ..Set R=^vhUSER("S",Groep) Quit:$P(R,D,5)
 ..Set GSortNr=$P(R,D),QValue=$P(R,D,3) Set:GSortNr="" GSortNr="~"
 ..Set User(GSortNr,Groep)=QValue
 .Set UserId=""
 .For  Set UserId=$O(^vhUSER("D",UserId)) Quit:UserId=""  Do
 ..Set R=^vhUSER("D",UserId),USortNr=$P(R,D),Name=$P(R,D,2)
 ..Set R=$G(^vhUSER("D",UserId,"M")),QValue=$P($P(R,D),";") Quit:QValue=""
 ..Set:USortNr="" USortNr="~" Set:Name="" Name="~"
 ..Set (GSortNr,Quit)=""
 ..For  Set GSortNr=$O(User(GSortNr)) Quit:GSortNr=""  Do  Quit:Quit
 ...Set Groep=""
 ...For  Set Groep=$O(User(GSortNr,Groep)) Quit:"~"[Groep  Set Quit=QValue=User(GSortNr,Groep) Quit:Quit
 ..Set:'Quit (GSortNr,Groep)="~" Set User(GSortNr,Groep,USortNr,Name)=UserId
 .Kill R
 .Merge R=User
 .Kill User
 .Set GSortNr=""
 .For  Set GSortNr=$O(R(GSortNr)) Quit:GSortNr=""  Do
 ..Set (Groep,SepLine)=""
 ..For  Set Groep=$O(R(GSortNr,Groep)) Quit:Groep=""  Do
 ...Set USortNr=""
 ...For  Set USortNr=$O(R(GSortNr,Groep,USortNr)) Quit:USortNr=""  Do
 ....Set Name=""
 ....For  Set Name=$O(R(GSortNr,Groep,USortNr,Name)) Quit:Name=""  Do
 .....Set UserId=R(GSortNr,Groep,USortNr,Name)
 .....Quit:'$$CHKPROXY(OwnPKey,UserId,Proxy)
 .....Set Count=Count+1,User(Count)=UserId_"`"_$P(^vhUSER("D",UserId),D,2),SepLine=1
 ..If SepLine,$O(R(GSortNr))'="" Set Count=Count+1,User(Count)="&S"
 .Quit:'Multiple
 .If Count,User(Count)'="&S" Set Count=Count+1,User(Count)="&S"
 .Set GSortNr=""
 .For  Set GSortNr=$O(R(GSortNr)) Quit:GSortNr=""  Do
 ..Set Groep=""
 ..For  Set Groep=$O(R(GSortNr,Groep)) Quit:Groep=""  Do
 ...Quit:Groep="~"
 ...Set Count=Count+1,User(Count)=Groep_"`"_$P(^vhUSER("S",Groep),D,2)
 Else  Do
 .Set UserId=""
 .For  Set UserId=$O(^vhUSER("D",UserId)) Quit:UserId=""  Do
 ..Set R=$G(^vhUSER("D",UserId,"M")),QValue=$P($P(R,D),";") Quit:QValue=""
 ..Quit:'$$CHKPROXY(OwnPKey,UserId,Proxy)
 ..Set Count=Count+1,User(Count)=UserId_"`"_$P(^vhUSER("D",UserId),D,2)
 .Quit:'Multiple
 .Set:Count Count=Count+1,User(Count)="&S"
 .Set Groep=""
 .For  Set Groep=$O(^vhUSER("S",Groep)) Quit:Groep=""  Do
 ..Set R=^vhUSER("S",Groep) Quit:$P(R,D,5)
 ..Set Count=Count+1,User(Count)=Groep_"`"_$P(R,D,2)
 If Count,User(Count)="&S" Kill User(Count) Set Count=Count-1
 Quit
 ;
 ; Voor een bepaalde 'Q'-waarde
UQSELECT 
 New I,R,TUserId,UserId,GSortNr,Count,Groep
 Set (Groep,TUserId)="",(Count,GSortNr)=0
 For  Set Groep=$O(^vhUSER("S",Groep)) Quit:Groep=""  Do
 .Set R=^vhUSER("S",Groep) Quit:$P($P(R,D,3),";")'=QValue!$P(R,D,5)
 .Set GSortNr=GSortNr+1 Set:Sorted GSortNr=$P(R,D) Set:GSortNr="" GSortNr="~" Set R(GSortNr,Groep)=""
 Set GSortNr=""
 For  Set GSortNr=$O(R(GSortNr)) Quit:GSortNr=""  Do
 .Set Groep=""
 .For  Set Groep=$O(R(GSortNr,Groep)) Quit:Groep=""  Do
 ..Set R=$$TGROEP(Groep,Sorted)
 ..For I=1:1 Set UserId=$P(R,";",I) Quit:UserId=""  Do
 ...Quit:(";"_TUserId_";")[(";"_UserId_";")
 ...Quit:'$$CHKPROXY(OwnPKey,UserId,Proxy)
 ...Set Count=Count+1,User(Count)=UserId_"`"_$P(^vhUSER("D",UserId),D,2)
 ..Set TUserId=TUserId_";"_R
 If Count Do
 .If Multiple Do
 ..Set Count=Count+1,User(Count)="&S"
 ..For  Set GSortNr=$O(R(GSortNr)) Quit:GSortNr=""  Do
 ...Set Groep=""
 ...For  Set Groep=$O(R(GSortNr,Groep)) Quit:Groep=""  Do
 ....Set Count=Count+1,User(Count)=Groep_"`"_$P(^vhUSER("S",Groep),D,2)
 Quit
 ;
 ; Voor een bepaalde Gebruiker
UUSELECT 
 New I,R,UserId,USortNr,GSortNr,Count,Quit,SepLine,UQValue,QValue,Name,Groep
 Set UserId="",Count=0,UQValue=$P($G(^vhUSER("D",CUserId,"M")),D)
 If Sorted Do
 .Set Groep=""
 .For  Set Groep=$O(^vhUSER("S",Groep)) Quit:Groep=""  Do
 ..Set R=^vhUSER("S",Groep) Quit:$P(R,D,5)
 ..Set GSortNr=$P(R,D),QValue=$P(R,D,3) Set:GSortNr="" GSortNr="~"
 ..Set User(GSortNr,Groep)=QValue
 .Set UserId=""
 .For  Set UserId=$O(^vhUSER("D",UserId)) Quit:UserId=""  Do
 ..Set R=^vhUSER("D",UserId),USortNr=$P(R,D),Name=$P(R,D,2)
 ..Set R=$G(^vhUSER("D",UserId,"M")),QValue=$P($P(R,D),";") Quit:QValue=""
 ..Set:USortNr="" USortNr="~" Set:Name="" Name="~"
 ..Set (GSortNr,Quit)=""
 ..For  Set GSortNr=$O(User(GSortNr)) Quit:GSortNr=""  Do  Quit:Quit
 ...Set Groep=""
 ...For  Set Groep=$O(User(GSortNr,Groep)) Quit:"~"[Groep  Set Quit=QValue=User(GSortNr,Groep) Quit:Quit
 ..Set:'Quit (GSortNr,Groep)="~" Set User(GSortNr,Groep,USortNr,Name)=UserId
 .Kill R
 .Merge R=User
 .Kill User
 .Set GSortNr=""
 .For  Set GSortNr=$O(R(GSortNr)) Quit:GSortNr=""  Do
 ..Set (Groep,SepLine)=""
 ..For  Set Groep=$O(R(GSortNr,Groep)) Quit:Groep=""  Do
 ...Set USortNr=""
 ...For  Set USortNr=$O(R(GSortNr,Groep,USortNr)) Quit:USortNr=""  Do
 ....Set Name=""
 ....For  Set Name=$O(R(GSortNr,Groep,USortNr,Name)) Quit:Name=""  Do
 .....Set UserId=R(GSortNr,Groep,USortNr,Name)
 .....Set R=$G(^vhUSER("D",UserId,"M")),QValue=$P(R,D)
 .....For I=1:1:$L(QValue,";") If (";"_UQValue_";")'[(";"_$P(QValue,";",I)_";") Set $P(QValue,";",I)=""
 .....Quit:$TR(QValue,";","")=""
 .....Quit:'$$CHKPROXY(OwnPKey,UserId,Proxy)
 .....Set Count=Count+1,User(Count)=UserId_"`"_$P(^vhUSER("D",UserId),D,2),SepLine=1
 ..If SepLine,$O(R(GSortNr))'="" Set Count=Count+1,User(Count)="&S"
 .Quit:'Multiple
 .If Count,User(Count)'="&S" Set Count=Count+1,User(Count)="&S"
 .Set GSortNr=""
 .For  Set GSortNr=$O(R(GSortNr)) Quit:GSortNr=""  Do
 ..Set Groep=""
 ..For  Set Groep=$O(R(GSortNr,Groep)) Quit:Groep=""  Do
 ...Quit:Groep="~"
 ...Set R=^vhUSER("S",Groep),QValue=$P(R,D,3)
 ...Quit:(";"_UQValue_";")'[(";"_QValue_";")!$P(R,D,5)
 ...Set Count=Count+1,User(Count)=Groep_"`"_$P(R,D,2)
 Else  Do
 .Set UserId=""
 .For  Set UserId=$O(^vhUSER("D",UserId)) Quit:UserId=""  Do
 ..Set R=$G(^vhUSER("D",UserId,"M")),QValue=$P(R,D)
 ..For I=1:1:$L(QValue,";") If (";"_UQValue_";")'[(";"_$P(QValue,";",I)_";") Set $P(QValue,";",I)=""
 ..Quit:$TR(QValue,";","")=""
 ..Quit:'$$CHKPROXY(OwnPKey,UserId,Proxy)
 ..Set Count=Count+1,User(Count)=UserId_"`"_$P(^vhUSER("D",UserId),D,2)
 .Quit:'Multiple
 .Set:Count Count=Count+1,User(Count)="&S"
 .Set Groep=""
 .For  Set Groep=$O(^vhUSER("S",Groep)) Quit:Groep=""  Do
 ..Set R=^vhUSER("S",Groep),QValue=$P(R,D,3)
 ..Quit:(";"_UQValue_";")'[(";"_QValue_";")!$P(R,D,5)
 ..Set Count=Count+1,User(Count)=Groep_"`"_$P(R,D,2)
 If Count,User(Count)="&S" Kill User(Count) Set Count=Count-1
 Quit
 ;
 ; Vertalen van gebruikersnamen (korte of lange versie) naar id
 ; LB = 1 -> fomaat $LB
USERID(Users,LB) 
 New D,I,R,UserId,UserIds,UserName,Groep,Quit
 ;Set Users=$G(Users,$$DEVUSER()),UserIds=""   ; ORIG code by CW; Modified by WimV on 2007/07/03
 Set D="\" Set:('$D(Users)) Users=$$DEVUSER()
 Set UserIds=""
 For I=1:1:$L(Users,";") Do
 .Set UserId=$P(Users,";",I)
 .If $L(UserId),'$D(^vhUSER("D",UserId)) Do
 ..Set (UserName,Groep)=$P(Users,";",I)
 ..Set $P(UserName,D,2)=$P(UserName," ",$L(UserName," "))_$P(UserName," ",1,$L(UserName," ")-1)
 ..Set $P(UserName,D)=$$UPTRIMAN^vhRtn1($P(UserName,D))
 ..Set $P(UserName,D,2)=$$UPTRIMAN^vhRtn1($P(UserName,D,2))
 ..Set (UserId,Quit)=""
 ..For  Set UserId=$O(^vhUSER("D",UserId)) Quit:UserId=""  Do  Quit:Quit
 ...Quit:'$$IsActief(UserId)
 ...Set R=^vhUSER("D",UserId),$P(R,D,2)=$$UPTRIMAN^vhRtn1($P(R,D,2))
 ...Set $P(R,D,4)=$$UPTRIMAN^vhRtn1($P(R,D,4)),$P(R,D,5)=$$UPTRIMAN^vhRtn1($P(R,D,5))
 ...If $P(R,D,2)=$P(UserName,D)!($P(R,D,2)=$P(UserName,D,2)) Set Quit=1
 ...If $P(R,D,4)=$P(UserName,D)!($P(R,D,4)=$P(UserName,D,2)) Set Quit=1
 ...If $P(R,D,5)=$P(UserName,D)!($P(R,D,5)=$P(UserName,D,2)) Set Quit=1
 ..If UserId="" Set UserId=$$TGROEP(Groep)
 .If $L(UserId) Set:$L(UserIds) UserIds=UserIds_";" Set UserIds=UserIds_UserId
 Set:$G(LB) UserIds=$$PiecesToList^vhLib(UserIds,";")
 Quit UserIds
 ;
 ; Vertalen van gebruikers id naar de naam (korte of lange versie)
 ; $G(Long) = -1  : Initialen
 ;             0  : Korte versie
 ;             1  : Lange versie
 ;             @  : E-mail adres
 ;             @1 : "Lange versie"<E-mail adres>
 ; LB = 1 -> fomaat $LB
USERNAME(Users,Long,LB) 
 New D,I,UserIds,zr,Piece,UserId
 Set D="\"
 Set Users=$G(Users,$$DEVUSER()),Long=$G(Long),UserIds=$$USERID(Users),Users=""
 If $E(Long)="@" Set zr="^vhUSER(""D"",UserId,""M"")",Piece=13
 Else  Set zr="^vhUSER(""D"",UserId)",Piece=$S(Long>0:5,Long<0:4,1:2)
 If $L(UserIds) For I=1:1:$L(UserIds,";") Do
 .Set:$L(Users) Users=Users_";"
 .Set UserId=$P(UserIds,";",I)
 .If $E(Long)="@",$L($E(Long,2)) Set Users=Users_""""_$$USERNAME(UserId,$E(Long,2))_""" <"_$P(@zr,D,Piece)_">"
 .Else  Set Users=Users_$P(@zr,D,Piece)
 Set:$G(LB) Users=$$PiecesToList^vhLib(Users,";")
 Quit Users
 ;
USERNAMESQL(Users,Long)   ; Added by WimV on 2007/07/2003
 New I,UserIds,D
 Set D="\"
 Set Users=$G(Users),Long=$G(Long),UserIds=$$USERID^vhUSER(Users),Users=""
 If $L(UserIds) For I=1:1:$L(UserIds,";") Do
 . Set:$L(Users) Users=Users_";"
 . If Long="@" Set Users=Users_$P(^vhUSER("D",$P(UserIds,";",I),"M"),D,13)
 . Else        Set Users=Users_$P(^vhUSER("D",$P(UserIds,";",I)),D,$S(Long>0:5,Long<0:4,1:2))
 Quit Users
 ;
 
LoggedInUser()
	Quit:$G(QU(1)) QU(1)
	Quit $$DEVUSER()
 
 ; De gebruikers id van een device
DEVUSER(Device,Select)
 If $IsObject($G(%request)) Quit "" ; Webservice kunnen geen gebruik maken van cQ5 alleen TELNET gebruikers, PV 23/06/2011
 If '$D(Device)&&'$D(Select)&&$D(QU(1)) Quit QU(1) ; LoggedInUser ipv via Device, PV 15/10/2010
 Set:'$D(Device) Device=$$IO^cQ5
 If (Device=$$IO^cQ5)&&'$D(Select)&&$D(QU(1)) Quit QU(1) ; LoggedInUser ipv via Device, PV 15/10/2010
 Set Select=$S($G(Select):"C;C",1:0)
 Quit $$USELECT^vhUSER("","",Device,"","","","","","",Select)
 ;
 ; De device van een gebruiker
USERDEV(User) 
 New Device,Devices
 Set (Device,Devices)=""
 For  Set Device=$O(^vhUSER("D",User,"D",Device)) Quit:Device=""  Set Devices=Devices_";"_Device
 Set $E(Devices)=""
 Quit Devices
 ;
 ; Vervang de groepen door de gebruikers van die groepen
MERGEGRP(CUserId,TUserId,Sorted,AutoFw) 
 New I,R,Groep,GUserId,UserId,FwUserId
 Set Sorted=$G(Sorted),AutoFw=$G(AutoFw)
 For I=$L(TUserId,";"):-1:1 Set Groep=$P(TUserId,";",I) Do
 .Quit:Groep=""  Quit:Groep="?"
 .Quit:$D(^vhUSER("S",Groep))  Quit:$D(^vhUSER("D",Groep))
 .Set UserId=$$USERID(Groep)
 .Quit:UserId=""
 .Set $P(TUserId,";",I)=UserId
 For I=1:1 Set Groep=$P(TUserId,";",I) Quit:Groep=""  Do
 .Quit:Groep="?"
 .If $E(Groep,1,2)'="&S",'$D(^vhUSER("S",Groep)),'$D(^vhUSER("D",Groep)) Set Groep="SYS"
 .If $E(Groep,1,2)'="&S" Quit:'$D(^vhUSER("S",Groep))
 .If $E(Groep,1,2)="&S" Set $P(TUserId,";",I)=Groep Quit
 .Set GUserId=";"_$$TGROEP(Groep,Sorted,AutoFw)
 .For R=2:1 Set UserId=$P(GUserId,";",R) Quit:UserId=""  Do
 ..If UserId'=CUserId Quit:(";"_TUserId_";")'[(";"_UserId_";")
 ..Set $P(GUserId,";",R-1,R)=$P(GUserId,";",R-1),R=R-1
 .If $L(GUserId) Set $E(GUserId)="",$P(TUserId,";",I)=GUserId
 .Else  Set $P(TUserId,";",I-1,I)=$P(TUserId,";",I-1),I=I-1
 If AutoFw For I=1:1:$L(TUserId,";") Do
 .Set UserId=$P(TUserId,";",I)
 .Quit:UserId=""  Quit:'$D(^vhUSER("D",UserId))
 .Set R=$G(^vhUSER("D",UserId,"M")),FwUserId=$P(R,D,17)
 .Quit:'FwUserId
 .If ";"_TUserId_";"[(";"_FwUserId_";") Set $P(TUserId,";",I,999)=$P(TUserId,";",I+1,999)
 .Else  Set $P(TUserId,";",I)=FwUserId
 Quit TUserId
 ;
 ; Haal de gebruikers van een groep
TGROEP(Groep,Sorted,AutoFw) 
 New D,I,R,User,TUserId,UserId,FwUserId,QValue,QSerie,USortNr,Name
 Set D="\",Sorted=$G(Sorted),AutoFw=$G(AutoFw)
 Set UserId="",QSerie=$P($G(^vhUSER("S",Groep)),D,4) Set:QSerie="" QSerie=$P($G(^vhUSER("S",Groep)),D,3)
 Set TUserId=""
 If $L(QSerie) Do
 .Set QSerie=";"_QSerie_";"
 .For  Set UserId=$O(^vhUSER("D",UserId)) Quit:UserId=""  Do
 ..Set QValue=$P($G(^vhUSER("D",UserId,"M")),D)
 ..For I=1:1:$L(QValue,";") Do
 ...Quit:QSerie'[(";"_$P($P(QValue,";",I),"~")_";")
 ...Set FwUserId=$P($P(QValue,";",I),"~",2) Set:'AutoFw FwUserId=""
 ...Set:'FwUserId FwUserId=UserId
 ...Set UserId(FwUserId)=""
 .Set UserId=""
 .For  Set UserId=$O(UserId(UserId)) Quit:UserId=""  Do
 ..Set R=$G(^vhUSER("D",UserId,"M")),FwUserId=$P(R,D,17) Set:'AutoFw FwUserId=""
 ..Set:'FwUserId FwUserId=UserId
 ..Set USortNr=FwUserId,Name=""
 ..If Sorted Set R=^vhUSER("D",FwUserId),USortNr=$P(R,D),Name=$P(R,D,2)
 ..Set:USortNr="" USortNr="~" Set:Name="" Name="~"
 ..Set User(USortNr,Name)=FwUserId
 .Set (TUserId,USortNr)=""
 .For  Set USortNr=$O(User(USortNr)) Quit:USortNr=""  Do
 ..Set Name=""
 ..For  Set Name=$O(User(USortNr,Name)) Quit:Name=""  Set TUserId=TUserId_";"_User(USortNr,Name)
 .Set $E(TUserId)=""
 Quit TUserId
 ;
 ; Bepalen van het tijdsinterval voor de gebruikers van een bepaalde groep
 ; Eventueel niet aangelogde gebruikers worden naar achter geschoven
TINTERV(Groep,UBefore,UAfter,URemove) 
 New I,R,UserId,Interv,GInterv,UInterv,FInterv,TStart,Count,TCumul,Users,IsAktief
 Set:$G(Groep)="" Groep="??????????"
 Set UBefore=$$USERID($G(UBefore)),UAfter=$$USERID($G(UAfter)),URemove=$$USERID($G(URemove))
 Set Interv="",R=$G(^vhUSER("S",Groep)),Users=$P(R,D,7),R=$P(R,D,6),(TCumul,FInterv)=0
 Set Users=";"_UBefore_";"_Users_";"_UAfter_";"
 For I=$L(Users,";"):-1:1 Set:$P(Users,";",1,I-1)_";"[(";"_$P(Users,";",I)_";") $P(Users,";",I)=""
 For I=1:1:$L(URemove,";") Do
 .Quit:Users'[(";"_$P(URemove,";",I)_";")
 .Set Users=$P(Users,";"_$P(URemove,";",I)_";")_";;"_$P(Users,";"_$P(URemove,";",I)_";",2,99)
 Set GInterv=$P(R,";"),TStart=$P(R,";",2)
 If $E(TStart)'="$",$E(TStart)'="""" Set TStart=""""_TStart_""""
 Xecute "Set TStart="_TStart
 Set:'$L($P(TStart,",",2)) TStart=+$H_","_TStart
 If $P(TStart,",")<$P($H,",") Set TStart=$H
 Else  If $P(TStart,",")=$P($H,",") Set:$P(TStart,",",2)<$P($H,",",2) $P(TStart,",",2)=$P($H,",",2)
 If $L(Users) For  Do  Quit:Users=""
 .Set UserId=$P(Users,";"),Users=$P(Users,";",2,99)
 .Set:'UserId UserId=$$USERID(UserId)
 .Quit:'UserId
 .Set TCumul=TCumul+GInterv Set:'FInterv FInterv=GInterv
 .Set Interv=Interv_D_UserId_";"_$$CALCTIME^vhDTyp(TStart,"S",TCumul-FInterv)
 Do:Interv=""
 .For Count=1:1 Quit:'$D(^vhUSER("S",Groep_Count))  Do
 ..Set UInterv=$P(^vhUSER("S",Groep_Count),D,6) Set:'UInterv UInterv=GInterv
 ..Quit:'UInterv
 ..Set UserId=$$USERID(Groep_Count)
 ..Quit:'UserId
 ..Set TCumul=TCumul+UInterv Set:'FInterv FInterv=UInterv
 ..Set Interv=Interv_D_UserId_";"_$$CALCTIME^vhDTyp(TStart,"S",TCumul-FInterv)
 Set $E(Interv)=""
 Do:$L(Interv,D)>1
 .For I=1:1:$L(Interv,D) Do
 ..Set UserId=$P($P(Interv,D,I),";")
 ..Set IsAktief=''$L($$USERJOBS^cS(UserId))                             
 ..Set Interv(IsAktief,I)=UserId
 .Quit:'$D(Interv(0))
 .Set Count=0
 .For IsAktief=1,0 Do
 ..Set I=0
 ..For  Set I=$O(Interv(IsAktief,I)) Quit:I=""  Do
 ...Set UserId=Interv(IsAktief,I),Count=Count+1
 ...Set R=$P(Interv,D,Count),$P(R,";")=UserId,$P(Interv,D,Count)=R
 Quit Interv
 ;
 ; Call back voor selekt gebruikers
CB(Select,Old,New,Rec) 
 New Groep,TUserId
 If New Do
 .Set Groep=$P(Rec,"`")
 .If Groep="?" Set sOptie=$TR(sOptie,"M","") Quit
 .If $L(Groep),$D(^vhUSER("S",Groep)) Do  Quit
 ..Set TUserId=$$TGROEP(Groep)
 ..Do DESEL^vhPOPUP(Select)
 ..For Select=1:1 Quit:'$D(sY(Select))  If (";"_TUserId_";")[(";"_$P(sY(Select),"`")_";") Do
 ...Do SEL^vhPOPUP(Select)
 ...Set Rec=sY(Select)
 ...If $L($G(CB("X"))) Do EXECS^vhRES(CB("X"),"","(Select,Old,New,Rec)")
 If $D(sY(Select)),$L($G(CB("X"))) Set Rec=sY(Select) Do EXECS^vhRES(CB("X"),"","(Select,Old,New,Rec)")
 Quit
 ;
 ; Gebruiker van een ander volume
OVUSER(CUserId,TUserId) 
 New I,Device,UserId
 Set CUserId=$G(CUserId),TUserId=$G(TUserId)
 For I=$L(TUserId,";"):-1:1 Do
 .Set UserId=$P(TUserId,";",I),Device="" Set:UserId Device=$O(^vhUSER("D",UserId,"D",""),-1)
 .If 'UserId!(UserId=CUserId)!(Device?.N) Set $P(TUserId,";",I-1,I)=$P(TUserId,";",I-1)
 Set:$E(TUserId)=";" $E(TUserId)=""
 Quit TUserId
 ;
 ; WIJZIG/RAADPL toegang voor proxykeys 
MODPROXY(OUserId,CUserId,PNode) 
 New I,Proxy,ModPKey,OwnPKey
 Set OwnPKey=$P($G(^vhUSER("D",OUserId,PNode)),D,10)
 Set Proxy=0,ModPKey=$P($G(^vhUSER("D",CUserId,PNode)),D,11)
 For I=1:1:$L(OwnPKey,";") If (";"_ModPKey_";")[(";"_$P(OwnPKey,";",I)_";") Set Proxy=1 Quit
 Quit Proxy
 ;
 ; Nazicht proxykeys
CHKPROXY(OwnPKey,UserId,PNode) 
 New I,R,Proxy,ModPKey,ReadPKey
 Quit:OwnPKey=-1 1
 If UserId=$G(CUserId) Quit $S(PNode="M":0,1:$L($P($G(^vhUSER("D",UserId,PNode)),D)))
 Set Proxy=0,R=$G(^vhUSER("D",UserId,PNode)),ModPKey=$P(R,D,11),ReadPKey=$P(R,D,12)
 If $L(OwnPKey) For I=1:1:$L(OwnPKey,";") If (";"_ModPKey_";"_ReadPKey_";")[(";"_$P(OwnPKey,";",I)_";") Set Proxy=1 Quit
 Quit Proxy
 ;
 ; Nazicht toegang van gebruikers tot programma's
CHKPROG(Key,QL) 
 New Ok
 Set Ok=1
 If $L($G(Key)),$L($G(QL))," "_QL'[(" "_Key_" ") Set Ok=0
 Quit Ok
 ;
INIT(Titel) 
 New UserId
 Set:$G(Titel)="" Titel="Gebruiker"
 If $P($G(sUser),D) Set UserId=$P(sUser,D)
 Else  If $D(QU(1)) Set UserId=$$LoggedInUser()
 Else  If $O(^($O(^vhUSER("ID",$$IO^cQ5,""))))="" Set UserId=$O(^vhUSER("ID",$$IO^cQ5,""))
 Else  Do  Quit:'UserId
 .Set UserId=$$USELECT("",Titel,$$IO^cQ5,"","","","","","","C;C")
 Set $P(sUser,D)=UserId
 Quit
 ;
BLDID ; Opbouw ID index in vhUSER vertrekkend van vhUSER("D",User,"D",
 Set User=""
 Set Dev=""
 Kill ^vhUSER("ID")
 For  Set User=$O(^vhUSER("D",User)) Quit:User=""  Do
 .For  Set Dev=$O(^vhUSER("D",User,"D",Dev)) Quit:Dev=""  Do
 ..Set ^vhUSER("ID",Dev,User)=""
 Quit
 ;
OTHER 
 New I,R,SepLine
 For I=1:1 Quit:'$D(Other(I))  Do
 .Set R=Other(I) Set:$P(R,D)="" $P(R,D)=$P(R,D,2) Set:$P(R,D,2)="" $P(R,D,2)=$P(R,D)
 .Quit:$TR($P(R,D,1,2),D,"")=""
 .If $P(R,D)="KL",$P(R,D,2),$D(^KK1($P(R,D,2))) Do
 ..Do KLANT($P(R,D,2))
 ..Kill SepLine
 .Else  If $P(R,D)="LE",$P(R,D,2),$D(^KL1($P(R,D,2))) Do
 ..Do LEVER($P(R,D,2))
 ..Kill SepLine
 .Else  Do
 ..Set:'$D(SepLine) SepLine=$D(User)\10
 ..If SepLine Set User($O(User(""),-1)+1)="&S",SepLine=0
 ..Set User($O(User(""),-1)+1)=$P(R,D)_"`"_$P(R,D,2)
 Set SepLine=0
 For I=1:1 Quit:'$D(User(I))  If $E(User(I),1,2)="&S" Set SepLine=SepLine+1
 If SepLine=1,$E(User(1),1,2)="&S",$L($E(User(1),3,99)) Do
 .Set Titel=$E(User(1),3,99)
 .For I=2:1 Quit:'$D(User(I))  Set User(I-1)=User(I) Kill User(I)
 Quit
 ;
KLANT(KLNr) 
 New I,R,Verantw,Rubriek,Naam,SepLine
 Set I=100,Naam=$P(^KKL(^KK1(KLNr),0),D,2),SepLine=1
 For  Set I=$O(^KKL(0,I)) Quit:I=""  Do
 .Set Rubriek=^KKL(0,I),R=$P(Rubriek,";",16)
 .Quit:"\311\312\701\405\404\314\313\702\703\704\705\706\"'[(D_R_D)
 .Set R=$P(^KKL(^KK1(KLNr),R\100-1),D,R#100) Quit:R=""
 .Set R=$$INITCAP^vhRtn1(R)
 .If SepLine Do
 ..If '$D(User),$O(Other($O(Other(""))))="" Set Titel=" Klant "_Naam_" "
 ..Else  Set User($O(User(""),-1)+1)="&S&C Klant "_Naam_" "
 ..Set SepLine=0
 .Set User($O(User(""),-1)+1)=R_"`"_R
 Quit
 ;
LEVER(LEVNr) 
 New I,R,Verantw,Rubriek,Naam,SepLine
 Set I=100,Naam=$P(^KLE(^KL1(LEVNr),0),D,2),SepLine=1
 For  Set I=$O(^KLE(0,I)) Quit:I=""  Do
 .Set Rubriek=^KLE(0,I),R=$P(Rubriek,";",16)
 .Quit:"\311\312\701\405\404\314\313\702\703\704\705\706\"'[(D_R_D)
 .Set R=$P(^KLE(^KL1(LEVNr),R\100-1),D,R#100) Quit:R=""
 .Set R=$$INITCAP^vhRtn1(R)
 .If SepLine Do
 ..If '$D(User),$O(Other($O(Other(""))))="" Set Titel=" Lev "_Naam_" "
 ..Else  Set User($O(User(""),-1)+1)="&S&C Lev "_Naam_" "
 ..Set SepLine=0
 .Set User($O(User(""),-1)+1)=R_"`"_R
 Quit
 ;
REINDEX ;REBUILD INDEX
 Kill ^vhUSER("ID")
 Kill ^vhUSER("II")
 Set Usr=""
 For  Set Usr=$O(^vhUSER("D",Usr)) Quit:Usr=""  Do
 .Set Init=$P(^vhUSER("D",Usr),D,4)
 .If $L(Init) Do
 .. If $D(^vhUSER("II",Init)) Do WARN^vhTXTPOP("Initialen bestaat reeds "_Init_":"_Usr_"&"_$G(^vhUSER("II",Init)))
 .. Set ^vhUSER("II",Init)=Usr
 .Set Dev=""
 .For  Set Dev=$O(^vhUSER("D",Usr,"D",Dev)) Quit:Dev=""  Do
 ..Set ^vhUSER("ID",Dev,Usr)=""
 Quit
 ;
CHKFILE 
 New
 Do INIT^vhTERMINA
 Write !!,"Nazicht data-nodes",!
 Set UserId=""
 For  Set UserId=$O(^vhUSER("D",UserId)) Quit:UserId=""  Do
 .Set UserName=$P(^vhUSER("D",UserId),D,5) Set:UserName="" UserName=$P(^vhUSER("D",UserId),D,2)
 .Set WachtW=$P(^vhUSER("D",UserId),D,13)
 .If $O(^vhUSER("D",UserId,""))="" Do
 ..Write !,UserId,?5,"DEL ",UserName
 ..Set Initialen=$$USERNAME(UserId,-1)
 ..If Initialen="" Write !,UserId,?5,"INI ",UserName
 ..Else  If $D(^vhUSER("II",Initialen)) Write !,UserId,?5,"INI ",UserName
 ..If $L(WachtW),$D(^vhUSER("IW",WachtW)) Write !,UserId,?5,"IWW ",UserName
 .Else  Do
 ..If '$D(^vhUSER("D",UserId,"D")) Write !,UserId,?5,"NA  ",UserName
 ..Else  Do
 ...Set DevNr=^vhUSER("D",UserId,"D")
 ...If DevNr Do
 ....If '$D(DevNr(DevNr)) Set DevNr(DevNr)=UserId
 ....Else  Write !,UserId,?5,"DUB ",DevNr,?15,UserName
 ..Set DevNr=""
 ..For  Set DevNr=$O(^vhUSER("D",UserId,"D",DevNr)) Quit:DevNr=""  Do
 ...Quit:$D(^vhUSER("ID",DevNr,UserId))
 ...Write !,UserId,?5,"ONB ",DevNr,?15,UserName
 ..Set Initialen=$$USERNAME(UserId,-1)
 ..If Initialen="" Write !,UserId,?5,"INI ",UserName
 ..Else  If '$D(^vhUSER("II",Initialen)) Write !,UserId,?5,"INI ",UserName
 ..If $L(WachtW),'$D(^vhUSER("IW",WachtW)) Write !,UserId,?5,"IWW ",UserName
 Write !!,"Nazicht indexen",!
 Set DevNr=""
 For  Set DevNr=$O(^vhUSER("ID",DevNr)) Quit:DevNr=""  Do
 .Set UserId=""
 .For  Set UserId=$O(^vhUSER("ID",DevNr,UserId)) Quit:UserId=""  Do
 ..Quit:$D(^vhUSER("D",UserId,"D",DevNr))
 ..Set UserName=$P(^vhUSER("D",UserId),D,5) Set:UserName="" UserName=$P(^vhUSER("D",UserId),D,2)
 ..Write !,UserId,?5,"ONB ",DevNr,?15,UserName
 Set Initialen=""
 For  Set Initialen=$O(^vhUSER("II",Initialen)) Quit:Initialen=""  Do
 .Set UserId=^vhUSER("II",Initialen)
 .Set UserName=$P(^vhUSER("D",UserId),D,5) Set:UserName="" UserName=$P(^vhUSER("D",UserId),D,2)
 .If $O(^vhUSER("D",UserId,""))="" Write !,UserId,?5,"INI ",UserName
 Set WachtW=""
 For  Set WachtW=$O(^vhUSER("IW",WachtW)) Quit:WachtW=""  Do
 .Set UserId=^vhUSER("IW",WachtW)
 .Set UserName=$P(^vhUSER("D",UserId),D,5) Set:UserName="" UserName=$P(^vhUSER("D",UserId),D,2)
 .If $O(^vhUSER("D",UserId,""))="" Write !,UserId,?5,"IWW ",UserName
 Quit
 ;
CLEAR(All) 
 If $G(All) Do  ; 's nachts
 .New
 .Kill ^vhUSER("ID")
 .Set UserId=0
 .For  Set UserId=$O(^vhUSER("D",UserId)) Quit:UserId=""  Kill ^vhUSER("D",UserId,"D")
 Else  Do  ; logoff van een gebruiker
 .New I,UserId,UserIos,Count,Dev
 .Set UserId=$G(QU(1))
 .Set:'UserId UserId=$$UI1^cAFA1("USR",101,QU)
 .Quit:'UserId
 .Set UserDevs=$$USERDEVS^cS(UserId)
 .For I=1:1:$L(UserDevs,",") Set $P(UserIos,",",I)=$$IO^cQ5($P(UserDevs,",",I))
 .Set Count=0
 .For I=1:1:$L(UserIos,",") Set:$P(UserIos,",",I)=io Count=Count+1
 .Quit:Count>1
 .Kill ^vhUSER("D",UserId,"D",io)
 .Kill ^vhUSER("ID",io,UserId)
 .Set Dev=$O(^vhUSER("D",UserId,"D",""))
 .If Dev="" Kill ^vhUSER("D",UserId,"D")
 .Else  Set:$G(^vhUSER("D",UserId,"D"))=io ^vhUSER("D",UserId,"D")=Dev
 Quit
 ;
 ; Is een gebruiker opgenomen in een bepaalde groep?
IsGroep(UserId,Groep)
 New TGroep
 Set UserId=$G(UserId),TGroep=$$USERID(Groep)
 Set:'UserId UserId=$$USERID^vhUSER($S($L(UserId):UserId,1:$G(QU)))
 Quit ";"_TGroep_";"[(";"_UserId_";")
 ;
 ; Is een gebruiker een vertegenwoordiger?
IsVTWExtern(UserId)
 Quit $$IsGroep($G(UserId),"VTWEXTERN")
 ;
 ; Is een bepaalde gebruiken nog actief?
IsActief(UserId)
 Quit:'UserId 0
 Quit $O(^vhUSER("D",UserId,""))'=""
 ;
MailTo(To,MiniMail)
 Set To=$$USERID($S($ZUTIL(110)'="CACHE01":"CW",1:To))
 Set:$G(MiniMail) To=$$PiecesToList^vhLib($$USERNAME(To,"@"),";")
 Quit To
 ;
 ; Controle of een persoon toegang heeft op basis van zijn uniek nummer
GetECToegang(UserId)
 New ID,HasAccess
 Set UserId=$G(UserId)
 Set:'UserId UserId=$$USERID^vhUSER($S($L(UserId):UserId,1:$G(QU)))
 &sql(Select ID,HasAccess into ID,HasAccess From Derde_EC.Toegang Where InternePersoon = :UserId)
 Quit $LB($G(ID),$G(HasAccess))
 ;
 ; Wijzig de initialen van een gebruiker (Data-M bestanden en vhUSER)
mu
 New r,uiOld,uiNew,un,uiSpace
 Read !,"Wijzig initialen? ",uiOld
 Set uiOld=$$UPCASE^vhRtn1(uiOld),un=$$USERID^vhUSER(uiOld)
 If un Do
 . Read !,"Wijzigen naar? ",uiNew
 . If uiNew="" Write !,"Geen initialen ingegeven!" Quit
 . If $$USERID^vhUSER(uiNew) Write !,"Deze initialen bestaan reeds -> ",$$USERNAME^vhUSER(uiNew,2),"!" Quit
 . Set uiNew=$$UPCASE^vhRtn1(uiNew)
 . Write !,"Wijzigen ",$$USERNAME^vhUSER(un,1)," van '",uiOld,"' naar '",uiNew,"' (j)? "
 . Read r
 . If $$UPCASE^vhRtn1(r)'="J" Write !,"Niet gewijzigd!!!" Quit
 . Set uiSpace=uiNew
 . For i=$L(uiSpace)-1:-1:1 Set $E(uiSpace,i)=$E(uiSpace,i)_" "
 . Write !,"Wijzigen '",uiOld,"' naar '",uiNew,"'."
 . Write !,"Aanpassen Data-M bestanden",!
 . ZWrite ^DATA(0,"USR",un)
 . Set r=^DATA(0,"USR",un,0),$P(r,D)=uiNew,^DATA(0,"USR",un,0)=r
 . Set r=^DATA(0,"USR",un,1) Set:$P($P(r,D,21),"@")=uiOld $P(r,D,21)=uiNew_"@"_$P($P(r,D,21),"@",2),^DATA(0,"USR",un,1)=r
 . ZWrite ^DATA(0,"USR",un)
 . ZWrite ^INDEX(0,"USR",101,uiOld_" "_un)
 . Set ^INDEX(0,"USR",101,uiNew_" "_un)=un
 . Kill ^INDEX(0,"USR",101,uiOld_" "_un)
 . ZWrite ^INDEX(0,"USR",101,uiNew_" "_un)
 . Write "Aanpassen vhUSER",!
 . ZWrite ^vhUSER("D",un)
 . Set r=^vhUSER("D",un)
 . Set $P(r,D,4)=uiNew Set:$TR($P(r,D,6)," ","")=uiOld $P(r,D,6)=uiSpace
 . Set ^vhUSER("D",un)=r
 . Set r=$G(^vhUSER("D",un,"M")) Set:$P($P(r,D,13),"@")=uiOld $P(r,D,13)=uiNew_"@"_$P($P(r,D,13),"@",2),^vhUSER("D",un,"M")=r
 . ZWrite ^vhUSER("D",un)
 . ZWrite ^vhUSER("II",uiOld)
 . Set ^vhUSER("II",uiNew)=un
 . Kill ^vhUSER("II",uiOld)
 . ZWrite ^vhUSER("II",uiNew)
 Else  Write !,"Gebruiker met initialen '",uiOld,"' bestaat niet!"
 Quit
 ;