KLANT ;KLANTEN [ 11/26/2003  3:56 PM ] 
#include BL.Derde.KlantSpecifiek
#include vhLib.Macro
 ;
LEVVW(LevVw,Taal) 
 New R,I,Count
 Set R(1)="",Count=0
 If $E(LevVw,$L(LevVw))'=" " Set LevVw=LevVw_" "
 If $D(^KBA(153,LevVw,Taal)) For I=1,2 If $L(^KBA(153,LevVw,Taal,I)) Set Count=Count+1,R(Count)=^KBA(153,LevVw,Taal,I)
 For Count=1,2 If $D(R(Count)) Do
 .If $L($P(R(Count),":",2)) Set R(Count)=$P(R(Count),":",2)
 .For I=1:1 Set R=$E(R(Count)) Quit:"- "'[R!(R="")  Set R(Count)=$E(R(Count),2,99)
 .If R(Count)="" Kill R(Count)
 Quit $S($D(R(1)):R(1),1:"")_$S($D(R(2)):"#"_R(2),1:"")
 ;
BETVW(BetVw,%KontKrt,TKontKrt,Rembours,VoorBet,Taal) 
 New R,BetDagen,DKontKrt,WisAval,Count
 Set Count=1,R(Count)=""
 If BetVw="" Do  Quit R(1)_$S($D(R(2)):"#"_R(2),1:"")_$S($D(R(3)):"#"_R(3),1:"")
 .Set R(Count)=$$TXT("Kontnt")
 .Do:Rembours!VoorBet
 ..Set R(Count)=R(Count)_" ("
 ..Set:VoorBet R(Count)=R(Count)_$$TXT("VoorBt")
 ..Set:VoorBet&Rembours R(Count)=R(Count)_", "
 ..Set:Rembours R(Count)=R(Count)_$$TXT("Remb")
 ..Set R(Count)=R(Count)_")"
 .If %KontKrt Set R(Count)=R(Count)_" "_$$TXT("KontPc")_" "_%KontKrt_"% "_$$TXT("KontPc",3)
 Set BetDagen=+BetVw,WisAval=""
 If "\-W\/A\"[(D_$E(BetVw,$L(BetVw)-1,$L(BetVw))_D) Set WisAval=$E(BetVw,$L(BetVw)-1,$L(BetVw))
 Set BetVw=$E(BetVw,$L(BetDagen)+1,$L(BetVw)-$L(WisAval))
 Set DKontKrt=+TKontKrt,TKontKrt=$E(TKontKrt,$L(DKontKrt)+1,$L(TKontKrt))
 If %KontKrt Do  If 'BetDagen Quit R(1)_$S($D(R(2)):"#"_R(2),1:"")_$S($D(R(3)):"#"_R(3),1:"")
 .Set R(Count)=$S(Taal="E":$$TXT("Kortng")_" ",1:"")_%KontKrt_"% "
 .Set R(Count)=R(Count)_$$TXT($S(Taal="E":"Voor",1:"Kortng"))_" "
 .Set R(Count)=R(Count)_DKontKrt_" "_$$TXT("Dag")
 .If DKontKrt'=1 Set R(Count)=R(Count)_$$TXT("Dag",3)
 .Set R(Count)=R(Count)_" "
 .If TKontKrt="D" Set:Taal="E" R(Count)=R(Count)_$$TXT("VanAf")_" " Set R(Count)=R(Count)_$$TXT("FaktDt")
 .Else  Set R(Count)=R(Count)_$$TXT("EndMth")
 .If BetVw=TKontKrt,BetDagen'>DKontKrt Set BetDagen="" Quit
 .Set Count=Count+1,R(Count)=$$TXT("Netto")_" "_$S(Taal="E":"",1:$$TXT("Netto",3)_" ")
 Set R(Count)=R(Count)_BetDagen_" "
 If BetVw'="M" Do
 .Set R(Count)=R(Count)_$$TXT("Dag") Set:BetDagen'=1 R(Count)=R(Count)_$$TXT("Dag",3)
 .Set:Taal="E" R(Count)=R(Count)_" "_$$TXT("Netto",3)
 Else  Set R(Count)=R(Count)_$$TXT("Maand") Set:BetDagen'=1 R(Count)=R(Count)_$$TXT("Maand",3)
 If "\D\M\"[(D_BetVw_D) Set R(Count)=R(Count)_" "_$$TXT("FaktDt")
 Else  Set R(Count)=R(Count)_" "_$$TXT("EndMth")
 If $L(WisAval) Do
 .Set Count=Count+1
 .Set R(Count)=$$TXT("Wissel")
 .If WisAval="/A" Set R(Count)=R(Count)_" "_$$TXT("Aval")
 Quit R(1)_$S($D(R(2)):"#"_R(2),1:"")_$S($D(R(3)):"#"_R(3),1:"")
 ;
COMPRES(KlantNm,KLNr)
 Quit $$DI^cAN000(KlantNm,KLNr) ; Code van DATA-M
 ; Onderstaande code is onze oude foutieve COMPRES, deze mag over enkele maanden weg - CW 19-07-2011
 ;Set Compressed = $$UPTRIMAN^vhRtn1(KlantNm)_" "_$G(KLNr)
 ;Quit $TR(Compressed,"ÄËÜÏÖÁÉÚÍÓÀÈÙÌÒÃÕ","AEUIOAEUIOAEUIOAO")
 ;
