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"))):^(Lijst("SELECT")),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 Sort=$$SORTKEY(PersNr,Rec)
 .Set ^HULP(%J,"S",Sort)=PersNr
 .Set ^HULP(%J,"P",PersNr)=Rec
 .Set UniekNr=$P(Rec,D) Set:UniekNr UniekNr(UniekNr)=Rec
 Do:Modif=1 SET^vhMenu("PERSE","M")
 Do:Modif=0 SET^vhMenu("PERSE","D")
 Quit
 
SAVE Quit:Modif<1
 ;TSTART
 Do REMINDEX(ObjType,ObjRef)
 Kill ^PERS(ObjType,ObjRef)
 For Nr=1:1:$O(^HULP(%J,"L",""),-1) Do
 .Set ^PERS(ObjType,ObjRef,Nr)=^HULP(%J,"P",^HULP(%J,"L",Nr))
 .Set UniekNr=$P(^PERS(ObjType,ObjRef,Nr),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^vhDTyp($H,"DK")
 Set:ObjType="K"&$D(B(8)) $P(B(8),D,7)=$$EXTDATE^vhDTyp($H,"DK")
 Do CONV2OLD^PERS2(ObjType,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=^HULP(%J,""S"",Sort)"
 .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=^HULP(%J,"L",SwapNr)
 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=^HULP(%J,"L",SwapNr)
 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
 
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 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
 
MAILSQL
	New %J,VolgNr,Key,Rec
	Set %J=$$%J^vhRtn1()
	Set VolgNr=""
	&sql(DECLARE C1 CURSOR FOR
	select ID 
	into :KLNr
	from derde_klant.Klant 
	where aktiviteit="KEUKENS" or aktiviteit="INTERIEUR")
	&sql(OPEN C1)
    For  &sql(FETCH C1) Quit:(SQLCODE '= 0)  Do 
	. Set ^HULP(%J,KLNr)=""
	&sql(CLOSE C1)
	Do MAILKL("N","NL;BE","BH;XX",$NA(^HULP(%J)))
	Do MAILKL("F","NL;BE","BH;XX",$NA(^HULP(%J)))
	Kill ^HULP(%J)
	Quit
 
EMAILMERGE(GlobRef,Exec)
	New %J,VolgNr,Key,Rec
	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)=""
	Do MAILKL("N","NL;BE","BH;XX",,$NA(^HULP(%J)))
	Do MAILKL("F","NL;BE","BH;XX",,$NA(^HULP(%J)))
	Kill ^HULP(%J)
	Quit
	
MAILALL
	;Do MAILKL("N")
	;Do MAILKL("F")
	;Do MAILKL("D",)
	;Do MAILKL("E",)
	Set IsSNM=0
	Do MAILKL("N",,,,,IsSNM)
	Do MAILKL("F",,,,,IsSNM)
	;Do MAILKL("N","NL","BH;XX",,,IsSNM)
	;Do MAILKL("N","NL;BE","BH;XX",,,IsSNM)
	;Do MAILKL("F","BE;LU","BH;XX",,,IsSNM)
	;Do MAILKL("F",,"BH;XX")
	;Do MAILKL("D",,"BH;XX")
	;Do MAILKL("E",,"BH;XX")
 
	Quit
	
MAILKL(TaalSel,LandSel,ExclTyp,InclTyp,LimGlobRef,IsSNM) Set Dev=0
 ; TaalSel = N of F
 ; LandSel = "NL;BE"
 ; ExclTyp = ""  bv "BH;XX" (boekhouding;diverse)
 ; InclTyp = ""  bv "AK;AB" (Aankoop;Algemeen beheerder)
 ; LimGlobRef wordt gebruikt om te testen of een klant mag opgenomen worden in de maillijst - $D(@LimGlobRef@(KLNr))
 Set BeginOmzetMaand=$$EXTDATE^vhDTyp($$CALCDATE^vhDTyp($H,"M",-12),"DM4")_" "
 Set EndOmzetMaand=$$EXTDATE^vhDTyp($$CALCDATE^vhDTyp($H,"M",0),"DM4")_" "
 New %J,Dev,KLId,KLNr,KLNm,Taal,Land,Pers,Nr,Found,I,connect,Typconnect,email,Naam,Voornaam,elink
 Set Dev=$$OPEN^vhDEV(,"MAILLIST"_$TR($G(TaalSel),";")_$TR($G(LandSel),";")_".TXT","W","T")
 Use Dev
 Set KLId=""
 Set %J=$$%J^vhRtn1()
 Kill ^HULP(%J)
 For  Set KLId=$O(^KKL(KLId)) Quit:KLId=""  Do
 . Set KLNr=$P(^KKL(KLId,0),D)
 . If $L($G(LimGlobRef)) Quit:'$D(@LimGlobRef@(KLNr))
 . Quit:$P(^KKL(KLId,2),D,10) ; non akt
 . Quit:$L($P(^KKL(KLId,0),D,30)) ; non akt of verwijderd
 . Quit:'$P(^KKL(KLId,0),D,20) ; geen regio
 . Quit:$P(^KKL(KLId,1),D,25)="Z" ; Non akt
 . Quit:$P(^KKL(KLId,1),D,25)=0 ; Non akt
 . 
 . ;Quit:$L($P(^KKL(KLId,1),D,10)) ; Klant Van 
 . 
 . Set Found=0
 . Set Vzwn=$P(^KKL(KLId,2),D,16)
 . For I=1:1:$L(Vzwn,"`") Do
 . . Set Vzw=$P(Vzwn,"`",I)
 . . Set:($P(Vzw,";")="OD4")&&($P(Vzw,";",2)=1) Found=1
 . . Set:($E($P(Vzw,";"),1,2)="OD")&&($P(Vzw,";",2)=1) Found=1
 . ;Quit:'Found
 . 
 . ;Quit:'$$IncludeKlant(KLNr)
 . 
 . Set Regio=$P(^KKL(KLId,0),D,20)
 . ;Quit:(Regio)'?1(1"1",1"2",1"3",1"20",1"21",1"22",1"23",1"24",1"25",1"26",1"27")
 . Quit:(Regio)?1(1"5",1"8",1"9",1"19",1"29") ; klanten die niet bewerkt worden
 . ;Quit:(Regio>39)
 . ;Quit:Regio=1 ; geen key accounts
 . Quit:Regio'<40 ; consumenten
 . 
 . Set Omzet=$$KLANT^STAT(KLNr,0,BeginOmzetMaand,EndOmzetMaand,3)
 . Quit:Omzet'>0 ; met omzet
 .
 . Set KLNm=$P(^KKL(KLId,0),D,2)
 . Set Taal=$P(^KKL(KLId,0),D,9)
 . ;Quit:(Taal="D")!(Taal="E")
 . If $L($G(TaalSel)) Quit:Taal'=TaalSel
 . Set Land=$$LAND^vhRtn1(KLNr,"K",1,1)
 . If $L($G(LandSel)) Quit:(";"_LandSel_";")'[(";"_Land_";")
 . Set Nr=""
 . For  Set Nr=$O(^PERS("K",KLNr,Nr)) Quit:Nr=""  Do
 .. Set Pers=^PERS("K",KLNr,Nr)
 .. 
 . ; KlantType
 . Set KlantType=$P(^KKL(KLId,1),D,25)
 . ;Quit:KlantType'=1 ; Handel 1
 ..
 .. ;Controleren of het één van de VerantwType NIET tot de ExclTyp behoort
 .. Set Typ=$P(Pers,D,5)
 .. Set Found=$S($L($G(ExclTyp)):0,1:1)
 .. If 'Found For I=1:1:$L(Typ,";") Do
 ... Quit:'$L($P(Typ,";"))
 ... Set:(";"_ExclTyp_";")'[(";"_$P(Typ,";",I)_";") Found=1
 .. Quit:'Found  ; Behoort to ExclTyp
 .. 
 .. ;Controleren of het één van de VerantwType tot de InclTyp behoort
 .. Set Typ=$P(Pers,D,5)
 .. Set Found=$S($L($G(InclTyp)):0,1:1)
 .. If 'Found For I=1:1:$L(Typ,";") Do
 ... Quit:'$L($P(Typ,";"))
 ... Set:(";"_InclTyp_";")[(";"_$P(Typ,";",I)_";") Found=1 ; Type van persoon behoort tot InclTyp 
 .. Quit:'Found  ; Behoort to IncTyp
 .. 
 .. For I=15:1:19 Do
 ... Quit:$P(Pers,D,6) ; mail non aktief
 ... Set connect=$P(Pers,D,I)
 ... Quit:$P(connect,";")'="E"
 ... Set email=$P(connect,";",2)
 ... Quit:'$l(email)
 ... Quit:email'["@"
 ... Quit:$E(email)="#" ; NOOIT versturen
 ... Quit:$E(email)="$"&&$G(IsSNM) ; Geen SNM mails gewenst
 ... Quit:$E(email)="~" ; PROBLEEM GEVAL  niet versturen
 ... If $E(email)="~" Set $E(email)=""  ; UNDELIVERABLE
 ... If $E(email)="$" Set $E(email)=""  ; geen SNM mail
 ... Quit:$D(^HULP(%J,$$UPTRIMAN^vhRtn1(email))) ;dubbel
 ... Set Naam=$P(Pers,D,2)
 ... Set VoorNaam=$P(Pers,D,3)
 ... Set elink=Naam_$S($L(VoorNaam):" "_VoorNaam,1:"")
 ... Set ^HULP(%J,$$UPTRIMAN^vhRtn1(email))=""
 ... Write elink,U,email,U,KLNr,U,KLNm,U,$P(^KKL(KLId,0),D,20),U,Taal,U,$P(Pers,D,1),!
 . Set email=$P(^KKL(KLId,2),D,19) Do
 . Quit:email=""
 . Quit:email'["@"
 . Quit:$E(email)="#" ; NOOIT versturen
 . Quit:$E(email)="~" ; PROBLEEM GEVAL niet versturen
 . Quit:$E(email)="$"&&$G(IsSNM) ; Geen SNM mails gewenst
 . If $E(email)="~" Set $E(email)=""  ; UNDELIVERABLE
 . If $E(email)="$" Set $E(email)=""  ; geen SNM mail
 . Quit:$D(^HULP(%J,$$UPTRIMAN^vhRtn1(email))) ;dubbel
 . Set ^HULP(%J,$$UPTRIMAN^vhRtn1(email))=""
 . Write U,email,U,KLNr,U,KLNm,U,$P(^KKL(KLId,0),D,20),U,Taal,!
 Do CLOSE^vhDEV(Dev)
 Quit
 
IncludeKlant(KLNr)
  ; KlantType
  Set KlantType=$P(^KKL(^KK1(KLNr),1),D,25)
  Quit:KlantType=1 1  ; Handel 1
	Set PRNr=0
	Set Found=0
	For  Set PRNr=$O(^KSTKL(KLNr,PRNr)) Quit:PRNr=""  Do  Quit:Found
	. Set:$E($P($G(^KPR(PRNr,0)),"\",1),1,4)?1(1"358L",1"359L") Found=1
	. Quit:$E($P($G(^KPR(PRNr,0)),"\",1),1,2)'="TB"
    . Set ZW=$LG(##class(Prod.Kenmerk.DataDefinitie).Get("TBX",PRNr,"ZW"))
	. Set:ZW="L" Found=1
 
	;Write:Found&&PRNr KLNr," ",PRNr," ",$G(^KPR(PRNr,0)),!
	Quit Found
 
 
MAILKLFoutiefOfZonder(TaalSel,LandSel,ExclTyp,LimGlobRef) Set Dev=0
 ; TaalSel = N of F
 ; LandSel = "NL;BE"
 ; ExclTyp = "BH;XX" (boekhouding;diverse)
 ; LimGlobRef wordt gebruikt om te testen of een klant mag opgenomen worden in de maillijst - $D(@LimGlobRef@(KLNr))
 New %J,Dev,KLId,KLNr,KLNm,Taal,Land,Pers,Nr,Found,I,connect,Typconnect,email,Naam,Voornaam,elink
 Set Dev=$$OPEN^vhDEV("\\notes01\shared\p v\","MAILLIST"_$G(TaalSel)_".TXT","W")
 Use Dev
 s U=$C(9)
 Set KLId=""
 Set %J=$$%J^vhRtn1()
 Kill ^HULP(%J)
 For  Set KLId=$O(^KKL(KLId)) Quit:KLId=""  Do
 . Set KLNr=$P(^KKL(KLId,0),D)
 . If $L($G(LimGlobRef)) Quit:'$D(@LimGlobRef@(KLNr))
 .
 . Quit:$P(^KKL(KLId,2),D,10) ; non akt
 . Quit:$L($P(^KKL(KLId,0),D,30)) ; non akt of verwijderd
 . Quit:'$P(^KKL(KLId,0),D,20) ; geen regio
 . Quit:$P(^KKL(KLId,1),D,25)="Z" ; Non akt
 . Quit:$P(^KKL(KLId,1),D,25)=0 ; Non akt
 .
 . Set KLNm=$P(^KKL(KLId,0),D,2)
 . Set Taal=$P(^KKL(KLId,0),D,9)
 . Set HasEmail=0
 . ;Quit:(Taal=D)!(Taal="E")
 . If $L($G(TaalSel)) Quit:Taal'=TaalSel
 . Set Land=$$LAND^vhRtn1(KLNr,"K",1,1)
 . ;If $L($G(LandSel)) Quit:(";"_LandSel_";")'[(";"_Land_";")
 . Set Nr=""
 . For  Set Nr=$O(^PERS("K",KLNr,Nr)) Quit:Nr=""  Do
 .. Set Pers=^PERS("K",KLNr,Nr)
 .. ;Controleren of het één van de VerantwType NIET tot de ExclTyp behoort
 .. Set Typ=$P(Pers,D,5)
 .. Set Found=$S($L($G(ExclTyp)):0,1:1)
 .. If $L($G(ExclTyp)) For I=1:1:$L(Typ,";") Do
 ... Quit:'$L($P(Typ,";"))
 ... Set:$P(Typ,";",I)'[ExclTyp Found=1
 .. ;Quit:'Found  ; Behoort to ExclTyp
 .. For I=15:1:19 Do
 ... Quit:$P(Pers,D,6) ; mail non aktief
 ... Set connect=$P(Pers,D,I)
 ... Quit:$P(connect,";")'="E"
 ... Set email=$P(connect,";",2)
 ... If email'="",email["@",$E(email)'="~" Set HasEmail=1
 ... Write:$E(email)="~" KLNr,U,KLNm,U,$P(^KKL(KLId,0),D,20),U,Taal,U,$P(^KKL(KLId,0),D,13),U,email,U,$P(Pers,D,2),U,$P(Pers,D,3),!
 . Set email=$P(^KKL(KLId,2),D,19) Do
 . If email'="",email["@",$E(email)'="~" Set HasEmail=1
 . Quit:HasEmail
 . If (email'="")||(email'["@") Quit ; Alleen email adressen
 . Write KLNr,U,KLNm,U,$P(^KKL(KLId,0),D,20),U,Taal,U,$P(^KKL(KLId,0),D,13),U,email,!
 Close:Dev'=0 Dev
 Quit
 
MAILLEV(TaalSel,ExclTyp) Set Dev=0
 New %J,Dev,LId,LEVNr,LEVNm,Taal,Land,Pers,Nr,Found,I,connect,Typconnect,email,Naam,Voornaam,elink
 Set Dev=$$OPEN^vhDEV(,"MAILLEV"_$G(TaalSel)_".TXT","W")
 Use Dev
 Set LId=""
 Set %J=$$%J^vhRtn1()
 Kill ^HULP(%J)
 For  Set LId=$O(^KLE(LId)) Quit:LId=""  Do
 . Set LEVNr=$P(^KLE(LId,0),D)
 .;W KLId
 . Quit:$P(^KLE(LId,0),D,27)'=1 ; alleen prod. leveranciers
 .;w "Non akt 0"
 . Set LEVNm=$P(^KLE(LId,0),D,2)
 . Set Taal=$P(^KLE(LId,0),D,9)
 . If $L($G(TaalSel)) Quit:Taal'=TaalSel
 . Set Nr=""
 . For  Set Nr=$O(^PERS("L",LEVNr,Nr)) Quit:Nr=""  Do
 .. Set Pers=^PERS("L",LEVNr,Nr)
 .. ;Controleren of het één van de VerantwType NIET tot de ExclTyp behoort
 .. Set Typ=$P(Pers,D,5)
 .. Set Found=$S($L($G(ExclTyp)):0,1:1)
 .. If $L($G(ExclTyp)) For I=1:1:$L(Typ,";") Do
 ... Quit:'$L($P(Typ,";"))
 ... Set:$P(Typ,";",I)'[ExclTyp Found=1
 .. Quit:'Found  ; Behoort to ExclTyp
 .. For I=15:1:19 Do
 ... Quit:$P(Pers,D,6) ; mail non aktief
 ... Set connect=$P(Pers,D,I)
 ... Quit:$P(connect,";")'="E"
 ... Set email=$P(connect,";",2)
 ... Quit:'$l(email)
 ... Quit:email'["@"
 ... Quit:$E(email)="#" ; NOOIT versturen
 ... Quit:$E(email)="~" ; PROBLEEM GEVAL  niet versturen
 ... If $E(email)="~" Set $E(email)=""  ; UNDELIVERABLE
 ... Quit:$D(^HULP(%J,$$UPTRIMAN^vhRtn1(email))) ;dubbel
 ... Set Naam=$P(Pers,D,2)
 ... Set VoorNaam=$P(Pers,D,3)
 ... Set elink=Naam_$S($L(VoorNaam):" "_VoorNaam,1:"")_" <"_email_">"
 ... Set ^HULP(%J,$$UPTRIMAN^vhRtn1(email))=""
 ... Write LEVNr,U,LEVNm,U,Taal,U,$P(Pers,D,1),U,elink,!
 . Set email=$P(^KLE(LId,2),D,19) Do
 . Quit:email=""
 . Quit:email'["@"
 . Quit:$E(email)="#" ; NOOIT versturen
 . Quit:$E(email)="~" ; PROBLEEM GEVAL niet versturen
 . If $E(email)="~" Set $E(email)=""  ; UNDELIVERABLE
 . Quit:$D(^HULP(%J,$$UPTRIMAN^vhRtn1(email))) ;dubbel
 . Set ^HULP(%J,$$UPTRIMAN^vhRtn1(email))=""
 . Write LEVNr,U,LEVNm,U,Taal,U,$P(Pers,D,1),U,email,!
 Close:Dev'=0 Dev
 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:"1e caracter # nooit versturen, $ geen SNM mails, ~ probleem niet versturen")
 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