#include BL.Derde.LevSpecifiek
BLCSBC1(SoDo) ;Converteren van CSB-SO bericht in BLImp naar BLVerv [ 11/05/2001  2:22 PM ]
 G BEGIN
BEGIN ; 
C1 Set:'$D(MsgId) MsgId=1
 Goto YZ:'$D(^BLImp(MsgId,1))
 Set LevNr=$P(^BLImp(MsgId),D,2)
 Set SIFANR=""
 Set FP=2301 Write @F,@F1,"Bezig met opbouw hulpbestand"
 Kill ^BLToe
 Set ToeNr=199999 
C2 Set ToeNr=$N(^KTO(LevNr,ToeNr)) Goto C4:(ToeNr=-1)
 Set SortNr=99
C3 Set SortNr=$N(^KTO(LevNr,ToeNr,SortNr)) Goto C2:SortNr=-1
 Set Lijn=^(SortNr) G:$P(Lijn,D,17)'="KTRPL" C3 ; Alleen indien produktlijn
 Set:$P(Lijn,D,14) ^BLToe("IA",ToeNr,$P(Lijn,D,14)_D_$P(Lijn,D,13)_D_SortNr)="" ; Volgens AB
 Set ^BLToe("IP",ToeNr,$P(Lijn,D,2),SortNr)="" ; Volgens Produktnummer
 Goto C3
C4 
 Set FP=2301 Write @F,@F1,"Bezig met importeren van de gegevens"
 Set RecNr=-1
L3 Do NextRec Goto YZ:RecNr=-1
 G L3:RecType'=21
Ship Do VShip
L3b Do NextRec Goto YZ:RecNr=-1
 Do SCom:$E(RecType,2)=9
 Goto Ship:RecType="21",L3b:RecType'=31
Fak Do VFak
L4 Do NextRec Goto YZ:RecNr=-1
 Do SCom:$E(RecType,2)=9
 Goto Ship:RecType="21",Fak:RecType="31",L4:RecType'=41
Lijn Do VLijn 
L5 Do NextRec 
 If RecNr=-1 Do  Goto YZ
 . Do:SIFANR'="" ##class(BL.Blum.Facturatie).%New().UpdateFromVervoer(,SIFANR) 
 Do VCom:$E(RecType,2)=9,VProd:RecType=42,VPack:RecType=44,VRecuPak:RecType=45
 Goto Ship:RecType=21,Fak:RecType=31,Lijn:RecType=41,L5
 
VShip
 If SIFANR'="" Do
 . Set $P(^Verv(LevNr,"D",SIFANR),D,1)=ToeLevNr
 . Do ##class(BL.Blum.Facturatie).%New().UpdateFromVervoer(,SIFANR)
 . Set SIFANR=""
 Set RecNaam="CSB-SO-21" Do TF
 Set ShipDate = $Piece(NewRec,D,3)
 Set T=$P(NewRec,D,8,17) Set NewRec=$P(NewRec,D,1,7)
 FOR I=1:2:9 Set:$L($P(T,D,I)) NewRec=NewRec_D_$P(T,D,I)_U_$P(T,D,I+1)
 Set $P(NewRec,D,15)=SoDo
 If $D(^Verv(LevNr,"D",SIFANR)) Do DUBBEL
 Set lbVervRef=$G(lbVervRef)_$Lb(SIFANR)
 Set ToeLevNr=$G(^Verv(LevNr,"D",SIFANR),0),$P(NewRec,D,1)=ToeLevNr,^Verv(LevNr,"D",SIFANR)=NewRec
 Set:SoDo="DO" MailId=$$SYSTEM^vhMAIL("LE",LevNr,"Vervoerslijst 'CSB-DO'","BLUMDO","Nieuwe vervoerslijst voor DIRECT ORDERS binnen gekomen~Vervoernummer : "_SIFANR,,,"A")
 Q
DUBBEL ; Vervoerslijst reeds geïmporteerd
 Set Txt(1)="Vervoerslijst met nummer "_SIFANR_" bestaat reeds !"
 Set Txt=1
 Set Btn(1)="Verwijder oude&V"
 Set Btn(2)="Bijvoegen&B"
 Set Btn(3)="Import onder ander nummer&I"
 Set Btn=3
 Set Check=$$WILD^vhTXTPOP("C;C","Dubbel","Txt","Btn",2)
 Kill:Check="V" ^Verv(LevNr,"D",SIFANR) ; Verwijder
 If Check="I" Do  ; Onder ander nummer
 .Set SIFANR=999999 
 .For  Quit:'$D(^Verv(LevNr,"D",SIFANR))  Set SIFANR=SIFANR-1
 Quit
 
