RPLAANK ;Raadplegen aankoop gedrag [ 03/07/2002  1:58 PM ]
 
 ; Nachtelijke JOB
JOB D ^cA604
 Set %J=$$%J^vhRtn1()
 Do PRIO^vhINITML("L")
 Set ^KBA("KG")=1
 Set KLNr=0
 Set BeginH=$P($H,",",2)
 For   Set KLNr=$O(^KSTKL(KLNr)) Quit:KLNr=""  Do FETCH(KLNr),ANAL(KLNr)
 Set EndH=$P($H,",",2)
 Set $P(^KKAAP(0),D,10)="RPLAANK Tijd : "_(EndH-BeginH)
 Set ^KBA("KG")=0
 Quit
 
ONE(KLNr,OnePRNr,Debug) 
 ;OnePRNr = Undefined of False, dan ganse klant
 ;        = 1, dan wordt er gevraagd naar PRNr door SELECT ^PRODUKT
 ;        = PRNr, dan wordt alleen dat produkt berekend
 New %J,Periode,Dat,FAKNr,PRNr,Lijn,LijnNr,ULNr,Week
 New FirsWeek,LastWeek,Mean,Cnt,Period,Qty,OldQty,NewQty,Faktor,HWeek,SpilWeek
 Do:'$D(Q) 
 .New KLNr,Debug,OnePRNr
 .Set Q="K"
 .Do ^cA604
 Set %J=$$%J^vhRtn1()
 Set:'$G(KLNr) KLNr=$$SELECT^KLANT6(1)
 If $G(OnePRNr),$L(OnePRNr)<2 Set OnePRNr=$$SELECT^PRODUKT6()
 Do FETCH(KLNr,$G(OnePRNr)),ANAL(KLNr)
 Quit
 
