PRLINK ;Samengestelde produkten [ 08/25/2003  3:43 PM ]
 ;
 New PRNr
 For  Do  Quit:PRNr="-"
 .For  Do  Quit:PRNr="-"  Quit:PRNr
 ..Set PRNr=$$SELECTPR()
 ..If $L($$CHKWMS(PRNr)) Do
 ...New KortText
 ...Do DISPLAY^vhScherm("PRLINK")
 ...Set KortText=$P(^KPR(PRNr,0),D),R=$$^vhTXTPOP("PRLINK","CHKWMS","",KortText)
 ...Set PRNr=""
 .Quit:PRNr="-"
 .Do VERWERK(PRNr)
 Quit
 ;
SELECTPR() 
 New PRNr,KortText
 Set PRNr=""
 Do REFRESH
 For  Do FIELD^vhScherm("PRLINK","PRNR") Quit:PRNr="-"  Quit:'$L($$CHKLINK(PRNr,"K"))  Do
 .Set LinkType=$P(^KPR(PRNr,0),D,23),LinkType=$S(LinkType="":"S",1:LinkType)
 .Do REFRESH
 .Set KortText=$P(^KPR(PRNr,0),D),R=$$^vhTXTPOP("PRLINK","MKPRNR","",KortText),PRNr=""
 .Do REFRESH
 Quit PRNr
 ;
