#include Prod.Product
 
HAD ;HALUX deur - Basisroutines  [ 11/08/2003   8:27 PM ]
 
DUEOUT(TOENr,TLUNr,NoDefault)
	; Bepalen van het DUEOUT tijdstip van productie.
	; Indien niet expliciet ingegeven dat bepalen vanuit de leverweek
	; NoDefault : Indien ProductieDueOut niet is ingevuld dan ook niet defaulten via Leveringsweek
	New Return,TijdStip,LevWk,TLNr
	Set TijdStip=$P($G(^KTO(6332,TOENr,1)),D,19)
	Quit:TijdStip=""&&$G(NoDefault) ""
	If TijdStip="" Do
	.Set TLNr=$G(^TO("IU",TOENr,TLUNr))
	.Set LevWk=$S(TLNr:$P(^KTO(6332,TOENr,TLNr),D,25),1:"")
	.Set TijdStip=$$INTDATE^vhDTyp(LevWk,"DW")
	Set:$P(TijdStip,",",2)="" TijdStip=TijdStip_",86340" ;23:59
	Quit TijdStip
	
DUEOUTFabKey(FabKey,NoDefault)
	Quit $$DUEOUT($P(FabKey,";"),$P(FabKey,";",2),.NoDefault)
 
VALAFM(Val,Def) 
 New Getal,Coord
 Set Getal=+$J(+$TR(Val,",","."),0,1) ;Nauwkeurigheid tot 1/10mm
 Set Coord=$$UPTRIMA^vhRtn1(Val)
 If 'Getal Set Val=""  Quit
 Set:Coord="" Coord=Def
 If ";LB;LO;RO;RB;T;"'[(";"_Coord_";") Set sEr="Foutief coordinatenstelsel"
 Set Val=Getal_Coord
 Quit
 
