KKOV12 Do GET(KC) ;BEHEER KONKLURRENTIEOVERZICHT (Module IMPORT verkopen voor één klant) [ 05/17/2002  10:18 AM ]
 Quit
 
GET(KLNr) 
 
 New %J
 Set %J=$$%J^vhRtn1()
 Kill ^HULP(%J)
 Do DELAUTO(KLNr)
 Do GETSG(KLNr)
 ;zw ^HULP(%J) r k
 Do VERDEEL
 ;zw ^HULP(%J) r k
 Do SAVE(KLNr)
 Do CHKHG(KLNr)
 Kill ^HULP(%J)
 Quit
 
DELAUTO(KLNr) 
 New HG,GR,Verd,Fabr,Rec
 Set (HG,GR,Verd,Fabr)=""
 For  Set HG=$O(^KKOV(KLNr,HG)) Quit:HG=""  Do
 .Set GR=""
 .For  Set GR=$O(^KKOV(KLNr,HG,GR)) Quit:GR=""  Do
 ..For  Set Verd=$O(^KKOV(KLNr,HG,GR,Verd)) Quit:Verd=""  Do
 ...For  Set Fabr=$O(^KKOV(KLNr,HG,GR,Verd,Fabr)) Quit:Fabr=""  Do
 ....Set Rec=^KKOV(KLNr,HG,GR,Verd,Fabr)
 ....Quit:'$P(Rec,D,25)  ; Manuele lijn
 ....Kill ^KKOV(KLNr,HG,GR,Verd,Fabr) ; Verwijder automatische lijnen
 Quit
 
