PERSS ;Beheer personen van zowel klanten, leveranciers en ev. derde [ 09/10/2002  11:50 AM ]
 
 ;N.B. De verschillende Opties lijken in een "EN"-modus te werken: dus een contactpersoon moet aan elke voorwaarde tegelijk voldoen, om opgenomen te worden.
 ;     Bvb. SELECT met een DOCVOORKEUR én een VWBEPERK, geeft enkel de contactpersonen die aan beide voorwaarden voldoen.
 ;Opties("AANSPR")      = aanspreking (0 = zonder)
 ;Opties("AFTER")       = item(s) toe te voegen achteraan de lijst
 ;Opties("AUTOSEL")     = autoselect indien een of geen element (1)
 ;Opties("BEFORE")      = item(s) toe te voegen vooraan de lijst
 ;Opties("CASE")        = "L" in lower- en "U" in UPPERcase
 ;Opties("CB")          = Callback functie voor vhPOPUP (zie vhPOPUP)
 ;Opties("CONNECT")     = met connectie "T" (telefoon), "F" (fax), "G" (GSM), "E" (E-mail)
 ;Opties("FORMAT")      = de lijstdefinitie
 ;Opties("FILTER")      = 1 verwijder de lege item(s) uit de lijst
 ;Opties("MULTI")       = "M" multiple select, "MS" met sorteervolgorde
 ;Opties("NAME")        = 1 wissel Naam en Voornaam
 ;Opties("PIECE")       = terug te keren velden 2(volgnr), 3(uniek nr), 4(verantw type), 5(naam) en 6(connectie)
 ;Opties("POS")         = positie op het scherm
 ;Opties("SELECT")      = te selekteren item(s)
 ;Opties("TITEL")       = titel
 ;Opties("VWTYPE")      = type verantwoordelijke ("K" indien kort)
 ;Opties("VWBEPERK")    = beperking op verantwoordelijke "," gescheiden
 ;Opties("NOPOP")       = selekteer alle elementen uit de lijst (geen POPUP)
 ;Opties("STRIPEM")     = Wegfilteren eerste char van het email-adres
 ;Opties("DOCVOORKEUR") = selecteer alle elementen met een voorkeur voor een bepaald documenttype
