PERS ;Beheer personen van zowel klanten, leveranciers en ev. derde [ 12/19/2003  2:27 PM ] 
 
VERWERK(ObjType,ObjRef,Modif,Opties) 
 ; Opties doorgeven dmv. .Local
 ; Opties("BEGIN") ; Lijnnr waarop de lijst begint (zonder hoofding), default=7
 ; Opties("RPL")   ; 1 is opgeroepen vanuit raadplegen
 ; Modif : -1 = Display lijst only, 0 = Display + Detail, 1 = Wijzig
 New Input,PersNr,%J,RPL,ZATemp,UniekNr
 Do INIT
 New:'RPL Lijst
 Do WRITE
 For  Do COMMAND If $L(Input) Quit:Input="-"!(Input=".")!(Input=",")!(Modif'=1)
 If RPL,ObjType="K" Do
 .Set VTB=U4,R=Input Set RLabel="33^RPLKL",(SW5,SW2)=0
 .Kill:Input="K" Lijst
 If 'RPL Do SAVE:Modif=1
 Do CLEAN
 Quit
 
RPLKL(ObjType,ObjRef) 
 New Input,PersNr,%J,RPL,Modif,Lijst
 Set Modif=0,Opties("RPL")=1
 IF VTB=U4,$P(RPLPERS,D)=ObjType,$P(RPLPERS,D,2)=ObjRef Do GETDEF
 Else  Do SA^RPLKL,INIT
 Do WRITE
 Do COMMAND
 Do PUTDEF
 Do CLEAN
 Quit
 
 ;Opties = zie PERSS
SELECT(ObjType,ObjRef,Opties) 
 Quit $$SELECT^PERSS(ObjType,ObjRef,.Opties)
 
COMMAND Set Input=$$SCROLL^vhLIST(.Lijst)
 Quit:Input="-"  Quit:Input="."
 Set PersNr=$S($D(^HULP(%J,"L",Lijst("SELECT"))):$P(^(Lijst("SELECT")),D),1:0)
 If Input="COM",'RPL Set Input="" Do CALL^vhMenu("PERS")
 If Input="SPEC" Set Input="" Do CALLSPEC^vhMenu(Lijst("POS")+Lijst("SELECT")_";80","PERSE","E")
 Do:$L(Input) EXEC^vhMenu("PERS",.Input)
 Quit
 
PUTDEF Merge ^HULP($J,ObjType_ObjRef,"PERS")=^HULP(%J)
 Merge ^HULP($J,ObjType_ObjRef,"PERSD")=Lijst
 Set R=Input,VTB=U4,SW2=0
 Set RPLPERS=ObjType_D_ObjRef
 Quit
GETDEF 
 Set Opties=$G(Opties),RPL=$G(Opties("RPL"))
 Set %J=$$%J^vhRtn1(),ZATemp=$ZA
 Xecute FLO
 Kill ^HULP(%J)
 Merge ^HULP(%J)=^HULP($J,ObjType_ObjRef,"PERS")
 Merge Lijst=^HULP($J,ObjType_ObjRef,"PERSD")
 Do:Modif=1 SET^vhMenu("PERSE","M")
 Do:Modif=0 SET^vhMenu("PERSE","D")
 Quit
 
INIT Do:'$D(Q)
 .New ObjRef,ObjType,Opties,Modif
 .Do INIT^vhTERMINA
 Set Opties=$G(Opties),RPL=$G(Opties("RPL"))
 Set %J=$$%J^vhRtn1(),ZATemp=$ZA
 Xecute FLO
 Kill ^HULP(%J)
 For PersNr=1:1:$O(^PERS(ObjType,ObjRef,""),-1) Do
 .Set Rec=^PERS(ObjType,ObjRef,PersNr)
 .Set ^HULP(%J,"P",PersNr)=Rec
 .Set UniekNr=$P(Rec,D) Set:UniekNr UniekNr(UniekNr)=Rec,^HULP(%J,"C",UniekNr)=Rec
 Do BLDSORT
 Do:Modif=1 SET^vhMenu("PERSE","M")
 Do:Modif=0 SET^vhMenu("PERSE","D")
 Quit
 
BLDSORT
	Kill ^HULP(%J,"S")
	New PersNr,Rec,lbSort,Pos
	Set PersNr=""
 	For  Set PersNr=$O(^HULP(%J,"P",PersNr)) Quit:PersNr=""  Do
 	. Set Rec=^HULP(%J,"P",PersNr)
	. Set Types=$P(Rec,D,5)
	. For Pos=1:1:$L(Types,";") Do
	. . Quit:$P(Types,";",Pos)=""
	. . Set Sort=$$SORTKEY2(PersNr,$P(Types,";",Pos))
 	. . Set ^HULP(%J,"S",Sort)=PersNr_D_$P(Types,";",Pos)
	Quit
	
SAVE Quit:Modif<1
 ;TSTART
 Do REMINDEX(ObjType,ObjRef)
 Kill ^PERS(ObjType,ObjRef)
 Kill AlreadySaved
 Set Cnt=0
 For Nr=1:1:$O(^HULP(%J,"L",""),-1) Do
 .Set PersNr=$P(^HULP(%J,"L",Nr),D)
 .Quit:$D(AlreadySaved(PersNr))
 .Set ^PERS(ObjType,ObjRef,$I(Cnt))=^HULP(%J,"P",PersNr)
 .Set AlreadySaved(PersNr)=""
 .Set UniekNr=$P(^PERS(ObjType,ObjRef,Cnt),D)
 .Kill UniekNr(UniekNr)
 Do:ObjType="K" ECToegangNonActief^PERS2(ObjRef,.UniekNr)
 Do BLDINDEX(ObjType,ObjRef)
 Set:ObjType="K" $P(^KKL(^KK1(ObjRef),7),D,7)=$$EXTDATE^vhLib.DataTypes($H,"DK")
 Set:ObjType="K"&$D(B(8)) $P(B(8),D,7)=$$EXTDATE^vhLib.DataTypes($H,"DK")
 Do:ObjType="K" CompMassMail^PERS2(%J,ObjRef)
 ;TCOMMIT
 Quit
 
DELOBJ(ObjType,ObjRef) 
 ;TSTART
 Do REMINDEX(ObjType,ObjRef)
 Kill ^PERS(ObjType,ObjRef)
 ;TCOMMIT
 Quit
 
BLDINDEX(ObjType,ObjRef) 
 Do INDEX(ObjType,ObjRef,0)
 Quit
 
REMINDEX(ObjType,ObjRef) 
 Do INDEX(ObjType,ObjRef,1)
 Quit
 
INDEX(ObjType,ObjRef,Kill) 
 New PersNr,Rec,C,EMail,Usr,Domain
 Set Kill=$G(Kill) ; BldIndex als default
 For PersNr=1:1:$O(^PERS(ObjType,ObjRef,""),-1) Do
 .Set Rec=^PERS(ObjType,ObjRef,PersNr)
 .Set:'Kill ^PERS("IN",$P(Rec,D,1),ObjType,ObjRef,PersNr)=""
 .Kill:Kill ^PERS("IN",$P(Rec,D,1),ObjType,ObjRef,PersNr)
 .For C=1:1:5 Do:$P($P(Rec,D,14+C),U)="E"  ; Email adres
 ..Set EMail=$P($P(Rec,D,14+C),U,2)
 ..Set Usr=$$UPCASE^vhRtn1($P(EMail,"@"))
 ..Set Domain=$$UPCASE^vhRtn1($P(EMail,"@",2))
 ..Quit:Usr=""!(Domain="")
 ..Set:'Kill ^PERS("IAM",Domain,Usr,ObjType,ObjRef,PersNr)=""
 ..Kill:Kill ^PERS("IAM",Domain,Usr,ObjType,ObjRef,PersNr)
 Quit  
 
REBLDIND ; Terug opbouwen van alle indexen
 Kill ^PERS("IN")
 Kill ^PERS("IAM")
 Set (ObjType,ObjRef)=""
 For  Set ObjType=$O(^PERS(ObjType)) Quit:ObjType=""  Do
 .For  Set ObjRef=$O(^PERS(ObjType,ObjRef)) Quit:ObjRef=""  Do
 ..Do INDEX(ObjType,ObjRef)
 Quit
 
CLEAN 
 Kill ^HULP(%J)
 Use 0:(::::ZATemp:64)
 Quit
 
WRITE 
 If 'RPL!'$D(Lijst) Do
 .Do INIT^vhLIST("PERS","LIJST",.Lijst)
 .Set Lijst("UPINIT")="X`Set Sort=""""" 
 .Set Lijst("UPTRAV")="X`S Sort=$O(^HULP(%J,""S"",Sort)),sRec="""" S:Sort'="""" sRec=$P(^HULP(%J,""S"",Sort),D,1,2),sRec=sRec_D_$G(^HULP(%J,""P"",$P(sRec,D)))"
 .Set Lijst("UPCOMP")="@`sRec=$G(^HULP(%J,""L"",sCnt))"
 .Set Lijst("UPSEL")="@`Sort=SelKey"
 .Set:$G(Opties("BEGIN")) $P(Lijst("POS"),";")=Opties("BEGIN")
 
 Do:Opties["T" TITEL
 Kill ^HULP(%J,"L")
 Do WRITE^vhLIST(.Lijst) ; Lege lijst, alleen hoofding
 Set SelKey=""
 Do UPDATE^vhLIST(.Lijst)
 Quit
 
CONNECTL(Rec) ; Formateren van de verschillende connecties
 New Return,ConRec,I
 Set Return=""
 For I=1:1:5 Do
 .Set ConRec=$P(Rec,D,14+I)
 .Quit:$P(ConRec,U)=""  ; Geen connectietype
 .Set Return=Return_"; "_$P(ConRec,U)_":"_$P(ConRec,U,2)_$S($L($P(ConRec,U,3)):"*",1:"")
 Quit $E(Return,3,99)
 
 ;***  Lijst oproepen ***
ECTOEGANG
 New Rec,BL
 Set Rec=^HULP(%J,"P",PersNr)
 Set BL=##class(BL.EC.Toegang).%New()
 ;Set BL.GetToegang.()
 ;Set BL.GetToegang
 Quit:'%SC
 Set:^HULP(%J,"P",PersNr)'=Rec $P(Rec,D,14)=$H
 Do UPDATE(PersNr,^HULP(%J,"P",PersNr),Rec)
 Quit
 
LNIEUW New Rec
 Set Rec=""
 Do NIEUW^vhScherm("PERSDTL","","","","","",3)
 Quit:'%SC
 Do UPDATE(0,"",Rec)
 Quit
 
LWIJZIG(PersNr) 
 New Rec
 Set Rec=^HULP(%J,"P",PersNr)
 Do EDIT^vhScherm("PERSDTL","","","","","",3)
 Quit:'%SC
 Set:^HULP(%J,"P",PersNr)'=Rec $P(Rec,D,14)=$H
 Do UPDATE(PersNr,^HULP(%J,"P",PersNr),Rec)
 Quit
 
DETAIL(PersNr) 
 New Rec
 Set Rec=^HULP(%J,"P",PersNr)
 Do DISPLAY^vhScherm("PERSDTL","","","","","",3)
 Set Input=R
 Quit
 
LDELETE(PersNr) 
 Do UPDATE(PersNr,^HULP(%J,"P",PersNr),"")
 Quit
 
LKOPIE(PersNr) 
 Set ClipB=^HULP(%J,"P",PersNr)
 Quit
 
LPLAK(PersNr) 
 Do UPDATE(0,"",ClipB)
 Quit
 
CHKMOVE(PersNr,Dir) 
 Quit:'PersNr 0
 Set SwapNr=$O(^HULP(%J,"L",Lijst("SELECT")),Dir)
 Quit:'SwapNr 0
 Set SwapPers=$P(^HULP(%J,"L",SwapNr),D)
 Quit:$P(^HULP(%J,"P",PersNr),D,5)'=$P(^HULP(%J,"P",SwapPers),D,5) 0
 Quit 1
 
LMOVE(PersNr,Dir) 
 Set SwapNr=$O(^HULP(%J,"L",Lijst("SELECT")),Dir)
 Quit:'SwapNr 0
 Set SwapPers=$P(^HULP(%J,"L",SwapNr),D)
 Set Rec=^HULP(%J,"P",PersNr)
 Set SwapRec=^HULP(%J,"P",SwapPers)
 Set SwapSort=$$SORTKEY(SwapPers,SwapRec)
 Set ^HULP(%J,"L",Lijst("SELECT"))="" ; Nodig voor refresh
 Set ^HULP(%J,"L",SwapNr)="" ; Nodig voor refresh
 Set ^HULP(%J,"P",PersNr)=SwapRec
 Set ^HULP(%J,"P",SwapPers)=Rec
 Set SelKey=SwapSort
 Do UPDATE^vhLIST(.Lijst)
 Quit
 
SORTKEY2(PersNr,Type) 
	Quit $P(^RES("PERS","PI","VERANTW"_ObjType,"D",Type),"`")*1000+PersNr
 	
SORTKEY(PersNr,Rec) 
 Quit $P(^RES("PERS","PI","VERANTW"_ObjType,"D",$P($P(Rec,D,5),";")),"`")*1000+PersNr
 
UPDATE(PersNr,OldRec,NewRec) 
 Set:'PersNr PersNr=$O(^HULP(%J,"P",""),-1)+1
 If $L(OldRec) Do
 .Set Sort=$$SORTKEY(PersNr,OldRec)
 .Kill ^HULP(%J,"S",Sort)
 .Kill ^HULP(%J,"P",PersNr)
 .Set ^HULP(%J,"L",Lijst("SELECT"))="" ; Wijziging
 .Set SelKey=$O(^HULP(%J,"S",Sort))
 .Set:SelKey="" SelKey=$O(^HULP(%J,"S",Sort),-1)
 If $L(NewRec) Do
 .If '$P(OldRec,D) Do  ; Het oude record heeft geen uniek nr daarom vernieuwen
 ..Set UniNr=$$NEXTID()
 ..Set $P(NewRec,D)=UniNr
 .Set SelKey=$$SORTKEY(PersNr,NewRec)
 .Set ^HULP(%J,"S",SelKey)=PersNr
 .Set ^HULP(%J,"P",PersNr)=NewRec
 Do BLDSORT
 Do UPDATE^vhLIST(.Lijst)
 Quit
 
NEXTID() 
 New NextId
 Lock +^PERS("N")
 Set NextId=^PERS("N")+1
 Set ^PERS("N")=NextId
 Lock -^PERS("N")
 Quit NextId
 
REMCON(Fld)  ; Verwijderen van een connectie
 New Last,GrpLen
 Set Last=23 ; Laatste veld van de laatste grp
 Set GrpLen=3 ; Aantal velden in een groep
 For Fld=Fld+GrpLen:1:Last Do
 .Do PUT^vhScherm(Fld-GrpLen,$$GET^vhScherm(Fld))
 For Fld=Last-GrpLen+1:1:Last Do
 .Do PUT^vhScherm(Fld,"")
 Quit
 
GETVERAN(ObjType,ObjRef,VerantW,Optie) ; Ophalen van de verantwoordelijke
 ;VerantW is een lijst met de VERANTW types met ";" gescheiden, volgorde is belangrijk
 New PersNr,Graad,MemGraad,Found,I
 Set Optie=$G(Optie,"AV") ;Include Aanspreking en voornaam
 Set MemGraad=999,PersNr="",Rec=""
 For  Set PersNr=$O(^PERS(ObjType,ObjRef,PersNr)) Quit:PersNr=""  Do  Quit:MemGraad=0
 . Set RecP=^(PersNr)
 . Set Found=0
 . For I=1:1:$L($P(RecP,D,5),";") Do
 . . Quit:VerantW'[$P($P(RecP,D,5),";",I)
 . . Set Graad=$L($P(VerantW,$P($P(RecP,D,5),";",I)),";")
 . . Quit:Graad'<MemGraad
 . . Set MemGraad=Graad
 . . Set Found=1
 . Quit:'Found
 . Set Rec=$$GETNAME^PERS(ObjType,ObjRef,PersNr,Optie)
 Quit Rec
 
GETNAME(ObjType,ObjRef,PersNr,Optie) ; Formateren van de naam van de persoon
 New Rec,Rtn,Taal
 Set Rec=$G(^PERS(ObjType,ObjRef,PersNr))
 Quit:Rec="" ""
 Set Optie=$G(Optie,"AV") ;Include Aanspreking en voornaam
 Set Rtn=""
 If Optie["A",$L($P(Rec,D,4)) Do
 .Set Taal=" "
 .Set:ObjType="K" Taal=$P(^KKL(^KK1(ObjRef),0),D,9)
 .Set:ObjType="L" Taal=$P(^KLE(^KL1(ObjRef),0),D,9)
 .Set:'$D(^RES("PERS","PI","AANSPR","D",$P(Rec,D,4),Taal)) Taal="N"
 .Quit:'$D(^RES("PERS","PI","AANSPR","D",$P(Rec,D,4),Taal))
 .Set Rtn=$P(^RES("PERS","PI","AANSPR","D",$P(Rec,D,4),Taal),"`",1)_" "
 Set Rtn=Rtn_$P(Rec,D,2)
 If Optie["V",$L($P(Rec,D,3)) Set Rtn=Rtn_" "_$P(Rec,D,3)
 Quit Rtn
 
 ; Ophalen van de referenties van een persoon via het uniek nummer
GetRef(UniekNr)
 New ObjType,ObjRef,PersNr
 Set (ObjRef,PersNr)=""
 Set:UniekNr ObjType=$O(^PERS("IN",UniekNr,""))
 Set:$L(ObjType) ObjRef=$O(^PERS("IN",UniekNr,ObjType,""))
 Set:$L(ObjRef) PersNr=$O(^PERS("IN",UniekNr,ObjType,ObjRef,""))
 Quit $LB(ObjType,ObjRef,PersNr)
 
 ; Ophalen van de connecties van een persoon via het uniek nummer
GetConnect(UniekNr,ConTypes)
 New I,R,PersRec,ObjType,ObjRef,PersNr,Connect
 Set ConTypes=$G(ConTypes,"TFGSE")
 Set R=$$GetRef(UniekNr),ObjType=$LI(R),ObjRef=$LI(R,2),PersNr=$LI(R,3),(PersRec,Connect)=""
 Set:PersNr PersRec=^PERS(ObjType,ObjRef,PersNr)
 For I=14:1:19 Set R=$P(PersRec,D,I) If $L(R),ConTypes[$E(R) Set Connect=Connect_$LB($$PiecesToList^vhLib(R,";"))
 Quit Connect
 
TRANSEM(EMailAdr,IsTxt) ; Het vertalen van een e-mail adres (usr@domainname) naar een leveranciersreferentie.
 ;Indien IsTxt=True dan naam van de persoon 
 New Domain,Usr,ObjType,Ref,Pers,Typ,Dummy
 Set Domain=$$UPCASE^vhRtn1($P(EMailAdr,"@",2))
 Set Usr=$$UPCASE^vhRtn1($P(EMailAdr,"@",1))
 Set (Ref,Pers,Dummy)=""
 Quit:Domain="" ""
 Set:Usr="" Usr="*"
 For ObjType="K","L" Do  Quit:$L(Ref)
 .If $D(^PERS("IAM",Domain)) Do
 ..Set:'$D(^PERS("IAM",Domain,Usr)) Usr=$O(^PERS("IAM",Domain,"")),Dummy=1
 ..Set Ref=$O(^PERS("IAM",Domain,Usr,ObjType,"")) ; Klantnr
 ..Set:'$G(Dummy)&$L(Ref) Pers=$O(^PERS("IAM",Domain,Usr,ObjType,Ref,"")) ; Persoonnr
 Quit:'$G(IsTxt) $S($L(Ref):ObjType_";"_Ref_";"_Pers,1:"") 
 Quit $$NAME(ObjType,Ref,Pers)
 
NAME(ObjType,ObjRef,PersNr) 
 New Rec
 Quit:'$G(ObjRef) ""
 Set Rec=""
 If $G(PersNr),$D(^PERS(ObjType,ObjRef,PersNr)) Do
 .Set Rec=^PERS(ObjType,ObjRef,PersNr)
 .Set Rec=$P(Rec,D,2)_$S($L($P(Rec,D,3)):", "_$P(Rec,D,3),1:"")
 Else  Do 
 .If ObjType="K" Set Rec=$G(^KK1(ObjRef)) Quit:Rec=""  Set Rec=$G(^KKL(Rec,0))
 .If ObjType="L" Set Rec=$G(^KL1(ObjRef)) Quit:Rec=""  Set Rec=$G(^KLE(Rec,0))
 .Set Rec=$P(Rec,D,2)
 Quit Rec
 
 ; Opgezet voor Cache
TITEL 
 Quit
 
 
EMAILMERGE(GlobRef,Exec)
	New %J,Key,VolgNr,blExport
	Set %J=$$%J^vhRtn1()
	Set VolgNr=""
	For  Set VolgNr=$O(@GlobRef@(VolgNr)) Quit:VolgNr=""  Do
	. Set Rec=@GlobRef@(VolgNr)
	. X Exec
	. Set ^HULP(%J,Key)=""
	
	Set blExport=##class(BL.Derde.Klant.MailLijstExport).%New("STAT")
	;Set blExport.lbExcludeTypes=$LB("BK1","BK2","BK3","ZZ3")
	Do blExport.MailingFromArrayWithKLNr($NAME(^HULP(%J)))
	Kill ^HULP(%J)
	Quit
	
 
 ; Callback routine voor de selectie v/h connecttype
 ; (om SMS enkel bij 4682 Van Hoecke toe te laten)
CBCONNECT(Ref)
 Quit $P(Ref,"`",3)=ObjRef!'$P(Ref,"`",3)
 
 ; Call back voor het opnemen van de elementen 'Gewenste documenten'
CBGWDOC(Element)
 New D,Include
 Set D="\"
 Set:$P(Element,"`",3)="" $P(Element,"`",3)=1
 Xecute "Set Include="_$P(Element,"`",3)
 Quit Include
 
 ; Helptekst voor het ingavescherm
HelpTekst(sFR,Help)
 New R,HelpTekst,Node,Type
 Set HelpTekst=""
 Set R=$P(sFR,"`",7),Node=$P(R,".")
 Set Type=$P(sFL(Node),D)
 Set:Type="T" HelpTekst=$S(Help=1:"Telefoonnummer",1:"")
 Set:Type="F" HelpTekst=$S(Help=1:"Faxnummer",1:"")
 Set:Type="G" HelpTekst=$S(Help=1:"GSM nummer",1:"")
 Set:Type="E" HelpTekst=$S(Help=1:"E-mail adres",1:"")
 Quit HelpTekst
 
 ; Call back voor het opnemen van de elementen in de popup type verantwoordelijke
PopUpInclElement(Element)
 Quit '$L($P(Element,"`",3))
  
 ; Converteer het type verantwoordelijke van oud naar nieuw of omgekeerd
 ; Richting = N = van oud naar nieuw (default)
 ; Richting = O = van nieuw naar oud
ConvertVwBeperk(VwBeperk,Richting,Delimiter)
 New I,R,From,To
 Set Richting=$G(Richting,"N"),Delimiter=$G(Delimiter,",")
 Set VwBeperk=$TR(VwBeperk,"#;",",,")
 For I=1:1:$L(VwBeperk,",") Do
 . Set (From,To)=$P(VwBeperk,",",I)
 . Set R=$G(^RES("PERS","PI","VERANTWK","D",From))
 . If Richting="N" Set:$L($P(R,"`",3)) To=$P(R,"`",3) ; Van oud naar nieuw
 . Else  Set:$L($P(R,"`",4)) To=$P($P(R,"`",4),";") ; Van nieuw naar oud
 . Set $P(VwBeperk,",",I)=To
 Set VwBeperk=$TR(VwBeperk,",#;",Delimiter_Delimiter_Delimiter)
 Quit VwBeperk
 
 ; Omzetten van alle klanten naar nieuwe codes
ConvertVwBeperkAllCust(Richting)
 New R,KLNr
 Set Richting=$G(Richting,"N"),KLNr=""
 For  Set KLNr=$O(^PERS("K",KLNr)) Quit:KLNr=""  Do
 . Write $J(KLNr,8)
 . Do ConvertVwBeperkOneCust(KLNr,Richting)
 Quit
 
 ; Omzetten van een klant naar nieuwe codes
ConvertVwBeperkOneCust(KLNr,Richting)
 New R,PersNr,VwBeperk
 Set Richting=$G(Richting,"N"),PersNr=""
 For  Set PersNr=$O(^PERS("K",KLNr,PersNr)) Quit:PersNr=""  Do
 . Set R=^PERS("K",KLNr,PersNr),VwBeperk=$P(R,D,5)
 . ;Write !,R,!,VwBeperk
 . Set VwBeperk=$$ConvertVwBeperk(VwBeperk,Richting,";"),$P(R,D,5)=VwBeperk
 . ;Write " - ",VwBeperk,!,R
 . Set ^PERS("K",KLNr,PersNr)=R
 Quit
 
 ;
 ; Conversie voor massmailing
ConvertPersPriv
 New ObjTyp,ObjRef
 For ObjTyp="K","L" Do
 . Set ObjRef=""
 . For  Set ObjRef=$O(^PERS(ObjTyp,ObjRef)) Quit:ObjRef=""  Do ConvertPersPrivObject(ObjTyp,ObjRef)
 Quit 
 ;
ConvertPersPrivObject(ObjTyp,ObjRef)
 New I,PersRec,PersNr,Privacy,Connect,OneConnect,ConnectType,ConnectRef
 Set PersNr=""
 For  Set PersNr=$O(^PERS(ObjTyp,ObjRef,PersNr)) Quit:PersNr=""  Do
 . Set PersRec=^PERS(ObjTyp,ObjRef,PersNr),Connect=$P(PersRec,D,15,19),Privacy=""
 . For I=1:1:5 Do
 . . Set OneConnect=$P(Connect,D,I),ConnectType=$P(OneConnect,";"),ConnectRef=$P(OneConnect,";",2)
 . . If ConnectType="E","#~$"[$E(ConnectRef) Set Privacy=Privacy_$E(ConnectRef),$P(OneConnect,";",2)=$E(ConnectRef,2,999),$P(Connect,D,I)=OneConnect
 . If $L(Privacy) Set Privacy=$S(Privacy["~":"",Privacy["#":"",Privacy["$":"PM",1:"PM;IM")
 . Else  Set Privacy="PM;IM"
 . Set $P(PersRec,D,7)=Privacy,$P(PersRec,D,15,19)=Connect,^PERS(ObjTyp,ObjRef,PersNr)=PersRec
 Quit
 
VERANTWFetch(vhUserIDVerantwoordelijke,PersID)
 New Verantwoordelijke
 #dim Verantwoordelijke As %String = ""
 If $G(vhUserIDVerantwoordelijke) && vhUserIDVerantwoordelijke '= "" {
	 Set Verantwoordelijke = $$USERNAME^vhUSER(vhUserIDVerantwoordelijke) 
 }
 If ($G(ObjType) = "K") &&  $G(ObjRef) && (Verantwoordelijke = "") && (PersID'= "") {
	#dim KlantNr As %String = ObjRef
	#dim KlantVerantwoordelijke As %String = ##class(Derde.Klant.Klant).GeefContactPersoonVerantw(KlantNr)
	Set Verantwoordelijke = "["_ExterneVerantwoordelijke_"]"
 }
 Quit Verantwoordelijke