Index: EWRCPBL.mac.rou
===================================================================
diff -u -r29059 -r37614
--- EWRCPBL.mac.rou	(.../EWRCPBL.mac.rou)	(revision 29059)
+++ EWRCPBL.mac.rou	(.../EWRCPBL.mac.rou)	(revision 37614)
@@ -8,7 +8,7 @@
  Quit
  
 CONVERT(LEVNr,VervId) 
- New FakNr,LNr,RCPNr,TLNr,TOENr,TLBLNr,Key,TLUNr
+ New FakNr,LNr,RCPNr,TLNr,TOENr,TLBLNr,Key,TLUNr,QuitFlag,HulpIndex,AB
  If $P(^Verv(LEVNr,"D",VervId),D,7)'="" Set Key=$$^TXTPOP("EWRCPBL","REEDSRCP","",VervId) Quit
  Set %J=$$%J^vhRtn1()
  Kill ^HULP(%J)
@@ -20,43 +20,58 @@
  For  Set FakNr=$O(^Verv(LEVNr,"D",VervId,FakNr)) Quit:FakNr=""  Do
  .Set LNr=""
  .For  Set LNr=$O(^Verv(LEVNr,"D",VervId,FakNr,LNr)) Quit:LNr=""  Do
+ ..Set QuitFlag = 0
  ..Set RecVL=^Verv(LEVNr,"D",VervId,FakNr,LNr)
+ ..Set AB=$P(RecVL,D,3)
+ ..Set HulpIndex = FakNr_AB
  ..Set ABL=$P(RecVL,D,4)
  ..Set ABL1=ABL\100
  ..Set ABL2=ABL#100
  ..If ABL2 Do  ; Kind-vervoerlijn
  ...Set PRNr=$P(RecVL,D,7)
- ...Quit:'PRNr
- ...If $D(^HULP(%J,FakNr,ABL1,PRNr)) Do ERROR^EWLOG($T(BLDUBBEL)) Quit
- ...Set ^HULP(%J,FakNr,ABL1,PRNr)=LNr
+ ...Set QuitFlag = 'PRNr
+ ...Quit:QuitFlag
+ ...If $D(^HULP(%J,HulpIndex,ABL1,PRNr)) Do ERROR^EWLOG($T(BLDUBBEL)) Set QuitFlag=1 Quit
+ ...Set ^HULP(%J,HulpIndex,ABL1,PRNr)=LNr
  ..Else  Do  ; Enkele produkt of moederprodukt
  ...Set Cnt=Cnt+1
  ...Set TOENr=$P(RecVL,D,1)
- ...Quit:'TOENr  ; Geen toelevering
+ ...Set QuitFlag = 'TOENr
+ ...Quit:QuitFlag  ; Geen toelevering
  ...Set TLBLNr=$P(RecVL,D,2)
- ...Quit:'TLBLNr  ; Geen toeleveringslijn
+ ...Set QuitFlag = 'TLBLNr
+ ...Quit:QuitFlag  ; Geen toeleveringslijn
  ...Set Key=$O(^KTO3(TOENr,TLBLNr_D))
- ...Quit:$P(Key,D)'=TLBLNr
+ ...set QuitFlag = $P(Key,D)'=TLBLNr
+ ...Quit:QuitFlag
  ...Quit:'$P(Key,D,3)  ; Geen 
  ...Set TLUNr=$P($G(^KTO(LEVNr,TOENr,$P(Key,D,3))),D,15)
- ...Quit:'TLUNr  ; Toeleveringslijn is ondertussen verwijderd
+ ...Set QuitFlag = 'TLUNr
+ ...Quit:QuitFlag  ; Toeleveringslijn is ondertussen verwijderd
  ...Set PRNr=$P($G(^KTO(LEVNr,TOENr,$P(Key,D,3))),D,2)