VFak Set RecNaam="CSB-SO-31" Do TF
 Set $P(NewRec,D,7)=""
 Set $P(NewRec,D,4)=$S($P(NewRec,D,4)="W01":"ATS",$P(NewRec,D,4)="W15":"BEF",$P(NewRec,D,4)="W30":"EUR",1:$P(NewRec,D,4))
 Set ^Verv(LevNr,"D",SIFANR,FAKNr)=NewRec       
 Set ToeLevNr=0
 Q
VLijn Set RecNaam="CSB-SO-41" Do TF
 Do ##class(APPS.EDIExport.AankoopOrderResponse.BLUM.impl.BLOrdRspService).%New().UpdateVerwerkVlag($Piece(ToeRef,".",1), $Piece(ToeRef,".",2),$Piece(NewRec,D,10),ShipDate) 
 If ($L(SIIDNO)=8)&&($E(SIIDNO)="0") Set $E(SIIDNO)="",$P(NewRec,D,8)=SIIDNO ; zonder voorloop nul opslaan
 Set ToeLevNr=ToeLevNr+1,(ToeNr,ToeLNr)=""
 Goto VL7:$P(NewRec,D,9)="P" ;Indien Phantom product geen best match mogelijk
 Goto VL1:'ABNr
 Set T=$N(^KTO4(LevNr,ABNr_D)) Goto VL1:$P(T,D,1)'=ABNr
 Set ToeNr=+$P(T,D,2)
 Goto VL2
 ; Volgens Toelevering referentie
VL1 Goto VL6:ToeRef'?6N1P2N Set STR=ToeRef Do StrPNum Set ToeNr=+$P(NUM,".",1),ToeLNr=+$P(NUM,".",2)
 Goto VL6:ToeNr'?6N,VL6:'$D(^KTO(LevNr,ToeNr)),VL4
 ;Volgens ABLijnNummer
VL2 Goto VL3:'ABLNr ; Geen ABreferentie ingevuld
 Set Key=$N(^BLToe("IA",ToeNr,ABLNr_D))
 Goto VL3:$P(Key,D,1)'=ABLNr ; Bestaat ABLijnNummer?
 Set ToeLNr=$P(Key,D,2),SortNr=$P(Key,D,3) Goto VL7
 ;Volgens ToeLijnRef
VL3 Goto VL5:ToeRef'?6N1P2N Set STR=ToeRef Do StrPNum Set ToeLNr=+$P(NUM,".",2)
VL4 Goto VL5:'ToeLNr ; Geen Lijnref ingevuld
 Set Key=$N(^KTO3(LevNr,ToeNr,ToeLNr_D))
 Goto VL5:$P(Key,D,1)'=ToeLNr ; Bestaat ToeLijnNummer?
 Set ToeLNr=$P(Key,D,1),SortNr=$P(Key,D,3) Goto VL7
 
VL5 ;Volgens BestMatch
 Set (Max,MaxCount)=0,Status="BL"
 If ($L(SIIDNO)=8)&&($E(SIIDNO)="0") Set $E(SIIDNO)="" 
 /* Set PR=SIIDNO_" "
 Set:$L(PR)=8 PR=0_PR
 Set:'$D(^KPR2(PR)) $E(PR)=8
 Goto VL61:'$D(^KPR2(PR)) Set PR=$P(^(PR),D,1)*/
 Set PR=$$GETVH^BLPROD("0"_SIIDNO,BLKLNr) ; PV 02/05/2012 - vertaling identnr naar product
 Goto VL61:PR="",VL61:'$D(^BLToe("IP",ToeNr,PR))
 Set SortNr=$N(^(PR,-1))
VL51 Goto VL53:SortNr=-1 
 Set ToeRec=^KTO(LevNr,ToeNr,SortNr),Count=8
 Set:+$P(ToeRec,D,3)>(SIQTSI-(SIQTSI*0.1))&(+$P(ToeRec,D,3)>(SIQTSI+(SIQTSI*0.05))) Count=Count+4
 Set:$$INTDATE^vhLib.DataTypes($P(ToeRec,D,25),"DW")'>$$INTDATE^vhLib.DataTypes($$EXTDATE^vhLib.DataTypes(,"DW"),"DW") Count=Count+2
 Set:Count'<8&(Max<Count) Max=Count,ToeLNr=$P(ToeRec,D,13),MaxCount=0
 Set:Count'<8&(Max=Count) MaxCount=MaxCount+1
