VANLOOY ;Verschillende routines voor het export van gegevens voor de magazijn analyze van VAN LOOY ;[ 08/16/2002  4:22 PM ]
 d ^cA604
 u 0:(::::4096)
 S %J=$$%J^vhRtn1()
 s Cnt(10)=""
 s Cnt(50)=""
 s Cnt(100)=""
 s Cnt(500)=""
 s Cnt(1000)=""
 s Cnt(2000)=""
 s Cnt(5000)=""
 s Cnt(10000)=""
 s Cnt(20000)=""
 s Cnt(50000)=""
 s Cnt(100000)=""
 s Cnt(9999999999)=""
 Set PRNr=0
 f  s PRNr=$O(^KPR(PRNr))  Quit:PRNr=""  Do
 .S Stock=$P(^KPR(PRNr,1),D,20)
 .Q:Stock'>0
 .S FysSt=$P(^KPR(PRNr,0),D,14)
 .Set Ind=$O(Cnt(FysSt))
 .Set $P(Cnt(Ind),D,Stock+1)=$P(Cnt(Ind),D,Stock+1)+1
 s I=""
 r "TRANSFERT",K
 For  Set I=$O(Cnt(I)) Quit:I=""  Do
 .W !,I,$C(9),$P(Cnt(I),D),$C(9),$P(Cnt(I),D,2)
 w "~~~"
 q
 
CHKABRS(PRNr,Key,Qty,GVerp) 
 Set Rec=$G(^PVPR(PRNr,"T",Key))
 ;Set:Rec="" Rec=$G(^PVPR(PRNr,"T"))
 Quit:Rec="" 0 ; Niet in ABRS
 Set ABRS=$P(Rec,D)
 If ABRS=3 Quit 1 ; Volledig
 Set Max=$P(Key,"%",2)
 If ABRS=2,Qty'>($P(Rec,D,3)*Max/100)!(Qty<GVerp) Quit 1
 Quit 0
 
