KKANAL ;Klant-Produkt verkoop analyze [ 02/21/2002  4:44 PM ]
 Goto COMMAND
 
INIT Set %J=$$%J^vhRtn1
 Kill ^HULP(%J)
 Do INIT^PROC("KKANAL")
 Set KKANAL(2,1)=^LD("L","KKANALT")
 Set SelCnt=0
 Do BEPERK(1) Quit:'%SC
 Do SORT
 Set (Input,Screen)=""
 Quit
 
COMMAND Do INIT
 Quit:'%SC
 For  Quit:Input="-"  Do
 .Do REFRESH
 .Do SL^PROC
 .Set Input=R
 .If R="COM" Do CALL^vhMenu("KKANAL")
 .Do:$L(Input) EXEC^vhMenu("KKANAL",.Input)
 .;If Input="HELP" Do HELP
 .If Input="B" Do BEPERK(0),SORT:%SC
 .If Input="S" Do SORT 
 .If Input="E" Do ETIKET
 .If Input="M" Do EMAIL
 .If Input="R" Do RAPPORT
 .If Input="PRINT" Do PRINT
 .If Input="K" Do RAADPL
 .If Input="L" Do KLANTFICHE
 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
 Kill BS Set BS=0
 D BLDCHK("KL")
 D BLDCHK("PR")
 Set BS=BS+2 ; 2 erbij dit voor SORT
 Do FETCH
 Do ADD^vhScherm(1,24)
 Do WRITEL("Totaal",$P(^HULP(%J,"V"),D,2),$P(^HULP(%J,"V"),D,1),$P(^HULP(%J,"H"),D,1),1)
 Set (Totaal(2),Totaal(3))=""
 Set KKANAL(3)=5,KKANAL(4)=24-4
 Quit
 