VL52 Set SortNr=$N(^BLToe("IP",ToeNr,PR,SortNr)) Goto VL51
VL53 If Max'<8&(MaxCount=1)!(Max>10) Goto VL7 ; Slecht 1 lijn welke voldoet aan de match.
VL54 Goto VL61
 
 ; Geen match gevonden
VL6 Set ToeNr=""
VL61 Set ToeLNr=""
 ;mogelijk lijn uit manuele toelevering: opkuisen zodat deze niet meer in de kallijst komt, in dat geval mag er geen lijnnr zijn
 Do:(+$Piece(ToeRef,".",2)=0) ##class(APPS.EDIExport.AankoopOrderResponse.BLUM.impl.BLOrdRspService).%New().VerwijderToelevering(ToeRef) 
 Goto VL7
 ; Opslaan vervoerlijn
VL7 
 If ($L(SIIDNO)=8)&&($E(SIIDNO)="0") Set $E(SIIDNO)="" 
 Set PR=SIIDNO_" "
 ; Nakijken of produkt voor die BLUM klant bestaat in ^PRPUTZ
 Set PRNr=""
 
 If ToeNr,ToeLNr Do  ; Produkt nemen dat opgeslagen is in de toelevering
 .New Rec,SortNr
 .Set Rec=$O(^KTO3(ToeNr,ToeLNr_D)) Quit:Rec=""
 .Set SortNr=$P(Rec,D,3)
 .Set:SortNr PRNr=$P(^KTO(LevNr,ToeNr,SortNr),D,2)
 .If PRNr,$E($TR($P(^KPR(PRNr,2),D,25),".",""),2,99)'=SIIDNO Set PRNr=""
 Set:'PRNr PRNr=$$GETVH^BLPROD("0"_SIIDNO,BLKLNr)
 Set $P(NewRec,D,7)=PRNr
 Set $P(NewRec,D,1,2)=ToeNr_D_ToeLNr
 If $P(NewRec,D,9)="M" Set $P(NewRec,D,11)=$P(NewRec,D,12)
 Else  Set $P(NewRec,D,11)=$P(NewRec,D,10)
 Set:$P(NewRec,D,13)'="P" $P(NewRec,D,13)=""
 Goto VL8:$P(NewRec,D,9)="P"
 Set $P(NewRec,D,17)="P"
 If PRNr Do  ; Verschil in prijs
 .Set BLPrijs=+$J($P(NewRec,D,14)/$P(NewRec,D,12),0,2)
 .Set VHRec=$$VHRec(PRNr)
 .Set VHPrijs=$P(VHRec,D,13)
 .Set:$S(VHPrijs>BLPrijs:VHPrijs-BLPrijs,1:BLPrijs-VHPrijs)<.05 $P(NewRec,D,17)=""
 .Set $P(NewRec,D,18,22)=$P(VHRec,D,4)_D_$P(VHRec,D,3)_D_($P(VHRec,D,5)/100)_D_D_VHPrijs
 Goto VL8:ToeNr=""
 Set SortNr=$N(^KTO3(ToeNr,ToeLNr_D))
 Goto VL8:$P(SortNr,D,1)'=ToeLNr
 Set VHRec=$G(^KTO(LevNr,ToeNr,$P(SortNr,D,3)))
 Goto VL8:'$L(VHRec)
 ; Verschil in aantal
 Set:$P(VHRec,D,3)'=$P(NewRec,D,11)&($P(NewRec,D,13)'="P") $P(NewRec,D,13)="V"
 ; Verschil in prijs volgens toelevering
 Set BLPrijs=+$J($P(NewRec,D,14)/$P(NewRec,D,12),0,2)
 Set VHPrijs=+$J($P(VHRec,D,9)/$P(VHRec,D,3),0,2)
 Set $P(NewRec,D,17)="T"
 Set:$S(VHPrijs>BLPrijs:VHPrijs-BLPrijs,1:BLPrijs-VHPrijs)<.05 $P(NewRec,D,17)=$S($L($P(VHRec,D,26)):"M",1:"")
 Set Kort=$P(VHRec,D,7)
 Set Kort=1-((1-($P(Kort,"#")/100))*(1-($P(Kort,"#",2)/100)))
 Set $P(NewRec,D,18,22)=$P(VHRec,D,6)_D_$P(VHRec,D,21)_D_Kort_D_$P(VHRec,D,26)_D_VHPrijs
 
