BLKALI2 ;Routines voor interaktieve verwerking van het geconverteerde COA-SO bericht [ 05/14/2001  11:09 AM ]
 Q  ;-------------------------------------------------------------------------
WBON Set Status=$P(RecToe,D,30),Test=$P(RecToe,D,31),ToeNr=SToeNr
 Set R="K"_D_23_D_1_D_"Ingave ABNummer"_D_"""T[] voor waarde uit Toelevering, [] voor de huidige waarde te behouden"""_D_10_D_D_"K?6N!(K=""-"")!(K="""")!(K=""T"")!(K=""t"")" Do ^cA100
 Goto WERR:K=""!(K="-")
 Set:K="T"!(K="t") K=$P(RecToe,D,10)
 Set $P(RecToe,D,34)=K
 Do BTest^BLKALC3
 If $F(Test,"LIJN") Set BTest="LIJN,"_BTest Set:$E(BTest,$L(BTest))="," BTest=$E(BTest,1,$L(BTest)-1)
 Set $P(RecToe,D,31)=BTest,^BLTO(LevNr,SoDo,ToeNr,1)=RecToe
 Set ^HULP($J,"B",SBon)=RecToe,Veld="A"
 Goto WYZ
 ;-------------------------------------------------------------------------
WLIJN Set SortNr=$P(RecToe,D,1),RecToe=^BLTO(LevNr,SoDo,SToeNr,SortNr),Status=$P(RecToe,D,30),Test=$P(RecToe,D,31),ToeNr=SToeNr
 If Status'="" Set FP=2401 Write @F,@F1,*7,"Alleen toeleveringslijnen die bestaan bij LVH en BLUM toegelaten" R *K Goto WERR
 Set FP=2301 Write @F,@F1,"Welk veld wilt U wijzigen ?"
 Write !,"Q=Aantal; W=Leverweek; P=Prijs; I=IdentNummer"
 Set IK(1)="" Kill IK(2) DO IK^PROC1
 If '$F("AQLWPI",R) Write *7 Goto WERR
 Set Veld=$S(R="Q":"A",R="W":"L",1:R)
 Goto WTOE:$F("PI",Veld) 
 Goto WIA:Veld="A",WIL:Veld="L"
WL1 Do LTest^P3
 Set $P(RecToe,D,31)=Test
 Set ^BLTO(LevNr,SoDo,SToeNr,SortNr)=RecToe
 Goto WYZ
 
 ; Overbrengen van uit de toelevering.
WTOE Set:Veld="A" $P(RecToe,D,37)=$P(RecToe,D,3)
 Set:Veld="L" $P(RecToe,D,40)=$P(RecToe,D,25)
 Set:Veld="P" $P(RecToe,D,38)=$J(-$P(RecToe,D,7)/100+1*$P(RecToe,D,6),0,2),$P(RecToe,D,39)=$P(RecToe,D,21)
 Set:Veld="I" ID=$P(^KPR($P(RecToe,D,2),2),D,25),$P(RecToe,D,36)=$P(ID,".",1)_$P(ID,".",2)_$P(ID,".",3)_$P(ID,".",4),$P(RecToe,D,35)=$P(RecToe,D,2)
 Goto WL1
 ; Ingave Toelevering
WIA Set R="K"_D_23_D_1_D_"Aantal stuks"_D_"""  T[] waarde toelevering, [] huidige waarde"""_D_10_D_D_"K?.N!(K=""-"")!(K=""T"")!(K=""t"")" Do ^cA100
 Goto WERR:K=""!(K="-"),WTOE:$F("Tt",K)
 Set $P(RecToe,D,37)=K
 Goto WL1
 ; Ingave leverweek
WIL Kill %TC,%INT,%EXT
 Set R="K"_D_23_D_1_D_"Aantal stuks"_D_"""  Formaat : JJ/WW, T[] waarde toelevering, [] huidige waarde"""_D_10_D_D
 Set R=R_"K?2N1""/"".2N!(K=""-"")!(K=""T"")!(K=""t"")"
 Do ^cA100
 Goto WERR:K=""!(K="-"),WTOE:$F("Tt",K)
 Do VALDATE^vhLib.DataTypes(K,"DW")
 Goto WIL:'%TC,WIL:%INT<$$CALCDATE^vhLib.DataTypes(,"J","FD"),WIL:%INT>$$CALCDATE^vhLib.DataTypes(,"J","+1","LD")
 Kill %TC,%INT,%EXT
 Set $P(RecToe,D,40)=$P(K,"/",1)_"/"_$E($P(K,"/",2)+100,2,3)
 Goto WL1
WERR Set Veld=""
WYZ Set R=Veld,FP=2301 Write @F,@F1 Q
 ;-------------------------------------------------------------------------
TDB1 ;@ToeLev    ABNummer  KreaDat             Order     Klantnaam                    
TDB2 ;@Referentie BLUM                        Referentie VH                           
DBON Set FP=1801 Write @F,@F1,@FMTI,$P($T(TDB1),"@",2),@FMTi
 If Status="VH" Set ABNr1=$P(RecToe,D,10)
 Else  Set ABNr1=$P(RecToe,D,34)
 Set ABNr2=$P(RecToe,D,10),ToeNr1=$P(RecToe,D,1),OrdNr=$P(RecToe,D,7)
 Set ToeNr1=$E(ToeNr1+1000000,2,4)_"."_$E(ToeNr1+1000000,5,7)
 If ABNr2,ABNr1'=ABNr2 Set ABNr2=$E(ABNr2+1000000,2,4)_"."_$E(ABNr2+1000000,5,7)
 Else  Set ABNr2=""
 If ABNr1 Set ABNr1=$E(ABNr1+1000000,2,4)_"."_$E(ABNr1+1000000,5,7)
 Else  Set ABNr1=""
 If OrdNr Set OrdNr=$E(OrdNr+1000000,2,4)_"."_$E(OrdNr+1000000,5,7)
 Else  Set OrdNr=""
 Set Status=$P(RecToe,D,30),Test=$P(RecToe,D,31)
 ;Do FbBLVH:Status="",FbVH:Status="VH",FbBL:Status="BL"
FbWrt Set FP=1901 Write @F,ToeNr1
 Set FP=1911 Write @F Write:ABNr2 @FMTB Write ABNr1,@FMTb
 Set FP=1921 Write @F Write:$F(Status,"VH") @FMTB Write $P(RecToe,D,2),@FMTb
 Set FP=1941 Write @F,OrdNr
 Set FP=1951 Write @F,$P(RecToe,D,9)
 Set FP=2011 Write @F,ABNr2
 Set FP=2101 Write @F,@F1,@FMTI,$P($T(TDB2),"@",2),@FMTi
 Set FP=2201 Write @F,$P(RecToe,D,33)
 Set FP=2240 Write @F,$P(RecToe,D,3)
 Set FP=2401 Write @F,"Verschillen : ",Test
 Q
 ;------------------------------------------------------------------------
TDL1 ;@        Toelev     IdentNummer     KortTekst                   K/S     Stock    
TDL2 ;@        Aantal     Leverweek          Bruto     Korting Man  Netto   Mnt/Eenh   
TDL3 ;@1;C;L;5\2;C;R;9\6;C;R;16;;;$F(Test,"ID")\;C;L;4\4;C;L;26;;  ;$F(Test,"ID")\7;C;C;5\5;N0;R;10
TDL4 ;@1;C;L;5\2;C;R;9\6;C;R;16\;C;L;4\4;C;L;26;;  \7;C;C;5\5;N0;R;10
TDL5 ;@1;C;L;5\2;N;R;10;;;$P(L2VH,D,2)\3;C;R;9;;;$P(L2VH,D,3)\4;C;R;8\5;N;R;14;2;\6;N;R;8;2\7;C;L;1\8;C;R;2;;;"1"\9;N;R;12;2;;$F(Test,"PR")\10;C;R;5
TDL6 ;@1;C;L;5\2;N;R;10\3;C;R;9\4;C;R;8\5;N;R;14;2\6;N;R;8;2\7;C;L;1;;;\8;C;R;2\9;N;R;12;2\10;C;R;5
 ; Record beschrijving
 ; L1 -> Symb\ToeNr\Intern ProduktNr\IdentNummer\KortTekst\Stock/KOM\Fysische stock
 ; L2 -> Symb\Aantal\Voorziene. LVW\Gevr.LVW\Bruttoprijs\Korting\"%"\Man. prijs\NettoPrijs\"ATS/"\GrooteOrde
DLIJN B  If SToeNr>499999 Set ToeNr1="xxx.xxx"
 Else  Set ToeNr1=$E(SToeNr+1000000,2,4)_"."_$E(SToeNr+1000000,5,7)
 Set (L1BL,L2BL,L1VH,L2VH)=""
 Set (PR1,PR2,PrdNr2,PrdId2,PrdNm2,LVW2,QTY2,NPR2,DIM2)=""
 Set Status=$P(RecToe,D,30),Test=$P(RecToe,D,31)
 Do DlVHBL:Status="",DlVH:Status="VH",DlBL:Status="BL"!(Status="BO")
 Goto DL1:Status="VH"
 Set P1=$P(L1BL,D,3)
 If P1 Set $P(L1BL,D,4,7)=$P(^KPR(P1,0),D,1)_D_$$GETSTOCK^PRODUKT4(P1,"F")_D_$P(^KPR(P1,2),D,25)_D_$S($P(^KPR(P1,1),D,20):"STOCK",1:"KOM")
 Else  Set $P(L1BL,D,4,7)="*** "_$P(RecToe,D,36)_" ***"
DL1 Set P2=$P(L1VH,D,3)
 Set:P2 $P(L1VH,D,4,7)=$P(^KPR(P2,0),D,1)_D_$$GETSTOCK^PRODUKT4(P2,"F")_D_$P(^KPR(P2,2),D,25)_D_$S($P(^KPR(P2,1),D,20):"STOCK",1:"KOM")
 Set FP=1801 Write @F,@F1,@FMTI,$P($T(TDL1),"@",2),@FMTi
 Set FL(1)=$P($T(TDL3),"@",2),FL(2)=1901,FL(3)=L1BL DO FL^PROC:$P(L1BL,D,1)'=""
 Set FL(1)=$P($T(TDL4),"@",2),FL(2)=2001,FL(3)=L1VH DO FL^PROC:$P(L1VH,D,1)'=""
 Set FP=2101 Write @F,@FMTI,$P($T(TDL2),"@",2),@FMTi
 Set FL(1)=$P($T(TDL5),"@",2),FL(2)=2201,FL(3)=L2BL DO FL^PROC:$P(L2BL,D,1)'=""
 Set FL(1)=$P($T(TDL6),"@",2),FL(2)=2301,FL(3)=L2VH DO FL^PROC:$P(L2VH,D,1)'=""
 Q
 ; Alleen VH Gedeelte
DlVH Set L1VH="VH->"_D_ToeNr1_D_$P(RecToe,D,2)
 Set L2VH="VH->"_D_$P(RecToe,D,37)_D_$P(RecToe,D,40)_D_D_$P(RecToe,D,6)_D_$P(RecToe,D,7)_D_$P(RecToe,D,26)_D_D_"ATS/"_$P(RecToe,D,21)
 Set $P(L2VH,D,9)=-$P(RecToe,D,7)/100+1*$P(RecToe,D,6) ;Nettoprijs
 Set:$P(L2VH,D,6) $P(L2VH,D,7)="%"
 Set:$P(L2VH,D,29)'="" $P(L2VH,D,4)="("_$P(RecToe,D,29)_")"
 Q
 ; Alleen BL gedeelte
DlBL Set L1BL="BL->"_D_ToeNr1_D_$P(RecToe,D,35)
 Set L2BL="BL->"_D_$P(RecToe,D,37)_D_$P(RecToe,D,40)_D_D_$P(RecToe,D,6)_D_$P(RecToe,D,7)_D_D_$P(RecToe,D,26)_D_$P(RecToe,D,38)_D_"ATS/"_$P(RecToe,D,39)
 Set:$P(L2BL,D,6) $P(L2BL,D,7)="%"
 Q
 ; Beide gedeelte
DlVHBL Do DlBL,DlVH
 Set $P(L1VH,D,2)=""
 If $F(Test,"PR") Set $P(L2BL,D,4,7)=D_D_D
 Else  Set $P(L2VH,D,5,10)=D_D_D_D_D_D
 Set:'$F(Test,"ID") L1VH=""
 If $P(RecToe,D,3) Set $P(L2VH,D,2)=$P(RecToe,D,3)
 Else  Set $P(L2VH,D,2)=""
 If $P(RecToe,D,25) Set $P(L2VH,D,3)=$P(RecToe,D,25) Set:$P(RecToe,D,29) $P(L2VH,D,4)="("_$P(RecToe,D,29)_")"
 Else  Set $P(L2VH,D,3)="" Set:$P(RecToe,D,29) $P(L2BL,D,4)="("_$P(RecToe,D,29)_")"
 Set:'($P(L2VH,D,2)!$P(L2VH,D,3)!$P(L2VH,D,9)) L2VH=""
 Q
 ;-------------------------------------------------------------------------
BToggle Set Status=$P(RecToe,D,30),Test=$P(RecToe,D,31)
 Set T=$S($P(RecToe,D,32)="*":"",1:"*")
 Set $P(^HULP($J,"B",SBon),D,32)=T
 Set $P(^BLTO(LevNr,SoDo,SToeNr,1),D,32)=T
 Q:Status=""
 Set LijnNr=$N(^BLTO(LevNr,SoDo,SToeNr,99))
BT1 Goto BT2:LijnNr=-1
 Set $P(^(LijnNr),D,32)=T,LijnNr=$N(^(LijnNr)) Goto BT1
BT2 Q
 
 ;-------------------------------------------------------------------------
LToggle Set T=$S($P(RecToe,D,32)="*":"",1:"*")
 Set $P(^HULP($J,"L",SToeNr,SLijn),D,32)=T
 Set $P(^BLTO(LevNr,SoDo,SToeNr,$P(RecToe,D,1)),D,32)=T
 Q
 ; Omzetten van "DD.MM.YY" naar $H-formaat Input->R,output->R
XT S R=$$INTDATE^vhLib.DataTypes(R)
 Q