SORT Do INIT^PROC("KKANAL")
 Set KKANAL(2,1)=^LD("L","KKANALT")
 Kill ^HULP(%J,"L")
 Do REFRESH
 Do EDIT^vhScherm("KKANAL2")
 Set %SC=1
 Do SORTVW
 Set BS=BS-2
 Set:$P($G(BS(BS)),D,2)["(Lijst)" BS=BS-1
 If $L(Totaal(2)) Do  ; Er is een beperking
 .Set B=$P(Sort,D,2)
 .Set B=$P(^POP("D","KKANALB",B),D,2)
 .Set B=$P(B,"x")_$TR($FN($P(Sort,D,1),"-",0),".,",",.")_$P(B,"x",2)
 .Set BS=BS+1,BS(BS)="\Beperkt (Lijst)\:\"_B_"\1"
 Set B=$P(Sort,D,3)
 Set B=$P(^POP("D","KKANALS",B),D,2)
 Set BS=BS+1,BS(BS)="\Sortering\:\"_B_"\1"
 Set BS=BS+1,BS(BS)=""
 If '$L(Totaal(2)) Set KKANAL(3)=5,KKANAL(4)=24-4
 Else  Set KKANAL(3)=7,KKANAL(4)=24-6
 ;Kill Sort
 Do ADD^vhScherm(4,24)
 Quit
 
 ; Merge met KLETIKET
ETIKET Do MERGE^KLETIKET("^HULP("_%J_",""L"")","S Key=$P(Rec,D,1)")
 Do ADD^vhScherm(1,24)
 Quit
 ; Merge met KLETIKET
EMAIL Do EMAILMERGE^PERS("^HULP("_%J_",""L"")","S Key=$P(Rec,D,1)")
 Do ADD^vhScherm(1,24)
 Quit
 
 ; Merge met geldige bezoeken VERSLAGEN
RAPPORT Do PRINT^RAPPORT($NA(^HULP(%J,"L")),1)
 Do ADD^vhScherm(1,24)
 Quit
 
PRIJSLST
 Do STORE^vhTERMINA()
 Do ##class(CHUI.Flow.PrijsLijst).SelectedCust($NA(^HULP(%J,"L")))
 Do REFRESH^vhTERMINA()
 Quit
 
PRINT ; Afdrukken op laserprinter of printer
 Set KKANAL(2,2)="$P(BS(SCnt),D,1);R;L;4;; \$P(BS(SCnt),D,2);C;L;25;; ;$P(BS(SCnt),D,5)\$P(BS(SCnt),D,3);C;L;1;; \$P(BS(SCnt),D,4);C;L;45;;;;X,SCnt=SCnt+1"
 Set KKANAL(11)="Statistiek : Verschil omzet"
 Set $P(KKANAL(11),D,2)="Periode van : "_$$EXTDATE^vhLib.DataTypes($P(Select,D,1),"DM")_" tot : "_$S($P(Select,D,2):$$EXTDATE^vhLib.DataTypes($P(Select,D,2),"DM"),1:"NU")
 Set KKANAL(10)="CB^KKANAL"
 Set SCnt=1
 Do PRINT^OUTPUT(.KKANAL,"SPT","S")
 Kill KKANAL(10),KKANAL(2,2)
 Quit
CB(Ref) ; Callback voor OUTPUT
 Set Ret=""
 If Ref="B" Do  ; Begin met de beperkingen
 .For I=1:1:BS Set Ret=Ret_"\;2"
 .Set $E(Ret)=""
 If Ref="E" Do  ; Einde met de totalen
 .Set Node=1,FL(3)=""
 .Set:$L(Totaal(2)) Ret="BR;\;1\;1\;1"
 .Set:'$L(Totaal(2)) Ret="BR;\;1"
 Quit Ret
 
REFRESH ; Herstellen scherm
 New FL
 If sRT<2 Write @F11,@FMTI,"Klant omzet verschillen - "_QN,@FMTi,@F2 
 If sRT<3,sRB>1 Set FP=201 Write @F,@FMTI,$J("",80),@FMTi
 If sRT<4,sRB>2 Set FL(1)=KKANAL(2,1),FL(2)=301,Node=1 Do FL^PROC W @F2
 If $L(Totaal(2)) Do
 .If sRT<5,sRB>3 Set FL(1)=KKANAL(2,1),FL(2)=401,Node=2 Do FL^PROC W @F2
 .If sRT<6,sRB>4 Set FL(1)=KKANAL(2,1),FL(2)=501,Node=3 Do FL^PROC W @F2
 .If sRB>5 Set DL(2)=sRT,DL(3)=sRB Do WL^PROC  Kill DL(2),DL(3)
 If '$L(Totaal(2)) Do
 .If sRB>3 Set DL(2)=sRT,DL(3)=sRB Do WL^PROC  Kill DL(2),DL(3)
 Do RESET^vhScherm
 Quit
 
WRITEL(Titel,Klanten,OmzetV,OmzetH,Node) 
 Set Totaal(Node)=Klanten_D_Titel_D_OmzetV_D_OmzetH
 Quit
 
RAADPL  
 Quit:'KKANAL(6)
 Set Rec=$G(^HULP(%J,"L",KKANAL(6)))
 Quit:'$P(Rec,D,1)
 Set Screen=$$RAADPL^KLANT($P(Rec,D,1),$P(Screen,D,1))
 Do ADD^vhScherm(1,24)
 Quit
 
KLANTFICHE
 Quit:'$D(^HULP(%J,"K"))
 Do STORE^vhTERMINA()
 Set lbKLNrs="",KLNr=""
 For  Set KLNr=$O(^HULP(%J,"K",KLNr)) Quit:KLNr=""  Do
 . Set lbKLNrs=lbKLNrs_$LB(KLNr)
 Do ##class(CHUI.Derde.Klant.FicheDoc).PrintKlantFiches(lbKLNrs)
 Do REFRESH^vhTERMINA()
 Quit
 
HELP ; Oproep van Menu en HELP
 Set R=""
 Do POP^MN("KKANAL")
 Set Input=R
 If Input'="HELP" Do REFRESH Quit
 New HLP
 Set HLP(1)="KKANAL"
 Set HLP(3)=9
 Do ^HELP
 Do ADD^vhScherm(9,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,SelKL,AantalKL)=0
 Kill ^HULP(%J,"H"),^HULP(%J,"V"),^HULP(%J,"K")
 Set KLNr=1
 Write @FCH
 For  Set KLNr=$O(^KSTKL(KLNr)) Quit:KLNr=""  Do
 .If AantalKL#5=0 Set FP=2221 Write @F,AantalKL,"/",SelKL
 .Set AantalKL=AantalKL+1
 .Do FETCHKL^UTILI(KLNr)
 .;B:KLNr=2671
 .Do KLANT(KLNr):$$CHECK^UTILI("Check(""KL"")")
 .;B:KLNr=2671
 Write @FCS
 Set ^HULP(%J,"H")=TotH_D_SelKL
 Set ^HULP(%J,"V")=TotV_D_SelKL
 Quit
 
KLANT(KLNr) 
 Set PRNr=1
 Set Tot=""
 If Check("PR")=1 Do
 .Do MAAND(KLNr,0,BMH,EMH,0)
 .Do MAAND(KLNr,0,BMV,EMV,10)
 Else  For  Set PRNr=$O(^KSTKL(KLNr,PRNr)) Quit:PRNr=""  Do
 .Do FETCHPR^UTILI(PRNr)
 .Quit:'$$CHECK^UTILI("Check(""PR"")")
 .Do MAAND(KLNr,PRNr,BMH,EMH,0)
 .Do MAAND(KLNr,PRNr,BMV,EMV,10)
 If '$P(Tot,D,3),'$P(Tot,D,13) Quit
 Set SelKL=SelKL+1
 For I=3,4,6,13,14,16 Set $P(Tot,D,I)=$J($P(Tot,D,I),0,0)
 Set ^HULP(%J,"K",KLNr)=Tot
 Set TotV=TotV+$P(Tot,D,13)
 Set ^HULP(%J,"V",555555555-$P(Tot,D,13)_" "_KLNr)=$P(Tot,D,3)
 Set TotH=TotH+$P(Tot,D,3)
 Set ^HULP(%J,"H",555555555-$P(Tot,D,3)_" "_KLNr)=$P(Tot,D,13)
 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)
 .For I=1,3,4,6 Set $P(Tot,D,Node+I)=$P(Tot,D,Node+I)+$P(Rec,D,I)
 Quit
 
 ; Verwerking van de sortering