- ...Quit:'PRNr
+ ...Set QuitFlag = 'PRNr
+ ...Quit:QuitFlag
  ...Set VHId=$E($TR($P($G(^KPR(PRNr,2)),D,25),".",""),2,99) ; Identnr van de toelevering
- ...Quit:'$L(VHId)
+ ...Set QuitFlag = '$L(VHId)
+ ...Quit:QuitFlag
  ...Set BLId=$P(RecVL,D,8) ; Identnr van de vervoerlijst
- ...Quit:VHId'=BLId  ; Verschillend produkt
- ...Quit:'$P(^KPR(PRNr,2),D,15)  ; Manueel product
- ...Quit:'$$CHKCONTR(LEVNr,TOENr,$P(Key,D,3),$P(RecVL,D,12))  ;Contract met exact aantal
- ...If $D(^RCP("IT",TOENr,TLUNr)) Do ERROR^EWLOG($T(ALRCP)) Quit
- ...If $D(^HULP(%J,FakNr,ABL1))#10 Do ERROR^EWLOG($T(BLDUBBEL)) Quit
- ...Set ^HULP(%J,FakNr,ABL1)=LNr_D_TLUNr
+ ...Set QuitFlag = VHId'=BLId
+ ...Quit:QuitFlag  ; Verschillend produkt
+ ...Set QuitFlag = '$P(^KPR(PRNr,2),D,15)
+ ...Quit:QuitFlag  ; Manueel product
+ ...Set QuitFlag = '$$CHKCONTR(LEVNr,TOENr,$P(Key,D,3),$P(RecVL,D,12))
+ ...Quit:QuitFlag ;Contract met exact aantal
+ ...If $D(^RCP("IT",TOENr,TLUNr)) Set QuitFlag = 1 Do ERROR^EWLOG($T(ALRCP)) Quit
+ ...If $D(^HULP(%J,HulpIndex,ABL1))#10 Set QuitFlag = 1 Do ERROR^EWLOG($T(BLDUBBEL)) Quit
+ ...Set ^HULP(%J,HulpIndex,ABL1)=LNr_D_TLUNr
+
  ; Creatie van receptielijnen
  If $D(^HULP(%J))>1 Set RCPNr=$$NEXTID^EWRCP
- Set (FakNr,ABL1,Key)=""
- For  Set FakNr=$O(^HULP(%J,FakNr)) Quit:FakNr=""  Do
- .For  Set ABL1=$O(^HULP(%J,FakNr,ABL1)) Quit:ABL1=""  Do
- ..Do BLDLIJN(LEVNr,VervId,RCPNr,FakNr,ABL1)
+ Set (HulpIndex,ABL1,Key)=""
+ For  Set HulpIndex=$O(^HULP(%J,HulpIndex)) Quit:HulpIndex=""  Do
+ .For  Set ABL1=$O(^HULP(%J,HulpIndex,ABL1)) Quit:ABL1=""  Do
+ ..Set FakNr=$E(HulpIndex,1,6)
+ ..Do BLDLIJN(LEVNr,VervId,RCPNr,FakNr,ABL1,HulpIndex)
  ..Set BldCnt=BldCnt+1
  ;Hoofding
  If $D(RCPNr),$D(^RCP("D",RCPNr)) Do
@@ -68,13 +83,13 @@
  .If X="V" Do DELOBJ^VERV(LEVNr,VervId)
  Quit
  
-BLDLIJN(LEVNr,VervId,RCPNr,FakNr,ABL1) 
+BLDLIJN(LEVNr,VervId,RCPNr,FakNr,ABL1,HulpIndex) 
  New TOENr,TLUNr,Rec,Qty,PRNr,RecVL,LNr
- Set LNr=$P($G(^HULP(%J,FakNr,ABL1)),D)
+ Set LNr=$P($G(^HULP(%J,HulpIndex,ABL1)),D)
  If 'LNr Do ERROR^EWLOG($T(NOMOEDER)) Quit
  Set RecVL=^Verv(LEVNr,"D",VervId,FakNr,LNr)
  Set TOENr=$P(RecVL,D,1)