TXT(Ref,Piece) 
 If '$D(Piece) Set Piece=2
 Quit $P($P($T(@("T"_Ref)),U,Piece),D,$F("NFDE",Taal)-1)
 ;
RAADPL(KLNr,Screen,NoMod,OrderNummer) 
 Set:'$D(Screen) Screen=""
 New (%ZR,%ZM,Q,QL,QM,QN,QO,QRVG,QT,QTU,QU,QW,QZ,D,DT,TD,DD,DM,DJ,F70,F71,U,boot,cs,master,workst,io,QP,QD,%Q1,KLNr,Screen,NoMod,sJC,sScr,sProgLog,RK,CUserId,OrderNummer)
 Xecute F71
 Set LScreen=Screen,Aktie=""
 If '$D(^KK1(KLNr)) Quit LScreen_D_Aktie
 Set EXTERN=1,PARAM=KLNr_D_Screen
 Set:($$$Not(""=$Get(OrderNummer))) $Piece(PARAM, D, 7) = "ORD;"_OrderNummer, OrderNummer=""
 Do ^RPLKL
 Set Aktie=$G(Aktie),LScreen=$G(LScreen)
 Set Aktie=$S(Aktie="(":"P",Aktie=")":"N",1:"")
 Quit LScreen_D_D_Aktie
 ;
WIJZIG(KLNr,Screen,Element) 
 Set:'$D(Screen) Screen="" Set:'$D(Element) Element=""
 Lock  ZD
 New (%ZR,%ZM,Q,QL,QM,QN,QO,QRVG,QT,QTU,QU,QW,QZ,D,DT,TD,DD,DM,DJ,F70,F71,U,boot,cs,master,workst,io,QP,QD,%Q1,KLNr,Screen,Element,sScr,sFVL,sProgLog,RK,CUserId)
 Xecute F71
 Set LScreen=$G(Screen),LElement=$G(Element),Aktie=""
 Set (K,RK)="" Do W^cAN200("KL","LVH1","","LVH","S UI1=^KK1(KLNr)")
 Lock  ZD
 Quit LScreen_D_LElement_D_Aktie
KLACHT(KLNr) 
 Do KLANT^KLACHT($G(KLNr))
 Quit
 ;
 ; Selekteer klant
KKL(Node) 
 If Node=5 Do  Quit  ; wijzigen en verwijderen klant
 .Set K=$$SELECT^KLANT6() Set:K="." K="-"
 .If K'="-" Set (K,I1)=^KK1(K),R=$D(^KKL(K))
 .Set FP=2101 Write @F,@F1 Quit
 Set K="-"
 Quit

 ; KLData doorgegven als .local (KLNr of geindexeerde local, dit i.v.m. openen klanten)
 ; Type = BL.Legacy.enu.CodexType
