KLETIKET ;UTILI Bepaalde klanten produkten of leveranciers[ 10/12/2001   4:09 PM ]
 ; Initialisatie
 If '$D(Q) S Q="K" D ^cA604,INIT^vhTERMINA
 Goto SELECT
 Do INIT
KLETI1 Set:$L(VerantW) R=$$BEPAALDE^UTILI3("KL","^HULP("_%J_",""L"")","",Titel,"KLETIKETB","CBVTW^KLETIKET")
 Set:'$L(VerantW) R=$$BEPAALDE^UTILI3("KL","^HULP("_%J_",""L"")","",Titel)
 Quit:'$D(^HULP(%J,"L"))
 
 ;Afdruk
KLETI2 
 Set X=$S('$G(Fax):"L;Lijst\E;Etiketten\O;Omslagen (enveloppen)\T;Transfer Windows (Ansi)\M;Transfer Mac",1:"F;Fax")
 Set X=X_"\V;Aanvullen lijst"
 Do LIST^POP(X,"E",21,"Selectie afdrukttype (- voor Exit)","FK")
 I X="" Kill ^HULP(%J) Quit
 If X="V" Goto KLETI1
 Set PrTyp=X
 Set X="A;Alfabetisch\I;Volgens ingave" Set:'$G(Fax) X=X_"\P;Postkode"
 Do LIST^POP(X,"I",21,"Selectie sortering (- voor Exit)","FK")
 I X="" Kill ^HULP(%J) Quit
 Set SrtTyp=X
 If SrtTyp="I" For I=1:1:$O(^HULP(%J,"L",99999),-1) Set ^HULP(%J,"T",I)=^HULP(%J,"L",I)
 If SrtTyp="A" Set Key=" ",I=0 For  Set Key=$O(^HULP(%J,"L",Key)) Quit:Key=""  Set I=I+1,^HULP(%J,"T",I)=^HULP(%J,"L",Key)
 If SrtTyp="P" Do
 .New Rec,NBewKey,Post,Land
 .Set Key=" ",I=0 
 .For Key=1:1:$O(^HULP(%J,"L",99999),-1) Do 
 ..Set Rec=^KKL($P(^HULP(%J,"L",Key),D,1),0)
 ..Set Land=$$LAND^vhRtn1($P(Rec,D,8)),Post=$P(Rec,D,6)
 ..Set NewKey=Land_" "_Post_" "_Key
 ..Set ^HULP(%J,"T",NewKey)=^HULP(%J,"L",Key)
 .Do RENUMBER^vhLIST($NA(^HULP(%J,"T")))
 
 If $G(Fax) Merge ^HULP(Fax,"S")=^HULP(%J,"T") Kill ^HULP(%J,"L"),^HULP(%J,"T") Quit
 
 ; Afdrukken
 Do INIT^PROC($S(PrTyp="L"!(PrTyp="PRINT"):"KLETIKETP",1:"KLETIKETT"),"VTW")
 Set PrList=$$GIVELIST^vhPRINTER($I)
 Set FP=2101 Write @F,@F1
 If PrTyp="E",PrList["BO"!(PrList["BR") Do PRINT^ETIKET("KL","^HULP("_%J_",""T"")","KLETIKETE","E1",1)
 If PrTyp="O",PrList["CA" Do PRINT^ETIKET("KL","^HULP("_%J_",""T"")","KLETIKETE","O1")
 Do:PrTyp="T" PRINT^OUTPUT(.VTW,"T","B")
 Do:PrTyp="M" PRINT^OUTPUT(.VTW,"M","B")
 Do:PrTyp="L" PRINT^OUTPUT(.VTW,"P","B")
 Do:PrTyp="PRINT" PRINT^OUTPUT(.VTW,"P","B")
 Kill ^HULP(%J,"T")
 Goto KLETI2
 Quit
 
TITEL 
 Set Titel=$S('$G(Fax):"Afdrukken etiketten",1:"Fax aan")_" klanten"
 Write @F11,@F1,@FMTI,Titel_" - "_QN,@FMTi
 Quit
  
INIT 
 New X
 S %J=$$%J^vhRtn1()
 Kill ^HULP(%J)
 Do TITEL
  ; Beperking
 Set Beperking=$$STRING^vhPOPUP("C;C","O-2","Beperking","B`Bewerkbare regio\A`Alle actieven","B")

 ; Verantwoordelijke
 Set VerantW=$$PI^vhPOPUP("C;C","OKSM-2","Verantwoordelijke klant","PERS","VERANTWK","AK1;AK2;AE1;AB1;AB2;EI")
 Set Nr=0
 Quit
 
 ; Callback voor de verantwoordelijke
CBVTW(KLNr,Rec) 
 New I,Aansp,PersNr,Graad,MemGraad
 If '$D(Rec) Do  Quit Rec
 .Set Rec=$$GETVERAN^PERS("K",KLNr,VerantW)
 S R=$$ASK^vhINP("Verantwoordelijke : ",30,Rec)
 If R="-"!(R=".") Set R=Rec
 Quit R
 
 ; GetExec geeft de klantref in Key en krijgt Ref als global referentie en Rec als datarecord.
MERGE(Global,GetExec,VerantW) 
 New %J
 Do INIT
 Set LegacyPartijAPI=##class(DOM.DomeinContext).Instance().GeefLegacyPartijAPI()
 Set PartijAPI=##class(DOM.DomeinContext).Instance().GeefPartijAPI()
 Set VerkoopAPI = ##class(DOM.DomeinContext).Instance().GeefVerkoopAPI()
 Set Ref=""
 Set FP=2401 Write @F,"Klanten aan het overbrengen naar de ",$S('$G(Fax):"etiketten",1:"fax"),"lijst ..."
 For  Set Ref=$O(@Global@(Ref)) Quit:Ref=""  Do
 .Set Rec=$G(^(Ref))
 .X GetExec
 .Quit:'$L(Key)
 .Set KLNr=Key
 . Set Id=$G(^KK1(KLNr)) Quit:'$L(Id)
 . Set PartijID = LegacyPartijAPI.GeefKlantPartijID(KLNr)
 . Set Partij = PartijAPI.GeefPartij(PartijID)
 . Set Klant = VerkoopAPI.GeefKlant(PartijID)
 . Quit:Partij.GeefActiefStatus()'=##class(DOM.CRM.enu.ActiefStatus).Actief()
 . Quit:(Beperking="B")&&('Klant.IsInBewerkbareRegio())
 . Quit:$$GetKlantType^KLANT5($P(Id," ",2))="Z" ; Non akt
 . Quit:$$GetKlantType^KLANT5($P(Id," ",2))=0 ; Non akt
 .Quit:$D(^HULP(%J,"L",Id))   
 .Set R=""
 .Set Aansp=$$UPTRIMAN^vhRtn1($P(^KKL(Id,0),D,4))
 .If $L(VerantW),("DHR;M;DHRN;MM;MEVR;MME;JUF;MLLE;DHRENMEVR;METMME"'[Aansp)!(Aansp="") S R=$$CBVTW(Key)
 .If R=-1 Quit
 .Set Rec=Id_D_Key_D_R      
 .Set Nr=Nr+1
 .Set ^HULP(%J,"L",Nr)=Rec
 .Set ^HULP(%J,"L",Id)=Rec
 Goto KLETI2
 Quit
 
 
	
SELECT 
 Do TITEL
 Set KSEL=1,NVG=1
 Do KP^KSEL Quit:K="-"
 Set:$G(Fax) B(224)="\6\\\TELEFAX"
 Set FP=2001 Write @F,@F1,!!!!,"Klanten aan het selekteren voor ",$S('$G(Fax):"de etiketten",1:"het faxen")," ..."
 New Count,KLNr,A,X,%J
 Set Count=0,%J=$$%J^vhRtn1()
 Set NVG=KL=1
 If KL'=0 Set X=$D(@Q0) Goto FKL2:X
FKL1 Set KL=$N(@Q0)
 If NVG,KL'?.N Goto FKL3
 If KL=-1!(KL]KLX) Goto FKL3
FKL2 Do ^KKCHKKL Goto FKL1:'OK
 Set KLNr=$P(A(0),D)
 Set Count=Count+1,^HULP(%J,"S",Count)=KLNr
 Goto FKL1
FKL3 Do MERGE("^HULP("_%J_",""S"")","S Key=$P(Rec,D,1)")
 Kill ^HULP(%J)
 Quit
 
FAX(Fax) 
 New (Fax,sJC)
 Do
 .New Fax,sJC
 .Set Q="K"
 .Do ^cA604,INIT^vhTERMINA
 Set B(224)="\6\\\TELEFAX"
 Do KLETIKET
 Quit
 
T1 ;211;Algemeen verantwoordelijke\212;Aankoop verantwoordelijke\213;Verkoop verantwoordelijke\214;Boekhouding en adminstratie verantwoordelijke\616;Aankoop administratie\304;Technisch verantwoordelijke\305;Produktieverantwoordelijke