- Set TLUNr=$P(^HULP(%J,FakNr,ABL1),D,2)
+ Set TLUNr=$P(^HULP(%J,HulpIndex,ABL1),D,2)
  Set TLNr=$P(^TO("IU",TOENr,TLUNr),D)
  Set PRNr=$P(RecVL,D,7)
  Set Qty=$P(RecVL,D,11)
@@ -97,22 +112,22 @@
  .Set KPRNr=""
  .For  Set KPRNr=$O(^PRLINK("D",PRNr,KPRNr)) Quit:KPRNr=""  Do 
  ..Set Faktor=$P(^PRLINK("D",PRNr,KPRNr),D)
- ..Do BLDSUB(LEVNr,VervId,RCPNr,FakNr,ABL1,,TOENr,TLUNr,PRNr,KPRNr,Qty*Faktor,BOQty*Faktor)
+ ..Do BLDSUB(LEVNr,VervId,RCPNr,FakNr,ABL1,,TOENr,TLUNr,PRNr,KPRNr,Qty*Faktor,BOQty*Faktor,HulpIndex)
  Else  Do 
  .If $P(RecVL,D,9)="M" Do ERROR^EWLOG($T(SAMEN2))
- .Do BLDSUB(LEVNr,VervId,RCPNr,FakNr,ABL1,LNr,TOENr,TLUNr,PRNr,PRNr,Qty,BOQty)
+ .Do BLDSUB(LEVNr,VervId,RCPNr,FakNr,ABL1,LNr,TOENr,TLUNr,PRNr,PRNr,Qty,BOQty,HulpIndex)
  Quit
  
-BLDSUB(LEVNr,VervId,RCPNr,FakNr,ABL1,LNr,TOENr,TLUNr,MPRNr,KPRNr,Qty,BOQty) 
+BLDSUB(LEVNr,VervId,RCPNr,FakNr,ABL1,LNr,TOENr,TLUNr,MPRNr,KPRNr,Qty,BOQty,HulpIndex) 
  New SubRec,SubTLNr,C,PRRec
  Set SubTLNr=$O(^RCP("D",RCPNr,"D",TOENr,TLUNr,""),-1)
  Set SubTLNr=SubTLNr\100+1*100
  Set SubRec=""
  Set $P(SubRec,D,1)=KPRNr
  Set $P(SubRec,D,3)=Qty
  Set $P(SubRec,D,12)=BOQty
- If $D(^HULP(%J,FakNr,ABL1,KPRNr)) Set LNr=$P(^(KPRNr),D) ; Eerst kijken bij het kind
- Else  Set:$D(^HULP(%J,FakNr,ABL1)) LNr=$P(^(ABL1),D) ; daarna bij de moeder, dit voor moeder-kind die gekend zijn bij VAN HOECKE maar niet bij BLUM
+ If $D(^HULP(%J,HulpIndex,ABL1,KPRNr)) Set LNr=$P(^(KPRNr),D) ; Eerst kijken bij het kind
+ Else  Set:$D(^HULP(%J,HulpIndex,ABL1)) LNr=$P(^(ABL1),D) ; daarna bij de moeder, dit voor moeder-kind die gekend zijn bij VAN HOECKE maar niet bij BLUM
  If $G(LNr) Do
  .Set $P(SubRec,D,10)=FakNr
  .Set $P(SubRec,D,11)=$G(LNr)
@@ -156,3 +171,4 @@
 BLDUBBEL ;"Dubbele ABLijnnr: "_VervId_";"_FakNr_";"_LNr_";"_ABL_";"_RecVL
 ALRCP ;"Toeleveringslijn reeds in een receptie opgenomen: "_VervId_";"_FakNr_";"_LNr_";"_RecVL
 
+