SELECT(ObjType,ObjRef,Opties) 
 New I,J,R,P,Count,Pers,Rubr,Select,sFmt,Titel,Naam,VoorNm,Aanspr,Case,Name,VwType
 New TConnect,Connect,Format,Length,UniekNr,Piece,Output,Multi,Temp,Quit,Filter,CallBack,VwBeperk,Voorkeur,GewensteDocs
 Set Titel=$G(Opties("TITEL")),Select=$G(Opties("SELECT")),Position=$G(Opties("POS"))
 Set Case=$G(Opties("CASE")),Name=$G(Opties("NAME")),VwType=$G(Opties("VWTYPE"))
 Set TConnect=$G(Opties("CONNECT")) Set:TConnect="*" TConnect="TGFE" Set:$L(TConnect) VwType="K"
 Set sFmt=$G(Opties("FORMAT")),Piece=$G(Opties("PIECE"),5),Multi=$G(Opties("MULTI"))
 Set Filter=$G(Opties("FILTER")),VwBeperk=$TR($G(Opties("VWBEPERK")),";#",",,"),Voorkeur=$G(Opties("DOCVOORKEUR"))
 Set:$L(VwBeperk) VwBeperk=$$ConvertVwBeperk(VwBeperk)
 Merge CallBack=Opties("CB")
 If sFmt="" Do
 .If Multi["M" Set sFmt="MULTI\" Set:Multi["S" sFmt="MULTIS\"
 .Set sFmt=sFmt_$S(VwType="K":"vwtype",1:"VWTYPE")
 .Set sFmt=sFmt_"\PERSOON" Set:$L(TConnect) sFmt=sFmt_"\CONNECT"
 Else  Do
 .Do EXEC^vhRES($P(sFmt,"`"),$P(sFmt,"`",2),"R")
 .If $E(sFmt)="T" Set sFmt=R
 .Else  Set sFmt="",Format(1)=R
 Set Select=$$UPCASE^vhRtn1(Select),Count=0
 For I=1:1 Quit:$P(sFmt,D,I)=""  Do
 .Set Count=Count+1,Format(Count)=^RES("PERS","LD","SELECT",$P(sFmt,D,I))
 .If $L(Format(Count),D)>1 Do
 ..Set R=Format(Count)
 ..For Count=Count:1 Set Format(Count)=$P(R,D),R=$P(R,D,2,99) Quit:R=""
 .If Multi["M",Count=1 Quit
 .Set:$L($P(sFmt,D,I+1)) Format(Count)=Format(Count)_" | "
 Set sFmt="Format",Count=0
 For I=1:1 Quit:'$D(^PERS(ObjType,ObjRef,I))  Do
 .Set R=^PERS(ObjType,ObjRef,I),Rubr=$TR($P(R,D,5),";",","),GewensteDocs=$P(R,D,6)
 .If Voorkeur'="" Quit:";"_GewensteDocs_";"'[(";"_Voorkeur_";")
 .Quit:Rubr=""
 .Set UniekNr=$P(R,D),Naam=$P(R,D,2),VoorNm=$P(R,D,3)
 .Set Aanspr=$P(R,D,4) Set:$G(Opties("AANSPR"))=0 Aanspr=""
 .Set Connect=$$CONNECT($P(R,D,15,19),TConnect)
 .Set:Name Pers=Naam,Naam=VoorNm,VoorNm=Pers
 .Set Pers=Naam Set:$L(Naam)&$L(VoorNm) Pers=Pers_" " Set Pers=Pers_VoorNm
 .Set R=$S($L(Aanspr):Aanspr_" ",1:"")_Pers
 .If $L(Case) Set:Case="L" R=$$INITCAP^vhRtn1(R) Set:Case="U" R=$$UPCASE^vhRtn1(R)
 .Set R="`"_I_"`"_UniekNr_"`"_Rubr_"`"_R_"`"_Connect
 .If $L(VwBeperk) Quit:'$$VWInclude(VwBeperk,Rubr)
 .If Filter Quit:'$$ADDREC(R,Piece)
 .If VwType'="K" For J=1:1:$L(Rubr,",") If $L($P(Rubr,",",J)) Set $P(Rubr,",",J)=$P($G(^RES("PERS","PI","VERANTW"_ObjType,"D",$P(Rubr,",",J))),"`",2)
 .Quit:Rubr=""
 .Set $P(R,"`",4)=Rubr
 .If I=1,Count Set Count=Count+1,Pers(Count)="&S"
 .Set Count=Count+1,Pers("Temp",Count)=R
 .If $L($G(Opties("STRIPEM"))),Opties("STRIPEM")[$E($P(R,"`",6)) Set $P(Pers("Temp",Count),"`",6)=$E($P(R,"`",6),2,999)
 .Set:$L($G(Pers("Temp"))) Pers("Temp")=Pers("Temp")_D
 .Set Pers("Temp")=$G(Pers("Temp"))_Pers
 .Set Pers=Naam,Naam=VoorNm,VoorNm=Pers
 .Set Pers=Naam Set:$L(Naam)&$L(VoorNm) Pers=Pers_" " Set Pers=Pers_VoorNm
 .Set Pers("Temp")=Pers("Temp")_D_Pers
 If $D(Opties("BEFORE")) Do
 .If '$D(Opties("BEFORE",1)),$L($G(Opties("BEFORE"))) Set Opties("BEFORE",1)=Opties("BEFORE")
 .Quit:'Count
 .Set I=""
 .For  Set I=$O(Opties("BEFORE",I)) Quit:I=""  Do
 ..Set Quit=0,R=Opties("BEFORE",I) Set:$L(R,"`")=1 R="````"_$TR(R,"\","`") Set R=$$UPCASE^vhRtn1(R)
 ..For Count=1:1:Count Do  Set:Quit R=""
 ...Quit:Quit
 ...Set Quit=1,Temp=$$UPCASE^vhRtn1(Pers("Temp",Count))
 ...Xecute "For J="_Piece_" If $P(R,""`"",J)'=$P(Temp,""`"",J) Set Quit=0"
 ..If R="" Kill Opties("BEFORE",I)
 If $D(Opties("AFTER")) Do
 .If '$D(Opties("AFTER",1)),$L($G(Opties("AFTER"))) Set Opties("AFTER",1)=Opties("AFTER")
 .Quit:'Count
 .Set I=""
 .For  Set I=$O(Opties("AFTER",I)) Quit:I=""  Do
 ..Set Quit=0,R=Opties("AFTER",I) Set:$L(R,"`")=1 R="````"_$TR(R,"\","`") Set R=$$UPCASE^vhRtn1(R)
 ..For Count=1:1:Count Do  Set:Quit R=""
 ...Quit:Quit
 ...Set Quit=1,Temp=$$UPCASE^vhRtn1(Pers("Temp",Count))
 ...Xecute "For J="_Piece_" If $P(R,""`"",J)'=$P(Temp,""`"",J) Set Quit=0"
 ..If R="" Kill Opties("AFTER",I)
 Set Count=0
 If $O(Opties("BEFORE","")) Do
 .Set I=""
 .If Count Set Count=Count+1,Pers(Count)="&S"
 .For  Set I=$O(Opties("BEFORE",I)) Quit:I=""  Do
 ..Set R=Opties("BEFORE",I) Set:$L(R,"`")=1 R="````"_$TR(R,"\","`")
 ..Quit:(D_$G(Pers("Temp"))_D)[(D_$P(R,"`",5)_D)
 ..Set Count=Count+1 Set:$P(R,"`")="" $P(R,"`")=Count Set Pers(Count)=R
 If $D(Pers("Temp")) Do
 .Set I=""
 .If Count Set Count=Count+1,Pers(Count)="&S"
 .For  Set I=$O(Pers("Temp",I)) Quit:I=""  Set Count=Count+1,R=Pers("Temp",I),$P(R,"`")=Count,Pers(Count)=R
 .Kill Pers("Temp")
 If $O(Opties("AFTER","")) Do
 .Set I=""
 .If Count Set Count=Count+1,Pers(Count)="&S"
 .For  Set I=$O(Opties("AFTER",I)) Quit:I=""  Do
 ..Set R=Opties("AFTER",I) Set:$L(R,"`")=1 R="````"_$TR(R,"\","`")
 ..Quit:(D_$G(Pers("Temp"))_D)[(D_$P(R,"`",5)_D)
 ..Set Count=Count+1 Set:$P(R,"`")="" $P(R,"`")=Count Set Pers(Count)=R
 Set Select("Temp")=Select
 For I=1:1 Quit:'$D(Pers(I))  Do  Quit:$TR(Select("Temp"),";","")=""
 .Set Temp=""
 .Xecute "For R="_Piece_" Set Temp=Temp_""`""_$P(Pers(I),""`"",R)"
 .Set $E(Temp)="",Temp=$$UPCASE^vhRtn1(Temp)
 .For R=1:1 Quit:$P(Select,";",R)=""  Do  Quit:Quit
 ..Set Quit=0
 ..Quit:Temp=""  Quit:$P(Select("Temp"),";",R)=""
 ..Set:$P(Select("Temp"),";",R)[Temp $P(Select,";",R)=I,$P(Select("Temp"),";",R)="",Quit=1
 ..Quit:Quit
 ..Set:Temp[$P(Select("Temp"),";",R) $P(Select,";",R)=I,$P(Select("Temp"),";",R)="",Quit=1
 If Position="" Do
 .Set Length=0
 .For I=1:1 Quit:'$D(Format(I))  Set Length=Length+$P(Format(I),"`",4)
 .Set Position=12-(Count\2)_";"_(78-Length\2)
 Set Opties=$S($G(Opties("AUTOSEL")):"A",1:"")_Multi_"O1L-"
 If $G(Opties("NOPOP")) Do
 .Set R=""
 .For I=1:1 Quit:'$D(Pers(I))  Set R=R_";"_I
 .Set $E(R)=""
 Else  Set R=$S(Count:$$WILD^vhPOPUP(Position,Opties,Titel,.Pers,$G(Select),.CallBack),1:"")
 Set Output=""
 For  Do  Quit:R=""
 .For I=1:1 Quit:'$D(Pers(I))  If $P(Pers(I),"`")=$P(R,";") Do  Quit
 ..Set Temp=""
 ..Xecute "For P="_Piece_" Set Temp=Temp_""`""_$P(Pers(I),""`"",P)"
 ..Set $E(Temp)="",Output=Output_";"_$TR(Temp,"`",D)
 ..Set R=$P(R,";",2,99)
 Set $E(Output)=""
 Quit Output
 ;
 ; Keert afhankelijk van TConnect (T,F,G,E) de connecties terug
CONNECT(Connect,TConnect) 
 New I,R,Multi
 Set R="",Multi=$L(TConnect)>1
 If $L(TConnect) Do
 .For  Quit:TConnect=""  Do
 ..For I=1:1 Quit:$P(Connect,D,I)=""  Do
 ...Quit:$P($P(Connect,D,I),";")'=$E(TConnect)
 ...Set R=R_"; " Set:Multi R=R_$P($P(Connect,D,I),";")_":" Set R=R_$P($P(Connect,D,I),";",2)
 ..Set TConnect=$E(TConnect,2,9)
 .Set $E(R,1,2)=""
 Quit R
 ;
ADDREC(R,Piece) 
 New I,AddRec
 Set AddRec=1
 Xecute "For I="_Piece_" Set AddRec=$L($P(R,""`"",I)) Quit:'AddRec"
 Quit AddRec
 ;
 ; Controle of een verantwoordelijke in de lijst mag
VWInclude(VwBeperk,Rubr)
 New I,Include
 Set Include=0
 ; Controle of Rubr een element van VwBeperk bevat
 For I=1:1:$L(VwBeperk,",") Set Include=(","_Rubr_",")[(","_$P(VwBeperk,",",I)_",") Quit:Include
 ; Controle of VwBeperk een element van Rubr bevat
 If 'Include For I=1:1:$L(Rubr,",") Set Include=(","_VwBeperk_",")[(","_$P(Rubr,",",I)_",") Quit:Include
 Quit Include
 ;
ConvertVwBeperk(VwBeperk)
 New ConvertVwBeperk
 Do:$L(VwBeperk)
 . Set ConvertVwBeperk=$$ConvertVwBeperk^PERS(VwBeperk)
 . Set:","_VwBeperk_","'[(","_ConvertVwBeperk_",") VwBeperk=VwBeperk_","_ConvertVwBeperk
 Quit VwBeperk
 ;