#include BL.Sys.FOP.Common
 
PRFUSIE2 ;Produkt fusioneren (data verwerking) [ 08/19/2003  3:28 PM ]
 ;VAN(PRNr) Bevat de produkten die moeten verwijderd worden
 ;    Piece 1 : Niet Telbaar (aantallen niet tellen)
 ;NAAR(PRNr) Bevat de produkten waar naar toe moet gefusioneerd worden
FUSIE Set NoAsk=$G(NoAsk)
 ;If 'NoDel,'$$DELWMS(.VAN) Set:'NoAsk R=$$^vhTXTPOP("PRFUSIE","NODELWMS") Quit
 If 'NoAsk Set FP=2201 Write @F,@F1,!,"Fusioneren van produkten"
 Do BS
 If 'NoAsk Set FP=2401 Write @F,"Historieken",@F2
 Do HIST
 If 'NoAsk Set FP=2401 Write @F,"Beweging ivm. Verkoop",@F2
 Do VKP
 If 'NoAsk Set FP=2401 Write @F,"Statistieken",@F2
 Do STAT
 If 'NoAsk Set FP=2401 Write @F,"Weekverkoop",@F2
 Do WVKP
 Do:'NoDel&&'$G(NoPakket) PAKKET ; Enkel indien verwijderen VAN-producten
 Do:'NoDel ALIAS ; Enkel indien verwijderen VAN-producten
 If 'NoAsk,'NoDel Set FP=2401 Write @F,"Verwijderen VAN-produkten",@F2
 Do LOG,DLOG
 Do DELVAN
 Do JOBNAAR
 Quit
 
 ; **** Halffabrikaten in HADPR("P" wijzigen ****
HALFFAB(PRLijst) 
 ; Via .Local doorgeven PRLijst(VanPRNr)=NaarPRNr
 
 If '$D(PRLijst) Do
 .Set FP=1801
 .Write @F,@F1,"Ingave VAN product (oud product)"
 .Set VanPRNr=$$SELECT^PRODUKT6()
 .Quit:VanPRNr'?4.7N
 .Write @F,@F1,"Ingave NAAR product (nieuw product)"
 .Set NaarPRNr=$$SELECT^PRODUKT6()
 .Quit:NaarPRNr'?4.7N
 .Set FP=1801
 .Write @F,@F1," VAN : ",VanPRNr," ",$P(^KPR(VanPRNr,0),"\")
 .Write !,"NAAR : ",NaarPRNr," ",$P(^KPR(NaarPRNr,0),"\")
 .Write !,"ENTER = Zoeken en vervangen    - =  Exit"
 .Read K
 .Quit:"-"
 .Set PRLijst(VanPRNr)=NaarPRNr
 Quit:'$D(PRLijst)
 New PRNr,HFCode,HFRec,HFPRNr
 Set PRNr=""
 For  Set PRNr=$O(^HADPR("P",PRNr)) Quit:PRNr=""  Do:$D(^HADPR("P",PRNr,"HF"))
 . Set HFCode=""
 . For  Set HFCode=$O(^HADPR("P",PRNr,"HF",HFCode)) Quit:HFCode=""  Do
 .. Set HFRec=^HADPR("P",PRNr,"HF",HFCode)
 .. Set HFPRNr=$P(HFRec,D)
 .. Quit:HFPRNr'?4.7N
 .. If $D(PRLijst(HFPRNr)) Do  ; Vervangen door NaarPRNr
 ... Write HFCode," ",PRNr," ",$P($G(^KPR(PRNr,0)),D),!
 ... Set $P(HFRec,D,10)=$P(HFRec,D,10)_$S($L($P(HFRec,D,10)):";",1:"")_HFPRNr ; Historiek info
 ... Set $P(HFRec,D,1)=PRLijst(HFPRNr) ; Oud product vervangen door nieuw
 ... Set ^HADPR("P",PRNr,"HF",HFCode)=HFRec
 Quit
 
 ; **** Statistiek KSTKL, KSTPR en KLKAN ****
 
STAT ; Statistiek
 For  Lock +^KSTKL:5 Quit:$T  Do LDISP^vhLock("^KSTKL")
 For  Lock +^KSTPR:5 Quit:$T  Do LDISP^vhLock("^KSTPR")
 For  Lock +^KLKAN:5 Quit:$T  Do LDISP^vhLock("^KLKAN")
 Kill ^HULP(%J,"S")
 Set PRNr=""
 For  Set PRNr=$O(VAN(PRNr)) Quit:PRNr=""  Do STATCOPY(PRNr,"S",'$P(VAN(PRNr),D,1),1)
 For  Set PRNr=$O(NAAR(PRNr)) Quit:PRNr=""  Do
 .Do STATDUPL($P(NAAR(PRNr),D,2),$P(NAAR(PRNr),D,3))
 .Do STATCOPY(PRNr,"T",1,0)
 .Do STATSAVE(PRNr)
 Lock -KSTKL,-KSTPR,-KLKAN
 Kill ^HULP(%J,"T"),^HULP(%J,"S")
 Quit
 
STATCOPY(PRNr,Node,TelB,RemLast) 
 Set KLNr=""
 For  Set KLNr=$O(^KSTPR(PRNr,KLNr)) Quit:KLNr=""  Do
 .If $$INTDATE^vhLib.DataTypes($P($G(^HULP(%J,Node,KLNr,0)),D),"DK")<$$INTDATE^vhLib.DataTypes($P($G(^KSTPR(PRNr,KLNr,0)),D),"DK") Do
 ..Set ^HULP(%J,Node,KLNr,0)=^KSTPR(PRNr,KLNr,0)
 ..Set:RemLast $P(^HULP(%J,Node,KLNr,0),2,6)="\\\\"
 .Set Mnd=0
 .For  Set Mnd=$O(^KSTPR(PRNr,KLNr,Mnd)) Quit:Mnd=""  Do
 ..Set From=^KSTPR(PRNr,KLNr,Mnd)
 ..Set To=$S($D(^HULP(%J,Node,KLNr,Mnd)):^(Mnd),1:"\\\\\\")
 ..Set:TelB $P(To,D,1)=$P(To,D,1)+$P(From,D,1)
 ..Set $P(To,D,2)=$P(To,D,2)+$P(From,D,2)
 ..Set $P(To,D,3)=$P(To,D,3)+$P(From,D,3)
 ..Set $P(To,D,4)=$P(To,D,4)+$P(From,D,4)
 ..Set:TelB $P(To,D,5)=$P(To,D,5)+$P(From,D,5)
 ..Set $P(To,D,6)=$P(To,D,6)+$P(From,D,6)
 ..Set From=$G(^KLKAN(KLNr,PRNr,$$INTDATE^vhLib.DataTypes($E(Mnd,1,7),"DM")))
 ..If From'="" For I=11:1:25 Set:$L($P(From,D,I-10)) $P(To,D,I)=$P(To,D,I)+$P(From,D,I-10)
 ..Set ^HULP(%J,Node,KLNr,Mnd)=To
 Quit
 
STATDUPL(DivAant,DivOmz) 
 Kill ^HULP(%J,"T")
 Set (KLNr,Mnd)=""
 For  Set KLNr=$O(^HULP(%J,"S",KLNr)) Quit:KLNr=""  Do
 .Set Mnd=0
 .Set ^HULP(%J,"T",KLNr,Mnd)=$G(^HULP(%J,"S",KLNr,Mnd))
 .For  Set Mnd=$O(^HULP(%J,"S",KLNr,Mnd)) Quit:Mnd=""  Do
 ..Set To=$G(^HULP(%J,"S",KLNr,Mnd))
 ..For I=1,5 Set $P(To,D,I)=$P(To,D,I)*DivAant\1
 ..For I=3,4,6 Set $P(To,D,I)=+$J($P(To,D,I)*DivOmz,0,2)
 ..If $P(To,D,11,25)'="" For I=11:1:25 Set:$L($P(To,D,I)) $P(To,D,I)=+$J($P(To,D,I)*DivOmz,0,2)
 ..Set ^HULP(%J,"T",KLNr,Mnd)=To
 Quit
 
STATSAVE(PRNr) 
 Kill ^KSTPR(PRNr)
 Set (KLNr,Mnd)=""
 For  Set KLNr=$O(^HULP(%J,"T",KLNr)) Quit:KLNr=""  Do
 .Kill:KLNr ^KSTKL(KLNr,PRNr),^KLKAN(KLNr,PRNr)
 .For  Set Mnd=$O(^HULP(%J,"T",KLNr,Mnd)) Quit:Mnd=""  Do
 ..Set Rec=^(Mnd)
 ..Set:KLNr ^KSTKL(KLNr,PRNr,Mnd)=$P(Rec,D,1,7)
 ..Set:KLNr&Mnd&($P(Rec,D,11,25)'="") ^KLKAN(KLNr,PRNr,$$INTDATE^vhLib.DataTypes($E(Mnd,1,7),"DM"))=$P(Rec,D,11,25)
 ..Set ^KSTPR(PRNr,KLNr,Mnd)=$P(Rec,D,1,7)
 Quit
 
 ; **** Verkoop node 'S' *****
 
VKP ;Verkoop
 For  Lock +^KPR:5 Quit:$T  Do LDISP^vhLock("^KPR")
 Kill ^HULP(%J,"V")
 Set PRNr=""
 For  Set PRNr=$O(VAN(PRNr)) Quit:PRNr=""  Do VKPCOPY(PRNr,"V",'$P(VAN(PRNr),D,1))
 For  Set PRNr=$O(NAAR(PRNr)) Quit:PRNr=""  Do
 .Do VKPDUPL($P(NAAR(PRNr),D,2),$P(NAAR(PRNr),D,3))
 .Do VKPCOPY(PRNr,"T",1)
 .Do VKPSAVE(PRNr)
 Kill ^HULP(%J,"T"),^HULP(%J,"V")
 Quit
 
VKPCOPY(PRNr,Node,TelB) 
 Set Key="S" 
 For  Set Key=$O(^KPR(PRNr,Key)) Quit:$E(Key)'="S"  Do
 .Set From=^KPR(PRNr,Key)
 .Set To=$S($D(^HULP(%J,Node,Key)):^(Key),1:"\\\\\\\\\")
 .Set:TelB $P(To,D,1)=$P(To,D,1)+$P(From,D,1)
 .Set $P(To,D,2)=$P(To,D,2)+$P(From,D,2)
 .Set $P(To,D,3)=$P(To,D,3)+$P(From,D,3)
 .Set:TelB $P(To,D,5)=$P(To,D,5)+$P(From,D,5)
 .Set $P(To,D,6)=$P(To,D,6)+$P(From,D,6)
 .Set ^HULP(%J,Node,Key)=To
 Quit
 
VKPDUPL(DivAant,DivOmz) 
 Kill ^HULP(%J,"T")
 Set Key="" 
 For  Set Key=$O(^HULP(%J,"V",Key)) Quit:$E(Key)=""  Do
 .Set To=$G(^HULP(%J,"V",Key))
 .Set $P(To,D,1)=$P(To,D,1)*DivAant\1
 .Set $P(To,D,2)=+$J($P(To,D,2)*DivOmz,0,2)
 .Set $P(To,D,3)=+$J($P(To,D,3)*DivOmz,0,2)
 .Set $P(To,D,5)=$P(To,D,5)*DivAant\1
 .Set $P(To,D,6)=+$J($P(To,D,6)*DivOmz,0,2)
 .Set ^HULP(%J,"T",Key)=To
 Quit
 
VKPSAVE(PRNr) 
 Set Key="S"
 For  Set Key=$O(^KPR(PRNr,Key)) Quit:$E(Key)'="S"  Kill ^(Key)
 Set Key=""
 For  Set Key=$O(^HULP(%J,"T",Key)) Quit:$E(Key)=""  Set ^KPR(PRNr,Key)=^(Key)
 Quit
 
 ; **** Weekverkoop *****
 
WVKP ;Verkoop
 For  Lock +^KSPW:5 Quit:$T  Do LDISP^vhLock("^KSPW")
 Kill ^HULP(%J,"V")
 Set PRNr=""
 For  Set PRNr=$O(VAN(PRNr)) Quit:PRNr=""  Do WVKPCOPY(PRNr,"V",'$P(VAN(PRNr),D,1))
 For  Set PRNr=$O(NAAR(PRNr)) Quit:PRNr=""  Do
 .Do WVKPDUPL($P(NAAR(PRNr),D,2),$P(NAAR(PRNr),D,3))
 .Do WVKPCOPY(PRNr,"T",1)
 .Do WVKPSAVE(PRNr)
 Lock -^KSPW
 Kill ^HULP(%J,"T"),^HULP(%J,"V")
 Quit
 
WVKPCOPY(PRNr,Node,TelB) 
 Set Key=" " 
 For  Set Key=$O(^KSPW(PRNr,Key)) Quit:Key=""  Do
 .Set From=^KSPW(PRNr,Key)
 .Set To=$S($D(^HULP(%J,Node,Key)):^(Key),1:"\\\\\\\\\\\\")
 .Set:TelB $P(To,D,1)=$P(To,D,1)+$P(From,D,1)
 .Set $P(To,D,2)=$P(To,D,2)+$P(From,D,2)
 .Set $P(To,D,3)=$P(To,D,3)+$P(From,D,3)
 .Set:TelB $P(To,D,4)=$P(To,D,4)+$P(From,D,4)
 .Set:TelB $P(To,D,5)=$P(To,D,5)+$P(From,D,5)
 .Set:TelB $P(To,D,6)=$P(To,D,6)+$P(From,D,6)
 .Set:TelB $P(To,D,7)=$P(To,D,7)+$P(From,D,7)
 .Set $P(To,D,8)=$P(To,D,8)+$P(From,D,8)
 .Set $P(To,D,9)=$P(To,D,9)+$P(From,D,9)
 .Set:TelB $P(To,D,10)=$P(To,D,10)+$P(From,D,10)
 .Set $P(To,D,11)=$P(To,D,11)+$P(From,D,11)
 .Set $P(To,D,12)=$P(To,D,12)+$P(From,D,12)
 .Set ^HULP(%J,Node,Key)=To
 Quit
 
WVKPDUPL(DivAant,DivOmz) 
 Kill ^HULP(%J,"T")
 Set Key="" 
 For  Set Key=$O(^HULP(%J,"V",Key)) Quit:$E(Key)=""  Do
 .Set To=$G(^HULP(%J,"V",Key))
 .Set $P(To,D,1)=$P(To,D,1)*DivAant\1
 .Set $P(To,D,2)=+$J($P(To,D,2)*DivOmz,0,2)
 .Set $P(To,D,3)=+$J($P(To,D,3)*DivOmz,0,2)
 .Set $P(To,D,7)=$P(To,D,7)*DivAant\1
 .Set $P(To,D,8)=+$J($P(To,D,8)*DivOmz,0,2)
 .Set $P(To,D,9)=+$J($P(To,D,9)*DivOmz,0,2)
 .Set $P(To,D,10)=$P(To,D,10)*DivAant\1
 .Set $P(To,D,11)=+$J($P(To,D,11)*DivOmz,0,2)
 .Set $P(To,D,12)=+$J($P(To,D,12)*DivOmz,0,2)
 .Set ^HULP(%J,"T",Key)=To
 Quit
 
WVKPSAVE(PRNr) 
 Set Key=""
 For  Set Key=$O(^HULP(%J,"T",Key)) Quit:$E(Key)=""  Set ^KSPW(PRNr,Key)=^(Key)
 Quit
 
 ; **** Begin stock ****
 
BS ;Beginstock 
 For  Lock +^KPR:5 Quit:$T  Do LDISP^vhLock("^KPR")
 Set PRNr=""
 Set BeginSt=0,BeginDat=9999999
 For  Set PRNr=$O(VAN(PRNr)) Quit:PRNr=""  Do
 .Quit:$P(VAN(PRNr),D,1)  ; Niet telbaar aantal
 .Do BSCOPY
 .Set:NoDel $P(^KPR(PRNr,0),D,12)=0,$P(^KPR(PRNr,0),D,13)=$$EXTDATE^vhLib.DataTypes($H,"DKP")
 Set TSt=BeginSt
 Set TDat=BeginDat
 Set PRNr=""
 For  Set PRNr=$O(NAAR(PRNr)) Quit:PRNr=""  Do
 .Set BeginSt=TSt,BeginDat=TDat
 .Do BSCOPY
 .Set $P(^KPR(PRNr,0),D,12)=$S(BeginSt:BeginSt,1:"")
 .Set $P(^KPR(PRNr,0),D,13)=$S(BeginDat=9999999:"",BeginDat:$$EXTDATE^vhLib.DataTypes(BeginDat,"DKP"),1:"")
 Lock -^KPR
 Quit
 
BSCOPY ; Opbouw beginstock
 Set BeginSt=BeginSt+$P(^KPR(PRNr,0),D,12)
 Set Dat=$$INTDATE^vhLib.DataTypes($P(^KPR(PRNr,0),D,13),"DK")
 Set:Dat&(Dat<BeginDat) BeginDat=Dat
 Quit
 
 ; **** HISTTORIEK ****
 
HIST ; Historiek
 Do OLDHIST,NEWHIST
 Quit
 
 ; **** HISTTORIEK (Node 'H') ****
 
OLDHIST ; Historiek
 Kill ^HULP(%J,"H")
 For  Lock +^KPR:5 Quit:$T  Do LDISP^vhLock("^KPR")
 ; Opslaan van de H-node in hulpbestand voor alle VAN produkten
 Set PRNr=""
 For  Set PRNr=$O(VAN(PRNr)) Quit:PRNr=""  Do
 .Do OLDHCOPY(PRNr,"H",'$P(VAN(PRNr),D,1),1,1)
 ; Overbrengen hulpbestand naar de NAAR produkten
 Set PRNr=""
 For  Set PRNr=$O(NAAR(PRNr)) Quit:PRNr=""  Do
 .Kill ^HULP(%J,"T")
 .Do COPYBOOM^vhRtn1("^HULP(%J,""H"")","^HULP(%J,""T"")")
 .Do OLDHCOPY(PRNr,"T",1,$P(NAAR(PRNr),D,2),$P(NAAR(PRNr),D,3))
 .Do OLDHSAVE(PRNr)
 Lock -^KPR
 Kill ^HULP(%J,"H"),^HULP(%J,"T")
 Quit
 
OLDHCOPY(PRNr,Node,TelB,DivAant,DivOmz) 
 ; DivAant en DivOmz niet van toepassing op historiek
 Quit:'TelB
 Set I2="H" 
 For  Set I2=$O(^KPR(PRNr,I2)) Quit:$E(I2)'="H"  Do
 .Set Rec=^KPR(PRNr,I2)
 .For Piece=1:1 Set HElem=$P(Rec,D,Piece) Quit:HElem=""  Do
 ..Set ^HULP(%J,Node,$S($E(HElem,1,2)>50:19,1:20)_HElem)=$G(^HULP(%J,Node,$S($E(HElem,1,2)>50:19,1:20)_HElem))+1
 Quit
 
OLDHSAVE(PRNr) 
 Kill ^KPR(PRNr,"H")
 Set Key="H"
 For  Set Key=$O(^KPR(PRNr,Key)) Quit:$E(Key)'="H"  Kill ^KPR(PRNr,Key)
 Set HElem=""
 Set HCnt=0,HNode=""
 For  Set HElem=$O(^HULP(%J,"T",HElem)) Quit:HElem=""  Do
 .For I=1:1:^HULP(%J,"T",HElem) Do
 ..If $L(HNode)+$L(HElem)-1>256 Set HCnt=HCnt+1,^KPR(PRNr,"H"_$E(10000+HCnt,2,5))=HNode,HNode=""
 ..Set HNode=HNode_$E(HElem,3,99)_D
 If HNode'="" Set HCnt=HCnt+1,^KPR(PRNr,"H"_$E(10000+HCnt,2,5))=HNode
 Set:HCnt ^KPR(PRNr,"H")=HCnt
 Quit
  
 ; **** HISTTORIEK (^PRHIST) ****
 
NEWHIST ; Historiek
 Kill ^HULP(%J,"H")
 For  Lock +^PRHIST:5 Quit:$T  Do LDISP^vhLock("^KPR")
 ; Opslaan van PRHIST in hulpbestand voor alle VAN produkten
 Set PRNr=""
 For  Set PRNr=$O(VAN(PRNr)) Quit:PRNr=""  Do
 .Do NEWHCOPY(PRNr,"H",'$P(VAN(PRNr),D,1),1,1)
 ; Overbrengen hulpbestand naar de NAAR produkten
 Set PRNr=""
 For  Set PRNr=$O(NAAR(PRNr)) Quit:PRNr=""  Do
 .Kill ^HULP(%J,"T")
 .Do COPYBOOM^vhRtn1("^HULP(%J,""H"")","^HULP(%J,""T"")")
 .Do NEWHCOPY(PRNr,"T",1,$P(NAAR(PRNr),D,2),$P(NAAR(PRNr),D,3))
 .Do NEWHSAVE(PRNr)
 Set PRNr=""
 For  Set PRNr=$O(VAN(PRNr)) Quit:PRNr=""  Kill ^PRHIST(PRNr)
 Lock -^PRHIST
 Kill ^HULP(%J,"H"),^HULP(%J,"T")
 Quit
 
NEWHCOPY(PRNr,Node,TelB,DivAant,DivOmz) 
 ; DivAant en DivOmz niet van toepassing op historiek
 New Rec,HistNr,HDate
 Quit:'TelB
 Set HistNr="" 
 For  Set HistNr=$O(^PRHIST(PRNr,HistNr)) Quit:HistNr=""  Do
 .Set Rec=^PRHIST(PRNr,HistNr),HDate=$P(Rec,D) Set:Node'="T" $P(HDate,",",2)=$P(HDate,",",2)+.01
 .For  Quit:'$D(^HULP(%J,Node,HDate))  Set $P(HDate,",",2)=$P(HDate,",",2)+.01
 .Merge ^HULP(%J,Node,HDate)=^PRHIST(PRNr,HistNr)
 .Set:Node'="T" $P(^HULP(%J,Node,HDate),D,13)=1
 Quit
 
NEWHSAVE(PRNr) 
 New Rec,HistNr,HDate
 Kill ^PRHIST(PRNr)
 Set HDate="",HistNr=0
 For  Set HDate=$O(^HULP(%J,"T",HDate)) Quit:HDate=""  Do
 .Set HistNr=HistNr+1
 .Merge ^PRHIST(PRNr,HistNr)=^HULP(%J,"T",HDate)
 Quit
  
PAKKET
 New FromPRNr,ToPRNr
 Set FromPRNr=$O(VAN("")),ToPRNr=$O(NAAR(""))
 If '$O(VAN(FromPRNr)),'$O(NAAR(ToPRNr)) Do ; Pakketten enkel indien één op één relatie
 . If 'NoAsk Set FP=2401 Write @F,"Pakketten",@F2
 . Do PAKKETCOPY(FromPRNr,ToPRNr)
 Quit
 
PAKKETCOPY(FromPRNr,ToPRNr)
 New KLNr,PakNr
 Set KLNr=""
 For  Set KLNr=$O(^PAKKET("IP",FromPRNr,KLNr)) Quit:KLNr=""  Do
 . Set PakNr=""
 . For  Set PakNr=$O(^PAKKET("IP",FromPRNr,KLNr,PakNr)) Quit:PakNr=""  Do
 . . Set ^PAKKET("D",PakNr,ToPRNr)=^PAKKET("D",PakNr,FromPRNr)
 . . Kill ^PAKKET("D",PakNr,FromPRNr)
 . . Set ^PAKKET("IP",ToPRNr,KLNr,PakNr)=""
 . . Kill ^PAKKET("IP",FromPRNr,KLNr,PakNr)
 Quit
  
LOG ; Logging van de fusie in ^LOG
 New VanPRNr,NaarPRNr,Txt
 Set (VanPRNr,NaarPRNr)=""
 ; Vermelden in ^LOG van alle NAAR en VAN producten
 For  Set NaarPRNr=$O(NAAR(NaarPRNr)) Quit:NaarPRNr=""  Do
 . For  Set VanPRNr=$O(VAN(VanPRNr)) Quit:VanPRNr=""  Do
 ..  Set Txt="Naar:"_NaarPRNr
 ..  Set:$L($TR(NAAR(NaarPRNr),D,"")) Txt=Txt_" Pn:("_$E($TR(NAAR(NaarPRNr),D,";"),2,99)_")"
 ..  Set:$L($TR(VAN(VanPRNr),D,"")) Txt=Txt_" Pv:("_$TR(VAN(VanPRNr),D,";")_")"
 ..  Do STORE^LOG("PR",VanPRNr,"FUSIE",Txt)
 Quit
 
DLOG ; Logging van de fusie in ^DLOG
 New VanPRNr,NaarPRNr,Txt,TempTxt
 Set (VanPRNr,NaarPRNr)=""
 ; Vermelden in ^DLOG van alle NAAR en VAN producten
 Set Txt="Van:"
 For  Set VanPRNr=$O(VAN(VanPRNr)) Quit:VanPRNr=""  Do
 . Set Txt=Txt_" "_VanPRNr
 . Set:$L($TR(VAN(VanPRNr),D,"")) Txt=Txt_" Pv:("_$TR(VAN(VanPRNr),D,";")_")"
 Set TempTxt=Txt
 For  Set NaarPRNr=$O(NAAR(NaarPRNr)) Quit:NaarPRNr=""  Do
 . Set Txt=TempTxt
 . Set:$L($TR(NAAR(NaarPRNr),D,"")) Txt=Txt_" Pn:("_$E($TR(NAAR(NaarPRNr),D,";"),2,99)_")"
 . Do PUTLOG^PRODUKT(NaarPRNr,,,Txt,"FUSIE")
 Quit
 
DELVAN  ; Verwijderen van alle VAN-produkten
 Quit:NoDel
 Set PRNr=""
 For  Set PRNr=$O(VAN(PRNr)) Quit:PRNr=""  Do
 . Do:$D(^PRBS("IP",PRNr))
 . . Do:Moeders(PRNr)="F"
 . . . Set FP=2203+F60 Write @F,@F1,@F4,"Een ogenblik, verwijderen ","product """,$P(^KPR(PRNr,0),D),"""",@F5
 . . . Set FP=2303+F60 Write @F,@F4,"*** Fusie van de moeders ***",@F5
 . . . Set FP=2403+F60 Write @F,@F4,"Dit kan enkele seconden (minuten) duren.",@F5,@F0
 . . Do:Moeders(PRNr)="D"
 . . . Set FP=2203+F60 W @F,@F1,@F4,"Een ogenblik, verwijderen ","product """,$P(^KPR(PRNr,0),D),"""",@F5
 . . . Set FP=2303+F60 W @F,@F4,"*** Deactiveren van de moeders ***",@F5
 . . . Set FP=2403+F60 W @F,@F4,"Dit kan enkele seconden duren.",@F5,@F0
 . Do DELETE^PRODUKT2(PRNr)
 . Do:$D(^PRBS("IP",PRNr))
 . . Do:Moeders(PRNr)="F" OnDeleteProduct^PRFUSIE(PRNr)
 . . Do:Moeders(PRNr)="D" OnDeleteProduct^Prod.Product.ProductBeheer.CommercieelActief(PRNr)
 Quit
 
JOBNAAR ; Herberekenen AKANAL van alle NAAR-produkten
 Set PRNr=""
 For  Set PRNr=$O(NAAR(PRNr)) Quit:PRNr=""  Job VerwerkEenProduct^Stat.Statistiek.OpbouwenArtikelKlantAnalyse(PRNr)
 Quit
 
DELWMS(VAN) 
 Quit 1 ; Verouderd PV 4-03-05
 New ChkDel,PRNr
 Set ChkDel=1,PRNr=""
 For  Set PRNr=$O(VAN(PRNr)) Quit:PRNr=""  Set ChkDel=$$CHKDEL^EWPR(PRNr) Quit:'ChkDel
 If 'ChkDel For  Set PRNr=$O(VAN(PRNr),-1) Quit:PRNr=""  Do ZEND^EWPR(PRNr)
 Quit ChkDel
  
  ; Copieren aliassen en opzetten nieuwe alias van oud naar nieuw product
ALIAS
 New FromPRNr,ToPRNr
 Set FromPRNr=$O(VAN("")),ToPRNr=$O(NAAR(""))
 If '$O(VAN(FromPRNr)),'$O(NAAR(ToPRNr)) Do ; Aliassen enkel indien één op één relatie
 . If 'NoAsk Set FP=2401 Write @F,"Aliassen",@F2
 . Do MoveAlias(FromPRNr,ToPRNr)
 Quit
 
MoveAlias(FromPRNr,ToPRNr)
 Do ##class(APPS.PM.impl.Fusie.IndexEnAliasOvernemer).%New().NeemIndexenEnAliassenOver(FromPRNr,ToPRNr)
 Quit