BONLIJN ; Ophalen van bonlijnen
 d ^cA604
 Set File="\\NOTES01\SHARED\P V\Bonlijn.txt"
 ;Set File="i:\BONLIJN.TXT"
 For Dev=54:-1:51 Open Dev:(File:"W"):0 Quit:$T
 If '$T Set Error=12 Quit
 U Dev
 S %J=$$%J^vhRtn1()
 Set BeginDat=$$INTDATE^vhDTyp("01.01.99")
 Set EndDat=$$INTDATE^vhDTyp("31.01.99")
 s Dat=-$H,Vrzw=""
 Do BLDCONTR^KPOSW
 ;read "transfert",k
 f  s Dat=$O(^KU3(Dat)) Quit:Dat=""  f  S Vrzw=$O(^KU3(Dat,Vrzw)) Quit:Vrzw=""  Do 
 .Quit:(-Dat)<BeginDat
 .Quit:(-Dat)>EndDat
 .s UL=""
 .f  s UL=$O(^KU3(Dat,Vrzw,UL)) Quit:UL=""  Do
 ..Set KLNr=$P(^KU3(Dat,Vrzw,UL),D)
 ..Set Node=$P(^KU3(Dat,Vrzw,UL),D,2)
 ..Set Lijn=90
 ..Set Dt=$$EXTDATE^DTyp(-Dat,"DKP")
 ..Set Vzw=$E(Vrzw,1,2)
 ..For  Set Lijn=$O(^KUL(KLNr,Node,UL,Lijn)) Quit:'Lijn  Do
 ...Set Rec=^KUL(KLNr,Node,UL,Lijn)
 ...Quit:'$P(Rec,D,2)&($P($P(Rec,D,17),"#")'="KF1925")
 ...Set PRNr=$P(Rec,D,2)
 ...If PRNr Do
 ....If $D(^KPR(PRNr)) Do
 .....Set Rec0=^KPR(PRNr,0)
 .....Set Rec1=^KPR(PRNr,1)
 .....Set RecI=$O(^KPR(PRNr,"I")),RecI=^KPR(PRNr,RecI)
 .....Set RecJ=$O(^KPR(PRNr,"J")),RecJ=^KPR(PRNr,RecJ)
 ....Else  If $D(^KPRO(PRNr)) Do
 .....Set Rec1=^KPRO(PRNr,1)
 .....Set Rec0=^KPRO(PRNr,0)
 .....Set RecI=$O(^KPRO(PRNr,"I")),RecI=^KPRO(PRNr,RecI)
 .....Set RecJ=$O(^KPRO(PRNr,"J")),RecJ=^KPRO(PRNr,RecJ)
 ....Else  Set PRNr=""
 ...If 'PRNr Do
 ....Set PRNr="MAN"
 ....Set KortT="Man. produkt"
 ....Set Klas="MN-MAN"
 ....Set Stock=""
 ....Set LigP=""
 ....Set Gew=""
 ....Set Verp=1
 ....Set (Stuk,Qty)=$P(Rec,D,3)
 ....Set (ABRS,ABRS0,ABRS25,ABRS50,ABRS100,GVerp,KVerp)=0
 ...Else  Do
 ....Set KortT=$P(Rec0,D,1)
 ....Set Gew=$P(Rec1,D,13)
 ....Set Qty=$P(Rec,D,3)
 ....Set Gew=Qty*Gew/1000
 ....Set Klas=$P(RecI,D,2)
 ....Set Klas=$$DISPLS^KLASS(Klas)
 ....Set Verp=""
 ....Set (GVerp,KVerp,Stuk)=0
 ....Set Stuk=Qty,Neg=$S(Stuk<0:-1,1:1)
 ....Set Stuk=Stuk*Neg
 ....If $P(RecJ,D,16) Set GVerp=Stuk\$P(RecJ,D,16),Stuk=Stuk#$P(RecJ,D,16) 
 ....If $P(RecJ,D,15) Set KVerp=Stuk\$P(RecJ,D,15),Stuk=Stuk#$P(RecJ,D,15) 
 ....Set Verpak=$P(RecJ,D,16)
 ....Set:$P(RecJ,D,15) Verpak=$P(RecJ,D,15)_"'"_Verpak
 ....Set:$P(RecJ,D,14) Verpak=$P(RecJ,D,14)_"'"_Verpak
 ....Set ABRS=$P($G(^PVPR(PRNr)),D)
 ....Set ABRS0=$$CHKABRS(PRNr,"2%0",Qty*Neg,$P(RecJ,D,16))
 ....Set ABRS25=$$CHKABRS(PRNr,"2%25",Qty*Neg,$P(RecJ,D,16))
 ....Set ABRS50=$$CHKABRS(PRNr,"3%50",Qty*Neg,$P(RecJ,D,16))
 ....Set ABRS100=$$CHKABRS(PRNr,"4%100",Qty*Neg,$P(RecJ,D,16))
 ....Set LigP=$P(Rec0,D,6)
 ....Set Stock=$P(Rec1,D,20)
 ....Set Stock=$S(Stock:"S",1:"N")
 ....Set:$L($P(Rec,D,13)) Stock="C"
 ...Write $TR(Dt,".","/"),$C(9),KLNr,$C(9),UL,$C(9),Vzw,$C(9)
 ...Write Klas,$C(9),PRNr,$C(9),KortT,$C(9),Stock,$C(9),LigP,$C(9),ABRS,$C(9),ABRS0,$C(9),ABRS25,$C(9),ABRS50,$C(9),ABRS100,$C(9),Verpak,$C(9),GVerp,$C(9),KVerp,$C(9),Stuk,$C(9),Qty,$C(9),$TR($J(Gew,0,3),".",",")
 ...Write !
 Close Dev ;Write "~~~"
 Quit
 
