PVVDR ; Van Driessche stockproducten [ 12/03/2003  8:51 AM ]
 GOTO STOCK
 
CORR ;Correctie van ORGALUX kinderen
 s PRNr=0
 For  S PRNr=$O(^KPR(PRNr))  Q:PRNr=""  Do
 .If '$$ISORGAL^ORGALUX(PRNr) Quit 
 .If '$D(^PRLINK("D",PRNr)) Quit
 .Set KPRNr=""
 .For  Set KPRNr=$O(^PRLINK("D",PRNr,KPRNr)) Quit:KPRNr=""  Do
 .Set Rec0=^KPR(PRNr,0)
 .;Quit:$P(Rec0,D,23)="S"
 .Write PRNr," ",$P(Rec0,D,1)," ",$P(Rec0,D,23),!
 .Quit:$P(Rec0,D,23)'="S"
 .;Set $P(^KPR(PRNr,0),D,23)="S"
 Q
 
BLUMHIST ; Historiek van de BLUM producten met levtrm>1 en stock of contract of stock en A of B klassificatie
 d ^cA604
 Set %J=$$%J^vhRtn1()
 Kill ^HULP(%J)
 Do BLDCONTR^KPOSW
 s PRNr=0
 set Dev=0
 Set Dev=$$OPEN^vhDEV($$DIRUSER^vhDEV,"BlumHist.txt","W")
 U Dev
 Write $Tr("PRNr;IdentNr;ShortDescription;BlumCust;SOPR;ABC;Rot;Stock;LevTrm;MinQty;MeanWVk;MeanStock;MinStock;MaxStock;PPL;Date;BuySell;Qty",";",$C(9)),!
 For  S PRNr=$O(^KPR(PRNr))  Q:PRNr=""  Do
 .If $$ISORGAL^ORGALUX(PRNr),$D(^PRLINK("D",PRNr)) Quit  ; Indien orgalux en het is een moederproduct dan product niet opnemen in de stock
 .Set Kind=$E($P(^KPR(PRNr,2),D,25))=6
 .Quit:Kind
 .Set JKey=$O(^KPR(PRNr,"J")) Quit:$E(JKey)'="J" 
 .Set RecJ=^KPR(PRNr,JKey)
 .Quit:$P(RecJ,D)'=5005
 .Set IKey=$O(^KPR(PRNr,"I")) Quit:$E(IKey)'="I" 
 .Set RecI=^KPR(PRNr,IKey)
 .Set Rec0=^KPR(PRNr,0)
 .Set Rec1=^KPR(PRNr,1)
 .Set Rec2=^KPR(PRNr,2)
 .Set Stock=$P(Rec1,D,20)
 .Set Stock=$S(Stock:"S",1:"N")
 .Set:$D(ContrInd(PRNr))&'$P(Rec1,D,20) Stock="C"
 .Set CiffPPL=$J($P(RecJ,D,23),0,4)
 .Set ABC=$P($P(^KPR(PRNr,0),D,8),"#",2)
 .Set ABCKwot=$$ABCKWOT^PRODUKT2(PRNr,1)
 .Set GGemWvk=$P(Rec1,D,21)
 .Set GGemWvk=$P(GGemWvk,"#")+$P(GGemWvk,"#",2)
 .Set GemWvk=$P(Rec1,D,23)
 .Set GemWvk=$P(GemWvk,"#")+$P(GemWvk,"#",2)
 .Set GemSt=$P(Rec1,D,24)
 .Set MinBH=$P(RecJ,D,6)
 .Set LevTrm=$P(RecJ,D,7)
 .Set CifPPL=$P(RecJ,D,23)
 .Set Rot=$P(GemSt,"#")
 .Set GemSt=$P(GemSt,"#",2)
 .Set KLNr=$O(^PRPUTZ("N",PRNr,""))
 .Set BLKLNr=""
 .Set:KLNr BLKLNr=$P(^PRPUTZ("N",PRNr,KLNr,0),D)
 .Set:BLKLNr="" BLKLNr=212250
 .Set BLId=$P(Rec2,D,25)
 .Set IDNr=$E($TR(BLId,".","")_" ",2,99)
 .Set IsSOPR=0
 .For Begin=0,1,2,3,4,5,8,9 Do  Quit:IsSOPR
 ..Quit:Begin=+$E(BLId)
 ..Set:$D(^KPR2(Begin_IDNr)) IsSOPR=1
 .Set $E(BLId)="0"
 .Quit:Stock="N"  ; alleen contracten en stock
 .Quit:ABC'="A"&(ABC'="B")&'IsSOPR  ; alleen A en B,
 .If ABC="A",LevTrm<2,'IsSOPR Quit
 .If ABC="B",LevTrm<2,'IsSOPR Quit  ; eventueel 3
 .Set MinMax=$$MINMAX(PRNr)
 .Set Prefix=PRNr_$C(9)_BLId_$C(9)_$P(Rec0,D,1)_$C(9)_BLKLNr_$C(9)_$S(IsSOPR:"S",1:"")_$C(9)_ABC_$C(9)_Rot_$C(9)_Stock_$C(9)_LevTrm_$C(9)_MinBH_$C(9)_GGemWvk_$C(9)_GemSt
 .Set Prefix=Prefix_$C(9)_$P(MinMax,D)_$C(9)_$P(MinMax,D,2)_$C(9)_$TR(CifPPL,".",",")
 .Do HISTONE(PRNr,Prefix,CifPPL)
 C Dev
 ; 
 ; Lege opvullen
 Set EndDat=$$CALCDATE^vhDTyp($$INTDATE^vhDTyp("30/11/2003"),"W","FD")
 Set PRNr=0
 For  Set PRNr=$O(^HULP(%J,PRNr)) Quit:PRNr=""  Do
 .Set Dat=$O(^HULP(%J,PRNr,""))
 .Set Dummy=^HULP(%J,PRNr,Dat)
 .Set $P(Dummy,$C(9),18)=0
 .Set Dat=$$CALCDATE^vhDTyp($$INTDATE^vhDTyp("2/12/2002"),"W","FD",-1)
 .For  Set Dat=$$CALCDATE^vhDTyp(Dat,"W",+1,"FD") Quit:Dat>EndDat  Do
 ..Set Rec=$G(^HULP(%J,PRNr,Dat),Dummy)
 ..Set Week=$TR($$EXTDATE^vhDTyp(Dat,"DK"),".-","//")
 ..Set $P(Rec,$C(9),16)=Week
 ..Set ^HULP(%J,PRNr,Dat)=Rec
 ; Totaal sommeren
 Set PRNr=0
 For  Set PRNr=$O(^HULP(%J,PRNr)) Quit:PRNr=""  Do
 . Set Dat=""
 . For  Set Dat=$O(^HULP(%J,PRNr,Dat)) Quit:Dat=""  Do 
 .. Set Rec=^HULP(%J,PRNr,Dat)
 .. Set IDNr=$P(Rec,$C(9),2)
 .. Set PRNr2=+$G(^KPR2($TR(IDNr,".","")_" "))
 .. Quit:PRNr2'?4.7N
 .. Set Rec2=^HULP(%J,PRNr2,Dat)
 .. Set $P(Rec2,$C(9),19)=$P(Rec2,$C(9),19)+$P(Rec,$C(9),18)
 .. Set ^HULP(%J,PRNr2,Dat)=Rec2
 
 set Dev=0
 Set Dev=$$OPEN^vhDEV($$DIRUSER^vhDEV,"BlumSOPR.txt","W")
 U Dev
 Write $Tr("PRNr;IdentNr;ShortDescription;BlumCust;SOPR;ABC;Rot;Stock;LevTrm;MinQty;MeanWVk;MeanStock;MinStock;MaxStock;PPL;Date;BuySell;Qty;QtyTot",";",$C(9)),!
 Set EndDat=$$CALCDATE^vhDTyp($$INTDATE^vhDTyp("30/11/2003"),"W","FD")
 Set PRNr=0
 For  Set PRNr=$O(^HULP(%J,PRNr)) Quit:PRNr=""  Do
 .Set Dat=""
 .For  Set Dat=$O(^HULP(%J,PRNr,Dat)) Quit:Dat=""  Do 
 ..Set Rec=^HULP(%J,PRNr,Dat)
 ..Write Rec,!
 C:Dev'=0 Dev
 Q
