KKANALX ;Klant-Produkt verkoop analyze  door middel van execute[ 01/30/2002  8:55 AM ]
 Do INIT
 ;Set CheckKL="$$CHECKKL^KKANALX()" ;Functie
 Set CheckPR="$$CHECKPR^KKANALX()" ;Functie
 Set FetchMH="FETCHMH^KKANALX" ; Huidige periode 
 ;Set FetchMV="FETCHMV^KKANALX" ; Vroegere periode
 ;Set StorePR="STOREPR^KKANALX"
 Set StoreKL="STOREKL^KKANALX"
 Set TotCH=0,TotGL=0
 Do BEPERK(1) Quit:'%SC
 ; Lijsten
LIJST Do INIT^PROC("PVKKANALX","List")
 Set List(11)="Potentieel Regio R0"_$P(Select(20),D)
 Do PRINT^OUTPUT(.List,"MPS","S")
 Quit
  
FETCHMH 
 If $P(B("I"),D)["CH" Set TotCH=TotCH+$P(Rec,D)
 If $P(B("I"),D)["GL"!($P(B("I"),D)["LA") Set TotGL=TotGL+$P(Rec,D)
 Q
STOREKL Set ^HULP(%J,^KK1(KLNr))=KLNr_D_TotCH_D_TotGL
 Set TotCH=0,TotGL=0
 Q
  
fetchmh(Rec) 
 For I=1,3,4,6 Set $P(Tot,D,Node+I)=$P(Tot,D,Node+I)+$P(Rec,D,I)
 Quit
 
CHECKKL() Quit $D(^KSTKL(KLNr)) ; Aanwezig in statistiek bestand
CHECKPR() Quit:'$D(B) 0 Quit '$P(B(2),D,7) ; Telbaar produkt
checkpr() Quit 1 ; Alle produkten
 ; ******************************
 
INIT S Q="K" D ^cA604 Set %J=$$%J^vhRtn1 
 Kill ^HULP(%J)
 Do INIT^PROC("KKANAL")
 Set KKANAL(2,1)=^LD("L","KKANALT")
 Set SelCnt=0
 Set (Input,Screen)=""
 Quit
 
 
BEPERK(First) 
 If 'First Do EDIT^vhScherm("KKANAL",1,24,"H") Quit:'%SC
 If First Do NIEUW^vhScherm("KKANAL",1,24,"H") Quit:'%SC
 D BLDCHK("PR")
 D BLDCHK("KL")
 Do FETCH
 Do ADD^vhScherm(1,24)
 Quit
 
 
 ; Ophalen van de omzetten per klant
FETCH 
 Set:$P(Select,D,2)="" $P(Select,D,2)=$H
 Set BMV=$$EXTDATE^vhLib.DataTypes($$CALCDATE^vhLib.DataTypes($P(Select,D,1),"M",-13),"DM4")_" "
 Set EMV=$$EXTDATE^vhLib.DataTypes($$CALCDATE^vhLib.DataTypes($P(Select,D,2),"M",-12),"DM4")_" "
 Set BMH=$$EXTDATE^vhLib.DataTypes($$CALCDATE^vhLib.DataTypes($P(Select,D,1),"M",-1),"DM4")_" "
 Set EMH=$$EXTDATE^vhLib.DataTypes($$CALCDATE^vhLib.DataTypes($P(Select,D,2),"M"),"DM4")_" "
 Set FP=2201 Write @F,@F1,"Klanten verwerkt : "
 Set (TotH,TotV,AantalKL)=0
 Set KLId=1
 For  Set KLId=$O(^KKL(KLId)) Quit:KLId=""  Do
 .Set KLNr=$P(^(KLId,0),D)
 .Do FETCHKL^UTILI(KLNr)
 .Quit:'$$CHECK^UTILI("Check(""KL"")")
 .If $L($G(CheckKL)) X "S R="_CheckKL Quit:'R
 .Do KLANT(KLNr) 
 Quit
 
KLANT(KLNr) 
 Set AantalKL=AantalKL+1
 If AantalKL#5=0 Set FP=2221 Write @F,AantalKL
 Set PRNr=1
 Set Tot=""
 If Check("PR")=1,'$L($G(CheckPR)) Do
 .Do MAAND(KLNr,0,BMH,EMH,0)
 .Do:$L($G(FetchMV)) MAAND(KLNr,0,BMV,EMV,10)
 Else  For  Set PRNr=$O(^KSTKL(KLNr,PRNr)) Quit:PRNr=""  Do
 .Do FETCHPR^UTILI(PRNr)
 .If $L($G(CheckPR)) X "S R="_CheckPR Quit:'R
 .Quit:'$$CHECK^UTILI("Check(""PR"")")
 .Do MAAND(KLNr,PRNr,BMH,EMH,0)
 .Do:$L($G(FetchMV)) MAAND(KLNr,PRNr,BMV,EMV,10)
 .Do:$L($G(StorePR)) @StorePR
 Do:$L($G(StoreKL)) @StoreKL
 Quit
 
MAAND(KLNr,PRNr,Begin,End,Node) 
 Set Mnd=Begin
 For  Set Mnd=$O(^KSTKL(KLNr,PRNr,Mnd)) Quit:Mnd=""  Quit:Mnd]End  Do 
 .Set Rec=^(Mnd)
 .Do:Node=0 @FetchMH
 .Do:Node=10 @FetchMV
 Quit
 
 ;  ***** Verwerking van de beperkingen op Produkt en Klant ****
 ; Opbouw van de Check local 
BLDCHK(Bestand) 
 New T
 Set:Bestand="KL" First=20,Last=23
 Set:Bestand="PR" First=10,Last=13
 Kill Check(Bestand)
 Set Cnt=1
 ;Sorteren op type
 For I=First:1:Last Do
 .Quit:$P(Select,D,I)="" 
 .Set T($P(Select,D,I),I)=Select(I)
 Set (IfString,Type,Cnt,I)=""
 For  Set Type=$O(T(Type)) Quit:Type=""  Do
 .Set IfString=IfString_"&("
 .For  Set I=$O(T(Type,I)) Quit:I=""  Do @("BLD"_Bestand_Type) Set IfString=IfString_"!"
 .Set IfString=$E(IfString,1,$L(IfString)-1)_")"
 Set IfString=$E(IfString,2,999)
 Set Check(Bestand)=$S($L(IfString):IfString,1:1)
 Quit
BLDKLR ;Check local : Klant Regio
 Set Cnt=Cnt+1,Check(Bestand,Cnt)="3;"_$P(T(Type,I),D)_";;;120"
 Set IfString=IfString_"T("_Cnt_")"
 Quit
BLDPRK ;Check local : Produkt Klassificatie
 Set Cnt=Cnt+1,Check(Bestand,Cnt)="3;"_$$GETSORT^KLASS($P(T(Type,I),D))_";;;I0"_$P(T(Type,I),D,2)
 Set IfString=IfString_"T("_Cnt_")"
 Quit
BLDPRL ;Check local : Produkt Leverancier
 Set Cnt=Cnt+1,Check(Bestand,Cnt)="3;"_$P(T(Type,I),D)_";;;J01"
 Set IfString=IfString_"T("_Cnt_")"
 Quit
BLDKLB ;Check local : Bepaalde klant/produkt
BLDPRB Set Cnt=Cnt+1
 Set Tabel=T(Type,I)
 Set Grp="",IfString=IfString_"T("_Cnt_")"
 Set:Bestand="KL" Check(Bestand,Cnt)="3;1;;;S U3=$D(^HULP("_%J_",""BK"_Tabel_""",^KK1(KLNr)))#10"
 Set:Bestand="PR" Check(Bestand,Cnt)="3;1;;;S U3=$D(^HULP("_%J_",""BP"_Tabel_""",$$COMPR^PRODUKT(PRNr)))#10"
 Quit
 
