BLKALC3 G BEGIN ;Opsporen van de verschillen in het BLTO bestand tov KTO bestand [ 01/15/2003  4:02 PM ]
BEGIN Kill ^BLToe("L"),^KHULP($J)
 Set FP=2301 Write @F,@F1,"Opsporen van de verschillen"
 Set FP=2401 Write @F,"Toelevering : ",@FCH
 ;Vergelijken import records met LVH bestand
 Set RecCnt=1
 Set ToeNr=199999
LOOP Set ToeNr=$N(^BLTO(LevNr,SoDo,ToeNr)) Goto EXIT:ToeNr=-1
 Set FP=2415 Write @F,ToeNr
 Do BVerw Goto LOOP
BVerw Set RecToe=^BLTO(LevNr,SoDo,ToeNr,1)
 Set BLKLNr=$P(RecToe,D,37)
 Do BTest
 Set SortNr=99,LijnCnt=0
BV1 Set SortNr=$N(^BLTO(LevNr,SoDo,ToeNr,SortNr)) Goto BV2:SortNr=-1
 Set RecToe=^(SortNr),LijnCnt=LijnCnt+1
 Do LTest
 Set:BStatus=""&'$F(BTest,"LIJN")&(Test'="") BTest="LIJN,"_BTest
 Set $P(RecToe,D,31,32)=Test_D_$S(Test="LVW":"*",1:"")
 Set ^BLTO(LevNr,SoDo,ToeNr,SortNr)=RecToe
 Goto BV1
BV2 Set:$E(BTest,$L(BTest))="," BTest=$E(BTest,1,$L(BTest)-1)
 Set $P(^BLTO(LevNr,SoDo,ToeNr,1),D,31,32)=BTest_D_$S(BStatus="":"*",1:"")
 Q
 ; Test BON
BTest Set BTest="",BStatus=$P(RecToe,D,30)
 Do @$S(BStatus="BL":"BBL",BStatus="VH":"BVH",1:"BVHBL")
 Q
 ; Beide delen zijn gekend
BVHBL 
 If $P(RecToe,D,34)'=$P(RecToe,D,10)&($P(RecToe,D,10)'="") Set BTest="ABNr wijziging " Q
 If +$P(RecToe,D,37)'=+$P(RecToe,D,9)&($P(RecToe,D,9)'="") Set BTest="KUNDE" Q
 If $P(RecToe,D,10)="" Set BTest="Invullen ABNr" Q
 Set STR=$P($P(RecToe,D,33)," ",1+(SoDo="DO")) Do StrNum Set:NUM'=ToeNr BTest="Ref BLUM"
 Q
 ; Alleen gekend bij BLUM
BBL Set BTest="ADD"
 Q
 ; Alleen gekend bij VH
BVH ; ABNummer was reeds ingevuld dus heeft bestaan bij BLUM
 If $P(RecToe,D,10)'="" Set BTest="DELETE" Set:$D(^RCP("IT",ToeNr)) BTest="" Q
 ; Bepalen van het aantal dagen tussen DJ en KreaDat
 Set R=$P(RecToe,D,2) Do XT
 IF R+4<+$H Set BTest="Niet in KAL"
 Q
 ; Invullen Lijn
LTest ; Invullen RecToe indien ledig
 Set Test="",Status=$P(RecToe,D,30)
 Do LInvBL:Status'="VH"
 Do @$S(Status="BL":"LBL",Status="BO":"LBO",Status="VH":"LVH",1:"LVHBL")
 Q
LInvBL Set PrdId=$P(RecToe,D,36)
 Set PrdNr=$$GETVH^BLPROD(PrdId,BLKLNr)
 Set $P(RecToe,D,35)=PrdNr
 Q
 
 ; Beide gedeelten bestaan -> De verschillende velden vergelijken
LVHBL Set:PrdNr'=$P(RecToe,D,2) Test="ID,"_Test
 Set T=$P(RecToe,D,6)*(-$P($P(RecToe,D,7),"#")/100+1)*(-$P($P(RecToe,D,7),"#",2)/100+1)-$P(RecToe,D,38)
 Set:(SoDo'="DO")&&((T*$S(T<0:-1,1:1)>0.05)!($P(RecToe,D,21)'=$P(RecToe,D,39))) Test="PR,"_Test
 Set:$P(RecToe,D,3)'=$P(RecToe,D,37) Test="QTY,"_Test
 Set:$P(RecToe,D,25)'=$P(RecToe,D,40)!($$INTDATE^vhDTyp($P(RecToe,D,25),"DW")<+$H) Test="LVW,"_Test
 Set:$P(RecToe,D,41)'=2 Test="NC,"_Test
 Set:$E(Test,$L(Test))="," Test=$E(Test,1,$L(Test)-1)
 Q
 ; Alleen gekend bij VH
LVH If BTest'="Niet in KAL" Set Test="Del" Set:$D(^RCP("IT",ToeNr)) Test="" Q
 ; Alleen gekend bij BLUM
LBL Set Test="Add"
 Set:$P(RecToe,D,41)'=2 Test="NC,"_Test
 Q
 ; Backorder van een bestaande lijn
LBO Set Test="BackOrder" Q
EXIT Goto YZ
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
 ; Omzetten van "DD.MM.YY" naar $H-formaat Input->R,output->R
XT S R=$$INTDATE^vhDTyp(R)
 Q
YZ Write @FCS Q