PVFUSIE ;Produkt fusioneren (data verwerking) [ 10/30/2001  4:37 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
 If 'NoAsk Set FP=2401 Write @F,"Verwijderen VAN-produkten",@F2 
 Do DELVAN
 Do JOBNAAR
 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^vhDTyp($P($G(^HULP(%J,Node,KLNr,0)),D),"DK")<$$INTDATE^vhDTyp($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^vhDTyp($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^vhDTyp($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^vhDTyp($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^vhDTyp(BeginDat,"DKP"),1:"")
 Lock -^KPR
 Quit
 
BSCOPY ; Opbouw beginstock
 Set BeginSt=BeginSt+$P(^KPR(PRNr,0),D,12)
 Set Dat=$$INTDATE^vhDTyp($P(^KPR(PRNr,0),D,13),"DK")
 Set:Dat&(Dat<BeginDat) BeginDat=Dat
 Quit
 
 ; **** HISTTORIEK (Node 'H') ****
 
HIST ; 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 HISTCOPY(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 HISTCOPY(PRNr,"T",1,$P(NAAR(PRNr),D,2),$P(NAAR(PRNr),D,3))
 .Do HISTSAVE(PRNr)
 Lock -^KPR
 Kill ^HULP(%J,"H"),^HULP(%J,"T")
 Quit
 
HISTCOPY(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,HElem)=$G(^HULP(%J,Node,HElem))+1
 Quit
 
HISTSAVE(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_HElem_D
 If HNode'="" Set HCnt=HCnt+1,^KPR(PRNr,"H"_$E(10000+HCnt,2,5))=HNode
 Set:HCnt ^KPR(PRNr,"H")=HCnt
 Quit
 
DELVAN  ; Verwijderen van alle VAN-produkten
 Quit:NoDel
 Set PRNr=""
 For  Set PRNr=$O(VAN(PRNr)) Quit:PRNr=""  Do DELETE^PRODUKT2(PRNr)
 Quit
 
JOBNAAR ; Herberekenen AKANAL van alle NAAR-produkten
 Set PRNr=""
 For  Set PRNr=$O(NAAR(PRNr)) Quit:PRNr=""  Job ONE^KAKA8(PRNr)
 Quit
 
DELWMS(VAN) 
 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