PRSTOCKR ;Reservatie van order, toelevering en terugnames        [ 11/14/2003  3:24 PM ]
 ;via recursie de reservatie van kindproducten en halffabrikaten bepalen
 K ^PRSTOCK("R")
 K ^PRSTOCK("IR")
 Set ^PRSTOCK("N")=0
 .;Do SETORD(3711,186032,104,.Res)
 Set tijd=$P($H,",",2)
 For Cnt=1:1:100 Do
 .;Set ResKey=$$SETORD(1000,195116,101,.Res)
 .;Do DELETE(ResKey)
 Write tijd,"-",$P($H,",",2),"=",$P($H,",",2)-tijd
 Quit
 
SETORD(KLNr,ORDNr,OLNr,Result) 
 ; Result wordt door gegeven via .Local en is globaal gekend in de subroutine
 New RecL,PRNr,Qty,OLUNr,LevWk,ResKey,Recurs
 Set RecL=^KOD(KLNr,"F",ORDNr,OLNr)
 Set PRNr=$P(RecL,D,2)
 Quit:($P(RecL,D,14)["S")&($P(RecL,D,14)["Z") "" ; Geen stockaanpassing
 Set Qty=-$P(RecL,D,3) ; Order Qty negatief
 ;If 'Qty Do REMORD(KLNr,ORDNr,OLNr) Quit ""
 Set OLUNr=$P(RecL,D,15)
 Set LevWk=$$INTDATE^vhDTyp($P(RecL,D,25),"DW")
 Set ResKey=$$SET(PRNr,"P",,,"O",ORDNr,OLUNr,Qty,LevWk,1)
 Set Recurs=$$SETBS(PRNr,ResKey,"K","O",Qty,LevWk)
 Do SETKOM(PRNr,ResKey,Qty,LevWk)
 Quit ResKey
 
DELETE(MResKey,MPRNr,FrResKey) 
 New Node,ResKey,PRNr,KomResKey,KomPRNr
 ;Write "MResKey:",MResKey
 ;Write "MPRNr:",$G(MPRNr)
 ;Write "FromResKey:",$G(FrResKey)
 Set:$G(MPRNr)'?4.7N MPRNr=$G(^PRSTOCK("IR",MResKey))
 ; Verwijder KOM-reservatie, in een richting daarom FrResKey meedoorgeven
 Set KomResKey=$P(^PRSTOCK("R",MPRNr,MResKey),D,4)
 If KomResKey Do
 . If '$P(^PRSTOCK("R",MPRNr,MResKey),D,15) Do  ; Geen KOM-toelevering
 .. Do DELETE(KomResKey,,MResKey) ; Verwijder KOM-reservatie
 . Else  If '$G(FrResKey) Do  ; Verwijderen van LINK
 .. Set KomPRNr=$G(^PRSTOCK("IR",KomResKey))
 .. Lock +^PRSTOCK("D",KomPRNr)
 .. Set $P(^PRSTOCK("R",KomPRNr,KomResKey),D,4)="" ; Verwijder KOM-link
 .. Lock -^PRSTOCK("D",KomPRNr)
 ; Verwijder kinderen en halffabrikaten reservatie
 Set (Node,ResKey)=""
 For  Set Node=$O(^PRSTOCK("IR",MResKey,Node)) Quit:Node=""  Do
 . For  Set ResKey=$O(^PRSTOCK("IR",MResKey,Node,ResKey)) Quit:ResKey=""  Do
 .. Set PRNr=^PRSTOCK("IR",MResKey,Node,ResKey)
 .. Do DELETE(ResKey,PRNr)
 ; Verwijder moederreservatie
 Lock +^PRSTOCK("D",MPRNr)
 Do PROPDEL(MPRNr,^PRSTOCK("R",MPRNr,MResKey))
 Kill ^PRSTOCK("IR",MResKey)
 Kill ^PRSTOCK("R",MPRNr,MResKey)
 Lock -^PRSTOCK("D",MPRNr)
 Quit
 
DELKOM(ResKey) ; Verbreken van de KOM-link
 New PRNr,KomPRNr,KomResKey
 Set:$G(PRNr)'?4.7N PRNr=$G(^PRSTOCK("IR",ResKey))
 Set KomResKey=$P(^PRSTOCK("R",MPRNr,MResKey),D,4)
 Quit:'KomResKey
 Set KomPRNr=$G(^PRSTOCK("IR",KomResKey))
 Lock +^PRSTOCK("D",KOMPRNr),+^PRSTOCK("D",PRNr)
 Set $P(^PRSTOCK("R",KomPRNr,KomResKey),D,4)="" ; Verwijder KOM-link
 Set $P(^PRSTOCK("R",PRNr,ResKey),D,4)="" ; Verwijder KOM-link
 Lock -^PRSTOCK("D",KOMPRNr),-^PRSTOCK("D",PRNr)
 Quit
 
SETBS(MPRNr,MResKey,BSTypes,ObjTyp,Qty,LevWk,Recurs) 
 ; Reservatie van bouwstenen (kindproducten en halffabrikaten
 ; afhankelijk van de parameter BSTyp)
 ; opm.: Recurs moet ongedefinieerd zijn wanneer de eerste keer opgeroepen
 ;Result globaal gedefinieerd
 New BSCode,BSRec,Faktor,PRNr,Rec15,PRNr,MetaTag,ResKey,HFRecD,UitvDim
 Quit:$G(Recurs)[(";"_MPRNr_";")  ; controle oneindige loop recursie
 Set Recurs=$G(Recurs,";")_MPRNr_";"
 Set BSCode=""
 For  Set BSCode=$O(^PRBS("BS",MPRNr,BSCode)) Quit:BSCode=""  Do
 . Set BSRec=^PRBS("BS",MPRNr,BSCode)
 . Set BSTyp=$P(BSRec,D,3)
 . Quit:BSTypes'[BSTyp ; Alleen halffabrikaten of kinderen 
 . Set Faktor=$P(BSRec,D,2)
 . Set PRNr=$P(BSRec,D,1)
 . Quit:PRNr'?4.7N
 . Quit:'$D(^KPR(PRNr))  ; product bestaat niet meer
 . If BSTyp="K" Do  ; Kindproduct
 .. Set QtyFakt=Qty*Faktor
 .. Set ResKey=$$SET(PRNr,"K",MPRNr,MResKey,ObjTyp,,,QtyFakt,LevWk,Faktor)
 .. Set Recurs=$$SETBS(PRNr,ResKey,BSTypes,ObjTyp,QtyFakt,LevWk,Recurs)
 .. Do:$P(^KPR(MPRNr,0),D,23)="S" SETKOM(PRNr,ResKey,QtyFakt,LevWk) ;Alleen voor die producten waar LinkType is 'stock over kinderen'
 . Else  Do  ; Halffabrikaten
 .. Do:Qty<0 RESULT(ResKey,PRNr,"E","H","halffabrikaat qty was neg")
 .. Do:ObjTyp'="T" RESULT(ResKey,PRNr,"E","T","objecttupe is geen toelevering")
 .. Set Rec15=$G(^KPR(PRNr,15))
 .. Set MetaTag=$P(Rec15,D,10)
 .. Set QtyFakt=-Qty*Faktor  ; Halffabrikaat is steeds een reservatie,daarom negatief 
 .. Set UitvDim=""
 .. If "PR"'[MetaTag Do  ; dimensie afhankelijk
 ... Set HFRecD=$G(^PRBS("BS",MPRNr,BSCode,"D"))
 ... Set UitvDim=$P(HFRecD,D,3)
 ... If 'UitvDim Do
 .... Set UitvDim=$P(Rec15,D,7)
 .... Do RESULT(MResKey,PRNr,"E","D","foutieve halffabrikaat dimensie")
 ... Set QtyFakt=-$J($$CV2WV^MRP(PRNr,0,-QtyFakt,UitvDim,$P(Rec15,D,7)),0,4) ; Bereken aantal stuks 
 .. ; opslaan
 .. Set ResKey=$$SET(PRNr,"H",MPRNr,MResKey,ObjTyp,,,QtyFakt,LevWk,Faktor,UitvDim)
 .. Set Recurs=$$SETBS(PRNr,ResKey,"K",ObjTyp,QtyFakt,LevWk,Recurs) ;Recursie alleen mogelijk voor kindproducten niet voor halffabrikaten
 .. Do SETKOM(PRNr,ResKey,+$J(QtyFakt,0,0.499999),LevWk) ; Afronden van aantal
 Quit Recurs
 
SETKOM(PRNr,ResKey,Qty,LevWk) 
 ; Controle op KOM-gelinkte reservatie
 ; Result globaal gedefinieerd
 Quit:Qty>0 ; is toelevering of terugname
 Set Qty=-Qty
 Quit:$P(^KPR(PRNr,0),D,23)="S" ;Alleen voor die producten waar LinkType is niet 'stock over kinderen'
 Quit:$P(^KPR(PRNr,1),D,20) ; Stock product
 Set LevWk=LevWk-7 ; 1 week vroeger leveren
 Set KomResKey=$$SET(PRNr,"P",,,"T",,,Qty,LevWk,1)
 Set $P(^PRSTOCK("R",PRNr,KomResKey),D,4)=ResKey
 Set $P(^PRSTOCK("R",PRNr,ResKey),D,4)=KomResKey
 ;Set ^PRSTOCK("IR",KomResKey,"X",ResKey)=PRNr
 ;Set ^PRSTOCK("IR",ResKey,"X",KomResKey)=PRNr
 Do RESULT(KomResKey,PRNr,"K","K","Komlink")
 Set Recurs=$$SETBS(PRNr,KomResKey,"KH","T",Qty,LevWk) ;Recursie alleen mogelijk voor kindproducten niet voor halffabrikaten
 Quit
 
RESULT(ResKey,PRNr,Type,SubTyp,MinQty,LevWk,Oms) 
 Quit
 
SET(PRNr,Type,MPRNr,UpResKey,ObjTyp,ObjRef,ObjLUNr,Qty,LevWk,Faktor,UitvDim) 
 ; Opslaan van een reservatie record en reservatie propageren naar product
 New ResKey,Rec
 ; Result globaal gedefinieerd
 Set ResKey=$$NEXTKEY($G(UpResKey))
 If $D(^PRSTOCK("R",PRNr,ResKey)) Do WARN^vhTXTPOP("Reservatie bestaat reeds "_PRNr_" "_ResKey)
 Set Rec=""
 Set $P(Rec,D,1)=LevWk
 Set $P(Rec,D,2)=Type
 Set $P(Rec,D,3)=$G(UpResKey)
 ;
 If Type="H" Set $P(Rec,D,6)=Qty ; Halffab in toelevering
 If Type="P",Qty<0 Set $P(Rec,D,7)=Qty ; Product in order
 If Type="K",Qty<0 Set $P(Rec,D,8)=Qty ; Kindproduct in order
 If ObjTyp="T",Qty>0 Set $P(Rec,D,10)=Qty ; Product in toelevering
 If (ObjTyp="O")!(ObjTyp="B"),Qty>0 Set $P(Rec,D,11)=Qty ; Product in terugname
 
 ;Markering indien KOM-toelevering
 If ObjTyp="T",Type="P",'$G(ObjRef) Set $P(Rec,D,15)=1
 ;Backlink naar object
 Set:$G(ObjRef) $P(Rec,D,16)=ObjTyp
 Set $P(Rec,D,17)=$G(ObjRef)
 Set $P(Rec,D,18)=$G(ObjLUNr)
 ; Opslaan om naderhand te kunnen terugrekenen
 Set $P(Rec,D,19)=$G(Faktor,1)
 Set $P(Rec,D,20)=$G(UitvDim)
 ; Opslaan in ^PRSTOCK
 Lock +^PRSTOCK("D",PRNr)
 Set ^PRSTOCK("R",PRNr,ResKey)=Rec
 Set ^PRSTOCK("IR",ResKey)=PRNr
 If $G(UpResKey) Set ^PRSTOCK("IR",UpResKey,Type,ResKey)=PRNr
 Do PROPSET(PRNr,Rec)
 Lock -^PRSTOCK("D",PRNr)
 ; Controle
 If $P(Rec,D,6)+$P(Rec,D,7)+$P(Rec,D,8)+$P(Rec,D,10)+$P(Rec,D,11)=0 Do WARN^vhTXTPOP("Reservatie som in NUL."_PRNr_" "_ResKey_"~"_Rec)
 Quit ResKey
 
PROPSET(PRNr,Rec) ; Propagatie van SET
 q
 ;Lock +^PRSTOCK("D",PRNr)
 Set RecP=$G(^PRSTOCK("D",PRNr))
 For I=6,7,8,10,11 Set $P(RecP,D,I)=$P(RecP,D,I)+$P(Rec,D,I)
 Set ^PRSTOCK("D",PRNr)=RecP
 ;Lock -^PRSTOCK("D",PRNr)
 Quit
 
PROPDEL(PRNr,Rec) ; Propagatie van DELETE
 q
 ;Lock +^PRSTOCK("D",PRNr)
 Set RecP=$G(^PRSTOCK("D",PRNr))
 For I=6,7,8,10,11 Set $P(RecP,D,I)=$P(RecP,D,I)-$P(Rec,D,I)
 Set ^PRSTOCK("D",PRNr)=RecP
 ;Lock -^PRSTOCK("D",PRNr)
 Quit
 
NEXTKEY(ResKey) ; reservatiekey : combinatie van ticket en olunr
 Quit:'ResKey $$NEWKEY()
 Set BasisKey=ResKey\10000
 Set ResKey=$O(^PRSTOCK("IR",BasisKey*10000+9999),-1)
 Set VolgNr=ResKey#10000
 Quit:ResKey\10000'=BasisKey ""
 Quit BasisKey*10000+(VolgNr+1)
 
NEWKEY() ; ophalen uniek volgnr
 New ResKey
 Lock +^PRSTOCK("N")
 Set (ResKey,^PRSTOCK("N"))=^PRSTOCK("N")+1
 Lock -^PRSTOCK("N")
 Quit ResKey*10000
 
UPKEY(ResKey,PRNr) 
 New KomResKey,UpResKey
 Set:$G(PRNr)'?4.7N PRNr=$G(^PRSTOCK("IR",ResKey))
 ; Verwijder KOM-reservatie, in een richting daarom FrResKey meedoorgeven
 ; Als eerste de KOM-link volgen
 Set KomResKey=$P(^PRSTOCK("R",PRNr,ResKey),D,4)
 Quit:KomResKey&$P(^PRSTOCK("R",PRNr,ResKey),D,15) $$UPKEY(KomResKey)
 ; Als tweede de uplink
 Set UpResKey=$P(^PRSTOCK("R",PRNr,ResKey),D,3)
 Quit:UpResKey $$UPKEY(UpResKey)
 ; De ResKey is de sleutel
 Quit ResKey