VALX(Val) 
 New Getal,Coord
 Set Getal=+Val
 Set Coord=$$UPTRIMA^vhRtn1(Val)
 Quit:Coord="T" Getal
 If ";RO;RB;"[(";"_Coord_";") Quit HAD(X)-Getal
 Quit Getal
 
VALY(Val) 
 New Getal,Coord
 Set Getal=+Val
 Set Coord=$$UPTRIMA^vhRtn1(Val)
 Quit:Coord="T" Getal
 If ";RO;LO;"[(";"_Coord_";") Quit HAD(Y)-Getal
 Quit Getal
 
KOSTFMT(Val,DefMunt,DefGO) 
 New Tmp,String
 Set Tmp=$P(Val,";")
 Set String=$TR(Tmp*(10**$S($G(DefGO)="%":2,1:0)),".",",")_$S($G(DefGO)="":" ",1:"%")_$G(DefMunt,"EUR")
 Set Tmp=$P(Val,";",2)
 Set:$L(Tmp) String=String_" ("_Tmp_")"
 Quit String
 
KOSTVAL(Val,DefMunt,DefGO,DefRnd) 
 New Getal,Coord,Munt,GO,MuntPar
 Set DefMunt=$G(DefMunt,"EUR")
 Set DefGO=$S($G(DefGO)="%":2,1:0)
 Set DefRnd=$G(DefRnd,2)
 ;
 Set (DispGetal,Getal)=+$TR(Val,",",".")
 Set Munt=$TR($$UPTRIMA^vhRtn1(Val)," ","")
 Set:Munt="BEF" Munt="BF"
 Set:Munt="" Munt=DefMunt
 Set GO=$S(Val["%":2,1:0)
 Set DispMunt=Munt,DispGO=GO
 If Munt=$E("MIN",1,$L(Munt)) Do  ; Minuten aanduiding
 .Set Getal=Getal*$P(^RES("HAD","PI","EXTRA","D","TIJDEUR"),"`",3)
 .Set Munt="EUR",GO=""
 .Set DispMunt="min."
 Set MuntPar=$$MUNTPAR^vhRtn1(Munt,"1","N",DefMunt)
 Set Val=Getal/(10**GO)/MuntPar ; Per stuk opslaan
 Set Val=+$J(Val,0,DefRnd+DefGO)
 Set:DispMunt'=DefMunt!(DispGO'=DefGO) Val=Val_";"_DispGetal_$S(DispGO=2:"%",1:" ")_DispMunt
 Quit 
 
VALSTAF(StafList,DefMunt,DefGO,DefRnd)  ; Not used 27-05-02 PV
 ;Staffeling de elementen zijn door ";" gescheiden
 ;Het staffelaantal en de prijs zijn door ":" gescheiden
 New Getal,Coord,Munt,GO,MuntPar,Val,ValList,StafEl,Qty,I
 Set DefMunt=$G(DefMunt,"EUR")
 Set DefGO=$G(DefGO)
 Set DefRnd=$G(DefRnd,2)
 Set ValList=StafList,StafList=""
 For I=1:1:$L(ValList,";") Do
 .Set StafEl=$P(ValList,";",I)
 .Set Qty=+$P(StafEl,":")
 .Set Val=$P(StafEl,":",2)
 .;Do VALPRIJS(.Val,DefMunt,DefGO,DefRnd)
 .Set StafList=StafList_";"_Qty_":"_Val
 Set $E(StafList)=""
 Quit
 
 
GENTYP(PRNr,CheckOldProducts) 
 New Typ,GenPRNr,SubGrp
 Quit:'PRNr ""
 Set GenPRNr=$P($G(^KPR(PRNr,0)),"\",3)
 Set:GenPRNr=""&&$G(CheckOldProducts) GenPRNr=$P($G(^KPRO(PRNr,0)),"\",3)
 Quit:GenPRNr="" ""
 Set:GenPRNr'?4.7N GenPRNr=PRNr ; het is reeds het generisch product
 Set Typ=$P($S($D(^KPR(GenPRNr)):$G(^KPR(GenPRNr,"G")),1:$G(^KPRO(GenPRNr,"G"))),"\",1,3)
 Set SubGrp=$P($S($D(^KPR(PRNr)):$G(^KPR(PRNr,"G")),1:$G(^KPRO(PRNr,"G"))),"\",3)
 ;Set:SubGrp?1A2.3E $P(Typ,"\",2)=SubGrp
 ;Set:$P(Typ,"\",2)'?1A2.3E $P(Typ,"\",2)=""
 Set:SubGrp?1A2E.1(1A,1N,1"+") $P(Typ,"\",2)=SubGrp
 Set:$P(Typ,"\",2)'?1A2E.1(1A,1N,1"+") $P(Typ,"\",2)=""
 Quit Typ  ;FabGrp\FabSubGrp\BarcodeBegin
 
ProductieGroep(PRNr)
	New GenTyp,ProductieGroep
	Set GenTyp=$$GENTYP^HAD(PRNr)
	If $P(GenTyp,"\")?1(1"KAD",1"PRF") Set ProductieGroep="KAD"  ; ALU Kaderdeur
	Else  If $P(GenTyp,"\")?1(1"TBX")&&($P(GenTyp,"\",2)'?1(1"HKS")) Set ProductieGroep="TBX" ; TBX (behalve hoekkast)
	Quit $G(ProductieGroep,"DIV") ; defaulting voor alle andere producten
 
 
GENLIST 
 New PRNr,Typ
 Set PRNr=0
 For  Set PRNr=$O(^KPR(PRNr)) Quit:PRNr=""  Do
 . Quit:$P(^KPR(PRNr,0),D,3)?4.7N  ; Afgeleid
 . Quit:$P(^KPR(PRNr,0),D,3)=""  ; Standaard
 . ; Generisch moederproduct
 . Set Typ=$G(^KPR(PRNr,"G"))
 . Quit:$P(Typ,D)=""
 . Write $P(Typ,D,1),$C(9),$P(Typ,D,2),$C(9),$P(Typ,D,3),$C(9),PRNr,$C(9),$P(^KPR(PRNr,0),D),!
 Quit
 
CHKDIGIT(BaseName) 
 New Sum,i,iChar
 For i=1:1:$L(BaseName) Do
 . Set iChar=$E(BaseName,i)
 . Set Sum=$G(Sum)+(i*$S(iChar?.N:iChar,1:10+$A(iChar)-$A("A")))
 Quit (Sum-1)#10
 
BARCODE(PRNr,Optie) 
 ; Optie="F" -> formateren met "." : G.DD.DD.S of G.DDD.S
 New DosNr,GenTyp,ChkDig,Res,D
 Set D="\"
 Set DosNr=$P($G(^KPR(PRNr,"G")),D)
 Quit:DosNr="" ""
 Set GenTyp=$P($$GENTYP(PRNr),D,3)
 Quit:GenTyp="" ""
 Set ChkDig=$$CHKDIGIT(GenTyp_DosNr)
 If $G(Optie)["F" Do
 . Set Res=GenTyp_"."_$S($L(DosNr)<4:DosNr,1:$E(DosNr,1,$L(DosNr)-2)_"."_$E(DosNr,$L(DosNr)-1,$L(DosNr)))_"."_ChkDig
 Else  Do
 . Set Res=GenTyp_DosNr_ChkDig
 Quit Res
 
GenerateTBXCode
    // [??]
	zn "HALUX"
	Do ATKUpdateCSPKey^cspBasis.TBX.Lib
	zn "ADMIN1"
	Quit
	
	// specialeke om levertermijn van kaderdeuren op 0 te zetten.
UpdateKAD20100816
	New PRNr Set PRNr = 0
	for  set PRNr = $O(^KPR(PRNr)) Q:PRNr=""  D
	. ;if (PRNr#100)=0 W PRNr,*13
	. if $$ProductieGroep(PRNr)="KAD" do
	. . set ctr=$I(ctr)
	. . Set JNode=$O(^KPR(PRNr,"J"))
	. . Quit:$E(JNode)'="J" 
	. . Set Termijn=+$P(^KPR(PRNr,JNode),"\",7) 
	. . Write PRNr,*13
    . . Do UpdateOneKAD(PRNr)
	Quit
 
UpdateOneKAD(PRNr)
	Set BIndex="J07"
	Do MODFIELD^PRODUKT(PRNr,BIndex,2,,"LEVERTERM.")
	Quit