VANLOOY2 ;Routines voor Van Looy cons. [ 01/09/2003  8:40 AM ]
 ; Tray hoogte definitie
 ;  6 rijen van 16cm
 ;  3 rijen van 25cm
 ;  4 rijen van 36cm
 
transfer s Q="K" d ^cA604
 Set Transfer=1
 Goto SHOW+1
PRINTALL For MaxTray=2,3,5,7,10  Write !,MaxTray," :" For %Voll=0,25,50,100,150,200 Do
 .Quit:MaxTray<5&(%Voll>100)
 .Quit:MaxTray'<5&(%Voll<50)
 .Do PRINT(MaxTray,%Voll,0,104)
 Quit
 
PRINT(MaxTray,%Voll,InclNS,Dev) 
 Do
 .New MaxTray,%Voll,InclNS,Dev
 .s Q="K" d ^cA604
 Set Dev=$G(Dev,0)
 O Dev u Dev
 Set Print=1
 Do SHOW2
 W #
 c Dev
 Q
SHOW s Q="K" d ^cA604
 Write @F11,@F1
 Read !,"Hoeveel volledige trays mogen door 1 produkt genomen worden : ",MaxTray
 Quit:MaxTray'?1.2N
 Read !,"Hoeveel dozen mogen er gepakt worden van de totale tray-cap (in %) : ",%Voll
 Quit:%Voll'?1.3N
 Read !,"Inclusief niet stock produkten (1 = incl): ",InclNS
 Quit:InclNS'?.1N
 Write @F11,@F1
 Goto SHOW2