DISP(KLNr,OnePRNr) 
 New %J,Periode,Dat,FAKNr,PRNr,Lijn,LijnNr,ULNr,Week,IsStore
 New FirsWeek,LastWeek,Mean,Cnt,Period,Qty,OldQty,NewQty,Faktor,HWeek,SpilWeek
 New LD,DL
 Do:'$D(Q) 
 .New KLNr,OnePRNr 
 .Set Q="K"
 .Do ^cA604
 Set %J=$$%J^vhRtn1()
 Set IsStore=""
 Do FETCH(KLNr,OnePRNr)
 Do ANAL(KLNr)
 For Dat=($H-356):7:$H  Do
 .Set Week=$$CALCDATE^vhDTyp(Dat,"W","MD")
 .Set ^HULP(%J,OnePRNr,Week)=$G(^HULP(%J,OnePRNr,Week))
 Set Week="",I=0
 For  Set Week=$O(^HULP(%J,OnePRNr,Week),-1) Quit:Week=""  Do
 .Set I=I+1
 .Set Rec=Week_D_^HULP(%J,OnePRNr,Week)
 .Set Param=$T(@("PAR"_I))
 .If $L(Param) Do
 ..X "Set $P(Rec,D,3)="_$P(Param,";",2)
 ..X "Set $P(Rec,D,4)="_$P(Param,";",3)
 .Set ^HULP(%J,"L",I)=Rec
 Kill ^HULP(%J,OnePRNr)
 Do INIT^PROC("RPLKLKGA2","LD"),WL^PROC
 For  Do SL^PROC Quit:R?.A!($L(R)&("ENTER,-"[R))
 Quit
 
PAR1 ;"KortTekst";$P(^KPR(OnePRNr,0),D,1)
PAR3 ;"Aantal aankopen";Cnt+1
PAR5 ;"Gemmid #weken tssn aankoop";$S(Cnt:$J(Mean/Cnt,0,1),1:"")
PAR6 ;"#weken * "_$J(VermFak,1,1);Period
PAR8 ;"Huidige week";$$EXTDATE^vhDTyp($H,"DW")
PAR9 ;"Recenste aankoop week";$$EXTDATE^vhDTyp(LastWeek,"DW")
PAR10 ;"Spil week";$$EXTDATE^vhDTyp(SpilWeek,"DW")
PAR12 ;"Qty vòòr spil (oud)";$J(Qty,0,0)
PAR13 ;"Qty na spil (recent)";NewQty
PAR14 ;"Faktor";Faktor
PAR15 ;"Gegevens opgeslagen";$S(IsStore:"Ja",1:"Nee")
 
 
FETCH(KLNr,OnePRNr) 
 Set Periode=-($H-356)
 Set:'$G(OnePRNr) OnePRNr=""
 Kill ^HULP(%J)
 Set (Dat,FAKNr)=""
 For  Set Dat=$O(^KFA1("F",KLNr,Dat)) Quit:Dat=""  Quit:Dat>Periode  Do
 .For  Set FAKNr=$O(^KFA1("F",KLNr,Dat,FAKNr)) Quit:FAKNr=""  Do
 ..Set ULNr=0 For  Set ULNr=$O(^KFA("F",FAKNr,ULNr)) Quit:ULNr=""  Do
 ...Set Week=$$CALCDATE^vhDTyp($$INTDATE^vhDTyp($P(^KFA("F",FAKNr,ULNr,1),D,2),"DK"),"W","MD")
 ...Set LijnNr=0
 ...For  Set LijnNr=$O(^KFA("F",FAKNr,ULNr,LijnNr)) Quit:LijnNr=""  Do
 ....Set Lijn=^(LijnNr)
 ....Quit:$P(Lijn,D,17)'="KF6"
 ....Set PRNr=$P(Lijn,D,2)
 ....If OnePRNr Quit:PRNr'=OnePRNr
 ....Set:$P(Lijn,D,3)>0 ^HULP(%J,PRNr,Week)=$G(^HULP(%J,PRNr,Week))+$P(Lijn,D,3)
 Quit
 
ANAL(KLNr) 
 Set HWeek=$$CALCDATE^vhDTyp($H,"W","MD")
 Set (PRNr,Week)=""
 For  Set PRNr=$O(^HULP(%J,PRNr)) Quit:PRNr=""  Do
 .Set (Cnt,Mean,LastWeek)=0
 .Set (Period,Qty,OldQty,NewQty,Faktor,SpilWeek)=""
 .Set (FirsWeek,LastWeek)=$O(^HULP(%J,PRNr,Week))
 .For  Set Week=$O(^HULP(%J,PRNr,Week)) Quit:Week=""  Do
 ..Set Cnt=Cnt+1
 ..Set Mean=Mean+(Week-LastWeek/7)
 ..Set LastWeek=Week
 .If Cnt<2!(LastWeek<($H-(26*7))) Do EMPTY(KLNr,PRNr) Quit
 .Set Period=Mean/Cnt
 .Set:Period>10 VermFak=1.1
 .Set:Period>5&(Period'>10) VermFak=1.3
 .Set:Period'>5 VermFak=1.5
 .Set Period=$J(Period*VermFak,"",0)
 .Set:Period<4 Period=4
 .Set:Period>30 Period=""
 .If Period="" Do EMPTY(KLNr,PRNr) Quit
 .Set Week=HWeek-(Period+26*7)-1
 .Set:Week<FirsWeek Week=FirsWeek-1
 .Set OldPer=HWeek-Week-1/7-Period
 .Set:OldPer<Period OldPer=Period
 .Set SpilWeek=HWeek-(Period*7)
 .Set (OldQty,NewQty)=""
 .For  Set Week=$O(^HULP(%J,PRNr,Week)) Quit:Week=""  Quit:Week'<SpilWeek  Do
 ..Set OldQty=OldQty+^(Week)
 .Set Week=SpilWeek-1
 .For  Set Week=$O(^HULP(%J,PRNr,Week)) Quit:Week=""  Do
 ..Set NewQty=NewQty+^(Week)
 .If 'NewQty,'OldQty Do EMPTY(KLNr,PRNr) Quit
 .Set Faktor=0,Qty=OldQty*Period/OldPer
 .Set:Qty Faktor=$J(NewQty-Qty/Qty*5,0,0)
 .Set:Faktor<-5 Faktor=-5
 .Set:Faktor>5 Faktor=5
 .Do STORE(KLNr,PRNr,Faktor)
 Quit
 
STORE(KLNr,PRNr,Faktor) 
 New I,Rec,HG,GR,SG,KT,Value,Stuks,Ref
 Set I=$O(^KPR(PRNr,"I")) Quit:$E(I)'="I"
 Set Rec=^KPR(PRNr,I)
 Set HG=$P(Rec,D,1),GR=$P(Rec,D,2),SG=$P(Rec,D,3)
 Set KT=$$COMPR^PRODUKT(PRNr)
 Set IsStore=1
 Do DEBUG(1):$G(Debug)
 Quit:'$D(^KKAAP(KLNr,HG,GR,SG,KT))
 Set $P(^(KT),D,17)=Faktor
 For Ref=0:1:5 Do  
 .Set Stuks=$P($G(^KSTKL(KLNr,PRNr,$$EXTDATE^vhDTyp($$CALCDATE^vhDTyp($H,"M",-Ref),"DM4")_" ")),D,1)
 .Set $P(^KKAAP(KLNr,HG,GR,SG,KT),D,18+Ref)=Stuks
 .Set Value(-Ref)=Stuks
 Quit
 
EMPTY(KLNr,PRNr) 
 New I,Rec,HG,GR,SG,KT
 Set I=$O(^KPR(PRNr,"I")) Quit:$E(I)'="I"
 Set Rec=^KPR(PRNr,I)
 Set HG=$P(Rec,D,1),GR=$P(Rec,D,2),SG=$P(Rec,D,3)
 Set KT=$$COMPR^PRODUKT(PRNr)
 Do DEBUG(0):$G(Debug)
 Quit:'$D(^KKAAP(KLNr,HG,GR,SG,KT))
 Set $P(^(KT),D,17,23)="\\\\\\"
 Quit
 
DEBUG(IsStore) 
   
 Write !!,$P(^KPR(PRNr,0),D,1),?40,PRNr,?50,KLNr,@F2
 Write !,"Cnt= ",Cnt,?40,"Som Weken= ",Mean,@F2
 Write !,"Gemmid Weken= ",$S(Cnt:$J(Mean/Cnt,0,1),1:""),?40,"Weken*1.5= ",Period,@F2
 Write !,"Laatste Wk= ",$$EXTDATE^vhDTyp(LastWeek,"DW"),?40,"Huid Wk= ",$$EXTDATE^vhDTyp($H,"DW"),@F2
 Write !,"Terug blik= ",$$EXTDATE^vhDTyp(HWeek-(Period+26*7),"DW"),?40,"Spil Wk= ",$$EXTDATE^vhDTyp(SpilWeek,"DW"),@F2
 Write !,"Qty  Terugblik= ",OldQty,@F2
 Write !,"Qty  Vroeger= ",$J(Qty,0,0),?40,"Qty  Nu= ",NewQty,@F2
 Write !,"Faktor= ",Faktor,?40,"Store=  ",$S(IsStore:"DATA",1:"EMPTY"),@F2
 Quit