PRIJSKL(KLData,PRNr,NoSa,Type,IsDefault)
 	New Klant,KLNr,KlantID,SchaduwPrijsKlasse,PrijsKlasse,PrijsKlasseBepaler,ProductTypeAPI
 	Set KLNr=$G(KLData)   ; ,DefaultBr=$G(DefaultBr)    ; komt nergens (?) meer voor in de code, noch in de "Search"-Globals. 
   	
   	If KLNr {
		set KlantID = ##class(DOM.DomeinContext).Instance().GeefLegacyPartijAPI().GeefKlantPartijID(KLNr)
	 	set Klant = ##class(DOM.DomeinContext).Instance().GeefVerkoopAPI().GeefNativeKlant(KlantID)
 	} else { 
 		set Klant = ##class(DOM.DomeinContext).Instance().GeefVerkoopAPI().GeefNativeKlantMultiDim(.KLData)
 	}
 	
 	set Type = $Get(Type,##class(BL.Legacy.enu.CodexType).Standaard())
 	set ProductTypeAPI = ##class(DOM.DomeinContext).Instance().GeefProductTypeAPI()
 	If ($G(PRNr)&&ProductTypeAPI.IsOrgaluxProduct(PRNr))||(Type = ##class(BL.Legacy.enu.CodexType).Orgalux()) {
 	 	Set PrijsKlasse = Klant.GeefPrijsCodexOrgalux()
 	 	Set SchaduwPrijsKlasse = Klant.GeefSchaduwPrijsCodexOrgalux()
 	} elseif ($G(PRNr)&&ProductTypeAPI.IsTAORIndelingProduct(PRNr))||(Type = ##class(BL.Legacy.enu.CodexType).TAOR()) {
 		Set PrijsKlasse = Klant.GeefPrijsCodexTAOR()
 		Set SchaduwPrijsKlasse = Klant.GeefSchaduwPrijsCodexTAOR()
 	} else {
 		Set PrijsKlasse = Klant.GeefPrijsCodexStandaard()
 		Set SchaduwPrijsKlasse = Klant.GeefSchaduwPrijsCodexStandaard()
 	}
 	
 	Set PrijsKlasseBepaler = ##class(BL.Legacy.PrijsKlasseBepaler).%New(Klant,PrijsKlasse,SchaduwPrijsKlasse,$Get(NoSa))
 	Set IsDefault = PrijsKlasseBepaler.IsDefaultPrijsKlasse()
 	Quit PrijsKlasseBepaler.GeefPrijsKlasse() 	

 ; Kodex tekstueel
 ; KLData doorgegven als .local (KLNr of geindexeerde local, dit i.v.m. openen klanten)
 ; Type = BL.Legacy.enu.CodexType
 ; BIndex en Value voor wijzigen klanten
KODEX(KLData,NoSa,Type,BIndex,Value) 
 New KLNr,Kodex,PrijsKl,IsDefault
 Set:$G(NoSa)'="S" NoSa="N"
 Set:$G(Type) Type = ##class(BL.Legacy.enu.CodexType).Standaard()
 
 If $G(BIndex) New R Merge R=KLData New KLData,DeltaBIndex Merge KLData=R set DeltaBIndex = $select($data(KLData(0)):1,1:0) Set $P(KLData((BIndex\100)-DeltaBIndex),D,BIndex#100)=Value
 Set PrijsKl = $$PRIJSKL(.KLData,,NoSa,.Type,.IsDefault)
 Set Kodex=##class(DOM.VKP.enu.PrijsCodex).LogicalToDisplay(PrijsKl)
 Set:IsDefault Kodex="["_Kodex_"]"
 Set KLNr=$G(KLData) Set:'KLNr KLNr=$P($G(KLData(0)),D) Set:'KLNr KLNr=$P($G(KLData(1)),D)
 If (KLNr)
 {
	 If ##class(BL.Legacy.enu.CodexType).Orgalux()=Type&&('$D(^KLPUTZ(NoSa,KLNr,$$GETSORTKEY^KLASS("OL"))))
	 Else  If ##class(BL.Legacy.enu.CodexType).TAOR()=Type&&('$D(^KLPUTZ(NoSa,KLNr,$$GETSORTKEY^KLASS("TA"))))
	 Else  If ##class(BL.Legacy.enu.CodexType).Standaard()=Type&&($O(^KLPUTZ(NoSa,KLNr,""))="")
	 Else  Set Kodex=Kodex_"+"
 }
 Quit Kodex
 
ALLECODEXEN(KLData,NoSa)
 Quit $$KODEX(.KLData,.NoSa)_"/"_$$KODEX(.KLData,.NoSa,##class(BL.Legacy.enu.CodexType).Orgalux())_"/"_$$KODEX(.KLData,.NoSa,##class(BL.Legacy.enu.CodexType).TAOR())

 ; Klanttype tekstueel
KLTYP(KLNr) 
 New R,KlTyp
 Set KlTyp=$$GetKlantType^KLANT5(KLNr)
 Set KlTyp=$S(KlTyp=0:KlTyp,KlTyp="Z":KlTyp,KlTyp?.N:"HAN-"_KlTyp,1:"IND-"_KlTyp)
 Quit KlTyp
 ;
LEVADR(KLNr,Hoofd,AutoSel) 
 New %J,R,levAdr,Count
 Set Hoofd=$G(Hoofd,1),AutoSel=$G(AutoSel,1)
 Set %J=$$%J^vhRtn1(),Count=0
 Kill ^HULP(%J)
 Do STORE^vhTERMINA()
 If Hoofd Set R=^KKL(^KK1(KLNr),0),$P(R,D)="HOOFD",Count=Count+1,^HULP(%J,Count)=R
 Set LevAdr="L"
 For  Set LevAdr=$O(^KKL(^KK1(KLNr),LevAdr)) Quit:$E(LevAdr)'="L"  Do
 .Set R=^KKL(^KK1(KLNr),LevAdr),Count=Count+1,^HULP(%J,Count)=R
 If AutoSel,Count<2 Set R=$S('Count:"",1:$P(^HULP(%J,1),D))
 Else  Do
 .Do INIT^vhLIST("KLANT","LEVADR",.LevAdr),WRITE^vhLIST(.LevAdr)
 .Set R=$$SCROLL^vhLIST(.LevAdr)
 .If R="ENTER" Set R=$P(^HULP(%J,LevAdr("SELECT")),D)
 Do REFRESH^vhTERMINA()
 Kill ^HULP(%J)
 Quit $S(R="HOOFD":0,1:R)
 ;
VERANTW(KLNr,Old,Position,AddList) 
 New Optie
 Set Optie("SELECT")=$G(Old),Optie("POS")=$G(Position),Optie("CASE")="L"
 Merge Optie("AFTER")=AddList
 Set FP=2201
 Write @F,@F1
 Quit $$SELECT^PERS("K",KLNr,.Optie)
 ;
LIDVAN(K) 
 Do:K="."
 .Set K=$$^cANSYN("KL","","","","","","","Lid van")
 .Set:K'="-" K=$P(K," ",2)
 If K'="-",K'="," Do DATAM^RUBRIEK(2,6,'K)
 Quit K
 ;
 ; Nieuw KLNr
NEXTID() 
 New KLNr,KLId,Ok
 If $$ISVERS6^vhRtn1() Do
 .Lock +^DIN(Q,"KL")
 .Set KLNr=$G(^DIN(Q,"KL"))
 .For  Do  Quit:Ok  ; Loop met controle of de klantnr nog vrij is
 ..Set Ok=1
 ..For  Quit:'$D(^KK1(KLNr))  Set KLNr=KLNr+1
 ..If KLNr>9999 Write !!!!!!!!!!!!!!!!!!,"FOUT MELDEN AAN ICT, geen KLANT nummers meer beschikbaar ",! H 20 H
 ..Set KLId=0
 ..For  Set KLId=$O(^KKL(KLId)) Quit:KLId=""  Set:$P(KLId," ",2)=KLNr Ok=0,KLNr=KLNr+1
 .Set ^DIN(Q,"KL")=KLNr+1
 .Lock -^DIN(Q,"KL")
 Else  Do
 .Lock +^KKL(0,1)
 .Set KLNr=$G(^KKL(0,1))
 .For  Quit:'$D(^KK1(KLNr))  Set KLNr=KLNr+1
 .Set ^KKL(0,1)=KLNr+1
 .Lock -^KKL(0,1)
 Quit KLNr
 ;
CHKTAAL(Taal) 
 New Check
 Set Check=0
 Do:$L(Taal)
 .If "NFDE"[Taal Set Check=1
 .Else  If $$ASK^vhWACHTW("MANAGER") Set Check=1
 Quit Check
 ;
VERWERKT(Total,Selected,Line,Column) 
 Set Total=$G(Total),Selected=$G(Selected),Line=$G(Line,20),Column=$G(Column,21)
 Set FP=Line*100+(Column-19)
 Write @F,"Klanten verwerkt : " Write Total Write:Selected "/",Selected Write @F2
 Quit
 ;
 ; Een klantenveld invullen in ^KKL,^DKL en in de Log
MODFIELD(KLNr,BIndex,NewValue)
 New R,KlKey,Node,Piece,OldValue
 Set KlKey=^KK1(KLNr),Node=BIndex\100-1,Piece=BIndex#100
 Set R=$G(^KKL(KlKey,Node)),OldValue=$P(R,D,Piece)
 Do:OldValue'=NewValue
 . Lock +^KKL(KlKey)
 . Do W^cAN220("KL","LVH1",KlKey,BIndex,NewValue)
 . Lock -^KKL(KlKey)
 Quit
 ;
VERZW(OldVerzW,MultSel,Compact,Zonder,Titel) 
 New R,VerzW,VolgNr,sFmt,VerzWCanc
 Set VerzWCanc=$G(OldVerzW)
 Set OldVerzW=$TR($G(OldVerzW),",",";"),MultSel=$S($G(MultSel)=1:"M",1:"")
 Set Zonder=$S($D(Zonder):$S(Zonder=1:"Z",1:Zonder),MultSel="":"",1:"Z")
 If MultSel="",OldVerzW="" Set OldVerzW="OD"
 Set VerzW=""
 For  Set VerzW=$O(^RES("KLANT","PI","VERZENDWIJZE","D",VerzW)) Quit:VerzW=""  Do
 .Set R=^RES("KLANT","PI","VERZENDWIJZE","D",VerzW),VolgNr=$P(R,"`")
 .If '$G(Compact) Quit:$P(R,"`",8)=0
 .If $G(Compact),$L(VerzW)>2 Quit
 .Set VerzW(VolgNr)=VerzW_"`"_$P(R,"`",2,99)
 Set sFmt=$S(MultSel="M":"^RES(""KLANT"",""LD"",""VERZENDWIJZEMULTSEL"")",1:"^RES(""KLANT"",""LD"",""VERZENDWIJZE"")")
 Set VerzW=$$WILD^vhPOPUP("C;C",MultSel_Zonder_"OK1-L",$G(Titel,"Verzendwijze"),.VerzW,OldVerzW)
 If zb="CANC" Set VerzW=VerzWCanc
 Else  Set VerzW=$TR(VerzW,";",",")
 Quit VerzW
 ;
LEVADRNR(KLNr,ORDNr) 
 New R,LAOrd,LAKlant,LevAdr,KlantInd
 Set LAOrd=""
 Do
 .Set LevAdr=$G(^KOD(KLNr,"F",ORDNr,3))
 .Quit:$TR($P(LevAdr,D,2,8),D,"")=""
 .Set KlantInd=^KK1(KLNr),LAKlant="L"
 .For  Set LAKlant=$O(^KKL(KlantInd,LAKlant)) Quit:$E(LAKlant)'="L"  Do  Quit:LAOrd
 ..Set R=^KKL(KlantInd,LAKlant) Set:$P(R,D,2,8)=$P(LevAdr,D,2,8) LAOrd=$P(R,D)
 Quit LAOrd
 ;
MUNT(KLNr,Par1,Par2,NoSa,ToMunt) 
 ; Par1 1 = afkorting
 ;      2 = Omschrijving
 ;      3 = Pariteit
 ;          Par2 = 1 Aankoop
 ;               = 2 Verkoop
 ;               = 3 financieel
 ;      4 = Afronding
 ;      5 = Omrekenen
 ;          Par2 = om te rekenen bedrag (Bedrag#Round)
 ;                 Round = 1 : afronden volgens ToMunt
 New R,KlKey,Land,Munt
 Do:KLNr
 .Set KlKey=^KK1(KLNr),R=^KKL(KlKey,0),Land=$$LAND^vhRtn1($P(R,D,8)),Munt=$P(R,D,11)
 .Set:Munt="" Munt=$$FADEF^vhRtn1()
 .Set:Munt="MTL" Munt=$$LANDMUNT(Land)
 .Set Munt=$$MUNTMUNT(Munt)
 If '$L($G(Par1)),'$L($G(Par2)),'$L($G(NoSa)),'$L($G(ToMunt))
 Else  Do
 .Set R="$$MUNT^vhRtn1("""_Munt_""","""_$S($L($G(Par1)):Par1,1:"")
 .Set R=R_""","""_$S($L($G(Par2)):Par2,1:"")
 .Set R=R_""","""_$S($L($G(NoSa)):NoSa,1:"")
 .Set R=R_""","""_$S($L($G(ToMunt)):ToMunt,1:"")_""")"
 .Xecute "Set Munt="_R
 Quit Munt
 ;
CONVMUNT(Munt,Land) 
 Set Munt=$S(Munt="MTL":$$LANDMUNT(Land),1:$$MUNTMUNT(Munt))
 Quit Munt
 ;
LANDMUNT(Land) 
 New Munt
 Set Land=$$LAND^vhRtn1(Land)
 If Land="NL" Set Munt=$$MUNTKODE^vhRtn1("NLG")
 Else  If Land="FR" Set Munt=$$MUNTKODE^vhRtn1("EUR")
 Else  If Land="DE" Set Munt=$$MUNTKODE^vhRtn1("DEM")
 Else  If Land="BE" Set Munt=$$MUNTKODE^vhRtn1("BEF")
 Else  Set Munt=$$FADEF^vhRtn1()
 Quit Munt
 ;
MUNTMUNT(Munt) 
 If Munt=$$MUNTKODE^vhRtn1("BEF")
 Else  If Munt=$$MUNTKODE^vhRtn1("NLG")
 Else  If Munt=$$MUNTKODE^vhRtn1("EUR")
 Else  If Munt=$$MUNTKODE^vhRtn1("DEM")
 Else  Set Munt=$$FADEF^vhRtn1()
 Quit Munt
 ;
LANDPAR(Land) 
 New Pariteit
 Set Pariteit=1,Land=$$LAND^vhRtn1(Land)
 If Land="NL" Set Pariteit=$$MUNT^vhRtn1("NLG",,12)
 If Land="FR" Set Pariteit=$$MUNT^vhRtn1("EUR",,12)
 If Land="DE" Set Pariteit=$$MUNT^vhRtn1("DEM",,12)
 Quit Pariteit
 
 ; Xecute opgeroepen via DATA-M software in ^DMA("LVH1","KL",0,2)
XecuteNaOpenen
 If '$D(EXTWIJZ) {
	 Set KlantID=##class(DOM.DomeinContext).Instance().GeefLegacyPartijAPI().GeefKlantPartijID($P(B(1),D,1))
	 Do ##class(CHUI.Klant.KlantCRUD).MaakKlant(KlantID)
 }
 Do OPEN^LOG("KL",$P(B(1),D,1)),BLDOBJ^TAPI("K",$P(B(1),D)),MailNewCust^KLOPV($P(B(1),D))
 Do ##class(APPS.CRM.KlantService).RaiseMaakEvent($Piece(B(1),D))
 Quit
 
 ; Xecute opgeroepen via DATA-M software in ^DMA("LVH1","KL",0,3)
XecuteNaWijzigen
 If '$D(EXTWIJZ) {
	 Set KlantID=##class(DOM.DomeinContext).Instance().GeefLegacyPartijAPI().GeefKlantPartijID($P(B(1),D,1))
	 Do ##class(CHUI.Klant.KlantCRUD).WijzigKlant(KlantID)
 }
 Do WIJZ^LOG("KL",$P(B(1),D,1))
 Do REBLDOBJ^TAPI("K",$P(B(1),D))
 
 Do ##class(APPS.CRM.KlantService).RaiseWijzigEvent($Piece(B(1),D))
 Quit

INDEX 
 N S01,S02,S03,S04
 S I="",S02=$P(B(1),D,2)
 F S03=1:1:$L(S02) S S01=$E(S02,S03),S04=$A(S01) S:S04>96&(S04<123) S01=$C(S04-32) S:S01'?1P I=I_S01
 S I=$$UPCASE^vhRtn1($E(I,1,24))_" "_$P(B(1),D)
 Q
 ; Xexcute bij openen klanten
XOPEN   
 D INDEX
 S @%Q1=0,$P(B(3),D,22)=$H F X=1:1:SW3 S @("^"_Q_Q1_"(I,X-1)")=B(X)
 S @Q4=I,(@%Q1,OK)=1
 Q
 ; Xexcute bij wijzigen klanten
XWIJZIG 
 S @%Q1=0,$P(B(3),D,22)=$H,@("^"_Q_Q1_"(I1,0)")=B(1),J=$O(B(""),-1),K=D,$P(K,D,24)=D F I=2:1:J S ^(I-1)=$G(B(I),K)
 D INDEX I I'=I1 D S1 L -@Q3 S I1=I L +@Q3:2 E  S R=14 X ^cTXT(0,"N",R) R K S K="-"
 S OK=1
 Q
 ;Do X^cAN200("KL","LVH1","","","S UI1="""_KlantInd_"""") ; DATA-M verwijderen vanaf de Menu
 ;Do X^cAN220("KL","LVH1",KlantId) ; DATA-M verwijderen in BG
 ; Xexcute bij verwijderen klanten
XDELETE(KLNr) 
 New Date,VerslId,FANr,PRNr,OFFNr
 ; Opkuis oude leveringen
 Kill ^KUL(KLNr,"G"),^KUL(KLNr,"M")
 ; Opkuis verslagen
 Set Date=""
 For  Set Date=$O(^VERSLAG("IK",KLNr,Date)) Quit:Date=""  Do
 .Set VerslId=""
 .For  Set VerslId=$O(^VERSLAG("IK",KLNr,Date,VerslId)) Quit:VerslId=""  Do DELOBJ^VERSLAG(VerslId)
 ; Copy fakturen naar ^COPYKFA
 Set Date=""
 For  Set Date=$O(^KFA1("F",KLNr,Date)) Quit:Date=""  Do
 .Set FANr=""
 .For  Set FANr=$O(^KFA1("F",KLNr,Date,FANr)) Quit:FANr=""  Do
 ..Do DELOBJ^FLOWCOPYKFA(FANr) ; Verwijderen indien deze nog zou bestaan van een vorig boekjaar
 ..Set ^COPYKFA1("F",KLNr,Date,FANr)=""
 ..Merge ^COPYKFA("F",FANr)=^KFA("F",FANr)
 ..Kill ^KFA1("F",KLNr,Date,FANr),^KFA("F",FANr)
 ; Opkuis proforma's
 Set Date=""
 For  Set Date=$O(^KFAP1("F",KLNr,Date)) Quit:Date=""  Do
 .Set FANr=""
 .For  Set FANr=$O(^KFAP1("F",KLNr,Date,FANr)) Quit:FANr=""  Do
 ..Kill ^KFAP1("F",KLNr,Date,FANr),^KFAP("F",FANr)
 ; Opkuis statistiek
 Set PRNr=0
 For  Set PRNr=$O(^KSTKL(KLNr,PRNr)) Quit:PRNr=""  Kill ^KSTPR(PRNr,KLNr)
 Kill ^KSTKL(KLNr)
 ; Opkuis offertes
 Set OFFNr=""
 For  Set OFFNr=$O(^KOFKL(KLNr,"F",OFFNr)) Quit:OFFNr=""  Do DELOBJ^FLOWOFF(OFFNr)
 ; Opkuis potentieel
 Kill ^KKOV(KLNr)
 ; Opkuis rembours
 Kill ^REMBOURS(KLNr)
 ; Opkuis incidenten
 Do DelCust^KLACHT(KLNr)
 Q
 ;
 ; Verwijderen van de E-commerce gebruikers
DelECToegang(KLNr,Warn)
 New sc,ecUsers
 Set ecUsers=$$ATKUSERS(KLNr)
 Do:$L(ecUsers)
 . Do:$G(Warn) WARN^vhTXTPOP("De Vhisie gebruikers ("_$L(ecUsers,D)_") van deze klant~worden verwijderd!","")
 . Set sc=##class(BL.EC.Toegang).DeleteViaKlantNr(KLNr)
 . Do:$L(sc) WARN^vhTXTPOP(sc)
 Quit
 ;
RPLINFO(kc) 
 New R,i1,TXTUI1,TXTUQC,TXTUSC
 Do STORE^vhTERMINA()
 Set i1=^KK1(kc)
 Set R=$NA(@^DMC(0,"KL","DATA","TXT")@($P(i1," ",2)),3)
 Set TXTUQC=0,TXTUSC="KL",TXTUI1=i1
 Do RT^cAN210("TXT",0,0,0,R)
 Do REFRESH^vhTERMINA()
 Quit
 ;
RPLHIST(kc) 
 New UI1,UQC,USC,KLI1,KLUQC,KLUSC,KM1,KM2,RSORT
 Do STORE^vhTERMINA()
 Set (KLI1,UI1)=^KK1(kc),(KLUQC,UQC)=0,(KLUSC,USC)="KL"
 Do A^cAN230("BH.HIS.KL",0,"")
 Do REFRESH^vhTERMINA()
 Quit
 ;
ATKUSERS(KLNr) 
 New lbUsers
 Set lbUsers=##class(BL.EC.Toegang).KlantHasToegang(KLNr,"VH")
 Quit $$ListToPieces^vhLib(lbUsers,"\")
 ;

ModBusinessType
 Set Locals("K")=##class(CHUI.enuSelectie).Selecteer("DOM.VKP.enu.BusinessType","Business Type")
 Quit

 ; Aanpassen interne verantwoordelijke bij openen en wijzigen
ModIntVw
 New zb,Regio,RegioVw
 Set Regio=$P(B(1),D,20),RegioVw=$$REGIOVW^KLOPV(Regio)
 Set K=$P(B(1),D,22) Set:K="" K=RegioVw
 Set K=$$USELECT^vhUSER("","Vw intern",,"KLINTVW;&S;ICT","K",1,,K,,"C"_U_"C",,,,,"Z")
 Set:$G(zb)="CANC" K="-" Set:K=RegioVw K=""
 Set Locals("K")=K
 Quit
 ;
 ; Aanpassen externe verantwoordelijke bij openen en wijzigen
ModExtVw
 New zb,Regio,RegioVw
 Set Regio=$P(B(1),D,20),RegioVw=$$REGIOVW^KLOPV(Regio,,,"E")
 Set K=$P(B(1),D,26) Set:K="" K=RegioVw
 Set K=$$USELECT^vhUSER("","Vw extern",,"VTW;&S;KSBE;&S;KSNL;&S;KLEXTVWPLUS","K",1,,K,,"C"_U_"C",,,,,"Z")
 Set:$G(zb)="CANC" K="-" Set:K=RegioVw K=""
 Set Locals("K")=K
 Quit
 ;
 ; Aanpassen orderbevestiging bij openen en wijzigen (fax, mail, ...)
ModOrdBev
 New zb
 Set K=$P(B(2),D,19) Set:K="" K=$S(UFU="O":"FM",1:0)
 Set K=$$PI^vhPOPUP("C;C","-O1","Orderbevestiging","KLANT","ORDBEV",K)
 Set:$G(zb)="CANC" K="-" Set:K=0 K=""
 Set Locals("K")=K
 Quit
 ;
 ; Aanpassen offertes bij openen en wijzigen (voorkeur fax of mail)
ModOffertes
 New zb
 Set K=$P(B(4),D,9) Set:K="" K="M"
 Set K=$$PI^vhPOPUP("C;C","-O1","Offertes","KLANT","OFFERTES",K)
 Set:$G(zb)="CANC" K="-" Set:K="M" K=""
 Set Locals("K")=K
 Quit
 ;
 ; Aanpassen extra bon bij openen en wijzigen
ModExtraBon
 New zb
 Set K=$P(B(2),D,17) Set:K="" K="G"
 Set K=$$PI^vhPOPUP("C;C","-O1","Extra bon","KLANT","LEVBON",K)
 Set:$G(zb)="CANC" K="-" Set:K="G" K=""
 Set Locals("K")=K
 Quit
 ;
 ; Aanpassen extra factuur bij openen en wijzigen
ModExtraFactuur
 New zb,I,K
 Set K=$P(B(2),D,2)
 If $L(K)>1 For I=$L(K):-1:2 Set $E(K,I)=";"_$E(K,I)
 Set K=$$PI^vhPOPUP("C;C","-O1ZM","Extra factuur","KLANT","EXTRAFACTUUR",K)
 Set:$G(zb)="CANC" K="-" Set K=$TR(K,";","")
 Set Locals("K")=K
 Quit
 ;
 ; Routine uitgevoerd na het ophalen van de elementen 'Extra factuur'
AExtraFactuur
 For sY=1:1:sY Do
 . Set:$P(sY(sY),"`",2)="ZONDER" $P(sY(sY),"`",2)="Geen"
 . If $P(sY(sY),"`")="&",$P(sY(sY),"`",2)="S" Set sY(sY)="&S"
 Quit
 ;
 ; Routine uitgevoerd na het selecteren van een element 'Extra factuur'
SExtraFactuur(Item,x,y,z)
 New Select, KlantNr
 Set Select=1
 Kill:Item=3 sX(4)
 Kill:Item=4 sX(3)
 Kill:Item=6 sX(7),sX(8)
 Kill:Item=7 sX(6),sX(8)
 If Item=8 Do
 . Set KlantNr = $Piece($Get(B(1)), "\")
 . If $$$Not(##class(TECH.StringUtils).Equals(KlantNr, $$$KlantBruynzeel, $$$KlantKeller, $$$KlantDKGDeKeukenfabriek)) Set Select=0
 . Else  Kill sX(6),sX(7)
 Quit Select
 ;
 ; Aanpassen factuur verzenden bij openen en wijzigen
ModFactuurVerzenden
 New zb,I,K
 Set K=$P(B(2),D,2)
 If K'["*",K'["@" S K="*"_K
 If $L(K)>1 For I=$L(K):-1:2 Set $E(K,I)=";"_$E(K,I)
 Set K=$$PI^vhPOPUP("C;C","-O1M","Factuur verzenden","KLANT","FACTUURVERZENDEN",K)
 Set:$G(zb)="CANC" K="-" Set K=$TR(K,";*","")
 Set Locals("K")=K
 Quit
 ;
 ; Routine uitgevoerd na het ophalen van de elementen 'Factuur verzenden'
AFactuurVerzenden
 For sY=1:1:sY If $E($P(sY(sY),"`"))="&" Set sY(sY)="&S"
 Quit
 ;
 ; Routine uitgevoerd na het selecteren van een element 'Factuur verzenden'
SFactuurVerzenden(Item,x,y,z)
 New Select, KlantNr
 Set Select=1
 Kill:Item=1 sX(2)
 Kill:Item=2 sX(1),sX(4),sX(5),sX(8)
 Kill:Item=4 sX(5)
 Kill:Item=5 sX(4)
 Kill:Item=7 sX(8),sX(9)
 Kill:Item=8 sX(7),sX(9)
 If Item=4,$G(sX(2)) Set Select=0
 If Item=5,$G(sX(2)) Set Select=0
 If Item=8,$G(sX(2)) Set Select=0
 If Item=9 Do
 . Set KlantNr = $Piece($Get(B(1)), "\")
 . If $$$Not(##class(TECH.StringUtils).Equals(KlantNr, $$$KlantBruynzeel, $$$KlantKeller, $$$KlantDKGDeKeukenfabriek)) Set Select = 0
 . Else  Kill sX(7),sX(8)
 Quit Select
 ;
 ; Ingave van de reden van aanmaak van de klant
RedenAanmaak
 New zb,R,RedenAanmaak
 Set RedenAanmaak=$P($G(B(4)),D,15)
 Set K=$$PI^vhPOPUP("C;C","-ZDO1","Reden aanmaak","KLANT","REDEN",RedenAanmaak)
 Set:zb="CANC" K="-"
 If K="A" Do  ; Vrije ingave
 . Set R="K\22\3\Reden aanmaak\\50"
 . Do ^cA100
 Set Locals("K")=K
 Quit
 ;
 ; Selecteer tandemboxverpakking
GetVerpTBX
 New Verpak,zb,ID,Omschrijving,VolgNr
 &sql(DECLARE GetVerpTBX CURSOR FOR
 SELECT ID,Omschrijving,VolgNr
 INTO ID,Omschrijving,VolgNr
 FROM Prod_GAMeta_BT.Verpakking)
 &sql(OPEN GetVerpTBX)
 For  &sql(FETCH GetVerpTBX) Quit:SQLCODE  Do
 . Set Verpak(VolgNr)=ID_D_Omschrijving
 &sql(CLOSE GetVerpTBX)
 Set K=$P(B(8),D,9)
 Set K=$$WILD^vhPOPUP("C;C","ZOK1-","Verpakking TBX",.Verpak,K)
 Set:$G(zb)="CANC" K="-"
 Set Locals("K")=K
 Quit
 ;
 ; Display tandemboxverpakking
DispVerpTBX(Verpak)
 New ID,Omschrijving
 &sql(DECLARE DispVerpTBX CURSOR FOR
 SELECT ID,Omschrijving
 INTO ID,Omschrijving
 FROM Prod_GAMeta_BT.Verpakking)
 &sql(OPEN DispVerpTBX)
 For  &sql(FETCH DispVerpTBX) Quit:SQLCODE  Do
 . Set Verpak(ID)=Omschrijving
 &sql(CLOSE DispVerpTBX)
 Quit $S($L($G(Verpak)):$G(Verpak(Verpak)),1:"")
 ;
 ; Ophalen rechtstreekse relaies
GetDirectRelaties(KLNr)
 New fRel,Relatie,lbRelatie,SQLCODE
 &sql(DECLARE fRel CURSOR FOR
 SELECT DISTINCT Relatie
 INTO :Relatie
 FROM Derde.Klant_Relaties WHERE Klant = :KLNr)
 &sql(OPEN fRel)
 Set lbRelatie=""
 For  &sql(FETCH fRel) Quit:(SQLCODE '= 0)  Do 
 . Set lbRelatie=lbRelatie_$LB($P(^RES("KLANT","PI","RELATIES","D",Relatie),"`",7))
 &sql(CLOSE fRel)
 Quit lbRelatie
 ;
 ; Ophalen omgekeerde relaties
GetReverseRelaties(KLNr)
 New rRel,Relatie,lbRelatie,SQLCODE
 &sql(DECLARE rRel CURSOR FOR
 SELECT DISTINCT Relatie
 INTO :Relatie
 FROM Derde.Klant_Relaties WHERE RelatieKlant = :KLNr)
 &sql(OPEN rRel)
 Set lbRelatie=""
 For  &sql(FETCH rRel) Quit:(SQLCODE '= 0)  Do 
 . Set lbRelatie=lbRelatie_$LB($P(^RES("KLANT","PI","RELATIES","D",Relatie),"`",7))
 &sql(CLOSE rRel)
 Quit lbRelatie
 ;
 ; Type : niet meegegeven -> alle
 ;      : 'IP' -> industriepool
 ;      : 'KS' -> klantenservice  
IsVTW(KLNr,Type)
 New IsVTW,KlNaam
 Set IsVTW=0
 ; Industriepool
 If "IP"[$G(Type) Do
 . Set IsVTW=KLNr=$$$KlantIPVtwLDS ; LDS
 . Set:'IsVTW IsVTW=KLNr=$$$KlantIPVtwPVT ; PVT
 ; Klantenservice
 If 'IsVTW,"KS"[$G(Type) Set IsVTW=$$UPTRIMAN^vhRtn1($P(^KKL(^KK1(KLNr),0),D,2))?1"KS"2N
 Quit IsVTW
 ;
 ; Om vanuit openen, wijzigen klanten vanuit ZWinterm bvb onze vhPOPUP op te roepen
 ; UFU = "O" openen
 ;     = "W" wijzigen
 ; A en B doorgegeven als .local
 ; Bindex is de node en $P van de B-local welke moeten gewijzigd worden
 ; Routine is de eigenlijke routine die ^vhPOPUP zal oproepen
ZWINT(UFU,A,B,BIndex,Routine)
 New U1,U2,U7,ATemp,BTemp,Locals
 Merge ATemp=A,BTemp=B,Locals("B")=B,Locals("UFU")=UFU
 New A,B
 Do E^cA612,DO^vhPROGRAM(Routine)
 Do P^cA612(2,1,20,80,1,"","","",$S(UFU="W":"Wijzigen",1:"Openen")_" klanten",$S($ZV["MSM":0,1:1),0,7,1,1)
 Merge A=ATemp,B=BTemp
 If $G(BIndex),Locals("K")'="-" Set $P(B(BIndex\100),D,BIndex#100)=Locals("K")
 Do S1^cAN202
 Set K=$G(Locals("K"))
 Quit
 ;
S1 S S01="^"_Q_Q1_"("""_I1_""")"
S1A S S01=$Q(@S01) I $P(S01,"""",2)=I1 S S02=$P(S01,I1)_I_$P(S01,I1,2,999),@S02=@S01 G S1A
S1B S @("^"_Q_Q2_"($P(B(1),D))")=I K @Q3
S1Z K S01,S02 Q
 ;
TKontnt ;Contant\Au comptant\Barzahlung\Cash
TRemb ;Rembours\Rembours\Rembours\Cash on delivery
TVoorBt ;Vooruitbetalen\Payer d'avance\Vorauszahlen\Prepay
TKontPc ;met\avec\mit\with;korting\d'escompte\skonto\discount
TKortng ;korting binnen de\d'escompte en dedans\skonto\discount
TDag ;dag\jour\tag\day;en\s\en\s
TVoor ;\\\within
TVanAf ;\\\from the
TFaktDt ;na factuurdatum\date de facturation\rechnungsdatum\date of invoice
TEndMth ;einde maand\fin de mois\ende monat\from the end of the month
TNetto ;of\ou\oder\or;netto\net\netto\net
TMaand ;maand\mois\monat\month;en\\e\s
TWissel ;met wissel\par traite\mit wechel\by bill
TAval ;getekend voor aval\avalisee\avaliert\guaranteed