KLKAN ;Klant Kodex verkoopanalyze [ 11/07/2001  1:36 PM ]
 
 Goto COMMAND
 
INIT S Q="K" D ^cA604,INIT^vhTERMINA Set %J=$$%J^vhRtn1 
 Kill ^HULP(%J)
 Do INIT^PROC("KLKAN")
 Set KLKAN(2,1)=^LD("L","KLKANT")
 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 Input="HELP" Do HELP
 .If Input="B" Do BEPERK(0),SORT:%SC
 .If Input="S" Do SORT 
 .If Input="E" Do ETIKET
 .If Input="PRINT" Do PRINT
 .If Input="K" Do RAADPL
 Quit
 
BEPERK(First) 
 If 'First Do EDIT^vhScherm("KLKAN",1,24,"H") Quit:'%SC
 If First Do NIEUW^vhScherm("KLKAN",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)
 Set KLKAN(3)=5,KLKAN(4)=24-4
 Quit
 
SORT Do INIT^PROC("KLKAN")
 Set KLKAN(2,1)=^LD("L","KLKANT")
 Kill ^HULP(%J,"L")
 Do REFRESH
 Do EDIT^vhScherm("KLKAN2")
 Set %SC=1
 Do SORTVW
 Set BS=BS-2
 Set:$P($G(BS(BS)),D,2)["(Lijst)" BS=BS-1
 If $L(Tot(2)) Do  ; Er is een beperking
 .Set B=$P(Sort,D,2)
 .Set B=$P(^POP("D","KLKANB",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","KLKANS",B),D,2)
 Set BS=BS+1,BS(BS)="\Sortering\:\"_B_"\1"
 Set BS=BS+1,BS(BS)=""
 If '$L(Tot(2)) Set KLKAN(3)=5,KLKAN(4)=24-4
 Else  Set KLKAN(3)=7,KLKAN(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
 
PRINT ; Afdrukken op laserprinter of printer
 Set KLKAN(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;50;;;;X,SCnt=SCnt+1"
 Set KLKAN(11)="Statistiek : Omzet per kodex"
 Set $P(KLKAN(11),D,2)="Periode van : "_$$EXTDATE^vhDTyp($P(Select,D,1),"DM")_" tot : "_$S($P(Select,D,2):$$EXTDATE^vhDTyp($P(Select,D,2),"DM"),1:"NU")
 Set KLKAN(10)="CB^KLKAN"
 Set SCnt=1
 Do PRINT^OUTPUT(.KLKAN,"SPT","S")
 Kill KLKAN(10),KLKAN(2,2)
 Quit
 
CB(Ref) ; Callback voor OUTPUT
 Set Ret=""
 If Ref="B" D  ; Begin met de beperkingen
 .For I=1:1:BS Set Ret=Ret_"\;2"
 .Set $E(Ret)=""
 If Ref="E" D  ; Einde met de totalen
 .Set Node=1,FL(3)=""
 .Set:$L(Tot(2)) Ret="BR;\;1\;1\;1"
 .Set:'$L(Tot(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)=KLKAN(2,1),FL(2)=301,Node=1 Do FL^PROC W @F2
 If $L(Tot(2)) Do
 .If sRT<5,sRB>3 Set FL(1)=KLKAN(2,1),FL(2)=401,Node=2 Do FL^PROC W @F2
 .If sRT<6,sRB>4 Set FL(1)=KLKAN(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(Tot(2)) Do
 .If sRB>3 Set DL(2)=sRT,DL(3)=sRB Do WL^PROC  Kill DL(2),DL(3)
 Do RESET^vhScherm
 Quit
 
RAADPL  
 Quit:'KLKAN(6)
 Set Rec=$G(^HULP(%J,"K",KLKAN(6)))
 Quit:'$P(Rec,D,1)
 Set Screen=$$RAADPL^KLANT($P(Rec,D,1),$P(Screen,D,1))
 Do ADD^vhScherm(1,24)
 Quit
  
HELP ; Oproep van Menu en HELP
 Set R=""
 Do POP^MN("KLKAN")
 Set Input=R
 If Input'="HELP" Do REFRESH Quit
 New HLP
 Set HLP(1)="KLKAN"
 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=$$CALCDATE^vhDTyp($P(Select,D,1),"M",-12,"FD")
 Set EMV=$$CALCDATE^vhDTyp($P(Select,D,2),"M",-12,"LD")
 Set BMH=$$CALCDATE^vhDTyp($P(Select,D,1),"M","FD")
 Set EMH=$$CALCDATE^vhDTyp($P(Select,D,2),"M","LD")
 Set FP=2201 Write @F,@F1,"Klanten verwerkt : "
 Set (AantalKL,SelKL)=0 Write @FCH
 Kill ^HULP(%J,"L")
 Set KLNr=""
 Set (Tot(1),Tot(2),Tot(3))=""
 For  Set KLNr=$O(^KLKAN(KLNr)) Quit:KLNr=""  Do
 .If AantalKL#5=0 Set FP=2221 Write @F,AantalKL,"/",SelKL
 .Set AantalKL=AantalKL+1
 .Do FETCHKL^UTILI(KLNr) Quit:'$$CHECK^UTILI("Check(""KL"")")
 .Set Tot=""
 .Do KLANT(KLNr)
 .For I=1:3:15 Set $P(Tot,D,16)=$P(Tot,D,16)+$P(Tot,D,I)
 .For I=21:3:35 Set $P(Tot,D,36)=$P(Tot,D,36)+$P(Tot,D,I)
 .For I=1:3:18,21:3:38 Set $P(Tot(1),D,I)=$P(Tot(1),D,I)+$P(Tot,D,I)
 .Set ^HULP(%J,"K",KLNr)=Tot
 .Set ^HULP(%J,"H",5555555555-$P(Tot,D,16)\1_KLNr)=KLNr
 .Set ^HULP(%J,"V",5555555555-$P(Tot,D,36)\1_KLNr)=KLNr
 .Set SelKL=SelKL+1
 Set ^HULP(%J,"H")=$P(Tot(1),D,16)
 Set ^HULP(%J,"V")=$P(Tot(1),D,36)
 Set $P(Tot(1),D,40)=SelKL
LABEL Write @FCS
 Quit
 
KLANT(KLNr,BM,EM,Offset) 
 Set PRNr=1
 Set Tot=""
 If Check("PR")=1 Do
 .Do MAAND(KLNr,0,BMH,EMH,0)
 .Do MAAND(KLNr,0,BMV,EMV,20)
 Else  For  Set PRNr=$O(^KLKAN(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,20)
 Quit
 
MAAND(KLNr,PRNr,Begin,End,Node) 
 Set Mnd=Begin-1
 For  Set Mnd=$O(^KLKAN(KLNr,PRNr,Mnd)) Quit:Mnd=""  Quit:Mnd>End  Do 
 .Set Rec=^(Mnd)
 .For I=1:3:15 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
 Set Tot(2)=""
 For  Set P=$O(^HULP(%J,Node,P)) Quit:P=""  Do
 .Set KLNr=^(P),Rec=^HULP(%J,"K",KLNr)
 .Set Omz=$P(Rec,D,$S(Node="H":16,1:36))
 .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
 .For I=1:3:18,21:3:38 Set $P(Tot(2),D,I)=$P(Tot(2),D,I)+$P(Rec,D,I)
 .Set Cnt=Cnt+1 ; AantalKL
 .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",5555555555+($P(Rec,D)-Omz)_" "_KLNr)=KLNr_D_Cnt
 .If SInd="P" Set ^HULP(%J,"L",5555555555+($P(Rec,D)-Omz/Omz*100)_" "_KLNr)=KLNr_D_Cnt
 Set $P(Tot(2),D,40)=Cnt
 Set Tot(3)=""
 If Cnt=$P(Tot(1),D,40) Set Tot(2)=""
 Else  Do
 .For I=1:3:18,21:3:38,40 Set $P(Tot(3),D,I)=$P(Tot(1),D,I)-$P(Tot(2),D,I)
 .Set $P(Tot(3),D,40)=$P(Tot(1),D,40)-Cnt
 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 klassficitie") 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 X=""
 Quit