PRFUSIE3 ;Produkt Fusie van de afgeleide producten met de generische producten [ 12/27/2003  2:25 PM ]
 
 Kill
 Set Q="K"
 Do ^cA604
 Set Max=500
 Set %J=$$%J^vhRtn1()
 Kill ^HULP(%J)
 Set EndPRNr=$O(^KPR(""),-1)-50000
 For  Do  Quit:'OneDone
 . Set OneDone=0
 . Set Cnt=0
 . Kill VanPRNr
 . Set MemGenPR=""
 . Set AfglPRNr=0
 . Set OmzetMaand=$$EXTDATE^vhDTyp($$CALCDATE^vhDTyp($H,"M",-8),"DM4")_" " 
 . Set OfferteMnd=""
 . For  Set AfglPRNr=$O(^KPR(AfglPRNr)) Quit:AfglPRNr=""  Do  Quit:AfglPRNr>EndPRNr
 .. Set GenPRNr=$P(^KPR(AfglPRNr,0),D,3)
 .. Quit:'GenPRNr  ; Geen afgeleid product
 .. If MemGenPR?4.7N,GenPRNr'=MemGenPR Quit  ; Niet de goede
 .. If '$D(^KPR(GenPRNr)) Write AfglPRNr," generisch product "_GenPRNr_" bestaat niet",! Quit
 .. Set Rede=$$CheckDelAfgeleid(AfglPRNr)
 .. Write:MemGenPR?4.7N AfglPRNr,"->",GenPRNr," ",$P(^KPR(GenPRNr,0),D,1),"  ",Rede,!
 .. Quit:$L(Rede)	
 .. Kill ^HULP(%J)
 .. Set MemGenPR=GenPRNr
 .. Set VanPRNr(AfglPRNr)=""
 .. Set Cnt=Cnt+1
 .. If Cnt=Max Do  ; Per max uitvoeren van de fusie
 ... Do FUSIE(.VanPRNr,GenPRNr)
 ... Kill VanPRNr
 ... Set Cnt=0
 ... Set OneDone=1
 . If Cnt Do  ; De achtergebleven ook afwerken
 .. Do FUSIE(.VanPRNr,GenPRNr)
 .. Kill VanPRNr
 .. Set Cnt=0
 .. Set OneDone=2
 Kill ^HULP(%J)
 Quit
 
CheckDelAfgeleid(PRNr,DagenOmzet,DagenCreatieZndOmzet)
 Set Del=""
 Set:$$INTDATE^vhDTyp($P($G(^KSTPR(PRNr,0,0)),D))>($H-$G(DagenOmzet,300)) Del="O" ; Omzet recenter dan X dagen
 Set Datum=+$P($P(^KPR(PRNr,2),D,17),"#",2)
 Set:Del=""&&(Datum>($H-$G(DagenCreatieZndOmzet,200))) Del="N" ; Het product is te recent gecreeerd
 Set:Del="" Del=$$CHECKDEL^PRODUKT2(PRNr,"OFSTZWKPE")
  ; Indien leeg dan mag het verwijderd worden
 Quit Del
 
FUSIE(VanPRNr,NaarPRNr) 
 ; VanPRNr via .Local
 New VAN,NAAR,NoAsk,NoDel
 Write "FUSIE",!
 Lock +^KSTKL:5 Else  Quit
 Lock +^KSTPR:5 Else  Quit
 Lock +^KLKAN:5 Else  Quit
 Lock +^KPR:5 Else  Quit
 Lock +^KSPW:5 Else  Quit
 If $G(VanPRNr)?4.7N Set VAN(VanPRNr)="" ; Produkt rechtstreeks
 Else  Merge VAN=VanPRNr ; via lijst
 Set NAAR(NaarPRNr)="\1\1"
 Set NoAsk=1
 Set NoDel=0
 Set NoPakket=1
 ;zw NAAR
 ;zw VAN r k
 Do FUSIE^PRFUSIE2
 Lock
 Quit