EWRCPBL ;E'WMS Overdracht BLUM vervoerlijst naar receptie [ 02/21/2002  4:55 PM ]
 
VERWERK New VRF
 Do DISPLAY^vhScherm("EWRCPBL")
 Do SELECT^VERVID("",5005,"SO","") 
 Quit:'VRF
 Do CONVERT(5005,VRF) ;,PRINT^BLCSBFAK(5005,VRF) <--- afgesloten op 18.06.2008 door CW
 Quit
 
CONVERT(LEVNr,VervId) 
 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)
 Set RecHfd=^Verv(LEVNr,"D",VervId)
 Set FakNr=""
 Set (Cnt,BldCnt)=0
 ;Opbouw sortcache
 ;Waar de kindproducten onder de ABLijnnr van de moeder geplaatst worden
 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)
 .. ;Vanaf BLUM SAP xml EDI 
 ..Set ABL1=ABL ;Set ABL1=ABL\100
 ..Set ABL2=0 ;Set ABL2=ABL#100
 ..If ABL2 Do  ; Kind-vervoerlijn
 ...Set PRNr=$P(RecVL,D,7)
 ...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)
 ...Set QuitFlag = 'TOENr
 ...Quit:QuitFlag  ; Geen toelevering
 ...Set TLBLNr=$P(RecVL,D,2)
 ...Set QuitFlag = 'TLBLNr
 ...Quit:QuitFlag  ; Geen toeleveringslijn
 ...Set Key=$O(^KTO3(TOENr,TLBLNr_D))
 ...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)
 ...Set QuitFlag = 'TLUNr
 ...Quit:QuitFlag  ; Toeleveringslijn is ondertussen verwijderd
 ...Set PRNr=$P($G(^KTO(LEVNr,TOENr,$P(Key,D,3))),D,2)
 ...Set QuitFlag = 'PRNr
 ...Quit:QuitFlag
 ...Set VHId=$E($TR($P($G(^KPR(PRNr,2)),D,25),".",""),2,99) ; Identnr van de toelevering
 ...Set QuitFlag = '$L(VHId)
 ...Quit:QuitFlag
 ...Set BLId=$P(RecVL,D,8) ; Identnr van de vervoerlijst
 ...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 (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
 .Do BLDHFD(LEVNr,VervId,RCPNr)
 .Set:Cnt=BldCnt X=$$^vhTXTPOP("EWRCPBL","ALLES","",VervId,RCPNr,Cnt)
 .Set:Cnt'=BldCnt X=$$^vhTXTPOP("EWRCPBL","DEELS","",VervId,RCPNr,BldCnt,Cnt-BldCnt)
 Else  Do
 .Set X=$$^vhTXTPOP("EWRCPBL","NOLINES",,VervId,Cnt)
 .If X="V" Do DELOBJ^VERV(LEVNr,VervId)
 Quit
 
BLDLIJN(LEVNr,VervId,RCPNr,FakNr,ABL1,HulpIndex) 
 New TOENr,TLUNr,Rec,Qty,PRNr,RecVL,LNr
 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,HulpIndex,ABL1),D,2)
 Set TLNr=$P(^TO("IU",TOENr,TLUNr),D)
 Set PRNr=$P(RecVL,D,7)
 Set Qty=$P(RecVL,D,11)
 Set IsBO=$P(RecVL,D,13)="P"
 Set Rec=""
 Set $P(Rec,D,1)=PRNr
 Set $P(Rec,D,4)=Qty
 Set BOQty=$S(IsBO:$P(^KTO(LEVNr,TOENr,TLNr),D,3)-Qty,1:"")
 Set:BOQty<1 BOQty="" ; Moet positief zijn
 Set $P(Rec,D,6)=BOQty
 Set $P(Rec,D,10)=FakNr
 Set $P(Rec,D,11)=LNr
 Set ^RCP("D",RCPNr,"D",TOENr,TLUNr)=Rec
 Set ^RCP("IT",TOENr,TLUNr)=RCPNr
 Set $P(RecVL,D,16)="R"
 Set ^Verv(LEVNr,"D",VervId,FakNr,LNr)=RecVL
 If $D(^PRLINK("D",PRNr)) Do  ; Kinder produkten
 .If $O(^PRLINK("D",PRNr,$O(^PRLINK("D",PRNr,""))))'="",$P(RecVL,D,9)'="M" Do ERROR^EWLOG($T(SAMEN1))
 .New LNr,KPRNr,Faktor
 .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,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,HulpIndex)
 Quit
 
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,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)
 Set ^RCP("D",RCPNr,"D",TOENr,TLUNr,SubTLNr)=SubRec
 Quit
 
BLDHFD(LEVNr,VervId,RCPNr) 
 New Rec
 Set Rec=""
 Set $P(Rec,D)="L"
 Set $P(Rec,D,2)=LEVNr
 Set $P(Rec,D,3)=VervId
 Set $P(Rec,D,4)=$H
 Set ^RCP("D",RCPNr)=Rec
 Set ^RCP("IL",LEVNr,RCPNr)=""
 Set ^RCP("IO",RCPNr)="" ;Openstaand
 Set Rec=^Verv(LEVNr,"D",VervId) ; Link in vervoerlijst
 Set $P(Rec,D,7)="R"
 Set $P(Rec,D,16)=RCPNr
 Set ^Verv(LEVNr,"D",VervId)=Rec
 Quit
 
 ;Indien aantal in Vervoerlijst verschilt van het aantal in de CONTRACT-toelevering
CHKCONTR(LEVNr,TOENr,TLNr,QtyVL) 
 New ORDNr,KLNr,KOMORDNr,RecT,Qty
 Set KLNr=$P(^KTO(LEVNr,TOENr,1),D,8)
 Quit:KLNr="" 1  ; Stock toelev
 Set ORDNr=$P(^KTO(LEVNr,TOENr,1),D,7)
 Quit:ORDNr="" 1 ; Stock toelev
 If $P($G(^KOD(KLNr,"F",ORDNr,1)),D,25)'="C" Quit 1
 Set RecT=^KTO(LEVNr,TOENr,TLNr)
 Set KOMORDNr=$P(RecT,D,27)
 Quit:KOMORDNr'=ORDNr 0 ;Verschillend ordernr in lijn en hoofding
 Set Qty=$P(RecT,D,3)
 Quit Qty=QtyVL
 
 ;Error meldingen
NOMOEDER ;"Wel kinderen maar geen moeder: "_VervId_";"_FakNr_";"_LNr_";"_RecVL
SAMEN1 ;"Er zijn kinderen in PRLINK maar niet bij BLUM: "_VervId_";"_FakNr_";"_LNr_";"_RecVL
SAMEN2 ;"Er zijn geen kinderen in PRLINK maar wel bij BLUM: "_VervId_";"_FakNr_";"_LNr_";"_RecVL
BLDUBBEL ;"Dubbele ABLijnnr: "_VervId_";"_FakNr_";"_LNr_";"_ABL_";"_RecVL
ALRCP ;"Toeleveringslijn reeds in een receptie opgenomen: "_VervId_";"_FakNr_";"_LNr_";"_RecVL