EWBON2 ;E'WMS Opbouw van naar RCP met Terugnamegegevens[ 05/28/2003  3:04 PM ]
 ;
BLDRCP(KLNr,BONNr,MarkRef,RCPNr,RCPDate,RCPKRef,RCPBRef) ; Opbouw van de Receptie en indien reeds doorgestuurd het nieuwe deel onmiddellijk doorsturen.
 ; De terugname is gelockt door het oproepende programma
 ; @MarkRef bevat voor de verschillende BLUNrs het aantal (piece 1) voor het WMS en of er een BackOrder moet gekreeerd worden (piece 2).
 ; Het BackOrder = markering B dan is BOQty=OLQty-MarkedQty, of het mag het Backorder aantal zelf zijn.
 New BLNr,BLUNr,BLCnt,BLRec,Qty,BOQty
 Lock +^RCP("D",RCPNr)
 ; Receptie hoofding
 Set RCPRec=$G(^RCP("D",RCPNr))
 If RCPRec=""  Do
 .Set $P(RCPRec,D,1)="K"
 .Set $P(RCPRec,D,2)=KLNr
 .Set $P(RCPRec,D,3)=RCPKRef
 .Set $P(RCPRec,D,4)=RCPDate
 ;
 Set DH=""
 Set (BONNr,BLUNr)=""
 Set BLCnt=0
 For  Set BONNr=$O(@MarkRef@(BONNr)) Quit:BONNr=""  Do
 .Lock +^KUL(KLNr,"F",BONNr)
 .For  Set BLUNr=$O(@MarkRef@(BONNr,BLUNr)) Quit:BLUNr=""  Do
 ..Set BLNr=^BON("IU",BONNr,BLUNr)
 ..Set BLRec=^KUL(KLNr,"F",BONNr,BLNr)
 ..Set Qty=$P($G(@MarkRef@(BONNr,BLUNr)),D)
 ..Quit:'Qty
 ..Set BOQty=$P(@MarkRef@(BONNr,BLUNr),D,2)
 ..Set BOQty=$S(BOQty="B":$P(BLRec,D,3)-Qty,BOQty>0:BOQty,1:"")
 ..Set:BOQty<1 BOQty="" ; kan niet negatief zijn
 ..Set BLCnt=BLCnt+1
 ..Do BLDTL(KLNr,RCPNr,BONNr,BLUNr,Qty,BOQty,RCPBRef)
 ..Set ^RCP("IU",BONNr)=RCPNr
 .Lock -^KUL(KLNr,"F",BONNr)
 .Do STORE^LOG("RCP",RCPNr,"O",BONNr)
 If BLCnt Do
 .Set ^RCP("D",RCPNr)=RCPRec
 .Set ^RCP("IK",KLNr,RCPNr)=""
 .Set ^RCP("IO",RCPNr)="" ; Openstaand
 .Do:$L($P(RCPRec,D,10)) SENDRCP^EWRCP3(RCPNr,MarkRef) ; Is RCP reeds doorgestuurd naar WMS, daarom nieuwe lijnen onmiddellijk doorsturen.
 Lock -^RCP("D",RCPNr)
 Quit
 
BLDTL(KLNr,RCPNr,BONNr,BLUNr,Qty,BOQty,RCPBRef) 
 ; Verwerken van een terugnamelijn met eventuele opslitsing in verschillende kindproducten
 New BLNr,BLRec,PRNr,KPRNr,OLCache
 New SubRec,SubBLNr,IsWerkVl,IsOrgal,LinkQty
 Set BLNr=^BON("IU",BONNr,BLUNr)
 Set BLRec=^KUL(KLNr,"F",BONNr,BLNr)
 Set PRNr=$P(BLRec,D,2)
 If 'PRNr Do ERROR^EWLOG("NOPROD") Quit
 ;Opbouw OL in RCP
 Set BLRec=""
 Set $P(BLRec,D,1)=PRNr
 Set $P(BLRec,D,4)=Qty
 Set $P(BLRec,D,6)=BOQty
 Set $P(BLRec,D,10)=RCPBRef
 Set ^RCP("D",RCPNr,"D",BONNr,BLUNr)=BLRec
 ;
 If $D(^PRLINK("D",PRNr)) Do  ; Opslitsen in kindproducten
 .Set IsOrgal=$$ISORGAL^PRODUKT2(PRNr),KPRNr=""
 .For  Set KPRNr=$O(^PRLINK("D",PRNr,KPRNr)) Quit:KPRNr=""  Do
 ..If IsOrgal,$$OPSLZONE^PRODUKT2(KPRNr)=9,$P(^PRLINK("D",PRNr,KPRNr),D,2)'="O" Quit
 ..Set LinkQty=$P(^PRLINK("D",PRNr,KPRNr),D)
 ..Quit:(+LinkQty)'>0
 ..Do BLDSUB(RCPNr,BONNr,BLUNr,KPRNr,Qty*LinkQty,RCPBRef)
 Else  Do
 .Do BLDSUB(RCPNr,BONNr,BLUNr,PRNr,Qty,RCPBRef)
 ;
 ; Kontrole of alle subreceptielijnen werkvloerprodukten zijn
 Set SubBLNr="",IsWerkVl=1
 For  Set SubBLNr=$O(^RCP("D",RCPNr,"D",BONNr,BLUNr,SubBLNr)) Quit:SubBLNr=""  Do  Quit:'IsWerkVl
 .Set SubRec=^RCP("D",RCPNr,"D",BONNr,BLUNr,SubBLNr),PRNr=$P(SubRec,D)
 .Set IsWerkVl=$$OPSLZONE^PRODUKT2(PRNr)=9
 Do:IsWerkVl
 .Set BLRec=^RCP("D",RCPNr,"D",BONNr,BLUNr)
 .Set $P(BLRec,D,2)="I",($P(BLRec,D,5),$P(BLRec,D,8))=Qty
 .Set ^RCP("D",RCPNr,"D",BONNr,BLUNr)=BLRec
 Quit
 
BLDSUB(RCPNr,BONNr,BLUNr,PRNr,Qty,RCPBRef) 
 ; opbouw van een subreceptielijn
 New SubRec,SubBLNr,C,PRRec
 Set SubBLNr=$O(^RCP("D",RCPNr,"D",BONNr,BLUNr,""),-1)
 Set SubBLNr=SubBLNr\100+1*100
 Set SubRec=""
 Set $P(SubRec,D,1)=PRNr
 Set $P(SubRec,D,3)=Qty
 Set $P(SubRec,D,10)=RCPBRef
 Set:$$OPSLZONE^PRODUKT2(PRNr)=9 $P(SubRec,D,2)="C",$P(SubRec,D,4)=Qty,($P(SubRec,D,6),$P(SubRec,D,7))=$H
 Set ^RCP("D",RCPNr,"D",BONNr,BLUNr,SubBLNr)=SubRec
 Quit
 
 ; Errormeldingen 
NOPROD ;"Geen product gedefinieerd in :"_BONNr_";"_BLUNr