CONSOL ; Bepalen consolidatie
 d ^cA604
 Set File="\\NOTES01\SHARED\P V\CONSOL.txt"
 For Dev=54:-1:51 Open Dev:(File:"W"):0 Quit:$T
 If '$T Set Error=12 Quit
 U Dev
 Set BeginDat=$$INTDATE^vhDTyp("01.08.97")
 Set EndDat=$$INTDATE^vhDTyp("31.10.97")
 s Dat=-$H,Vrzw=""
 ;read "transfert",k
 Set KGKey="2%0"
 Write $TR(KGKey_";Klant;BonNr;Consol;#OL;#Pal;#KG;#KOM;#LG;#Ugly",";",$C(9)),!
 Set TOTCNT=0,DIFFCNT=0
 f  s Dat=$O(^KU3(Dat)) Quit:Dat=""  f  S Vrzw=$O(^KU3(Dat,Vrzw)) Quit:Vrzw=""  Do 
 .Quit:(-Dat)<BeginDat
 .Quit:(-Dat)>EndDat
 .s UL=""
 .f  s UL=$O(^KU3(Dat,Vrzw,UL)) Quit:UL=""  Do
 ..Set KLNr=$P(^KU3(Dat,Vrzw,UL),D)
 ..Set Node=$P(^KU3(Dat,Vrzw,UL),D,2)
 ..Set Lijn=90
 ..Set Dt=$$EXTDATE^DTyp(-Dat,"DKP")
 ..Set Vzw=$E(Vrzw,1,2)
 ..Set (OLCnt,KomCnt,LGCnt,KGCnt,PalCnt,UglyCnt)=0
 ..For  Set Lijn=$O(^KUL(KLNr,Node,UL,Lijn)) Quit:'Lijn  Do
 ...Set Rec=^KUL(KLNr,Node,UL,Lijn)
 ...Quit:'$P(Rec,D,2)&($P($P(Rec,D,17),"#")'="KF1925")
 ...Set PRNr=$P(Rec,D,2)
 ...Quit:'PRNr  Quit:'$D(^KPR(PRNr))
 ...Set RecJ=$O(^KPR(PRNr,"J")),RecJ=^KPR(PRNr,RecJ)
 ...Set Qty=$P(Rec,D,3)
 ...Set Kom=$P($P(Rec,D,28),";")="KOM"
 ...Quit:'Qty
 ...Set Stuk=Qty,Neg=$S(Stuk<0:-1,1:1)
 ...Set Stuk=Stuk*Neg
 ...Set (GVerp,KVerp)=0
 ...If $P(RecJ,D,16) Set GVerp=Stuk\$P(RecJ,D,16),Stuk=Stuk#$P(RecJ,D,16) 
 ...If $P(RecJ,D,15) Set KVerp=Stuk\$P(RecJ,D,15),Stuk=Stuk#$P(RecJ,D,15) 
 ...Set ABRS=$P($G(^PVPR(PRNr)),D)
 ...Set ABRS=$$CHKABRS(PRNr,KGKey,Qty*Neg,$P(RecJ,D,16))
 ...Set OLCnt=OLCnt+1
 ...Set LangG=$P($G(^PVPR(PRNr)),D,6)="L"
 ...Set Ugly=$P($G(^PVPR(PRNr)),D,6)="U"
 ...Set PVPR=$G(^PVPR(PRNr))
 ...Set Lengte=$P(PVPR,D,2),Breedte=$P(PVPR,D,3),Hoogte=$P(PVPR,D,4)
 ...Set:Lengte<Breedte Temp=Lengte,Lengte=Breedte,Breedte=Temp
 ...Set:Hoogte>180 Ugly=1 
 ...Set:Lengte>120&(Breedte<80) LangG=1
 ...Set:Lengte>120&(Breedte'<80) Ugly=1
 ...If Kom Do
 ....Set KomCnt=KomCnt+1
 ...Else  If Ugly Do
 ....Set UglyCnt=UglyCnt+1
 ...Else  If LangG Do
 ....Set LGCnt=LGCnt+1
 ...Else  If ABRS Do
 ....Set KGCnt=KGCnt+1
 ...Else  Do  ; Palet
 ....Set PalCnt=PalCnt+1
 ....Set:$P($G(^PVPR(PRNr,"T",KGKey)),D)=2&(KVerp!Stuk) KGCnt=KGCnt+1
 ..Quit:'OLCnt
 ..Set Cnt=0
 ..Set:PalCnt Cnt=Cnt+1
 ..Set:KGCnt Cnt=Cnt+1
 ..Set:KomCnt Cnt=Cnt+1
 ..Set:UglyCnt Cnt=Cnt+1
 ..Set:LGCnt Cnt=Cnt+1
 ..Set TOTCNT=TOTCNT+1
 ..Set:Cnt'=1 DIFFCNT=DIFFCNT+1
 ..Write $TR(Dt,".","/"),$C(9),KLNr,$C(9),UL,$C(9) ;,Vzw,$C(9)
 ..Write $S(Cnt'=1:1,1:""),$C(9),OLCnt,$C(9),PalCnt,$C(9),KGCnt,$C(9),KomCnt,$C(9),LGCnt,$C(9),UglyCnt
 ..Write !
 Close Dev ;Write "~~~"
 zw TOTCNT,DIFFCNT
 Quit
 
TOELIJN ; Ophalen van toeleveringslijnen
 d ^cA604
 Set File="\\NOTES01\SHARED\P V\Toelijn.txt"
 ;Set File="i:\BONLIJN.TXT"
 For Dev=54:-1:51 Open Dev:(File:"W"):0 Quit:$T
 If '$T Set Error=12 Quit
 U Dev
 Set PRNr=0
 For  Set PRNr=$O(^KPR(PRNr)) Quit:PRNr=""  Do
 .Quit:$P(^KPR(PRNr,1),D,25)  ; NON Aktief
 .Set Cnt=0,Delta=0
 .Set H="H"
 .For  Set H=$O(^KPR(PRNr,H)) Quit:H=""!($E(H)'="H")  Do
 ..Set RecH=^KPR(PRNr,H)
 ..For ICnt=1:1:$L(RecH,D) Do
 ...Set Rec=$P(RecH,D,ICnt)
 ...Quit:Rec=""
 ...Quit:$E(Rec,1,6)<970701!($E(Rec,1,6)>971031)
 ...Quit:$E(Rec,7)'=1  ; Alleen aankoop
 ...Set Qty=$E($P(Rec,"#"),8,99)
 ...Set Rec0=^KPR(PRNr,0)
 ...Set Rec1=^KPR(PRNr,1)
 ...Set RecI=$O(^KPR(PRNr,"I")),RecI=^KPR(PRNr,RecI)
 ...Set RecJ=$O(^KPR(PRNr,"J")),RecJ=^KPR(PRNr,RecJ)
 ...Set Gew=$P(Rec1,D,13)
 ...Set Gew=Qty*Gew/1000
 ...Set Klas=$P(RecI,D,2)
 ...Set Klas=$$DISPLS^KLASS(Klas)
 ...Set Verp=""
 ...If $P(RecJ,D,16) Set Verp=+$J(Qty/$P(RecJ,D,16),0,0)
 ...Set Verpak=$P(RecJ,D,16)
 ...Set:$P(RecJ,D,15) Verpak=$P(RecJ,D,15)_"/"_Verpak
 ...Set:$P(RecJ,D,14) Verpak=$P(RecJ,D,14)_"/"_Verpak
 ...Set ABRS=$P($G(^PVPR(PRNr)),D)
 ...Set LigP=$P(Rec0,D,6)
 ...Set Stock=$P(Rec1,D,20)
 ...Set Stock=$S(Stock:"S",1:"N")
 ...;Set:$L($P(Rec,D,13)) Stock="C"
 ...Write $E(Rec,5,6),"/",$E(Rec,3,4),"/",$E(Rec,1,2),$C(9),Klas,$C(9),PRNr,$C(9),Stock,$C(9),LigP,$C(9),ABRS,$C(9),Verpak,$C(9),Verp,$C(9),Qty,$C(9),$TR($J(Gew,0,3),".",",")
 ...Write !
 Close Dev ;Write "~~~"
 Quit
 
BONVZW ; Ophalen van bons per dag en vervoerwijze
 d ^cA604
 S %J=$$%J^vhRtn1()
 s Dat=-$H,Vrzw=""
 k Som
 f  s Dat=$O(^KU3(Dat)) Quit:Dat>(-$H+370)  f  S Vrzw=$O(^KU3(Dat,Vrzw)) Quit:Vrzw=""  Do 
 .s UL=""
 .f  s UL=$O(^KU3(Dat,Vrzw,UL)) Quit:UL=""  Do
 ..Set KLNr=$P(^KU3(Dat,Vrzw,UL),D)
 ..Set Node=$P(^KU3(Dat,Vrzw,UL),D,2)
 ..Set Lijn=90
 ..Set Dt=$$EXTDATE^DTyp(-Dat,"DKP")
 ..Set Vzw=$E(Vrzw,1,2)
 ..Set $P(Som(Dt,Vzw),D)=$P($G(Som(Dt,Vzw)),D)+1
 ..For  Set Lijn=$O(^KUL(KLNr,Node,UL,Lijn)) Quit:'Lijn  Do
 ...Set Rec=^KUL(KLNr,Node,UL,Lijn)
 ...Set PRNr=$P(Rec,D,2)
 ...Quit:'$P(Rec,D,2)&($P($P(Rec,D,17),"#")'="KF1925")
 ...Set $P(Som(Dt,Vzw),D,2)=$P(Som(Dt,Vzw),D,2)+1
 ...Set (GVerp,KVerp,Stuk)=0
 ...Set Stuk=$P(Rec,D,3)
 ...If PRNr Do
 ....If $D(^KPR(PRNr)) Do
 .....Set Rec0=^KPR(PRNr,0)
 .....Set Rec1=^KPR(PRNr,1)
 .....Set RecI=$O(^KPR(PRNr,"I")),RecI=^KPR(PRNr,RecI)
 .....Set RecJ=$O(^KPR(PRNr,"J")),RecJ=^KPR(PRNr,RecJ)
 ....Else  If $D(^KPRO(PRNr)) Do
 .....Set Rec1=^KPRO(PRNr,1)
 .....Set Rec0=^KPRO(PRNr,0)
 .....Set RecI=$O(^KPRO(PRNr,"I")),RecI=^KPRO(PRNr,RecI)
 .....Set RecJ=$O(^KPRO(PRNr,"J")),RecJ=^KPRO(PRNr,RecJ)
 ....Else  Set PRNr=""
 ....Quit:'PRNr
 ....If $P(RecJ,D,16) Set GVerp=Stuk\$P(RecJ,D,16),Stuk=Stuk#$P(RecJ,D,16) 
 ....If $P(RecJ,D,15) Set KVerp=Stuk\$P(RecJ,D,15),Stuk=Stuk#$P(RecJ,D,15) 
 ...Set $P(Som(Dt,Vzw),D,3)=$P(Som(Dt,Vzw),D,3)+GVerp
 ...Set $P(Som(Dt,Vzw),D,4)=$P(Som(Dt,Vzw),D,4)+KVerp
 ...Set $P(Som(Dt,Vzw),D,5)=$P(Som(Dt,Vzw),D,5)+Stuk
TRANS read "transfert",k
 s Dat="",Vzw=""
 F  s Dat=$O(Som(Dat)) Quit:Dat=""  Do
 .F  s Vzw=$O(Som(Dat,Vzw)) Quit:Vzw=""  Do
 ..Write !,Dat,$C(9),Vzw,$C(9),$TR(Som(Dat,Vzw),"\.",$C(9)_",")
 w "~~~"
 Quit
 
BONPAK ; Ophalen van bons met verpakking, aantal lijnen verzendw
 d ^cA604
 S %J=$$%J^vhRtn1()
 s Dat=-$H,Vrzw=""
 k Som
 read "transfert",k
 f  s Dat=$O(^KU3(Dat)) Quit:Dat>(-$H+10)  f  S Vrzw=$O(^KU3(Dat,Vrzw)) Quit:Vrzw=""  Do 
 .s UL=""
 .f  s UL=$O(^KU3(Dat,Vrzw,UL)) Quit:UL=""  Do
 ..Set KLNr=$P(^KU3(Dat,Vrzw,UL),D)
 ..Set Node=$P(^KU3(Dat,Vrzw,UL),D,2)
 ..Set Lijn=90
 ..Set Vzw=$E(Vrzw,1,2)
 ..Set Dt=$$EXTDATE^DTyp(-Dat-$S(Vzw="OD":1,1:0),"DKP")
 ..Set Som=""
 ..For  Set Lijn=$O(^KUL(KLNr,Node,UL,Lijn)) Quit:'Lijn  Do
 ...Set Rec=^KUL(KLNr,Node,UL,Lijn)
 ...Quit:'$P(Rec,D,2)&($P($P(Rec,D,17),"#")'="KF1925")
 ...Set $P(Som,D,2)=$P(Som,D,2)+1
 ...Set $P(Som,D,3)=$P(Som,D,3)+$P(Rec,D,3)
 ...Quit:'$P(Rec,D,2)
 ...Set PRNr=$P(Rec,D,2)
 ...Set Gew=$P($G(^KPR(PRNr,1)),D,13)
 ...Set:'Gew Gew=$P($G(^KPRO(PRNr,1)),D,13)
 ...Set $P(Som,D,4)=$P(Som,D,4)+($P(Rec,D,3)*Gew/1000)
 ..Set Rec=$P(^KUL(KLNr,Node,UL,1),D,24)
 ..Write !,Dt,$C(9),Vzw,$C(9),KLNr,$C(9),UL,$C(9),$P(Rec,"#",1),$C(9),$P(Rec,"#",2),$C(9),$P(Rec,"#",3),$TR(Som,"\.",$C(9)_",")
 w "~~~"
 Quit
 
SERVICE ; Servicegraad
 d ^cA604
 S %J=$$%J^vhRtn1()
 Read "TRANSFERT",K
 s Dat=-$H,Vrzw=""
 k Som
 f  s Dat=$O(^KU3(Dat)) Quit:Dat>(-$H+180)  f  S Vrzw=$O(^KU3(Dat,Vrzw)) Quit:Vrzw=""  Do 
 .s UL=""
 .Set Result=""
 .f  s UL=$O(^KU3(Dat,Vrzw,UL)) Quit:UL=""  Do
 ..Set KLNr=$P(^KU3(Dat,Vrzw,UL),D)
 ..Set Node=$P(^KU3(Dat,Vrzw,UL),D,2)
 ..Set Lijn=90
 ..Set Dt=-Dat
 ..Set Vzw=$E(Vrzw,1,2)
 ..For  Set Lijn=$O(^KUL(KLNr,Node,UL,Lijn)) Quit:'Lijn  Do
 ...Set Rec=^KUL(KLNr,Node,UL,Lijn)
 ...Quit:'$P(Rec,D,2)&($P($P(Rec,D,17),"#")'="KF1925")
 ...Set PRNr=$P(Rec,D,2)
 ...;If PRNr Do
 ....If $D(^KPR(PRNr)) Do
 .....Set RecI=$O(^KPR(PRNr,"I")),RecI=^KPR(PRNr,RecI)
 ....Else  If $D(^KPRO(PRNr)) Do
 .....Set RecI=$O(^KPRO(PRNr,"I")),RecI=^KPRO(PRNr,RecI)
 ....Else  Set RecI=""
 ...;Quit:$P(RecI,D,1)["DE"
 ...Set WK=$P(Rec,D,25)
 ...If $P(Rec,D,3)<0 Set $P(Result,D,8)=$P(Result,D,8)+1 Quit
 ...Set WkDat=$$CALCDATE^vhDTyp($$INTDATE^vhDTyp(WK,"DW"),"W","FD")
 ...Set Verschil=Dt-WkDat\7
 ...Set:Verschil<0 Verschil=0
 ...Set:Verschil>5 Verschil=6
 ...Set Verschil=0
 ...Set $P(Result,D,Verschil+1)=$P(Result,D,Verschil+1)+1
 .Write !,$$EXTDATE^vhDTyp(Dt,"DK"),$C(9),UL
 .For I=1:1:8 Write $C(9),$P(Result,D,I)
 Write "~~~"
 Quit
 
FREQ ; Frequentie van het voorkomen van produkten
 d ^cA604
 S %J=$$%J^vhRtn1()
 Kill ^HULP(%J)
 s Dat=-$H,Vrzw=""
 k Som
 f  s Dat=$O(^KU3(Dat)) Quit:Dat>(-$H+365)  f  S Vrzw=$O(^KU3(Dat,Vrzw)) Quit:Vrzw=""  Do 
 .s UL=""
 .Set Result=""
 .f  s UL=$O(^KU3(Dat,Vrzw,UL)) Quit:UL=""  Do
 ..Set KLNr=$P(^KU3(Dat,Vrzw,UL),D)
 ..Set Node=$P(^KU3(Dat,Vrzw,UL),D,2)
 ..Set Lijn=90
 ..Set Dt=-Dat
 ..Set Vzw=$E(Vrzw,1,2)
 ..For  Set Lijn=$O(^KUL(KLNr,Node,UL,Lijn)) Quit:'Lijn  Do
 ...Set Rec=^KUL(KLNr,Node,UL,Lijn)
 ...Quit:'$P(Rec,D,2)&($P($P(Rec,D,17),"#")'="KF1925")
 ...Set PRNr=$P(Rec,D,2)
 ...If PRNr Do
 ....If $D(^KPR(PRNr)) Do
 .....Set IsStock=$P(^KPR(PRNr,1),D,20),RecI=$O(^KPR(PRNr,"I")),RecI=^KPR(PRNr,RecI)
 ....Else  If $D(^KPRO(PRNr)) Do
 .....Set IsStock=$P(^KPRO(PRNr,1),D,20),RecI=$O(^KPRO(PRNr,"I")),RecI=^KPRO(PRNr,RecI)
 ....Else  Set (IsStock,RecI)=""
 ...Set:'IsStock&($P($P(Rec,D,28),";")'["KOM")&($P(RecI,D,1)'["DE") IsStock=1
 ...Quit:'PRNr  Quit:'IsStock  Quit:RecI=""
 ...Quit:$P($G(^PVPR(PRNr),2),D)'=1
 ...Set SortKey=$P(RecI,D)
 ...Set ^HULP(%J,SortKey,PRNr)=$G(^HULP(%J,SortKey,PRNr))+1
 Set HoofdGr=""
 For  Set HoofdGr=$O(^HULP(%J,HoofdGr)) Quit:HoofdGr=""  Do
 .Set PRNr=""
 .For  Set PRNr=$O(^HULP(%J,HoofdGr,PRNr)) Quit:PRNr=""  Do
 ..Set Lijnen=^HULP(%J,HoofdGr,PRNr)
 ..Set Lijnen=$S(Lijnen<5:5,Lijnen<10:10,Lijnen<20:20,Lijnen<50:50,Lijnen<100:100,Lijnen<200:200,1:999999)
 ..Set Tabel(HoofdGr,Lijnen)=$G(Tabel(HoofdGr,Lijnen))+1
 Read "TRANSFERT",K
 Write "HoofdGr",$C(9)
 For Lijnen=5,10,20,50,100,200 Write "<",Lijnen,$C(9)
 Write ">200",!
 Set HoofdGr=""
 For  Set HoofdGr=$O(Tabel(HoofdGr)) Quit:HoofdGr=""  Do         
 .Write HoofdGr,$C(9)
 .For Lijnen=5,10,20,50,100,200,999999 Do
 ..Write $G(Tabel(HoofdGr,Lijnen))
 ..If Lijnen<1000 Write $C(9)
 ..Else  Write !
 Write "~~~"
 Kill ^HULP(%J)
 Quit
 
GEWTRAY Set PRNr=0
 Read "TRANSFERT",k
 u 0:(::::4096)
 Write $TR("PRNr,Korttekst,ABRS,TrayHoogte,Gew,GVP,Lengte,Breedte,Hoogte",",",$C(9))
 For  Set PRNr=$O(^PVPR(PRNr)) Quit:PRNr=""  Do
 .Set Rec=$tr($G(^PVPR(PRNr)),".",",")
 .Quit:Rec=""
 .Set Gew=$TR($P($G(^KPR(PRNr,1)),D,13),".",",")
 .Quit:Gew=""
 .Set Key=$O(^KPR(PRNr,"J")) Set Verpak=$P(^KPR(PRNr,Key),D,16)
 .Quit:'$P(^KPR(PRNr,1),D,20)  ; NIET-stock
 .Set ABRSType=$P($G(^PVPR(PRNr,"T","3%50")),D)
 .Set TrayHigh=$P($G(^PVPR(PRNr,"T","3%50")),D,5)
 .Write !,PRNr,$C(9),$P(^KPR(PRNr,0),D),$C(9),ABRSType,$C(9),TrayHigh,$C(9),Gew,$C(9),Verpak,$C(9),$P(Rec,D,2),$C(9),$P(Rec,D,3),$C(9),$P(Rec,D,4)
 Write !,"~~~"