SORTVW  
 Set Qty=$P(Sort,D,1)
 Set Type=$P(Sort,D,2)
 If "PR"[Type Set Qty=Qty/100
 If 'Qty Set Type=""
 Set SInd=$P(Sort,D,3)
 Set Node=$S(SInd="H"!(SInd="K"):"H",1:"V")
 Kill ^HULP(%J,"L")
 Set P=""
 Set STot=^HULP(%J,Node),(Tot2,Tot,Cnt,Rest)=0
 For  Set P=$O(^HULP(%J,Node,P)) Quit:P=""  Do
 .Set Rec=^(P)
 .Set Omz=555555555-P
 .If Type="O",Omz<Qty Set P="a" Quit  ; Stoppen omzet wordt kleiner dan gewenst
 .If Type="K",Omz'<Qty Quit  ; Alleen klanten met omzet kleiner
 .If Type="P",Tot/STot'<Qty Set P="a" Quit  ;Stoppen x% klanten gehad
 .If Type="R",Rest/STot<Qty Set Rest=Rest+Omz Quit  ; Lijsten na de x% klanten    
 .If Type="T",Cnt+1>Qty Set P="a" Quit  ; Lijsten tot eerste x klanten 
 .If Type="V",Rest+1'>Qty Set Rest=Rest+1 Quit  ; Lijsten vanaf eerste x klanten 
 .Set Tot=Tot+Omz,Tot2=Tot2+$P(Rec,D)
 .Set KLNr=$P(P," ",2)
 .Set Cnt=Cnt+1 ; SelKL
 .If SInd="K" Set ^HULP(%J,"L",^KK1(KLNr))=KLNr
 .If SInd="O" Set ^HULP(%J,"L",Cnt)=KLNr
 .If SInd="H" Set ^HULP(%J,"L",Cnt)=KLNr
 .If SInd="V" Set ^HULP(%J,"L",555555555+($P(Rec,D)-Omz)_" "_KLNr)=KLNr_D_Cnt
 .If SInd="P" Set ^HULP(%J,"L",555555555+($P(Rec,D)-Omz/$S(Omz:Omz,1:1)*100)_" "_KLNr)=KLNr_D_Cnt
 Set SelKL=Cnt
 If Node="V" Set OmzetV=Tot,OmzetH=Tot2
 If Node="H" Set OmzetV=Tot2,OmzetH=Tot
 Set ^HULP($J,"L")=SelKL_D_OmzetH_D_OmzetV
 Set (Totaal(2),Totaal(3))=""
 Do:$P(^HULP(%J,"V"),D,2)'=SelKL WRITEL("Beperkt (Lijst)",SelKL,OmzetV,OmzetH,2)
 Do:$P(^HULP(%J,"V"),D,2)-SelKL WRITEL("Rest",$P(^HULP(%J,"V"),D,2)-SelKL,$P(^HULP(%J,"V"),D,1)-OmzetV,$P(^HULP(%J,"H"),D,1)-OmzetH,3)
 If "KVP"[SInd Do RL^PROC1
 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)
 If '$D(T) Set Check(Bestand)=1 Quit
 Set (IfString,Type,Cnt,I,Boolean)=""
 Set BS=BS+1,BS(BS)="\Beperking op "_$S(Bestand="KL":"Klanten",1:"Produkten")_"\\\1"
 For  Set Type=$O(T(Type)) Quit:Type=""  Do
 .Set:$L(IfString) Boolean="EN"
 .Set IfString=IfString_"&("
 .For  Set I=$O(T(Type,I)) Quit:I=""  Do @("BLD"_Bestand_Type) Set IfString=IfString_"!",Boolean="OF"
 .Set IfString=$E(IfString,1,$L(IfString)-1)_")"
 Set IfString=$E(IfString,2,999)
BLDCHK2 Set Check(Bestand)=$S($L(IfString):IfString,1:1)
 Quit
BLDKLR ;Check local : Klant Regio
 Set X=$P(T(Type,I),D)
 Set BS=BS+1,BS(BS)=Boolean_"\  Regio\:\"_"R0"_X_" "_$P(^RES("KLANT","PI","REGIO","D",X),"`",2)
 Set Cnt=Cnt+1,Check(Bestand,Cnt)="3;"_X_";;;120"
 Set IfString=IfString_"T("_Cnt_")"
 Quit
BLDPRK ;Check local : Produkt Klassificatie
 Set X=$P(T(Type,I),D)
 Set BS=BS+1,BS(BS)=Boolean_"\  Klassificatie\:\"_$$DISPL^KLASS(+X,1)
 Set Cnt=Cnt+1,Check(Bestand,Cnt)="3;"_$$GETSORT^KLASS(X)_";;;I0"_$P(T(Type,I),D,2)
 Set IfString=IfString_"T("_Cnt_")"
 Quit
BLDPRL ;Check local : Produkt Leverancier
 Set X=$P(T(Type,I),D)
 Set BS=BS+1,BS(BS)=Boolean_"\  Leverancier\:\"_X_" "_$P(^KLE(^KL1(X),0),D,2)
 Set Cnt=Cnt+1,Check(Bestand,Cnt)="3;"_X_";;;J01"
 Set IfString=IfString_"T("_Cnt_")"
 Quit
BLDKLB ;Check local : Bepaalde klant/produkt
BLDPRB Set Cnt=Cnt+1
 Set BS=BS+1,BS(BS)=Boolean_"\  Bepaalde "_$S(Bestand="KL":"Klanten",1:"Produkten")_"\:\..."
 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 BS=BS+1,BS(BS)=Boolean_"\  Eenmalige selectie\:\..."
 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 X=$P(T(Type,I),D)
 Set UTLId=^KLIS1(X)
 Set BS=BS+1,BS(BS)=Boolean_"\  UTILI-Data selectie\:\"_X_" "_$P(^KLIS(UTLId,0),D,2)
 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(^RES("KLANT","PI","REGIO","D",X),"`",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" S X=$$PI^vhPOPUP("C;C","KO-1B","Beperkt tot Regio","KLANT","REGIO",Val)
 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&(Type'="R") X=""
 Quit