GETSG(KLNr) 
 New HG,GR,SG,Verd,Fabr,Rec,Hulp,Mnd,PRNr,BMnd,EMnd,Verdeel,Offset,Klas,KKey
 Set Debug=0
 Set PRNr=0
 Set BMnd=$$EXTDATE^vhLib.DataTypes($$CALCDATE^vhLib.DataTypes($H,"M",-13,"MD"),"DM4")_" "
 Set EMnd=$$EXTDATE^vhLib.DataTypes($$CALCDATE^vhLib.DataTypes($H,"M",-1,"MD"),"DM4")_" "
 If Debug Do
 . Set Dev=$$OPEN^vhDEV(,"PotentieelDetail "_KLNr_".txt","W","T")
 . Use Dev
 . Write *9,BMnd," (+1 mnd)",*9,EMnd
 . Write !,"PRNr	Korttekst	HG	GR	GRTel	SGTel	PRTel	Fabr	PotQty	Qty	Omz	Multiplier	Rec"
 . Use 0
 For  Set PRNr=$O(^KSTKL(KLNr,PRNr)) Quit:PRNr=""  Do
 . Set Klas=$O(^KPR(PRNr,"I")) Quit:$E(Klas)'="I"
 . Set Klas=^KPR(PRNr,Klas)
 . Set TelbaarProduct=$P(^KPR(PRNr,1),D,7)
 . Set KKey=$P(Klas,D,4)
 . Set GenTyp=$$GENTYP^HAD(PRNr)
 . If $P(GenTyp,"\")="TBX" Do ; gemonteerde TBX laden converteren naar BX
 . . Do AfgeleidTBX(PRNr,.KKey,.TelbaarProduct) 
 . If $P(GenTyp,"\",1)="LBX" Do ; gemonteerde legrabox converteren naar BX
 . . Do AfgeleidLBX(PRNr,.KKey,.TelbaarProduct) 
 . If $P(GenTyp,"\",1)="TAO" Do ; gemonteerde taorbox converteren naar TANDEM/MOVENTO
 . . Do AfgeleidTAO(PRNr,.KKey,.TelbaarProduct) 
 . If $P(GenTyp,"\",1,2)="DIV\SDM" Do ; servodrive voorgemonteerd 
 . . Do AfgeleidSDM(PRNr,.KKey,.TelbaarProduct) 
 . Set HG=$$GETSORT^KLASS(KKey,1),GR=$$GETSORT^KLASS(KKey,2),SG=$$GETSORT^KLASS(KKey,3) ; Gemonteerde tandemboxen naar GR BX-VVO
 . Set:$P($G(^KPGR1(GR)),D,5)=1 TelbaarProduct=0 ; Verdeelbare groep (1 = niet telbaar)
 . Set:$P($G(^KPSG1(SG)),D,5)="V" TelbaarProduct=0 ; Verdeelbare subgroep (V = verdeelbaar)
 . Set Offset=2 ; telbaar
 . Set:+TelbaarProduct=0 TelbaarProduct=0,Offset=2 ; verdeelbaar
 .
 . If Debug,$O(^KSTKL(KLNr,PRNr,BMnd))'="" Do
 . . Use Dev
 . . Write !,PRNr,*9,$P(^KPR(PRNr,0),D,1),*9,HG,*9,GR
 . . Write *9,$P($G(^KPGR1(GR)),D,5),*9,$P($G(^KPSG1(SG)),D,5)
 . . Use 0
 .
 . Quit:($P($G(^KPSG1(SG)),D,5)=0)||($P($G(^KPSG1(SG)),D,5)="")  ; SubGroep is noch telbaar noch verdeelbaar daarom product niet opnemen in potentieel
 .
 . Set Fabr=$O(^KPR(PRNr,"J")) Quit:$E(Fabr)'="J"
 . Set Fabr=$P(^KPR(PRNr,Fabr),D,1)
 . Set:'$D(^HULP(%J,HG,Fabr,GR)) ^HULP(%J,HG,Fabr,GR)=""
 . Set Mnd=BMnd
 . Set DbgHulp=""
 . For  Set Mnd=$O(^KSTKL(KLNr,PRNr,Mnd)) Quit:Mnd=""  Quit:Mnd]EMnd  Do
 . . Set Rec=^KSTKL(KLNr,PRNr,Mnd)
 . . Set TelbaarMultiplier=TelbaarProduct
 . . Set:'$P(Rec,D,3) TelbaarMultiplier=0 ; geen omzet
 . . Set:'$P(Rec,D,4) TelbaarMultiplier=0 ; geen marge
 . . Set:'$P(Rec,D,6) TelbaarMultiplier=0 ; geen lijstrpijs
 . . Set Cnt=1
 . . Set Hulp=^HULP(%J,HG,Fabr,GR)
 . . Set $P(Hulp,D,Offset)=$P(Hulp,D,Offset)+($P(Rec,D,1)*TelbaarMultiplier) ; Qty
 . . Set $P(Hulp,D,Offset+1)=$P(Hulp,D,Offset+1)+$P(Rec,D,2) ; # fakt lijn
 . . Set $P(Hulp,D,Offset+2)=$P(Hulp,D,Offset+2)+$P(Rec,D,3) ; Omzet
 . . Set $P(Hulp,D,Offset+3)=$P(Hulp,D,Offset+3)+$P(Rec,D,4) ; Marge
 . . Set $P(Hulp,D,Offset+4)=$P(Hulp,D,Offset+4)+$P(Rec,D,6) ; Lijstprijs
 . . Set ^HULP(%J,HG,Fabr,GR)=Hulp
 . . If Debug Do
 . . . Set $P(DbgHulp,D,Offset)=$P(DbgHulp,D,Offset)+($P(Rec,D,1)*TelbaarMultiplier) ; VerdeelQty
 . . . Set $P(DbgHulp,D,Offset+1)=$P(DbgHulp,D,Offset+1)+$P(Rec,D,2) ; # fakt lijn
 . . . Set $P(DbgHulp,D,Offset+2)=$P(DbgHulp,D,Offset+2)+$P(Rec,D,3) ; Omzet
 . . . Set $P(DbgHulp,D,Offset+3)=$P(DbgHulp,D,Offset+3)+$P(Rec,D,4) ; Marge
 . . . Set $P(DbgHulp,D,Offset+4)=$P(DbgHulp,D,Offset+4)+$P(Rec,D,6) ; Lijstprijs
 . . . Set $P(DbgHulp,D,Offset+5)=$P(DbgHulp,D,Offset+5)+$P(Rec,D,1) ; Qty
 . Kill:$G(^HULP(%J,HG,Fabr,GR))="" ^HULP(%J,HG,Fabr,GR) ; geen omzet gegevens ingevuld, dus terug verwijderen
 . ;zw ^HULP(%J) w !!
 . If Debug,$O(^KSTKL(KLNr,PRNr,BMnd))'=""  Do
 . . Use Dev
 . . Write *9,Fabr,*9,$P(DbgHulp,"\",2),*9,$P(DbgHulp,"\",7),*9,$TR($P(DbgHulp,"\",Offset+2),".",","),*9,TelbaarMultiplier,*9,DbgHulp
 . . Use 0
 Do:Debug CLOSE^vhDEV(Dev)
 Quit

VERDEEL New Temp,HG,GR,SG,Rec,I,Fabr,Tot,VTot,TotQty,HGVTot,HGTotQty
 ;zw %J
 ;Do ^cG
  
 Set HG=""
 For  Set HG=$O(^HULP(%J,HG)) Quit:HG=""  Do
 . Do VerdeelHoofdGroep(HG)
 Quit
 
VerdeelHoofdGroep(HG)
 New Rec,Fabr
 Set Fabr=""
 Set VerdeelbaarRec="",TelbaarRec=""
 For  Set Fabr=$O(^HULP(%J,HG,Fabr)) Quit:Fabr=""  Do
 . Do VerdeelGroep(HG,Fabr)
 . Set Rec=^HULP(%J,HG,Fabr)
 . If $P(Rec,D,2)=0 Do ; Geen telbare aantallen
 . . For I=4:1:6 Set $P(VerdeelbaarRec,D,I)=$P(VerdeelbaarRec,D,I)+$P(Rec,D,I) ; Sommatie om later te verdelen of andere telebare
 . . Kill ^HULP(%J,HG,Fabr)
 . Else  Do
 . . For I=2:1:6 Set $P(TelbaarRec,D,I)=$P(TelbaarRec,D,I)+$P(Rec,D,I) ; Sommatie om later regel van 3 toe te passen

 ;zw ^HULP(%J,HG)
 ;zw TelbaarRec
 ;zw VerdeelbaarRec  w !!
 ;Herverdelen
 Set Fabr=""
 For  Set Fabr=$O(^HULP(%J,HG,Fabr)) Quit:Fabr=""  Do
 . Set Rec=^HULP(%J,HG,Fabr)
 . Set FabrExtraRec=""
 . Set FabrTotaalRec=Rec
 . For I=4:1:6 Set $P(FabrExtraRec,D,I)=$P(VerdeelbaarRec,D,I)*$P(Rec,D,I)/$P(TelbaarRec,D,I),$P(Rec,D,I)=$P(Rec,D,I)+$P(FabrExtraRec,D,I) ; regel van 3
 . Set ^HULP(%J,HG,Fabr)=Rec
 . Do DuwExtraFabrNaarGroep(HG,Fabr,FabrExtraRec,FabrTotaalRec)
 
  Set Rec=""
 For I=2:1:6 Set $P(Rec,D,I)=$P(VerdeelbaarRec,D,I)+$P(TelbaarRec,D,I) ; Groeperen op hoofdgroep
 Set ^HULP(%J,HG)=Rec
 
 Quit
 
DuwExtraFabrNaarGroep(HG,Fabr,FabrExtraRec,FabrTotaalRec)
 New GR,Rec,I
 Set GR=""
 For  Set GR=$O(^HULP(%J,HG,Fabr,GR)) Quit:GR=""  Do
 . Set Rec=^HULP(%J,HG,Fabr,GR)
 . For I=4:1:6 Set $P(Rec,D,I)=$P(Rec,D,I)+($P(FabrExtraRec,D,I)*$P(Rec,D,I)/$P(FabrTotaalRec,D,I)) ; regel van 3
 . Set ^HULP(%J,HG,Fabr,GR)=Rec
 
 Quit
 
VerdeelGroep(HG,Fabr)
 New GR,Rec,VerdeelbaarRec,TelbaarRec
 ;zw ^HULP(%J,HG,Fabr) w !!
 Set GR=""
 Set VerdeelbaarRec="",TelbaarRec=""
 For  Set GR=$O(^HULP(%J,HG,Fabr,GR)) Quit:GR=""  Do
 . Set Rec=^HULP(%J,HG,Fabr,GR)
 . If $P(Rec,D,2)=0 Do ; Geen telbare aantallen
 . . For I=4:1:6 Set $P(VerdeelbaarRec,D,I)=$P(VerdeelbaarRec,D,I)+$P(Rec,D,I) ; Sommatie om later te verdelen of andere telebare
 . . Kill ^HULP(%J,HG,Fabr,GR)
 . Else  Do
 . . For I=2:1:6 Set $P(TelbaarRec,D,I)=$P(TelbaarRec,D,I)+$P(Rec,D,I) ; Sommatie om later regel van 3 toe te passen
 
 ; Verdeelbaar verdelen
 Set GR=""
 For  Set GR=$O(^HULP(%J,HG,Fabr,GR)) Quit:GR=""  Do
 . Set Rec=^HULP(%J,HG,Fabr,GR)
 . For I=4:1:6 Set $P(Rec,D,I)=$P(Rec,D,I)+($P(VerdeelbaarRec,D,I)*$P(Rec,D,I)/$P(TelbaarRec,D,I)) ; regel van 3
 . Set ^HULP(%J,HG,Fabr,GR)=Rec
 
 Set Rec=""
 For I=2:1:6 Set $P(Rec,D,I)=$P(VerdeelbaarRec,D,I)+$P(TelbaarRec,D,I) ; Groeperen op groep
 Set ^HULP(%J,HG,Fabr)=Rec
 ;zw ^HULP(%J,HG,Fabr) r k
 Quit

 
VERDEELo New Temp,HG,GR,SG,Rec,I,Fabr,Tot,VTot,TotQty,HGVTot,HGTotQty
 ;zw %J
 ;Do ^cG
  
 Set (HG,GR,SubGrFabrKey,Tot)=""
 For  Set HG=$O(^HULP(%J,HG)) Quit:HG=""  Do
 .Set HGVTot="",HGTotQty=0
 .For  Set GR=$O(^HULP(%J,HG,GR)) Quit:GR=""  Do
 ..Kill Tot Set VTot="",TotQty=0
 ..For  Set SubGrFabrKey=$O(^HULP(%J,HG,GR,SubGrFabrKey)) Quit:SubGrFabrKey=""  Do
 ...Set Rec=^HULP(%J,HG,GR,SubGrFabrKey)
 ...Set Fabr=$P(Rec,D)
 ...If $P(Rec,D,2) Do ; er zijn aantallen
 ....For I=1:1:3 Set $P(Rec,D,3+I)=$P(Rec,D,3+I)+$P(Rec,D,11+I),$P(Rec,D,11+I)="" ; Verdelen binnen de subgroep van omzet, marge,lijstprijs
 ....Set $P(Rec,D,7,99)=""
 ...;Overbrengen van de subgroep telling naar Tot en VTot
 ...Set Temp=$G(Tot(Fabr))
 ...For I=2:1:5 Set $P(Temp,D,I)=$P(Temp,D,I)+$P(Rec,D,I)
 ...Set TotQty=TotQty+$P(Temp,D,2)
 ...Set Tot(Fabr)=Temp
 ...For I=2:1:5 Set $P(VTot,D,I)=$P(VTot,D,I)+$P(Rec,D,8+I)
 .. ;zw HG,GR,Tot,TotQty r k
 ..;Verdelen van Verdeelbare over de Telbare
 ..Kill ^HULP(%J,HG,GR)
 ..If $D(Tot)>1,TotQty Do  ; Telbare groep
 ...Set Fabr=""
 ...For  Set Fabr=$O(Tot(Fabr)) Quit:Fabr=""  Do
 ....Set Temp=Tot(Fabr)
 ....For I=4:1:6 Set $P(Temp,D,I)=$P(Temp,D,I)+($P(VTot,D,I)*$P(Temp,D,2)/TotQty)
 ....Set Tot(Fabr)=Temp
 ...Merge ^HULP(%J,HG,GR)=Tot
 ..Else  Do  ; Geen telbare groep
 ...For I=2:1:6 Set $P(HGVTot,D,I)=$P(HGVTot,D,I)+$P(VTot,D,I)
 ..Set HGTotQty=HGTotQty+TotQty
 .;De verdeelbare groepen zijn gesommeerd in HGVTot en moeten verdeeld worden over de telbare groepen
 .If $P(HGVTot,D,4) Do
 ..Set (GR,Fabr)=""
 ..For  Set GR=$O(^HULP(%J,HG,GR)) Quit:GR=""  Do
 ...For  Set Fabr=$O(^HULP(%J,HG,GR,Fabr)) Quit:Fabr=""  Do
 ....Set Temp=^HULP(%J,HG,GR,Fabr)
 ....For I=4:1:6 Set:HGTotQty'=0 $P(Temp,D,I)=$P(Temp,D,I)+($P(HGVTot,D,I)*$P(Temp,D,2)/HGTotQty)
 ....Set ^HULP(%J,HG,GR,Fabr)=Temp
 Quit
 
SAVE(KLNr) 
 New I,HG,GR,Fabr,Verd,FabrNm,VerdNm,Kov,Rec
 Set (HG,GR,Fabr)=""
 For  Set HG=$O(^HULP(%J,HG)) Quit:HG=""  Do
 .For  Set Fabr=$O(^HULP(%J,HG,Fabr)) Quit:Fabr=""  Do
 ..For  Set GR=$O(^HULP(%J,HG,Fabr,GR)) Quit:GR=""  Do
 ...Set Rec=^HULP(%J,HG,Fabr,GR)
 ...Quit:$P(Rec,D,2)<1 ; geen aantal 
 ...Set Verd="8005" ; Van Hoecke
 ...Quit:$D(^KKOV(KLNr,HG,GR,Verd,Fabr))  ; Bestaat reeds als man. lijn dus SKIP
 ...Set VerdNm=$P(^KVER(^KVER1(Verd),0),D,10)
 ...If '$D(^KFAB1(Fabr)) Set (K,^KFAB1(Fabr))=^KL1(Fabr),^KFAB(K,0)=^KLE(K,0),$P(^KFAB(Fabr,0),D,10)=$P($E(K,1,4)," ",1) ; Aanmaken van fabrikant vanuit het leveranciers bestand
 ...If '$L($P(^KFAB(^KFAB1(Fabr),0),D,10)) Set $P(^KFAB(^KFAB1(Fabr),0),D,10)=$P($E(^KFAB1(Fabr),1,4)," ",1)
 ...Set FabrNm=$P(^KFAB(^KFAB1(Fabr),0),D,10)
 ...Set Kov=""
 ...Set $P(Kov,D,1)=FabrNm
 ...Set $P(Kov,D,3)=$J($P(Rec,D,2),0,0)
 ...Set $P(Kov,D,5)="    "_$$DISPLS^KLASS(GR)_" "
 ...Set $P(Kov,D,6)=$J($P(Rec,D,4)/$S($P(Rec,D,2):$P(Rec,D,2),1:1),0,2)
 ...Set $P(Kov,D,11)=VerdNm
 ...Set $P(Kov,D,12)=$P(Rec,D,3)
 ...Set $P(Kov,D,14)=Fabr
 ...Set $P(Kov,D,15)=Verd
 ...Set $P(Kov,D,16)=$J($P(Rec,D,4),0,0)
 ...Set $P(Kov,D,17)="KKOV10"
 ...Set $P(Kov,D,21)="G"
 ...Set $P(Kov,D,22)=$$FADEF^vhRtn1()
 ...Set $P(Kov,D,25)=1
 ...Set ^KKOV(KLNr,HG,GR,Verd,Fabr)=Kov
 .;Opslaan voor hoofdgroep
 .Quit:$D(^KKOV(KLNr,HG,0,0,0))  ; Bestaat reeds dus skip
 .Set (Verd,Fabr,Kov)="",GR=0
 .For  Set GR=$O(^KKOV(KLNr,HG,GR)) Quit:GR=""  Do
 ..For  Set Verd=$O(^KKOV(KLNr,HG,GR,Verd)) Quit:Verd=""  Do
 ...For  Set Fabr=$O(^KKOV(KLNr,HG,GR,Verd,Fabr)) Quit:Fabr=""  Do
 ....Set Rec=^KKOV(KLNr,HG,GR,Verd,Fabr)
 ....For I=3,12,16 Set $P(Kov,D,I)=$P(Kov,D,I)+$P(Rec,D,I)
 .Set $P(Kov,D,5)=$$DISPLS^KLASS(HG)_" "
 .Set $P(Kov,D,6)=$J($P(Kov,D,16)/$S($P(Kov,D,3):$P(Kov,D,3),1:1),0,2)
 .Set $P(Kov,D,8)="*"
 .Set $P(Kov,D,17)="KKOV10"
 .Set $P(Kov,D,21)="H"
 .Set $P(Kov,D,22)=$$FADEF^vhRtn1()
 .Set $P(Kov,D,25)=1
 .Set ^KKOV(KLNr,HG,0,0,0)=Kov
 If $D(^KKOV(KLNr)) Do
 .Set ^KKOV(KLNr,0)=$G(KKOV(KLNr,0),101)
 .Set ^KKOV(KLNr,1)=$G(KKOV(KLNr,0))
 Kill:$O(^KKOV(KLNr,1))="" ^KKOV(KLNr)
 Quit
 
 ; Nazicht of alle hoofdgroepnodes zijn opgezet
CHKHG(KLNr) 
 New I,HG,GR,Verd,Fabr,Rec,Kov
 Set HG=" ",(Rec,Kov)=""
 For  Set HG=$O(^KKOV(KLNr,HG)) Quit:HG=""  Do
 .Quit:$D(^KKOV(KLNr,HG,0))
 .Set GR=""
 .For  Set GR=$O(^KKOV(KLNr,HG,GR)) Quit:GR=""  Do
 ..Set Verd=""
 ..For  Set Verd=$O(^KKOV(KLNr,HG,GR,Verd)) Quit:Verd=""  Do
 ...Set Fabr=""
 ...For  Set Fabr=$O(^KKOV(KLNr,HG,GR,Verd,Fabr)) Quit:Fabr=""  Do
 ....Set Rec=^KKOV(KLNr,HG,GR,Verd,Fabr)
 ....For I=3,12,16 Set $P(Kov,D,I)=$P(Kov,D,I)+$P(Rec,D,I)
 .Set $P(Kov,D,5)=$$DISPLS^KLASS(HG)_" "
 .Set $P(Kov,D,6)=$J($P(Kov,D,16)/$S($P(Kov,D,3):$P(Kov,D,3),1:1),0,2)
 .Set $P(Kov,D,8)="*"
 .Set $P(Kov,D,17)="KKOV10"
 .Set $P(Kov,D,21)="H"
 .Set $P(Kov,D,22)=$$FADEF^vhRtn1()
 .Set $P(Kov,D,25)=""
 .Set ^KKOV(KLNr,HG,0,0,0)=Kov
 Quit
 
AfgeleidTBX(PRNr, KKey, Verdeel) ; Tandembox op maat
 ; params Verdeel en KKey via .Local
 Set Verdeel=1
 Set:$P($$GENTYP^HAD(PRNr),"\",1,2)="TBX\HKS" Verdeel=3 ; Hoekkast
 Set KKey=409 ; volledig uittrekbaar BX-VVO-365/BL
 Set:$LG(##class(Prod.Kenmerk.DataDefinitie).Get("TBX",PRNr,"GT"))="E" KKey=406 ; enkel uittrekbaar BX-VEN-305/BL
 Quit	
 
AfgeleidTAO(PRNr, KKey, Verdeel) ; TA'OR BOX op maat -> conversie via corpusprofielen
 ; params Verdeel en KKey via .Local
 New GlijderPRNr,GlijderKlas,IKey
 Set Verdeel=1
 Set GlijderPRNr=$P($G(^PRBS("BS",PRNr,"PRGLIJDER.001")),"\",1)
 If 'GlijderPRNr 
 {
  	Set GlijderPRNr=$P($G(^PRBS("BS",PRNr,"PRCPLI.001")),"\",1)
 }
 If GlijderPRNr
 {
	Set IKey=$O(^KPR(GlijderPRNr,"I")) 
	If $E(IKey)="I"
	{
	
		Set GlijderKlas=^KPR(GlijderPRNr,IKey)
	 	Set Verdeel=1
	 	Set KKey=$P(GlijderKlas,D,4)
	}
 }
 Quit	

AfgeleidLBX(PRNr, KKey, Verdeel) ; LEGRABOX op maat -> conversie via zijkanten
 ; params Verdeel en KKey via .Local
 New GlijderPRNr,GlijderKlas,IKey
 Set Verdeel=1
 Set GlijderPRNr=$P($G(^PRBS("BS",PRNr,"PRLALI.001")),"\",1)
 If 'GlijderPRNr 
 {
  	Set GlijderPRNr=$P($G(^PRBS("BS",PRNr,"PRLARE.001")),"\",1)
 }
 If GlijderPRNr
 {
	Set IKey=$O(^KPR(GlijderPRNr,"I")) 
	If $E(IKey)="I"
	{
		Set GlijderKlas=^KPR(GlijderPRNr,IKey)
	 	Set Verdeel=1
	 	Set KKey=$P(GlijderKlas,D,4)
	}
 }
 Quit	

AfgeleidSDM(PRNr, KKey, Verdeel) ; Servo drive op maat
 ; params Verdeel en KKey via .Local
 Set NewVerdeel=""
 Set BSKey=""
 ;Write !,PRNr," ",$P(^KPR(PRNr,0),D,1),!
 For  Set BSKey=$O(^PRBS("BS",PRNr,BSKey)) Quit:BSKey=""  Do
 . Set HFPRNr=$P(^PRBS("BS",PRNr,BSKey),"\",1)
 . Quit:'HFPRNr
 . Set HFVerdeel=$P($G(^KPR(HFPRNr,1)),"\",7)
 . Set HFQty=$P(^PRBS("BS",PRNr,BSKey),"\",2)
 . ;Write " ->",HFPRNr," ",$P(^KPR(HFPRNr,0),D,1)," ",HFQty," ",HFVerdeel,!
 . Quit:'HFVerdeel
 . Set NewVerdeel=NewVerdeel+(HFQty*HFVerdeel)
 Set:NewVerdeel Verdeel=NewVerdeel
 Set Verdeel=NewVerdeel
 Quit