BLDKLE ;Check local : Eenmalig
BLDPRE Set LnNr=0
 Set Grp="",String="("
 Set Tabel=$P(T(Type,I),D)
 For  Set LnNr=$O(^HULP(%J,"E"_$E(Bestand)_Tabel,LnNr)) Quit:LnNr=""  Do
 .Set Cnt=Cnt+1,Check(Bestand,Cnt)=^(LnNr)
 .Set String=String_"T("_Cnt_")&"
 Set IfString=IfString_$E(String,1,$L(String)-1)_")"
 Quit 
BLDKLU ;Check local : UTILI-Data
BLDPRU Set UTLId=^KLIS1($P(T(Type,I),D))
 Set LnNr=100
 Set Grp="",String="("
 For  Set LnNr=$O(^KLIS(UTLId,LnNr)) Quit:LnNr=""  Do
 .If Grp'=(LnNr\100),$L(Grp) Set String=$E(String,1,$L(String)-1)_")!("
 .Set Grp=LnNr\100
 .Set Cnt=Cnt+1,Check(Bestand,Cnt)=^(LnNr)
 .Set String=String_"T("_Cnt_")&"
 Set IfString=IfString_$E(String,1,$L(String)-1)_")"
 Quit
 
REMOVE(Fld,Bestand)  ; Verwijderen van een selectie kenmerk
 Set Last=$S(Bestand="KL":10,1:19)
 For Fld=Fld+2:2:Last Do
 .Do PUT^vhScherm(Fld-2,$$GET^vhScherm(Fld))
 .Do PUT^vhScherm(Fld-1,$$GET^vhScherm(Fld+1))
 Do PUT^vhScherm(Last,""),PUT^vhScherm(Last+1,"")
 Quit
 