SHOW2 Read:$G(Transfer) !,"TRANSFER",K
 Write:$G(Transfer) $TR("PRNr,KortTekst,Klas,GemWVKP,GemStock,MaxStock,Lengte,Breedte,Hoogte,GrVerpak,KlVerpak,#OLTot,#OLPal,#OLGPak,#OLKPak,#OLStuk,#OLToel,QtyPal,QtyGPak,QtyKPak,QtyStuk,Doos/Tray,Qty/Tray,Gew/Tray,Hoogte/Tray,ABRSBasis,ABRScalc,TrayTyp,#Tray,#Refill",",",$C(9))
 Set CKey=MaxTray_"%"_%Voll
 IF '$D(^PVPR(0,"C",CKey)) Do
 .Do CLEAN(CKey)
 .Do TRAYCAP(CKey,MaxTray,%Voll)
 Set PRNr=0
 For  Set PRNr=$O(^KPR(PRNr)) Quit:PRNr=""  Do 
 .;Set PRNr=1103  Do
 .If 'InclNS Quit:'$P(^KPR(PRNr,1),D,20)  ; NIET stock
 .Quit:$P(^KPR(PRNr,1),D,25)  ; NON Aktief
 .;If '($D(^PVPR(PRNr))#10) Quit
 .Set RecT=$G(^PVPR(PRNr,"T",CKey))
 .;Quit:RecT=""
 .Set ABRS=$P(RecT,D,1)
 .Set RecO=""
 .If ABRS>1 Set RecO=$G(^PVPR(PRNr,"O",CKey))
 .Set:'$L(RecO) RecO=$G(^PVPR(PRNr,"O"))
 .Set TrayQty=$P(RecT,D,3)
 .Set TrayType=$P(RecT,D,6)
 .Set TrayCnt=$P(RecT,D,7)
 .Set:'TrayType TrayType=1
 .Set Refill=""
 .Set GPak=$P($G(^PVPRH(PRNr),D_1),D,2)
 .Set KPak=$P($G(^PVPRH(PRNr),D_D_1),D,3)
 .Set ST=$P($G(^PVPRH(PRNr),D_D_D_"N"),D,4)
 .Set OLTot=$G(OLTot)+$P(RecO,D,5)
 .Set OLQty=$P(RecO,D,10)+$P(RecO,D,11)+$P(RecO,D,12)
 .Set:ABRS<2 TrayCnt=0,TrayQty="",TrayType="",TrayHigh=""
 .If ABRS=3 Do  ;Volledig in ABRS
 ..Set OLQty=OLQty+$P(RecO,D,13)
 ..Set Refill=$P(RecO,D,20) ; Toelevering
 ..Set OL(ST,"A","G")=$G(OL(ST,"A","G"))+$P(RecO,D,3)+$P(RecO,D,4) ; OL grootvp
 ..Set OL(ST,"A","K")=$G(OL(ST,"A","K"))+$P(RecO,D,2) ; OL kleinvp
 ..Set OL(ST,"A","S")=$G(OL(ST,"A","S"))+$P(RecO,D,1) ; OL stuk
 ..Set Som(ST,"A","G")=$G(Som(ST,"A","G"))+($P(RecO,D,12)+$P(RecO,D,13)/GPak) ; Grootvp
 ..Set Som(ST,"A","K")=$G(Som(ST,"A","K"))+($P(RecO,D,11)/KPak) ; Kleinvp
 ..Set Som(ST,"A","S")=$G(Som(ST,"A","S"))+$P(RecO,D,1) ; Stuk (hiervoor wordt het aantal OL genomen omdat men moet weten hoeveel keer er geteld moet worden en niet hoeveel stuks
 ..Set CntProd3=$G(CntProd3)+1
 .Else  If ABRS=2  Do  ; DEELS ABRS
 ..Set:TrayCnt Refill=$J(OLQty/(TrayQty*$S(TrayCnt<TrayType:TrayCnt,1:TrayType)),0,1) 
 ..Set OL(ST,"P","G")=$G(OL(ST,"P","G"))+$P(RecO,D,4) ; OL grootvp
 ..Set OL(ST,"A","G")=$G(OL(ST,"A","G"))+$P(RecO,D,3) ; OL grootvp
 ..Set OL(ST,"A","K")=$G(OL(ST,"A","K"))+$P(RecO,D,2) ; OL kleinvp
 ..Set OL(ST,"A","S")=$G(OL(ST,"A","S"))+$P(RecO,D,1) ; OL stuk
 ..Set Som(ST,"P","G")=$G(Som(ST,"P","G"))+($P(RecO,D,13)/GPak) ; Grootvp
 ..Set Som(ST,"A","G")=$G(Som(ST,"A","G"))+($P(RecO,D,12)/GPak) ; Grootvp
 ..Set Som(ST,"A","K")=$G(Som(ST,"A","K"))+($P(RecO,D,11)/KPak) ; Kleinvp
 ..Set Som(ST,"A","S")=$G(Som(ST,"A","S"))+$P(RecO,D,1) ; Stuk (hiervoor wordt het aantal OL genomen omdat men moet weten hoeveel keer er geteld moet worden en niet hoeveel stuks
 ..Set CntProd2=$G(CntProd2)+1
 .Else  Do  ; NIET stock of NIET in ABRS
 ..Set OL(ST,"P","G")=$G(OL(ST,"P","G"))+$P(RecO,D,3)+$P(RecO,D,4) ; OL grootvp
 ..Set OL(ST,"P","K")=$G(OL(ST,"P","K"))+$P(RecO,D,2) ; OL kleinvp
 ..Set OL(ST,"P","S")=$G(OL(ST,"P","S"))+$P(RecO,D,1) ; OL stuk
 ..Set Som(ST,"P","G")=$G(Som(ST,"P","G"))+($P(RecO,D,12)+$P(RecO,D,13)/GPak) ; Grootvp
 ..Set Som(ST,"P","K")=$G(Som(ST,"P","K"))+($P(RecO,D,11)/KPak) ; Kleinvp
 ..Set Som(ST,"P","S")=$G(Som(ST,"P","S"))+$P(RecO,D,1) ; Stuk (hiervoor wordt het aantal OL genomen omdat men moet weten hoeveel keer er geteld moet worden en niet hoeveel stuks
 ..Set CntProd1=$G(CntProd1)+1
 .Set:ABRS=2 SomRef2=$G(SomRef2)+Refill
 .Set:ABRS=3 SomRef3=$G(SomRef3)+Refill
 .Set:ABRS>1 SomTray=$G(SomTray)+(TrayCnt/TrayType)
 .Set TrayHigh=$P(RecT,D,5)
 .Set:ABRS>1 TrayHigh(TrayHigh,TrayType)=$G(TrayHigh(TrayHigh,TrayType))+(TrayCnt/TrayType)
 .Set:ABRS>1 TrayHigh(0,TrayType)=$G(TrayHigh(0,TrayType))+(TrayCnt/TrayType)
 .Quit:'$G(Transfer)
 .Kill Rec
 .For I="T","O" Set Rec(I)=$G(^PVPR(PRNr,I,CKey))
 .Set Rec("S")=$G(^PVPR(PRNr,"S"))
 .Set Rec=$G(^PVPR(PRNr))
 .If '$D(Rec("T")) Quit
 .Set Klas=$$SORTKEY^PRODUKT(PRNr)
 .Set GemVKP=$P(^KPR(PRNr,1),D,21) Set GemVKP=$P(GemVKP,"#")+$P(GemVKP,"#",2)
 .Write !,PRNr,$C(9),$P(^KPR(PRNr,0),D),$C(9),Klas,$C(9),GemVKP
 .Write $C(9),$P(Rec("S"),D),$C(9),$P(Rec("S"),D,2) ; Stock
 .Write $C(9),$TR($P(Rec,D,2),".",","),$C(9),$TR($P(Rec,D,3),".",","),$C(9),$TR($P(Rec,D,4),".",","),$C(9),GPak,$C(9),KPak ; Afmetingen
 .For I=5,4,3,2,1,20,13,12,11,10 Write $C(9),$P(Rec("O"),D,I) ; Orderinfo
 .Write $C(9),$TR($P(Rec("T"),D,2),".",","),$C(9),$TR($P(Rec("T"),D,3),".",","),$C(9),$TR(+$J($P(Rec("T"),D,4),0,0),".",","),$C(9),$P(Rec("T"),D,5) ; Traycalc
 .Set:'$P(Rec("T"),D,6) $P(Rec("T"),D,6)=1
 .Write $C(9),$P(Rec,D,1),$C(9),$P(Rec("T"),D,1),$C(9),$TR(1/$P(Rec("T"),D,6),".",","),$C(9),$P(Rec("T"),D,7),$C(9),Refill
 
 Write !!,"Hoeveel volledige trays mogen door 1 produkt genomen worden : ",MaxTray
 Write !,"Hoeveel dozen mogen er gepakt worden van de totale tray-cap (in %) : ",%Voll
 Write !,"Inclusief NIET-stock produkten : ",$S(InclNS:"Ja",1:"Nee")
 Write !,"Aantal prod. NIET ABRS  : ",$J(CntProd1,0,0)
 Write !,"Aantal prod. deels ABRS : ",$J(CntProd2,0,0)
 Write !,"Aantal prod. voll. ABRS : ",$J(CntProd3,0,0)
 Write !,"Aantal trays (voll.)    : ",$J(SomTray,0,0)
 Write !,"Aantal trays + 15%      : ",$J(SomTray*1.15,0,0)
 Write !,"Aantal trays + extra    : ",$J(SomTray*1.15,0,0)+50," (10 mach.,20 N-St, 10 verpakking, 10 document.)"
 Set TrayHigh="",TrayType=""
 Write !,"Lade hoogte : "
 For  Set TrayType=$O(TrayHigh(0,TrayType)) Quit:TrayType=""  Write $J(TrayType,10)
 Write $J("Totaal",10)
 Set TrayHigh=0
 For  Set TrayHigh=$O(TrayHigh(TrayHigh)) Quit:TrayHigh=""  Do
 .Write !,$J(TrayHigh,11)," : "
 .Set Som=0
 .For  Set TrayType=$O(TrayHigh(0,TrayType)) Quit:TrayType=""   Do
 ..Write $J($G(TrayHigh(TrayHigh,TrayType)),10,0)
 ..Set Som=Som+$G(TrayHigh(TrayHigh,TrayType))
 .Write $J(Som,10,0)
 Write !,"     Totaal : "
 Set Som=0
 Set TrayHigh=0
 For  Set TrayType=$O(TrayHigh(0,TrayType)) Quit:TrayType=""  Do
 .Write $J(TrayHigh(0,TrayType),10,0)
 .Set Som=Som+TrayHigh(0,TrayType)
 Write $J(Som,10,0)
 ; OL Tellingen
 Write !!,"Aantal refills (ABRS=2) : ",$J(SomRef2,5,0),"  (",$J(SomRef2/200,0,1),"/dag)"
 Write !!,"Aantal refills (ABRS=3) : ",$J(SomRef3,5,0),"  (",$J(SomRef3/200,0,1),"/dag)"
 Write !,"Aantal OL (Totaal)      : ",$J(OLTot,5),"  (",$J(OLTot/200,3,0),"/dag)"
 Write !!,"S",?2,"Pak",?20,"ABRS",?55,"PALLET magazijn"
 Write !,?10,"OL/jr",?20,"OL/dag",?30,"Verpak",?50,"OL/jr",?60,"OL/dag",?70,"Verpak"
 For ST="S","N","C" Do
 .Write !,ST
 .For PT="G","K","S" Do
 ..Write:PT'="G" !
 ..Write ?3,PT,?10,$J($G(OL(ST,"A",PT)),5,0),?20,"(",$J($G(OL(ST,"A",PT))/200,3,0),")",?30,$J($G(Som(ST,"A",PT)),6,0)
 ..Write ?50,$J($G(OL(ST,"P",PT)),5,0),?60,"(",$J($G(OL(ST,"P",PT))/200,3,0),")",?70,$J($G(Som(ST,"P",PT)),6,0)
 
 Read:'$G(Print)&'$G(Transfer) K:5
 Write:$G(Transfer) "~~~"
 Quit
 
CALCALL For MaxTray=2,3,4,5,7,10  Write !,MaxTray," :" For %Voll=0,25,50,100,150,200 Do
 .Quit:MaxTray<5&(%Voll>100)
 .Quit:MaxTray'<5&(%Voll<50)
 .Write "  ",%Voll
 .Set CKey=MaxTray_"%"_%Voll
 .Do CLEAN(CKey)
 .Do TRAYCAP(CKey,MaxTray,%Voll)  ;:CKey="5%100"
 Write !,"Niet stock"
 Set PRNr=0
 For  Set PRNr=$O(^KPR(PRNr)) Quit:PRNr=""  Do 
 .;If $P(^KPR(PRNr,1),D,20),($D(^PVPR(PRNr))#10) Quit  ; NIET stock
 .Quit:$P(^KPR(PRNr,1),D,25)  ; NON Aktief
 .Set Bon=$$BONLIJN(PRNr,"","",0,0)
 .Set ^PVPR(PRNr,"O")=Bon
 Quit
 
 ; Conversie van afm. verpakking naar TRAY capaciteit
TRAYCAP(CKey,MaxTray,%Voll) 
 S (SomRef,SomTray)=0
 Set PRNr=0
 For  Set PRNr=$O(^KPR(PRNr)) Quit:PRNr=""  Do 
 .;Quit:PRNr'=3025
 .;Set PRNr=10316 Do
 .Set Ok=0
 .; Read !,"Produkt : ",PRNr Do
 .Quit:'$P(^KPR(PRNr,1),D,20)  ; NIET stock
 .Quit:$P(^KPR(PRNr,1),D,25)  ; NON Aktief
 .If '($D(^PVPR(PRNr))#10) Quit
 .If '$D(^PVPR(PRNr,"S")) Set ^PVPR(PRNr,"S")=$$STOCKONE(PRNr)
 .Set MaxStock=$P(^PVPR(PRNr,"S"),D,2)
 .Set:'MaxStock MaxStock=1
 .Set OLQty=$P($G(^PVPR(PRNr,"O")),D,5)
 .Set Rec=^PVPR(PRNr)
 .Set ABRSDef=$P(Rec,D) Set:ABRSDef=1 ABRSDef=2
 .Quit:'$P(Rec,D,2)
 .Set Key=$O(^KPR(PRNr,"J")) Quit:$E(Key)'="J"
 .Set RecJ=^KPR(PRNr,Key)
 .Set PakQty=$P(RecJ,D,16)
 .Set Lengte=$P(Rec,D,2)
 .Set Breedte=$P(Rec,D,3)
 .Set Hoogte=$P(Rec,D,4)
 .;Write !,PRNr," ",$P(^KPR(PRNr,0),D)," ",Lengte," ",Breedte," ",Hoogte," ",PakQty
 .Kill Tray,Bon
 .Set Ok=0
 .For TrayType=8,4,2,1,-1 Do  Quit:Ok 
 ..Set Tray=$$TRAY(TrayType)
 ..Set ABRS=$P(Tray,D,1)
 ..Quit:ABRS<2  ; Niet in ABRS
 ..Set TrayQty=$P(Tray,D,3)
 ..Set TrayCnt=1
 ..Set ABSType=$P(Tray,D,6)
 ..Set Bon=$$BONLIJN(PRNr,CKey,%Voll,ABRS,TrayQty)
 ..If MaxStock<TrayQty Set Ok=1,(ABRS,$P(Tray,D,1))=3 ;ABRSDef ; Indien de MaxStock kleiner is dan de TrayQty dan speelt de gew. beperking geen rol
 ..Set TrayCnt=0
 ..If ABRS=3 Do
 ...Set TrayCnt=MaxStock\TrayQty
 ...Set:TrayCnt>(MaxTray*ABSType) TrayCnt=MaxTray*ABSType
 ...Set Refill=$P(Bon,D,20) ; Toeleveringen
 ..If ABRS=2 Do
 ...Set OLQty=$P(Bon,D,10)+$P(Bon,D,11)+$P(Bon,D,12)
 ...Set:OLQty<1 OLQty=1
 ...Set TrayCnt=OLQty\TrayQty
 ...Set:TrayCnt<1 TrayCnt=1
 ...Set:TrayCnt>(MaxTray*ABSType) TrayCnt=MaxTray*ABSType
 ...Set Refill=$J(OLQty/(TrayQty*$S(TrayCnt<ABSType:TrayCnt,1:ABSType)),0,1) 
 ..Set $P(Tray,D,7)=TrayCnt
 ..Set $P(Tray,D,8)=Refill
 ..Set Tray(TrayType)=Tray
 ..Set Bon(TrayType)=Bon
 .If 'Ok,$D(Tray)>1 Do  ; Nakijken welke het beste is
 ..Set IncFakt=1.1
 ..If $P(Tray(1),D,8)>30,$D(Tray(-1)) Set TrayType=-1,Ok=1 Quit
 ..For TrayType=1,2,4 Do:$D(Tray(TrayType))  Quit:Ok
 ...; Stopt als de aantal OL lijnen over het PalMag stopt met dalen (zie IncFakt)
o ...If $P(Bon(TrayType),D,4)*IncFakt<$P($G(Bon(TrayType*2)),D,4),$P($G(Tray(TrayType*2)),D,8)<30 Set Ok=1
 ..For TrayType=8,4,2,1 If $D(Tray(TrayType)) Set Ok=1 Quit
 .If Ok Do
 ..Set ^PVPR(PRNr,"T",CKey)=Tray(TrayType)
 ..Set ^PVPR(PRNr,"O",CKey)=Bon(TrayType)
 ..Set ^PVPR(0,"C",CKey)=""
 Quit
 
TRAY(TrayType) 
 New ABRS,PasHoog
 Set LPal=125
 Set BPal=82.5
 Set MaxGew=300
 Set ABRS=ABRSDef
 If TrayType=-1 Set TrayType=1,PasHoog=1
 Set:TrayType=2 LPal=LPal/2,MaxGew=MaxGew/2
 Set:TrayType=4 LPal=LPal/2,BPal=BPal/2,MaxGew=MaxGew/4
 Set:TrayType=8 LPal=LPal/4,BPal=BPal/2,MaxGew=MaxGew/8
 Set LQty=LPal/Lengte\1
 Set BQty=BPal/Breedte\1
 Set Qty1=LQty*BQty
 Set LQty=BPal/Lengte\1
 Set BQty=LPal/Breedte\1
 Set Qty2=LQty*BQty
 Set Qty=$S(Qty2>Qty1:Qty2,1:Qty1)
 Set TrayQty=Qty*PakQty
 If Hoogte<16 Set TrayQty=TrayQty*(16\Hoogte) ; Meerdere dozen op elkaar
 Set TrayHigh=$S(Hoogte<16:16,Hoogte<25:25,Hoogte<35:35,Hoogte<45:45,1:Hoogte)
 If Lengte>LPal&(Lengte>BPal)!((Breedte>LPal)&(Breedte>BPal))!(Qty=0) Set ABRS=0 ; Niet geschikt voor ABRS te breed of te lang
 If PakQty=1,Hoogte>45 Set ABRS=0 ; Niet geschikt voor ABRS, te hoog
 If Hoogte>45,ABRS>1 Do  ; Reductie TrayQty volgens de beschikbare hoogte
 .Set TrayQty=TrayQty*35/Hoogte\1
 .Set TrayHigh="35*"
 Set Gew=TrayQty*$P(^KPR(PRNr,1),D,13)/1000
 If Gew>MaxGew Set TrayQty=TrayQty*MaxGew/Gew\1,Gew=MaxGew
 If $G(PasHoog) Quit:+TrayHigh>30 "" Do  ; Maximale hoogte
 .Set Faktor=35\Hoogte
 .For  Set Gew=$P(Rec,D,4)*Faktor Quit:Gew<MaxGew  Set Faktor=Faktor-1 Quit:Faktor<2
 .Quit:Faktor<2
 .Set Qty=Qty*Faktor
 .Set TrayQty=TrayQty*Faktor
 .Set Gew=Gew*Faktor
 .Set TrayHigh="35+"
 Quit ABRS_D_Qty_D_TrayQty_D_Gew_D_TrayHigh_D_TrayType
 
CLEAN(CKey) 
 Set PRNr=0
 For  Set PRNr=$O(^PVPR(PRNr)) Quit:PRNr=""  Do 
 .Kill ^PVPR(PRNr,"O",CKey)
 .Kill ^PVPR(PRNr,"T",CKey)
 Kill ^PVPR(0,"C",CKey)
 Quit
 
BONLIJN(PRNr,CKey,%Voll,ABRS,TrayQty) ; Ophalen van bonlijnen en invullen van de COUNT en SOM in ^PVPR(,"O")
 New Rec,PVPR
 Set PVPR=""
 For Cnt=1:1:$O(^PVPRH(PRNr,""),-1) Do
 .Set Rec=^PVPRH(PRNr,Cnt)
 .If $P(Rec,D)'=2 Set $P(PVPR,D,20)=$P(PVPR,D,20)+1 Quit
 .Set QtyGPak=$P(Rec,D,2)
 .Set QtyPak=$P(Rec,D,3)
 .Set QtyStuk=$P(Rec,D,4)
 .Set PalMag=0
 .If ABRS=2,(QtyGPak+QtyPak)>(TrayQty*%Voll/100) Set PalMag=1
 .Set $P(PVPR,D,5)=$P(PVPR,D,5)+1 ; Telling orderlijnen omdat er soms dubbels lopen
 .If PalMag Do  ; Teveel voor ABRS=2
 ..;Hier kunnen een aantal dubbel OL voorkomen die gespilts worden over PalMag en ABRS
 ..Set $P(PVPR,D,4)=$P(PVPR,D,4)+1
 ..Set $P(PVPR,D,13)=$P(PVPR,D,13)+QtyGPak
 ..Set $P(PVPR,D,11)=$P(PVPR,D,11)+QtyPak
 ..Set $P(PVPR,D,10)=$P(PVPR,D,10)+QtyStuk
 ..If QtyStuk Set $P(PVPR,D,1)=$P(PVPR,D,1)+1
 ..If QtyPak,'QtyStuk Set $P(PVPR,D,2)=$P(PVPR,D,2)+1
 .Else  Do  ; Voldoende voor ABRS OF geheel palletmag
 ..;Het aantal orderlijnen wordt verhoogd bij de kleinste verpakking
 ..;bv. Als kleinvp en grootvp dan wordt het aantal OL van de kleinvp verhoogd en niet van grootvp
 ..If QtyStuk Set $P(PVPR,D,1)=$P(PVPR,D,1)+1
 ..If QtyPak,'QtyStuk Set $P(PVPR,D,2)=$P(PVPR,D,2)+1
 ..If QtyGPak,'QtyStuk,'QtyPak Set $P(PVPR,D,3)=$P(PVPR,D,3)+1
 ..Set $P(PVPR,D,12)=$P(PVPR,D,12)+QtyGPak
 ..Set $P(PVPR,D,11)=$P(PVPR,D,11)+QtyPak
 ..Set $P(PVPR,D,10)=$P(PVPR,D,10)+QtyStuk
 Quit PVPR
 
HISTO 
 Set PRNr=0
 Kill ^PVPRH,^PVPRS
 Do BLDCONTR^cwvlooy
 For  Set PRNr=$O(^KPR(PRNr)) Quit:PRNr=""  Do 
 .;Quit:'$P(^KPR(PRNr,1),D,20) ; NIET stock
 .Quit:$P(^KPR(PRNr,1),D,25)  ; NON Aktief
 .;If '($D(^PVPR(PRNr))#10) Quit
 .Set Cnt=0,Delta=0
 .Set H="H"
 .Kill ^PVPRH(PRNr)
 .For  Set H=$O(^KPR(PRNr,H)) Quit:H=""!($E(H)'="H")  Do
 ..Set RecH=^KPR(PRNr,H)
 ..For I=1:1:$L(RecH,D) Do
 ...B
 ...Set Rec=$P(RecH,D,I)
 ...Quit:Rec=""
 ...If $E(Rec,1,6)>970831 Do 
 ....Set Qty=$E($P(Rec,"#"),8,99)
 ....Set Delta=Delta+(Qty*$S($E(Rec,7)=2!($E(Rec,7)=3):-1,1:1))
 ...Quit:$E(Rec,1,6)<960901!($E(Rec,1,6)>970831)
 ...Quit:$E(Rec,7)>2
 ...Set Qty=$E($P(Rec,"#"),8,99)
 ...Set RecJ=$O(^KPR(PRNr,"J")),RecJ=^KPR(PRNr,RecJ)
 ...Quit:Qty<0  ; Geen terugnames
 ...Set (GPak,Pak)=$P(RecJ,D,16)
 ...Set:$P(RecJ,D,15) Pak=$P(RecJ,D,15)
 ...Set:$P(RecJ,D,14) Pak=$P(RecJ,D,14)
 ...Set QtyGPak=Qty\GPak*GPak
 ...Set Qty=Qty#GPak
 ...Set QtyPak=Qty\Pak*Pak
 ...Set QtyStuk=Qty#Pak
 ...Set Delta=Delta+(Qty*$S($E(Rec,7)=2:-1,1:1))
 ...Quit:'QtyStuk&'QtyPak&'QtyGPak
 ...Set Cnt=Cnt+1
 ...Set ^PVPRH(PRNr,Cnt)=$E(Rec,7)_D_QtyGPak_D_QtyPak_D_QtyStuk_D_$E(Rec,1,6)
 ...Set Nxt=$O(^PVPRS($E(Rec,1,6),""),-1)+1
 ...Set ^PVPRS($E(Rec,1,6),Nxt)=PRNr_D_$E(Rec,7)_D_QtyGPak_D_QtyPak_D_QtyStuk
 .Set FysStock=$P(^KPR(PRNr,0),D,14)
 .Set NS=$S($P(^KPR(PRNr,1),D,20):"S",$D(ContrInd(PRNr)):"C",1:"N")
 .Set ^PVPRH(PRNr)=(FysStock-Delta)_D_GPak_D_Pak_D_NS
 Quit
 
CONVHIST Kill ^PVPRS
 Set PRNr=0
 For  Set PRNr=$O(^PVPRH(PRNr)) Quit:PRNr=""  Do
 .Set Cnt=0
 .For  Set Cnt=$O(^PVPRH(PRNr,Cnt)) Quit:Cnt=""  Do
 ..Set Rec=^(Cnt)
 ..Set Dat=$P(Rec,D,4)
 ..Set Nxt=$O(^PVPRS(Dat,""),-1)+1
 ..Set ^PVPRS(Dat,Nxt)=PRNr_D_$P(Rec,D,1,3)
 Quit
 
STOCK Set PRNr=0
 For  Set PRNr=$O(^KPR(PRNr)) Quit:PRNr=""  Do  ;Quit:PRNr=3551
 .If '($D(^PVPR(PRNr))#10) Quit
 .Quit:'$P(^KPR(PRNr,1),D,20)  ; NIET stock
 .Quit:$P(^KPR(PRNr,1),D,25)  ; NON Aktief
 .Set ^PVPR(PRNr,"S")=$$STOCKONE(PRNr)
 Quit
 
STOCKONE(PRNr) 
 New Periode,R,TotFysSt,FysStock,Weken,MaxFysSt
 Set Periode="1996.37 ",(TotFysSt,MaxFysSt,Weken)=0
 For  Set Periode=$O(^KSPW(PRNr,Periode)) Quit:Periode=""  Do
 .Set R=^KSPW(PRNr,Periode),FysStock=$P(R,D,4)
 .Set TotFysSt=TotFysSt+FysStock,Weken=Weken+1
 .Set:FysStock>MaxFysSt MaxFysSt=FysStock
 Quit (TotFysSt\$S(Weken:Weken,1:1))_D_MaxFysSt
 
TRANSFER 
 D ^cA604 U 0:(::::4096)
 Read "TRANSFERT",K
 Set PRNr=0
 Write $TR("PRNr,KortTekst,Klas,GemWVKP,GemStock,MaxStock,Lengte,Breedte,Hoogte,#OL=Verp,#OL>Verp,#OL<Verp,Qty=Verp,Qty>Verp,Qty<Verp,Doos/Tray,Qty/Tray,Gew/Tray,Hoogte/Tray,ABRSBasis,ABRScalc,TrayTyp,#Tray,#Refill",",",$C(9))
 For  Set PRNr=$O(^KPR(PRNr)) Quit:PRNr=""  Do  ;Quit:PRNr=3551
 .Quit:'$P(^KPR(PRNr,1),D,20)  ; NIET stock
 .Quit:$P(^KPR(PRNr,1),D,25)  ; NON Aktief
 .;If '$D(^PVPR(PRNr)) Q
 .Kill Rec
 .Merge Rec=^PVPR(PRNr)
 .If '$D(Rec("T")) Quit
 .Set Klas=$$SORTKEY^PRODUKT(PRNr)
 .Set GemVKP=$P(^KPR(PRNr,1),D,21) Set GemVKP=$P(GemVKP,"#")+$P(GemVKP,"#",2)
 .For I="S","T","O" Set Rec(I)=$G(Rec(I))
 .Write !,PRNr,$C(9),$P(^KPR(PRNr,0),D),$C(9),Klas,$C(9),GemVKP
 .Write $C(9),$P(Rec("S"),D),$C(9),$P(Rec("S"),D,2) ; Stock
 .Write $C(9),$TR($P(Rec,D,2),".",","),$C(9),$TR($P(Rec,D,3),".",","),$C(9),$TR($P(Rec,D,4),".",",") ; Afmetingen
 .For I=3,2,1,7,6,5 Write $C(9),$P(Rec("O"),D,I) ; Orderinfo
 .Write $C(9),$TR($P(Rec("T"),D,2),".",","),$C(9),$TR($P(Rec("T"),D,3),".",","),$C(9),$TR(+$J($P(Rec("T"),D,4),0,0),".",","),$C(9),$P(Rec("T"),D,5) ; Traycalc
 .Write $C(9),$P(Rec,D,1),$C(9),$P(Rec("T"),D,1),$C(9),$tr(1/$P(Rec("T"),D,6),".",","),$C(9),$P(Rec("T"),D,7),$C(9),$TR($P(Rec("T"),D,8),".",",")
 w "~~~"
 Quit
CONTROL 
 D ^cA604 U 0:(::::4096)
 Read "TRANSFERT",K
 Set PRNr=0
 For  Set PRNr=$O(^KPR(PRNr)) Quit:PRNr=""  Do  ;Quit:PRNr=3551
 .Quit:'$P(^KPR(PRNr,1),D,20)  ; NIET stock
 .Quit:$P(^KPR(PRNr,1),D,25)  ; NON Aktief
 .Merge Rec=^PVPR(PRNr)
 .Set Klas=$$SORTKEY^PRODUKT(PRNr)
 .If $P(Rec,D),$P(Rec,D,2),$P(Rec,D,3),$P(Rec,D,4),$D(Rec("T")),$D(Rec("S")),$D(Rec("O")) Quit
 .Write !,PRNr,$C(9),$P(^KPR(PRNr,0),D),$C(9),Klas,$C(9),$P(^KPR(PRNr,0),D,6)
 w "~~~"
 Quit
 
 F  Do  Quit:PRNr=""
 .Write @F11,@F1,"Produkt" Read PRNr
 .Quit:PRNr'?4.7N
 .Write !,$P(^KPR(PRNr,0),D)
 .Write !,$P(^KPR(PRNr,$O(^KPR(PRNr,"J"))),D,16)
 .Read !,"ABRS : ",ABRS
 .If ABRS'?1N,ABRS<0!(ABRS>3) W *7 Quit
 .Read !,"Lengte : ",L
 .Read !,"Breedte : ",B
 .Read !,"Hoogte : ",H
 .Set ^PVPR(PRNr)=ABRS_D_L_D_B_D_H
 Quit
 
 F  Do  Quit:ToPRNr=""
 .Write @F11,@F1,"Produkt" Read ToPRNr
 .Quit:ToPRNr'?4.7N
 .Set PRNr=$$SELECT^PRODUKT6()
 .Quit:PRNr=""
 .IF '$P($G(^PVPR(PRNr)),D,2) Write *7 Quit
 .Set ^PVPR(ToPRNr)=^PVPR(PRNr)
 Quit
TRANSH d ^cA604 U 0:(::::4096)
 S PRNr=$$SELECT^PRODUKT6()
 Quit:'PRNr
 Read "TRANSFER",k
 Write !,"Produkt",$C(9),$P(^KPR(PRNr,0),D)
 Set H="H"
 Set Delta=0
 For  Set H=$O(^KPR(PRNr,H)) Quit:H=""!($E(H)'="H")  Do
 .Set RecH=^KPR(PRNr,H)
 .For I=1:1:$L(RecH,D) Do
 ..Set Rec=$P(RecH,D,I)
 ..Quit:Rec=""
 ..If $E(Rec,1,6)>970831 Do 
 ...Set Qty=$E($P(Rec,"#"),8,99)
 ...Set Delta=Delta+(Qty*$S($E(Rec,7)=2!($E(Rec,7)=3):-1,1:1))
 ..Quit:$E(Rec,1,6)<960901!($E(Rec,1,6)>970831)
 ..Quit:$E(Rec,7)>2
 ..Set Qty=$E($P(Rec,"#"),8,99)
 ..Set RecJ=$O(^KPR(PRNr,"J")),RecJ=^KPR(PRNr,RecJ)
 ..Quit:Qty<0  ; Geen terugnames
 ..Set (GPak,Pak)=$P(RecJ,D,16)
 ..Set:$P(RecJ,D,15) Pak=$P(RecJ,D,15)
 ..Set:$P(RecJ,D,14) Pak=$P(RecJ,D,14)
 ..Set QtyGPak=Qty\GPak*GPak
 ..Set Qty=Qty#GPak
 ..Set QtyPak=Qty\Pak*Pak
 ..Set QtyStuk=Qty#Pak
 ..Set Delta=Delta+(Qty*$S($E(Rec,7)=2:-1,1:1))
 ..Quit:'QtyStuk&'QtyPak&'QtyGPak
 ..Write !,$E(Rec,7),$C(9),QtyGPak,$C(9),QtyPak,$C(9),QtyStuk,$C(9),$E(Rec,5,6),"-",$E(Rec,3,4),"-",$E(Rec,1,2)
 ..Q
 ..Set RecO=^HULP(%J,$E(Rec,1,6))
 ..Set Multi=$S($E(Rec,7)=2:-1,1:1)
 ..Set $P(RecO,D,1)=$P(RecO,D,1)+(Multi*QtyGPak)
 ..Set $P(RecO,D,2)=$P(RecO,D,2)+(Multi*QtyPak)
 ..Set $P(RecO,D,3)=$P(RecO,D,3)+(Multi*QtyStuk)
 Set FysStock=$P(^KPR(PRNr,0),D,14)
 Write !,"Begin FysStock",$C(9),FysStock-Delta
 Write "~~~"