VERWERK(PRNr,Raadpl,FabKey) 
 New %TC,%SC,%J,zb,R,Quit,List,sMod,NoMod,PRLink,ChkWms,KortText,GHrp New:'$G(RPLPR) Input
 Set Raadpl=$G(Raadpl)
 Do:Raadpl STORE^vhTERMINA()
 If $L($$CHKLINK(PRNr,"K")) Set LinkType=$P(^KPR(PRNr,0),D,23),LinkType=$S(LinkType="":"S",1:LinkType)
 Do INIT,DISPLAY^vhScherm("PRLINK")
 Set NoMod=+Raadpl
 If 'NoMod Do  Quit:Quit
 .Set Quit=0
 .Do ADD^vhLock("^PRLINK(""D"",PRNr)")
 .If '%TC Do LDISP^vhLock("^PRLINK(""D"",PRNr)",$P(^KPR(PRNr,0),D)) Set Quit=1
 Set HGrp=$P(^KPR(PRNr,$O(^KPR(PRNr,"I"))),D,1)
 Do FETCH($G(FabKey))
 Set PRLink=$$CHKLINK(PRNr) Set:PRLink="" PRLink="M"
 Do INIT^vhLIST("PRLINK","PRLINK"_PRLink_$S(HGrp["OL":"O",1:""),.List),WRITE^vhLIST(.List)
 For  Do  Quit:Quit
 .Do COMMAND
 .Set Quit=0
 .If Raadpl,NoMod,$L(Input) Set Quit=1
 .If "\-\CANC\"[(D_Input_D) Set:Raadpl Quit=1 Quit:Quit  Set Quit=$L($$SAVE^vhINP(1,0))
 .If Input="SAVE" Set Quit=$$SAVE(1)
 Kill ^HULP(%J)
 Do:Raadpl REFRESH^vhTERMINA()
 Quit
 ;
RAADPL(PRNr,RPLPR,FabKey) 
 Set RPLPR=$G(RPLPR)
 Do VERWERK(PRNr,1,$G(FabKey))
 Set:RPLPR VTB=$G(U4),SW2=0,R=Input
 Quit
 ;
COMMAND 
 Set Input=$$SCROLL^vhLIST(.List)
 If Input="COM" Set Input="" Do CALL^vhMenu("PRLINK")
 ;If Input="SPEC" Set Input="" Do CALLSPEC^vhMenu(List("POS")+List("SELECT")_";80","PRLINKS","E")
 Quit:Input=""
 If Input="ENTER",'NoMod Do MODIFY Quit
 Do EXEC^vhMenu("PRLINK",.Input)
 Quit
 ;
NEW 
 New R,%SC,LEVNr,KPRNr,LinkType,Aantal,OrgVerp,KortText,HGrp,FysStock
 If PRLink="HF" Goto NEWHF
 Set R=$O(^KPR(PRNr,"J"))
 Quit:$E(R)'="J"
 Set R=^KPR(PRNr,R),LEVNr=$P(R,D)
 Do STORE^vhTERMINA()
 Set HGrp=$P(^KPR(PRNr,$O(^KPR(PRNr,"I"))),D,1)
 Set:HGrp["OL" KPRNr=$$SELECT^PRODUKT6(,,,"Kindprodukt : ")
 Set:HGrp'["OL" KPRNr=$$SELECT^PRODUKT6("L",LEVNr,,"Kindprodukt : ")
 Do REFRESH^vhTERMINA()
 If KPRNr Do
 .If KPRNr=PRNr!$D(^PRLINK("D",KPRNr)) Do  Quit
 ..Set KortText=$P(^KPR(KPRNr,0),D),R=$$^vhTXTPOP("PRLINK","MPRNR","",KortText)
 .If $D(^HULP(%J,"K",KPRNr)) Do  Quit
 ..Set KortText=$P(^KPR(KPRNr,0),D),R=$$^vhTXTPOP("PRLINK","KPRNR","",KortText)
 .Do STORE^vhTERMINA()
 .Set FP=2101
 .Write @F,@F1
 .Set R=$G(^HULP(%J,"V",KPRNr))
 .If $L(R) Set LinkType=$P(R,D,2),Aantal=$P(R,D,3),OrgVerp=$P(R,D,4),FysStock=$P(R,D,5)
 .Else  Do
 ..Set LinkType=$P(^KPR(KPRNr,0),D,23),LinkType=$S(LinkType="":"S",1:LinkType)
 .Set Key=$P(R,D,1)
 .Set Aantal=1,OrgVerp="",FysStock=$$GETSTOCK^PRODUKT4(KPRNr,"F")
 .If HGrp'["OL" Do
 ..Do DISPLAY^vhScherm("PRLINKD")
 ..Do FIELD^vhScherm("PRLINKD","AANTAL")
 .Else  Do NIEUW^vhScherm("PRLINKD")
 .Do REFRESH^vhTERMINA()
 .If $G(%SC) Do
 ..Set sMod("N")=1
 ..Set R=KPRNr_";1\"_LinkType_D_Aantal_D_OrgVerp_D_FysStock
 ..If $O(^HULP(%J,"L",""),-1),'$P($P(^($O(^HULP(%J,"L",""),-1)),D),";",2) Do NIEUW^vhLISTE(.List,"&S")
 ..Do NIEUW^vhLISTE(.List,R)
 ..Set ^HULP(%J,"K",KPRNr)=""
 ..Kill ^HULP(%J,"V",KPRNr)
 Quit
 ;
MODIFY 
 New R,%SC,KPRNr,LinkType,Aantal,OrgVerp,FysStock,HGrp
 If PRLink="HF" Goto MODHF
 Set R=$G(^HULP(%J,"L",List("SELECT")))
 If $L(R) Do
 .Do STORE^vhTERMINA()
 .Set HGrp=$P(^KPR(PRNr,$O(^KPR(PRNr,"I"))),D,1)
 .Set KPRNr=$P(R,D),LinkType=$P(R,D,2),Aantal=$P(R,D,3),OrgVerp=$P(R,D,4),FysStock=$P(R,D,5)
 .If HGrp'["OL" Do
 ..Do DISPLAY^vhScherm("PRLINKD")
 ..Do FIELD^vhScherm("PRLINKD","AANTAL")
 .Else  Do EDIT^vhScherm("PRLINKD")
 .Do REFRESH^vhTERMINA()
 .Quit:'$G(%SC)
 .Set sMod("M")=1
 .Set R=KPRNr_D_LinkType_D_Aantal_D_OrgVerp_D_FysStock
 .Set ^HULP(%J,"L",List("SELECT"))=R
 .Do LINE^vhLIST(.List,List("SELECT"))
 Quit
 ;
MODHEAD 
 New sFL
 Do EDIT^vhScherm("PRLINK")
 Set:%SC sMod("H")=sFL(1)
 Do REFRESH
 Quit
 ;
MODHF ;Wijzigen HFabrikaat
 New R,%SC,HFPRNr,Aantal,HFCode,RecHF,IsDim,RecHFD,sFL
 Set R=$G(^HULP(%J,"L",List("SELECT")))
 If $L(R) Do
 .Do STORE^vhTERMINA()
 .Set HFCode=$P(R,D,4)
 .Set sFL(1)=$G(^HADPR("P",PRNr,"HF",HFCode))
 .Set sFL(2)=$G(^HADPR("P",PRNr,"HF",HFCode,"D"))
 .Quit:sFL(1)=""
 .Set HFPRNr=$P(sFL(1),D),Aantal=$P(sFL(1),D,2)
 .Set IsDim="PR"'[$P($G(^KPR(HFPRNr,15)),D,10)
 .Set IsDim=1
 .Do EDIT^vhScherm("PRLINKHF")
 .Do REFRESH^vhTERMINA()
 .Quit:'$G(%SC)
 .Set $P(sFL(1),D,5)=$G(sUser)
 .Set $P(sFL(1),D,6)=$H
 .Set ^HADPR("P",PRNr,"HF",HFCode)=sFL(1)
 .If IsDim,$TR(sFL(2),D,"")'="" Do
 .. Set ^HADPR("P",PRNr,"HF",HFCode,"D")=sFL(2)
 .Else  Do
 .. Kill ^HADPR("P",PRNr,"HF",HFCode,"D")
 .Set R=$G(^HULP(%J,"L",List("SELECT")))
 .Set $P(R,D,1)=$P(sFL(1),D,1)
 .Set $P(R,D,3)=$P(sFL(1),D,2)
 .Set $P(R,D,5)=$P(sFL(2),D,1)
 .Set $P(R,D,6,7)=""
 .Set ^HULP(%J,"L",List("SELECT"))=R
 .Do LINE^vhLIST(.List,List("SELECT"))
 Quit
 
NEWHF ;Nieuw HFabrikaat
 New R,%SC,HFPRNr,Aantal,HFCode,IsDim,sFL
 Do STORE^vhTERMINA()
 Set HFCode=""
 Set sFL(1)=""
 Set sFL(2)=""
 Set $P(sFL(1),D,2)=1
 Set IsDim=1
 Do NIEUW^vhScherm("PRLINKHF")
 Do REFRESH^vhTERMINA()
 Quit:'$G(%SC)
 Quit:HFCode'?1A.E
 Quit:$P(sFL(1),D)'?4.7N  ; Geen geldig product
 Set IsDim="PR"'[$P($G(^KPR($P(sFL(1),D),15)),D,10)
 Set $P(sFL(1),D,5)=$G(sUser)
 Set $P(sFL(1),D,6)=$H
 Set ^HADPR("P",PRNr,"HF",HFCode)=sFL(1)
 If IsDim,$TR(sFL(2),D,"")'="" Do
 . Set ^HADPR("P",PRNr,"HF",HFCode,"D")=sFL(2)
 Else  Do
 . Kill ^HADPR("P",PRNr,"HF",HFCode,"D")
 Set R=""
 Set $P(R,D,1)=$P(sFL(1),D,1)
 Set $P(R,D,2)=HFCode
 Set $P(R,D,3)=$P(sFL(1),D,2)
 Set $P(R,D,4)=HFCode
 Set $P(R,D,5)=$P(sFL(2),D,1)
 Set $P(R,D,6,7)=""
 Do NIEUW^vhLISTE(.List,R)
 Quit
 
DELHF ;Verwijder HFabrikaat
 New R,%SC,HFCode
 Set R=$G(^HULP(%J,"L",List("SELECT")))
 If $L(R) Do
 .Set HFCode=$P(R,D,4)
 .Set R=$$^vhTXTPOP("PRLINK","DELETEHF","",HFCode)
 .Quit:'R
 .Kill ^HADPR("P",PRNr,"HF",HFCode)
 .Do DELETE^vhLISTE(.List)
 Quit
 
DELETE 
 New R,KPRNr
 If PRLink="HF" Goto DELHF
 Set R=$G(^HULP(%J,"L",List("SELECT")))
 If $L(R) Do
 .Set sMod("D")=1,KPRNr=$P($P(R,D),";"),^HULP(%J,"V",KPRNr)=R
 .Kill ^HULP(%J,"K",KPRNr)
 .Do DELETE^vhLISTE(.List)
 .If $P($G(^HULP(%J,"L",List("SELECT"))),D)="&S" Do
 ..If $P($G(^HULP(%J,"L",List("SELECT")-1)),D)'="&S",$P($G(^HULP(%J,"L",List("SELECT")+1)),D)'="&S" Do  Quit
 ...If List("SELECT")=1,$O(^HULP(%J,"L",List("SELECT")))="" Do DELETE^vhLISTE(.List)
 ..If List("SELECT")=$O(^HULP(%J,"L","")) Do DELETE^vhLISTE(.List) Quit
 ..If List("SELECT")=$O(^HULP(%J,"L",""),-1) Do DELETE^vhLISTE(.List) Quit
 ..If $P($G(^HULP(%J,"L",List("SELECT")-1)),D)="&S" Set List("SELECT")=List("SELECT")-1 Do DELETE^vhLISTE(.List) Quit
 ..If $P($G(^HULP(%J,"L",List("SELECT")+1)),D)="&S" Do DELETE^vhLISTE(.List) Quit
 .If $P($G(^HULP(%J,"L",List("SELECT"))),D)="&S" Do
 ..If $O(^HULP(%J,"L",List("SELECT")))="" Do DELETE^vhLISTE(.List) Quit
 ..Do MOVE^vhLIST(.List,"DO",0)
 Quit
 ;
FETCH(FabKeyDef) 
 New R,MPRNr,KPRNr,LinkType,Aantal,OrgVerp,SortKey,Count,FysStock
 New Rec,RecDim,Key
 If $$CHKLINK(PRNr)="M" Do  ; tonen van kind en andere moeders
 .Set ^HULP(%J,"M",PRNr)="",KPRNr=""
 .For  Set KPRNr=$O(^PRLINK("D",PRNr,KPRNr)) Quit:'KPRNr  Do
 ..Set SortKey=$$SORTKEY^PRODUKT(KPRNr),^HULP(%J,"S","K",SortKey)=KPRNr_D_PRNr,^HULP(%J,"K",KPRNr)=""
 ..Set MPRNr=""
 ..For  Set MPRNr=$O(^PRLINK("IKM",KPRNr,MPRNr)) Quit:'MPRNr  Do
 ...Set SortKey=$$SORTKEY^PRODUKT(MPRNr),^HULP(%J,"S","M",SortKey)=MPRNr_D_KPRNr
 .Set SortKey="",Count=0
 .For  Set SortKey=$O(^HULP(%J,"S","K",SortKey)) Quit:SortKey=""  Do
 ..Set R=^HULP(%J,"S","K",SortKey),KPRNr=$P(R,D),MPRNr=$P(R,D,2)
 ..Set R=^PRLINK("D",MPRNr,KPRNr),Aantal=$P(R,D),OrgVerp=$P(R,D,2)
 ..Set LinkType=$P(^KPR(KPRNr,0),D,23),LinkType=$S(LinkType="":"S",1:LinkType)
 ..Set R=KPRNr_D_LinkType_D_Aantal_D_OrgVerp_D_$$GETSTOCK^PRODUKT4(KPRNr,"F")_D
 ..Set Count=Count+1,^HULP(%J,"L",Count)=R
 .If NoMod Do
 ..Set Count=Count+1,^HULP(%J,"L",Count)="MP"
 ..For  Set SortKey=$O(^HULP(%J,"S","M",SortKey)) Quit:SortKey=""  Do
 ...Set R=^HULP(%J,"S","M",SortKey),MPRNr=$P(R,D),KPRNr=$P(R,D,2)
 ...Set R=MPRNr_D_D_D_D_$$GETSTOCK^PRODUKT4(MPRNr,"F")_D
 ...Set Count=Count+1,^HULP(%J,"L",Count)=R
 Else  If $D(^PRLINK("IKM",PRNr)) Do  ; Kind -> tonen van alle moeders
 .Set ^HULP(%J,"K",PRNr)="",MPRNr=""
 .For  Set MPRNr=$O(^PRLINK("IKM",PRNr,MPRNr)) Quit:'MPRNr  Do
 ..Set SortKey=$$SORTKEY^PRODUKT(MPRNr),^HULP(%J,"S","M",SortKey)=MPRNr,^HULP(%J,"M",MPRNr)=""
 ..Set KPRNr=""
 ..For  Set KPRNr=$O(^PRLINK("D",MPRNr,KPRNr)) Quit:'KPRNr  Do
 ...Set SortKey=$$SORTKEY^PRODUKT(KPRNr)
 ...If SortKey="" Do
 .... Write "**** KIND PRODUCT BESTAAT NIET (Moeder:"_MPRNr_") Kind:"_KPRNr_" *****" r k
 ...Else  Do
 .... Set ^HULP(%J,"S","K",SortKey)=KPRNr
 .Set SortKey="",Count=0
 .For  Set SortKey=$O(^HULP(%J,"S","M",SortKey)) Quit:SortKey=""  Do
 ..Set MPRNr=^HULP(%J,"S","M",SortKey),R=^PRLINK("D",MPRNr,PRNr),Aantal=$P(R,D),OrgVerp=$P(R,D,2)
 ..Set R=MPRNr_D_D_Aantal_D_OrgVerp_D_$$GETSTOCK^PRODUKT4(MPRNr,"F")_D
 ..Set Count=Count+1,^HULP(%J,"L",Count)=R
 Else   Do  ; Tonen van halffabrikaten
 .Set Key=""
 .Set FabKey=$S($L($G(FabKeyDef)):FabKeyDef,1:$$FABKEYP^HADOPV(PRNr))
 .For  Set Key=$O(^PRBS("BS",PRNr,Key)) Quit:Key=""  Do
 ..Set Rec=^PRBS("BS",PRNr,Key)
 ..Set RecDim=$G(^PRBS("BS",PRNr,Key,"D"))
 ..Quit:$P(Rec,D)'?4.7N
 ..If '$D(^KPR($P(Rec,D),0)) Do  ; Product is verwijderd
 ... Set $P(Rec,D)=$P(^KPR(PRNr,0),D,3) ; dan generisch product
 ... Set ^PRBS("BS",PRNr,Key)=Rec
 ..Set SortKey=$$SORTKEY^PRODUKT($P(Rec,D))_Key,^HULP(%J,"S","HF",SortKey)=$P(Rec,D)_D_Key_D_$P(Rec,D,2)_D_Key_D_$P(RecDim,D)_D_$$STATHF(FabKey,Key)
 .Set Count=0,SortKey=""
 .For  Set SortKey=$O(^HULP(%J,"S","HF",SortKey)) Quit:SortKey=""  Do
 ..Set Count=Count+1,^HULP(%J,"L",Count)=^HULP(%J,"S","HF",SortKey)
 Kill ^HULP(%J,"S")
 Quit
 ;
STATHF(FabKey,HFCode) 
 If FabKey="" Quit "" ; Geen fabkey
 If FabKey["\" Quit "+++" ; Meerdere fabkey
 Quit $P($G(^HADPR("F",FabKey,"AR",HFCode)),D,6)_D_$P($G(^HADPR("F",FabKey,"AR",HFCode)),D,10)
 
SAVE(NotSave) 
 New %TC,R,Save,Next,KPRNr,Aantal,OrgVerp,MinStock
 Set Save=$$SAVE^vhINP(NotSave,$D(sMod))
 If Save="-",$D(sMod) Do
 .Do DELIND(PRNr)
 .Kill ^PRLINK("D",PRNr)
 .Set MinStock=999999999
 .For Next=1:1 Quit:'$D(^HULP(%J,"L",Next))  Do
 ..Set R=^HULP(%J,"L",Next)
 ..Quit:R="&S"  Quit:'$P(R,D)
 ..Set KPRNr=$P($P(R,D),";"),Aantal=$P(R,D,3),OrgVerp=$P(R,D,4)
 ..Quit:'Aantal
 ..Set R=Aantal_D_OrgVerp,^PRLINK("D",PRNr,KPRNr)=R
 ..Set Stock=$P(^KPR(KPRNr,0),D,14)/Aantal
 ..Set:MinStock>Stock MinStock=Stock
 .Do BLDIND(PRNr)
 .Set:$D(sMod("H")) ^PRLINK("D",PRNr)=sMod("H")
 .;Set $P(^KPR(PRNr,0),D,14)=$S(MinStock>999999990:0,1:MinStock)
 Set Save=$L(Save)
 Quit Save
 ;
PRINT 
 New PList,PRLink
 If $D(sMod("N"))  Quit:'$$SAVE(0)  Do
 .Kill ^HULP(%J),sMod
 .Do FETCH()
 .Set PRLink=$$CHKLINK(PRNr) Set:PRLink="" PRLink="M"
 .Do INIT^vhLIST("PRLINK","PRLINK"_PRLink,.List),WRITE^vhLIST(.List)
 Do MFETCHE^PRLINKL(PRNr)
 Quit
 ;
REFRESH 
 New sFL
 Do DISPLAY^vhScherm("PRLINK")
 If PRNr,$D(List) Do WRITE^vhLIST(.List)
 Quit
 ;
LIST 
 Goto ^PRLINKL
 Quit
 ;
INIT 
 Set %J=$$%J^vhRtn1()
 Kill ^HULP(%J)
 Quit
 ;
INITSCR(ScrnTyp) 
 New Activate,Rubriek
 If ScrnTyp="" Do
 .Set (Activate,sFL(1))=""
 .If $L(PRNr) Do
 ..If $L($$CHKLINK(PRNr,"K")) Set Activate=Activate_"LINKTYPE"
 ..Else  Set sFL(1)=$G(sMod("H"),$G(^PRLINK("D",PRNr))) ;,Activate="VERPAKKING\HANDELING\TOESLAG"
 .For  Set Rubriek=$P(Activate,D) Quit:Rubriek=""  Do
 ..Do REMATTR^vhScherm(Rubriek,"H","HD")
 ..Set Activate=$P(Activate,D,2,99)
 Quit
 ;
NEXTID() 
 New NextId
 Quit NextId
 ;
BLDIND(PRNr) 
 New KPRNr
 Set KPRNr=""
 For  Set KPRNr=$O(^PRLINK("D",PRNr,KPRNr)) Quit:'KPRNr  Set ^PRLINK("IKM",KPRNr,PRNr)=""
 Quit
 ;
DELIND(PRNr) 
 New KPRNr
 Set KPRNr=""
 For  Set KPRNr=$O(^PRLINK("D",PRNr,KPRNr)) Quit:'KPRNr  Kill ^PRLINK("IKM",KPRNr,PRNr)
 Quit
 ;
BLDALL ; Heropbouwen van alle indexen
 Kill ^PRLINK("IKM")
 Set PRNr=""
 For  Set PRNr=$O(^PRLINK("D",PRNr))  Quit:PRNr=""  Do
 .Do BLDIND(PRNr)
 Quit
CHKLINK(PRNr,Type) 
 New SamProd
 Set Type=$G(Type),Type=$TR(Type,$TR(Type,"MK",""),"") Set:Type="" Type="MK"
 Set SamProd=""
 If Type["M" Do
 .If $D(^PRLINK("D",PRNr)) Set SamProd="M" Quit
 If Type["K" Do
 .If $D(^PRLINK("IKM",PRNr)) Set SamProd=SamProd_"K" Quit
 .Set:$P(^KPR(PRNr,0),"\",23)="K" SamProd=SamProd_"K"
 If $$HasHalfFabr^PRBS(PRNr) Set SamProd="HF"
 Quit SamProd
 ;
 
LINKDISP(PRNr)
	Quit:PRNr'?4.7N ""
	Set LinkType=$P($G(^PRBS("BS",PRNr)),"\",2)
	If LinkType="" Quit "No type defined"
	Set VerwerkType=$P($G(^PRBS("BS",PRNr)),"\",1)
	If VerwerkType="" Quit "No type defined"
	Quit $$FETCHPOP^vhScherm("PRBS","META",LinkType,"O")_" - "_$$FETCHPOP^vhScherm("PRBS","VERWERK",VerwerkType,"O")
 
LINKTYPE(LinkType,NoPop) 
 New R,Position
 If LinkType="HF" Quit "HALFFAB"
 Set LinkType=$G(LinkType) Set:LinkType="" LinkType="ST"
 If '$G(NoPop) Do
 .If '$D(U2) New U2 Set U2="LinkType;;;;C;C" Set:$D(sFR) $P(U2,D,5,6)=$TR($P(sFR,"`",5,6),"`",";")
 .Set Position=$P(U2,";",5)
 .If Position Do
 ..Set Position=Position-$P($G(^RES("PRLINK","PI","LINKTYPE","D",LinkType)),"`")+1
 ..Set:$D(sFR) Position=Position+17
 .Set Position=Position_";"_$P(U2,";",6)
 .Set LinkType=$$PI^vhPOPUP(Position,"O1-",$P(U2,";"),"PRLINK","LINKTYPE",LinkType)
 Else  Do
 .If $L(LinkType) Set LinkType=$P($G(^RES("PRLINK","PI","LINKTYPE","D",LinkType)),"`",2)
 .Else  Set LinkType=""
 Set:LinkType="ST" LinkType=""
 Quit LinkType
 ;
CHKWMS(PRNr,Type) 
 New Wms,ORDNr,OLUNr,TOENr,TLUNr
 Set Wms="",Type=$G(Type,"OR")
 If Type["O" Do
 .Set ORDNr=""
 .For  Set ORDNr=$O(^ORD("IP",PRNr,ORDNr)) Quit:ORDNr=""  Do  Quit:Wms["O"
 ..Set OLUNr=""
 ..For  Set OLUNr=$O(^ORD("IP",PRNr,ORDNr,OLUNr)) Quit:OLUNr=""  Do  Quit:Wms["O"
 ...Set:$D(^ORDW("IO",ORDNr,OLUNr)) Wms=Wms_"O"
 If Type["R" Do
 .Set TOENr=""
 .For  Set TOENr=$O(^TO("IP",PRNr,TOENr)) Quit:TOENr=""  Do  Quit:Wms["R"
 ..Set TLUNr=""
 ..For  Set TLUNr=$O(^TO("IP",PRNr,TOENr,TLUNr)) Quit:TLUNr=""  Do  Quit:Wms["R"
 ...Set:$D(^RCP("IT",TOENr,TLUNr)) Wms=Wms_"R"
 Quit Wms
 ;
 ; Bepaal het aantal kinderen van een moeder
AANTKIND(MPRNr) 
 New R,AantKind,KPRNr
 Set AantKind=0,KPRNr=""
 For  Set KPRNr=$O(^PRLINK("D",MPRNr,KPRNr)) Quit:KPRNr=""  Set R=^PRLINK("D",MPRNr,KPRNr),AantKind=AantKind+$P(R,D)
 Quit AantKind
 
 ; Bepaal het aantal kinderen van een moeder
AANTKIND2(MPRNr) 
 New R,AantKind,KPRNr
 Set AantKind=0,BSKey=""
 For  Set BSKey=$O(^PRBS("BS",MPRNr,BSKey)) Quit:BSKey=""  Set R=^PRBS("BS",MPRNr,BSKey) Set:$P(R,"\",3)="K" AantKind=AantKind+$P(R,D,2)
 Quit AantKind
 
 ; Ophalen van de reletie moeder, kinderen en kleinkinderen
Moeder2KindRecursief(MPRNr,Moeder2Kind)
 New KPRNr,KKPRNr,StockOverKind,LinkQty,KKLinkQty
 Set StockOverKind=$P(^KPR(MPRNr,0),D,23)="S"
 Set (Moeder2Kind(MPRNr),Moeder2Kind("M",MPRNr))=1
 If $D(^PRLINK("D",MPRNr)) Do
 .Set KPRNr=""
 .For  Set KPRNr=$O(^PRLINK("D",MPRNr,KPRNr)) Quit:KPRNr=""  Do
 ..Set LinkQty=$P(^PRLINK("D",MPRNr,KPRNr),D)
 ..Quit:(+LinkQty)'>0
 ..Set (Moeder2Kind(KPRNr),Moeder2Kind("K",KPRNr))=LinkQty
 ..If StockOverKind,$D(^PRLINK("D",KPRNr)) Do  ; Indien stock over kinderen de kleinkinderen aflopen
 ...Set KKPRNr=""
 ...For  Set KKPRNr=$O(^PRLINK("D",KPRNr,KKPRNr)) Quit:KKPRNr=""  Do
 ....Set KKLinkQty=$P(^PRLINK("D",KPRNr,KKPRNr),D)
 ....Quit:(+KKLinkQty)'>0
 ....Set (Moeder2Kind(KKPRNr),Moeder2Kind("KK",KKPRNr))=(LinkQty*KKLinkQty)
 Quit