DISPLPR(Fld)  ; Tonen van een produkt selectie kenmerk
 Set Type=$$GET^vhScherm(Fld-1)
 Set Ret=""
 If Type="K" S:X Ret=$$DISPL^KLASS(+X,1)
 If Type="L" S:X Ret=X_" "_$P(^KLE(^KL1(X),0),D,2)
 If Type="U" S:X Ret=X_" "_$P(^KLIS(^KLIS1(X),0),D,2)
 If Type="B" S:X Ret=$O(^HULP(%J,"BP"_X,9999),-1)_" produkt(en)"
 If Type="E" S:X Ret=$O(^HULP(%J,"EP"_X,9999),-1)_" test(en)"
 Quit Ret
DISPLKL(Fld)  ; Tonen van een klant selectie kenmerk
 Set Type=$$GET^vhScherm(Fld-1)
 Set Ret=""
 If Type="R" S:X Ret="R0"_X_" "_$P(^POP("D","KLREGIO",X),D,2)
 If Type="U" S:X Ret=X_" "_$P(^KLIS(^KLIS1(X),0),D,2)
 If Type="B" S:X Ret=$O(^HULP(%J,"BK"_X,9999),-1)_" klant(en)"
 If Type="E" S:X Ret=$O(^HULP(%J,"EK"_X,9999),-1)_" test(en)"
 Quit Ret
GETPR(Fld) ; Ingave van een bepaald produkt selectie kenmerk
 Set Type=$$GET^vhScherm(Fld-1)
 Set Val=$$GET^vhScherm(Fld)
 If "BE"[Type,$L(Type) Set Tabel=Val Set:'Tabel (Tabel,SelCnt)=SelCnt+1
 If Type="K" S X=$$SELECT^KLASS(-3,1,Val,"","Beperkt tot klassificatie") S X=X
 If Type="L" S X=$$SELECT^LEVER(1,Val,"Beperkt tot leverancier : ")
 If Type="U" S X=$$SELECT^UTILI("PR",Val,"Beperkt tot UTILI-Data : ")
 If Type="B" S X=$$BEPAALDE^UTILI("PR","^HULP("_%J_",""BP"_Tabel_""")","","Verkoop analyze") Do PAINT^vhScherm Set X=$S($D(^HULP(%J,"BP"_Tabel))>1:Tabel,1:0)
 If Type="E" D EENMALIG^UTILI("PR","^HULP("_%J_",""EP"_Tabel_""")","","Verkoop analyze") Do PAINT^vhScherm Set X=$S($D(^HULP(%J,"EP"_Tabel))>1:Tabel,1:0)
 Set:'X X=""
 Quit
GETKL(Fld)  ; Ingave van een bepaald klant selectie kenmerk
 New Tabel
 Set Type=$$GET^vhScherm(Fld-1)
 Set Val=$$GET^vhScherm(Fld)
 If "BE"[Type,$L(Type) Set Tabel=Val Set:'Tabel (Tabel,SelCnt)=SelCnt+1
 If Type="R" D LIST^POP("KLREGIO",Val,21,"Beperkt to Regio","KPF")
 If Type="U" S X=$$SELECT^UTILI("KL",Val,"Beperkt tot UTILI-Data : ")
 If Type="B" S X=$$BEPAALDE^UTILI("KL","^HULP("_%J_",""BK"_Tabel_""")","","Verkoop analyze") Do PAINT^vhScherm Set X=$S($D(^HULP(%J,"BK"_Tabel))>1:Tabel,1:0)
 If Type="E" D EENMALIG^UTILI("KL","^HULP("_%J_",""EK"_Tabel_""")","","Verkoop analyze") Do PAINT^vhScherm Set X=$S($D(^HULP(%J,"EK"_Tabel))>1:Tabel,1:0)
 Set:'X X=""
 Quit