MINMAX(PRNr) 
 New Stock,Week
 Set Min=9999999
 Set Max=-99999999
 Set Week="2002.47 "
 For  Set Week=$O(^KSPW(PRNr,Week)) Quit:Week=""  Do
 .Set Stock=$P(^(Week),D,4)
 .Set:Min>Stock Min=Stock
 .Set:Max<Stock Max=Stock
 Set:Min=9999999 Min=""
 Set:Max=-99999999 Max=""
 Quit Min_D_Max
 
HISTONE(PRNr,Prefix,CifPPL) 
 ;Begin,Einde : Formaat 'JJMMDD'
 ;Soort : 1 = Aankoop,2=Verkoop,3=Man. UIT,4=Man. IN
 New Key,I,Cumul
 Set Key="H"
 For  Set Key=$O(^KPR(PRNr,Key)) Quit:$E(Key)'="H"  Do
 .Set Rec=^(Key)
 .For  Set Node=$P(Rec,D),Rec=$P(Rec,D,2,999)  Do:Node'=""  Quit:Rec=""
 ..Quit:$E(Node,7)>2&($P(Node,"#",3)'="T/W")  ; geen manuele
 ..Quit:$S($E(Node,1,2)>50:19,1:20)_$E(Node,1,6)<20021201
 ..Quit:$S($E(Node,1,2)>50:19,1:20)_$E(Node,1,6)>20031130
 ..Set Dat=$E(Node,5,6)_"/"_$E(Node,3,4)_"/"_$E(Node,1,2)
 ..Set Qty=$E($P(Node,"#"),8,99)
 ..Set IDNr=$P(Prefix,$C(9),2)
 ..Set SelBuy=$S($P(Node,"#",3)="T/W":"V",$E(Node,7)=1:"A",1:"V")
 ..Set Data=Prefix_$C(9)_Dat_$C(9)_SelBuy_$C(9)_Qty
 ..Write Data,!
 ..If SelBuy'="V" Quit
 ..If "0.185.095.1;0.328.333.3;0.356.086.0;0.226.646.1;0.445.186.2;0.490.939.2;0.673.897.3;0.117.006.3;0.222.535.6;0.328.368.3;0.328.376.3"[IDNr Do
 ...Set Dat=$$CALCDATE^vhDTyp($$INTDATE^vhDTyp(Dat),"W","FD")
 ...Set Rec=$G(^HULP(%J,PRNr,Dat),Data)
 ...Set $P(Rec,$C(9),18)=$P(Rec,$C(9),18)+Qty
 ...;Use 0 Write Prefix,! Use Dev
 ...Set ^HULP(%J,PRNr,Dat)=Rec
 Quit 
 
BLUMH2 ; Overzicht BLUM  producten
 d ^cA604
 Set %J=$$%J^vhRtn1()
 Kill ^HULP(%J)
 Do BLDCONTR^KPOSW
 s PRNr=0
 set Dev=0
 Set Dev=$$OPEN^vhDEV($$DIRUSER^vhDEV,"BlumHist.txt","W")
 U Dev
 Write $Tr("PRNr;IdentNr;ShortDescription;BlumCust;SOPR;ABC;Rot;Stock;LevTrm;MinQty;MeanWVk;MeanStock;MinStock;MaxStock;PPL;Date;BuyCnt;SellCnt",";",$C(9)),!
 For  S PRNr=$O(^KPR(PRNr))  Q:PRNr=""  Do
 .If $$ISORGAL^ORGALUX(PRNr),$D(^PRLINK("D",PRNr)) Quit  ; Indien orgalux en het is een moederproduct dan product niet opnemen in de stock
 .Set Kind=$E($P(^KPR(PRNr,2),D,25))=6
 .Quit:Kind
 .Set JKey=$O(^KPR(PRNr,"J")) Quit:$E(JKey)'="J" 
 .Set RecJ=^KPR(PRNr,JKey)
 .Quit:$P(RecJ,D)'=5005
 .Set IKey=$O(^KPR(PRNr,"I")) Quit:$E(IKey)'="I" 
 .Set RecI=^KPR(PRNr,IKey)
 .Set Rec0=^KPR(PRNr,0)
 .Set Rec1=^KPR(PRNr,1)
 .Set Rec2=^KPR(PRNr,2)
 .Set Stock=$P(Rec1,D,20)
 .Set Stock=$S(Stock:"S",1:"N")
 .Set:$D(ContrInd(PRNr))&'$P(Rec1,D,20) Stock="C"
 .Set CiffPPL=$J($P(RecJ,D,23),0,4)
 .Set ABC=$P($P(^KPR(PRNr,0),D,8),"#",2)
 .Set ABCKwot=$$ABCKWOT^PRODUKT2(PRNr,1)
 .Set GGemWvk=$P(Rec1,D,21)
 .Set GGemWvk=$P(GGemWvk,"#")+$P(GGemWvk,"#",2)
 .Set GemWvk=$P(Rec1,D,23)
 .Set GemWvk=$P(GemWvk,"#")+$P(GemWvk,"#",2)
 .Set GemSt=$P(Rec1,D,24)
 .Set MinBH=$P(RecJ,D,6)
 .Set LevTrm=$P(RecJ,D,7)
 .Set CifPPL=$P(RecJ,D,23)
 .Set Rot=$P(GemSt,"#")
 .Set GemSt=$P(GemSt,"#",2)
 .Set KLNr=$O(^PRPUTZ("N",PRNr,""))
 .Set BLKLNr=""
 .Set:KLNr BLKLNr=$P(^PRPUTZ("N",PRNr,KLNr,0),D)
 .Set:BLKLNr="" BLKLNr=212250
 .Set BLId=$P(Rec2,D,25)
 .Set IDNr=$E($TR(BLId,".","")_" ",2,99)
 .Set IsSOPR=0
 .For Begin=0,1,2,3,4,5,8,9 Do  Quit:IsSOPR
 ..Quit:Begin=+$E(BLId)
 ..Set:$D(^KPR2(Begin_IDNr)) IsSOPR=1
 .Set $E(BLId)="0"
 ..Quit:Stock="N"  ; alleen contracten en stock
 ..Quit:ABC'="A"&(ABC'="B")&'IsSOPR  ; alleen A en B,
 ..If ABC="A",LevTrm<2,'IsSOPR Quit
 ..If ABC="B",LevTrm<2,'IsSOPR Quit  ; eventueel 3
 .Set MinMax=$$MINMAX(PRNr)
 .Set Prefix=PRNr_$C(9)_BLId_$C(9)_$P(Rec0,D,1)_$C(9)_BLKLNr_$C(9)_$S(IsSOPR:"S",1:"")_$C(9)_ABC_$C(9)_Rot_$C(9)_Stock_$C(9)_LevTrm_$C(9)_MinBH_$C(9)_GGemWvk_$C(9)_GemSt
 .Set Prefix=Prefix_$C(9)_$P(MinMax,D)_$C(9)_$P(MinMax,D,2)_$C(9)_$TR(CifPPL,".",",")_$C(9)_$C(9)_$$HISTCNT(PRNr)
 .Write Prefix,!
 C Dev
 ; 
 Quit 
HISTCNT(PRNr) 
 ;Begin,Einde : Formaat 'JJMMDD'
 ;Soort : 1 = Aankoop,2=Verkoop,3=Man. UIT,4=Man. IN
 New Key,I,Cumul
 Set Key="H"
 Set Buy=0,Sell=0
 For  Set Key=$O(^KPR(PRNr,Key)) Quit:$E(Key)'="H"  Do
 .Set Rec=^(Key)
 .For  Set Node=$P(Rec,D),Rec=$P(Rec,D,2,999)  Do:Node'=""  Quit:Rec=""
 ..Quit:$E(Node,7)>2&($P(Node,"#",3)'="T/W")  ; geen manuele
 ..Quit:$S($E(Node,1,2)>50:19,1:20)_$E(Node,1,6)<20021201
 ..Quit:$S($E(Node,1,2)>50:19,1:20)_$E(Node,1,6)>20031130
 ..Set Dat=$E(Node,5,6)_"/"_$E(Node,3,4)_"/"_$E(Node,1,2)
 ..Set Qty=$E($P(Node,"#"),8,99)
 ..Set IDNr=$P(Prefix,$C(9),2)
 ..Set SelBuy=$S($P(Node,"#",3)="T/W":"V",$E(Node,7)=1:"A",1:"V")
 ..If SelBuy="V" Set Sell=Sell+1
 ..If SelBuy="A" Set Buy=Buy+1
 Quit Buy_$C(9)_Sell
 
STOCK ; Maandelijkse stocklijst voor voorraadbeheer
 d ^cA604
 Do BLDCONTR^KPOSW
 s PRNr=0
 Set Dev=$$OPEN^vhDEV($$DIRUSER^vhDEV,"VDRProd.txt","W")
 U Dev
 Write $Tr("PRNr;KortTekst;Klas;LevNr;LevNm;Stock;IsNotKind;Kost;CiffPPL;Qty;ABC;ABCKwot;GemWVK;GewGemWVK;Rotatie;GemStock;GemKost;MinBH;LevTrm;WVStock;WVStWaarde",";",$C(9)),!
 For  S PRNr=$O(^KPR(PRNr))  Q:PRNr=""  Do
 .If $$ISORGAL^ORGALUX(PRNr),$D(^PRLINK("D",PRNr)) Quit  ; Indien orgalux en het is een moederproduct dan product niet opnemen in de stock
 .Set Kind=$E($P(^KPR(PRNr,2),D,25))=6
 .Set JKey=$O(^KPR(PRNr,"J")) Quit:$E(JKey)'="J" 
 .Set RecJ=^KPR(PRNr,JKey)
 .Set IKey=$O(^KPR(PRNr,"I")) Quit:$E(IKey)'="I" 
 .Set RecI=^KPR(PRNr,IKey)
 .Set Rec0=^KPR(PRNr,0)
 .Set Rec1=^KPR(PRNr,1)
 .Set Stock=$P(Rec1,D,20)
 .Set Stock=$S(Stock:"S",1:"N")
 .Set:$D(ContrInd(PRNr))&'$P(Rec1,D,20) Stock="C"
 .Set CiffPPL=$J($P(RecJ,D,23),0,4)
 .Set ABC=$P($P(^KPR(PRNr,0),D,8),"#",2)
 .Set ABCKwot=$$ABCKWOT^PRODUKT2(PRNr,1)
 .Set GGemWvk=$P(Rec1,D,21)
 .Set GGemWvk=$P(GGemWvk,"#")+$P(GGemWvk,"#",2)
 .Set GemWvk=$P(Rec1,D,23)
 .Set GemWvk=$P(GemWvk,"#")+$P(GemWvk,"#",2)
 .Set GemSt=$P(Rec1,D,24)
 .Set MinBH=$P(RecJ,D,6)
 .Set LevTrm=$P(RecJ,D,7)
 .Set Rot=$P(GemSt,"#")
 .Set GemSt=$P(GemSt,"#",2)
 .Write PRNr,$C(9),$P(Rec0,D,1),$C(9),$P(RecI,D,3),$C(9),$P(RecJ,D,1),$C(9),$P(^KLE(^KL1($P(RecJ,D,1)),0),D,2),$C(9),Stock,$C(9),'Kind,$C(9),$S(Kind:0,1:$TR(CiffPPL*$P(Rec0,D,14),".",",")),$C(9),$TR(CiffPPL,".",",")
 .Write $C(9),$P(Rec0,D,14),$C(9),ABC,$C(9),"="""_ABCKwot_"""",$C(9),GemWvk,$C(9),GGemWvk,$C(9),Rot,$C(9),GemSt,$C(9),$S(Kind:0,1:$TR(CiffPPL*GemSt,".",",")),$C(9),MinBH,$C(9),LevTrm,$C(9),$TR($P($G(^PRSTOCK("D",PRNr)),D,2),".",","),$C(9),$TR($P($G(^PRSTOCK("D",PRNr)),D,2)*CiffPPL,".",","),!
 C Dev
 Q