VL8 Set:$L($P(NewRec,D,17)) $P(^Verv(LevNr,"D",SIFANR,FAKNr),D,7)=1
 If ($L(SIIDNO)=8)&&($E(SIIDNO)="0") Set $E(SIIDNO)="" 
 Set ^Verv(LevNr,"D",SIFANR,FAKNr,ToeLevNr)=NewRec
 Set ^Verv(LevNr,"IA",SIFANR,ABNr_D_ABLNr_D_FAKNr_D_ToeLevNr)=""
 Q
VProd Q  Set RecNaam="CSB-SO-42" Do TF
 Set ^HULP($J+100,ABNr,ABLNr,42)=NewRec
 Q
VPack Set RecNaam="CSB-SO-44" Do TF
 If $D(^Verv(LevNr,"D",SIFANR,FAKNr,ToeLevNr,"V")) Set PackRec=^("V")
 Else  Set PackRec=""
 FOR I=1:3:13 Set:$P(NewRec,D,I)!$P(NewRec,D,I+1) Pack=$P(NewRec,D,I)_U_$P(NewRec,D,I+1)_U_$P(NewRec,D,I+2),PackRec=PackRec_Pack_D
 Set:PackRec'="" ^Verv(LevNr,"D",SIFANR,FAKNr,ToeLevNr,"V")=PackRec
 Q
VRecuPak
 New RecuPak,RecuPakRec
 Set RecNaam="CSB-SO-45" Do TF
 Set RecuPak=$P(NewRec,D,1)_U_$P(NewRec,D,3)_U_$P(NewRec,D,4)
 Quit:$TR($P(NewRec,D,3),"0 ")="" ; geen identnr
 If $D(^Verv(LevNr,"D",SIFANR,FAKNr,ToeLevNr,"RP")) Set RecuPakRec=^("RP")_D_RecuPak
 Else  Set RecuPakRec=RecuPak
 Set ^Verv(LevNr,"D",SIFANR,FAKNr,ToeLevNr,"RP")=RecuPakRec
 Q
 
SCom Q
VCom Q
NextRec Set RecNr=$N(^BLImp(MsgId,RecNr)) Q:RecNr=-1  
 Set RecInp=^(RecNr),RecType=$E(RecInp,2,3) Q
StrPNum Set NUM="",SN1=1
SPN1 Set:+$E(STR,SN1)!($E(STR,SN1)=0)!($E(STR,SN1)=".") NUM=NUM_$E(STR,SN1) Set SN1=SN1+1 Goto SPN1:SN1'>$L(STR)
 Q
StrNum Set NUM="",SN1=1
SN1 Set:+$E(STR,SN1)!($E(STR,SN1)=0) NUM=NUM_$E(STR,SN1) Set SN1=SN1+1 Goto SN1:SN1'>$L(STR)
 Q
 
TF SET Tptr=0,Tptr=$N(^BLRecDef(LevNr,RecNaam,Tptr)),NewRec=""
TLoop Q:Tptr=-1
 Set TRec=^(Tptr),Piece=$P(TRec,D,4),Local=$P(TRec,D,5),Type=$P(TRec,D,6)
 If 'Piece&(Local="") Set Tptr=$N(^(Tptr)) Goto TLoop
 Set TF1=$E(RecInp,$P(TRec,D,1),$P(TRec,D,2))
LTRIM If $E(TF1,1)=" " Set TF1=$E(TF1,2,999) Goto LTRIM
RTRIM If $E(TF1,$L(TF1))=" " Set TF1=$E(TF1,1,$L(TF1)-1) Goto RTRIM
 Set:Type="N" TF1=+TF1
 Set:Type="D" TF1=$E(TF1,5,6)_"."_$E(TF1,3,4)_"."_$E(TF1,1,2)
 If Type="W" Do
 .Set TF1=$E(TF1,5,6)_"."_$E(TF1,3,4)_"."_$E(TF1,1,2)
 .Set TF1=$$EXTDATE^vhLib.DataTypes($$INTDATE^vhLib.DataTypes(TF1),"DW")
 Set:Piece $P(NewRec,D,Piece)=TF1
 Set:Local'="" @Local=TF1
 Set Tptr=$N(^(Tptr))
 Goto TLoop

YZ Set FP=2301 Write @F,@F1
 If $D(lbVervRef) Do
 . Do ##class(Flow.RecuPak.Verv).Check(lbVervRef)
 . Do Verwerk^BLCSBFAKVerschillenMail($$$LevBlum,lbVervRef)
 . Kill lbVervRef
 Q
 

VHRec(PRNr)
 New NoSa,VHRec,VHPRijs
 Set NoSa=$$NoSaAankoop^PRODUKT2(PRNr)	
 Set VHRec=$$LEVPR^KPRIJS($$$LevBlum,PRNr,NoSa)
 Quit VHRec