FOLTEC ;Produkt duplicering voor FolieTec deuren[ 02/21/2003  1:08 PM ]
 Do FETCHPR^UTILI(11822,"NewRec")
 Set $P(NewRec(0),D)=$P(^KPR(3414,0),D)
 Set New=$$GETEXIST
 q
 
GENERATE(KLNr,PRNr,Params) ; Generatie van het afgeleide product
 New Reeks,Kleur,BasisTyp,Hoogte,Breedte,Type,Acc,GNode,%SC
 Set GNode=$G(^KPR(PRNr,"G"))
 Set Acc=$G(GNode)["ACC"
 Do EDIT(PRNr,Acc)
 Quit:'%SC 0
 Quit $$BLDAFGL(PRNr,Reeks,Kleur,BasisTyp,Hoogte,Breedte,Type,99,"")
 
EDIT(PRNr,Acc) 
 Do STORE^vhTERMINA()
 Set FP=2201 Write @F,@F1,!,@FMTK,"Generatie voor folietec nog niet geimplementeerd",@FMTk," (Druk op ENTER)" R %SC
 Do REFRESH^vhTERMINA()
 Set %SC=0
 Quit
 
 ; Basistype = zie popup FRONT (P,D,H,K,A,G)
 ; Type = zie popup FRONTDTL en ACCESSOIRE en PANEEL en HOEKDEUR
 ; Code = afmeting omgezet naar een pregedefinierde afm.code
BGOPEN(FromPRNr,Reeks,Kleur,BasisTyp,Hoogte,Breedte,Type,Code,Params,Optie) 
 ; Optie : "S" Toon productinfo voor de SAVE
 Set:$G(CUserId)'=3 Optie="S"
 New NewPRNr
 If Code=99 Do
 .Set NewPRNr=$$BLDAFGL(,Reeks,Kleur,BasisTyp,Hoogte,Breedte,Type,Code,$G(Params),$G(Optie))
 Else  Do
 .Set NewPRNr=$$BLDSTD(Reeks,Kleur,BasisTyp,Hoogte,Breedte,Type,Code,$G(Params),$G(Optie))
 Quit NewPRNr
 
BLDSTD(Reeks,Kleur,BasisTyp,Hoogte,Breedte,Type,Code,Params,Optie) 
 New NewRec,NewPRNr,KortT,LT1,LT2,LT3,LevT1,LevT2,LevRef,AKPrijs,SAKPrijs,Gewicht,SG,GR,KKey,ExtraF,SExtraF,VKPrijs,Opp,AFM
 Do BUILD
 Quit:'$D(NewRec) ""
 Set NewPRNr=$$GETEXIST
 If NewPRNr=-1 Quit ""
 Quit:NewPRNr NewPRNr
 Do SAVE:$$SHOW
 Quit $G(NewPRNr)
 
 ;Opbouw van een afgeleid product
 ;indien het Generisch product niet bestaat wordt het eerst gekreeerd 
BLDAFGL(GenPRNr,Reeks,Kleur,BasisTyp,Hoogte,Breedte,Type,Code,Params,Optie) 
 New NewRec,NewPRNr,KortT,LT1,LT2,LT3,LevT1,LevT2,LevRef,AKPrijs,SAKPrijs,Gewicht,SG,GR,KKey,ExtraF,SExtraF,VKPrijs,Opp,AFM
 If '$G(GenPRNr) Set GenPRNr=$$GETGEN(Reeks,Kleur,BasisTyp,Hoogte,Breedte,Type,Code,$G(Params),$G(Optie))
 Quit:'GenPRNr "" ; Geen product
 Do BUILD
 Quit:'$D(NewRec) ""
 Set $P(NewRec(0),D,3)=GenPRNr
 Set NewRec("G")=$$REEKS(BasisTyp,Reeks,Type)_D_Kleur_D_BasisTyp_D_Hoogte_D_Breedte_D_Type_D_Code_D_Params
 ; Nakijken of Korttekst bestaat reeds en eventueel herbruiken product
 Set NewPRNr=$$GETEXIST
 If NewPRNr=-1 Quit "" 
 Quit:NewPRNr NewPRNr
 Do SAVE:$$SHOW
 Quit $G(NewPRNr)
 
GETGEN(Reeks,Kleur,BasisTyp,Hoogte,Breedte,Type,Code,Params,Optie) 
 New PRNr
 If BasisTyp="G"!(BasisTyp="A") Do  Quit
 .Set KortT=""
 Else  Do
 .Set KortT=$$KORTTXT(Reeks,Kleur,"G","","","",99,"")
 .Set PRNr=$$EXISTKT^PRODUKT2(KortT,"",1)
 .Quit:PRNr
 .Set PRNr=$$BLDGEN(Reeks,Kleur,"G","","","",99,"",$G(Optie))
 Quit PRNr
        
BLDGEN(Reeks,Kleur,BasisTyp,Hoogte,Breedte,Type,Code,Params,Optie) 
 New NewRec,NewPRNr,KortT,LT1,LT2,LT3,LevT1,LevT2,LevRef,AKPrijs,Gewicht,SG,GR,KKey,ExtraF,SExtraF,VKPrijs,Opp,AFM
 Do BUILD
 Quit:'$D(NewRec) ""
 Set $P(NewRec(0),D,3)="FOLTEC"
 Set NewRec("G")=$S(BasisTyp="A":"ACC",1:"")
 Do SAVE:$$SHOW
 Quit $G(NewPRNr)
 
BUILD 
 New I
 Set:$G(FromPRNr)="" FromPRNr=11822
 Do FETCHPR^UTILI(FromPRNr,"NewRec")
 For I=1:1:8 Set:'$D(NewRec(I)) $P(NewRec(I),D,26)=""
 Do CLEAN
 Set KortT=$$KORTTXT(Reeks,Kleur,BasisTyp,Hoogte,Breedte,Type,Code,Params)
 Do AFMETING
 Do LANGTXT("N"),LANGTXT("F")
 Do LEVTXT
 Do LEVREF
 Do PRIJS2
 Do GEWICHT
 Do KLASSIF(BasisTyp,Reeks,Type)
 Set $P(NewRec(0),D,1)=KortT ; Korttekst
 Set $P(NewRec(0),D,2)=LT1("N")
 Set $P(NewRec(0),D,11)=$E(LT2("N"),1,45)
 Set $P(NewRec(1),D,22)=LT1("F")
 Set $P(NewRec(3),D,20)=$S($L(AFM):BasisTyp_";"_Type_";"_AFM,1:"")
 Set $P(NewRec(3),D,21)=$E(LT2("F"),1,45)
 Set $P(NewRec(4),D,1,3)=$E(LevT1,1,45)_D_$E(LevT2,1,45)_D
 Set $P(NewRec(6),D)=$E(LT3("N"),1,45)
 Set $P(NewRec(8),D)=$E(LT3("F"),1,45)
 Set $P(NewRec("J"),D,3)=LevRef
 Set $P(NewRec("J"),D,19)=AKPrijs
 Set:SAKPrijs'=AKPrijs $P(NewRec(2),D,3)=SAKPrijs
 Set $P(NewRec(1),D,13)=Gewicht
 If '$D(GR)!'$D(SG) Do  Quit
 .Set NewRec=$$^vhTXTPOP("FOLTEC","NOKLAS",0,Reeks)
 .Kill NewRec
 Set $P(NewRec("I"),D,2)=GR
 Set $P(NewRec("I"),D,3)=SG
 Set $P(NewRec("I"),D,4)=KKey
 Quit
 
GETEXIST() ; De BUILD is uitgevoerd de gegevens zitten in NewRec, tevens is de eventuele G-node ingevuld
 ; met de BUILD-gegevens wordt nagekeken of de gegevens van het bestaande produkt overeenkomt met deze nieuw gekreëerde gevens 
 New OldRec,Txt,OTxt,NTxt,KortT,I,Input,DBSchad
 Set Txt=0
 Set KortT=$P(NewRec(0),D)
 Quit:'$$EXISTKT^PRODUKT2(KortT) "Bestaat niet" ; Produkt bestaat niet
 Set NewPRNr=$$EXISTKT^PRODUKT2(KortT,,1)
 Do FETCHPR^UTILI(NewPRNr,"OldRec")
 Set:$P(OldRec("J"),D)=6428 NewRec("J")=OldRec("J"),NewRec(2)=OldRec(2)
 For I=1:1:8 Set:'$D(OldRec(I)) $P(OldRec(I),D,26)=""
 If $P(OldRec("J"),D)'=$P(NewRec("J"),D) Do  Quit -1 ; Verschillende leverancier
 .Set Input=$$^vhTXTPOP("FOLTEC","DIFFLEV",,$P(OldRec(0),D))
 If $P(OldRec(0),D,2)'=$P(NewRec(0),D,2)!($P(OldRec(0),D,11)'=$P(NewRec(0),D,11))!($P(OldRec(6),D)'=$P(NewRec(6),D)) Do
 .Set Txt=Txt+1,OTxt(Txt)="ªBLangtekst N:ªb "_$P(OldRec(0),D,2)
 .Set NTxt(Txt)="ªBLangtekst N:ªb "_$P(NewRec(0),D,2)
 .Set Txt=Txt+1,OTxt(Txt)="             "_$P(OldRec(0),D,11)
 .Set NTxt(Txt)="             "_$P(NewRec(0),D,11)
 .Set Txt=Txt+1,OTxt(Txt)="             "_$P(OldRec(6),D)
 .Set NTxt(Txt)="             "_$P(NewRec(6),D)
 If $P(OldRec(1),D,22)'=$P(NewRec(1),D,22)!($P(OldRec(3),D,21)'=$P(NewRec(3),D,21)) Do
 .Set Txt=Txt+1,OTxt(Txt)="ªBLangtekst F:ªb "_$P(OldRec(1),D,22)
 .Set NTxt(Txt)="ªBLangtekst F:ªb "_$P(NewRec(1),D,22)
 .Set Txt=Txt+1,OTxt(Txt)="             "_$P(OldRec(3),D,21)
 .Set NTxt(Txt)="             "_$P(NewRec(3),D,21)
 If $P(OldRec("J"),D,3)'=$P(NewRec("J"),D,3) Do
 .Set Txt=Txt+1,OTxt(Txt)="ªBLev. Ref.  :ªb "_$P(OldRec("J"),D,3)
 .Set NTxt(Txt)="ªBLev. Ref.  :ªb "_$P(NewRec("J"),D,3)
 If $P(OldRec(4),D,1)'=$P(NewRec(4),D,1)!($P(OldRec(4),D,2)'=$P(NewRec(4),D,2)) Do
 .Set Txt=Txt+1,OTxt(Txt)="ªBLev. tekst :ªb "_$P(OldRec(4),D,1)
 .Set NTxt(Txt)="ªBLev. tekst :ªb "_$P(NewRec(4),D,1)
 .Set Txt=Txt+1,OTxt(Txt)="             "_$P(OldRec(4),D,2)
 .Set NTxt(Txt)="             "_$P(NewRec(4),D,2)
 If +$P(NewRec(2),D,3) Do  ; Schaduwprijs is ingevuld
 .; *************************************************************
 .; Opgelet : Indien de schaduwprijs reeds is ingevuld als verkoopprijs
 .; dan is er geen controle op de DB
 .; *************************************************************
 .If +$P(OldRec("J"),D,19)'=+$P(NewRec(2),D,3) Do  ; AKP <-> Schaduw
 ..Set Txt=Txt+1,OTxt(Txt)="ªBAKP        :ªb "_$P(OldRec("J"),D,19)_" "_$P(OldRec("J"),D,17)
 ..Set NTxt(Txt)="ªBSchaduw AKP:ªb "_$P(NewRec(2),D,3)_" "_$P(NewRec("J"),D,17)
 Else  Do  ; Geen schaduw prijs 
 .If +$P(OldRec("J"),D,19)'=+$P(NewRec("J"),D,19) Do  ; AKP
 ..Set Txt=Txt+1,OTxt(Txt)="ªBAKP        :ªb "_$P(OldRec("J"),D,19)_" "_$P(OldRec("J"),D,17)
 ..Set NTxt(Txt)="ªBAKP        :ªb "_$P(NewRec("J"),D,19)_" "_$P(NewRec("J"),D,17)
 .If +$P(OldRec("J"),D,24)'=+$P(NewRec("J"),D,24) Do  ; Winst - DB
 ..Set Txt=Txt+1,OTxt(Txt)="ªBDB%        :ªb "_$P(OldRec("J"),D,24)
 ..Set NTxt(Txt)="ªBDB%        :ªb "_$P(NewRec("J"),D,24)
 If +$P(OldRec("J"),D,9)'=+$P(NewRec("J"),D,9) Do  ; Korting
 .Set Txt=Txt+1,OTxt(Txt)="ªBKorting%   :ªb "_$P(OldRec("J"),D,9)
 .Set NTxt(Txt)="ªBKorting%   :ªb "_$P(NewRec("J"),D,9)
 If $G(^KPR(NewPRNr,"G"))'=$G(NewRec("G")) Do
 .Set Txt=Txt+1,OTxt(Txt)="G-Node      :  "_$G(^KPR(NewPRNr,"G"))
 .Set NTxt(Txt)="G-Node      :  "_$G(NewRec("G"))
 ; De prijs moet steed herekend worden !!!!!
 Set $P(^KPR(NewPRNr,"J"_$P(NewRec("J"),D)),D,19)=$P(NewRec("J"),D,19) ;AKPrijs
 Set:$P(NewRec(2),D,3) $P(^KPR(NewPRNr,2),D,3)=$P(NewRec(2),D,3) ;Schaduw AKPrijs
 Set $P(^KPR(NewPRNr,"J"_$P(NewRec("J"),D)),D,24)=$P(NewRec("J"),D,24) ;Winst - DB
 Set $P(^KPR(NewPRNr,"J"_$P(NewRec("J"),D)),D,9)=$P(NewRec("J"),D,9) ;Korting
 Do RECALC^PRODUKT2(NewPRNr)
 Do:$P(NewRec(2),D,3) ONE^PRSCALC(NewPRNr,0,"H")
 Quit:'Txt NewPRNr ; Geen verschillen
 Set Txt=0
 Set Txt=Txt+1,Txt(Txt)="ªiOud produktªI"
 For I=1:1:$O(OTxt(""),-1) Set Txt=Txt+1,Txt(Txt)=OTxt(I)
 Set Txt=Txt+1,Txt(Txt)="&S"
 Set Txt=Txt+1,Txt(Txt)="ªiNieuw produktªI"
 For I=1:1:$O(NTxt(""),-1) Set Txt=Txt+1,Txt(Txt)=NTxt(I)
 Do INIT^vhLIST("FOLTEC","GETEXIST",.List)
 Do WRITE^vhLIST(.List)
 Set Input=$$SCROLL^vhLIST(.List)
 Quit:Input'="W" -1 ; Geen wijziging daarom geen goede product
 Lock +^KPR(NewPRNr):1 Else  Do  Quit -1
 .Do STORE^vhTERMINA()
 .Do LDISP^vhLock($NA(^KPR(NewPRNr)),"Produkt "_KortT)
 .Do REFRESH^vhTERMINA()
 Do DELIND^PRODUKT2(NewPRNr)
 Set $P(^KPR(NewPRNr,0),D,2)=$P(NewRec(0),D,2) ; LT1("N")
 Set $P(^KPR(NewPRNr,0),D,11)=$P(NewRec(0),D,11) ;LT2("N")
 Set $P(^KPR(NewPRNr,1),D,22)=$P(NewRec(1),D,22) ;LT1("F")
 Set $P(^KPR(NewPRNr,3),D,21)=$P(NewRec(3),D,21) ;LT2("F")
 Set $P(^KPR(NewPRNr,4),D,1,3)=$P(NewRec(4),D,1,3) ; LevT1_D_LevT2_D
 Set $P(^KPR(NewPRNr,6),D)=$P(NewRec(6),D) ;LT3("N")
 Set $P(^KPR(NewPRNr,8),D)=$P(NewRec(8),D) ;LT3("F")
 Set $P(^KPR(NewPRNr,"J"_$P(NewRec("J"),D)),D,3)=$P(NewRec("J"),D,3) ;LevRef
 Do BLDIND^PRODUKT2(NewPRNr)
 ;Do:$P(NewRec(2),D,3) ONE^PRSCALC(NewPRNr,0,"H") ;wordt steeds uitgevoerd
 Lock -^KPR(NewPRNr)
 Quit NewPRNr
 
KORTTXT(Reeks,Kleur,BasisTyp,Hoogte,Breedte,Type,Code,Params) 
 New FrontK,KortT,CodeK,Dikte
 Set Reeks=$$REEKS(BasisTyp,Reeks,Type)
 Set CodeK=Code
 If BasisTyp="G" Do
 .Set FrontK="MAATWERK"
 Else  If BasisTyp="A" Do
 .Set FrontK=$P(^RES("FOLTEC","PI","ACCESSOIRE","D",Type),"`",3)
 .Set CodeK=Type
 Else  If BasisTyp="P" Do
 .Set FrontK=""
 .If "\EP\ER\EO\DP\DR\DO\ES\"[(D_Type_D),Code=99 Do
 ..Set CodeK=$P(^RES("FOLTEC","PI","PANEEL","D",Type),"`",3)
 ..Set CodeK=CodeK_$E($P(Params,";"),2)_$P(Params,";",2)
 Else  Do  ; Deur, Kaderdeur, Hoekdeur, Passtuk
 .Set FrontK=$P(^RES("FOLTEC","PI","FRONTDTL","D",Type),"`",3)
 Set KortT="D"_Reeks_$S($L(Kleur)=2:".",1:"")_Kleur
 Set KortT=KortT_$S(Type="FPM":$S($L(FrontK)<4:".",1:"")_FrontK,1:$S($L(CodeK)<4:".",1:"")_CodeK)
 Set:Type'="FPM" $E(KortT,12,999)=$$UPCASE^vhRtn1(FrontK)
 Set:BasisTyp'="A"&(BasisTyp'="G") $E(KortT,13+($L(Hoogte)<4),999)=$J(Hoogte,3)_"x"_Breedte
 Set $E(KortT,23,999)=$J(Kleur,3)
 Quit KortT
 
AFMETING ; Afmetingen
 If BasisTyp="G" Do
 .Set AFM=""
 Else  If BasisTyp="A" Do
 .Set AFM=$P(^RES("FOLTEC","PI","ACCESSOIRE","D",Type),"`",6)
 Else  If BasisTyp="P" Do  ; Alle panelen
 .Set AFM=Hoogte_"x"_Breedte
 Else  Do  ; Deur, Kaderdeur, Hoekdeur, Passtuk
 .Set AFM=Hoogte_"x"_Breedte
 Quit
 
LANGTXT(Taal) ; Langtekst NED en FR
 New OldReeks,Afm,ReeksO,FrontO
 If BasisTyp="G" Do
 .Set ReeksO=$P($G(^RES("FOLTEC","PI","REEKS","D",Reeks),"`"_Reeks),"`",2)
 .Set LT1(Taal)=ReeksO_", generisch"
 .Set LT2(Taal)="",LT3(Taal)=""
 Else  If BasisTyp="A" Do
 .Set Rec=^RES("FOLTEC","PI","ACCESSOIRE","D",Type,Taal)
 .Set LT1(Taal)=$P(Rec,"`")
 .Set LT2(Taal)=$P(Rec,"`",2)
 .Set LT3(Taal)=""
 Else  If BasisTyp="P" Do  ; Alle panelen
 .Set Rec=^RES("FOLTEC","PI","PANEEL","D",Type,Taal)
 .Set Afm=Hoogte_"x"_Breedte_$S(Type="PL"!("\EP\ER\EO\DP\DR\DO\"[(D_Type_D)):"x"_$P(Params,";"),1:"")_"mm"
 .Set:"\EP\ER\EO\DP\DR\DO\ES\"[(D_Type_D) Afm=Afm_" R="_$P(Params,";",2)
 .Set LT1(Taal)=$P(Rec,"`")_", "_Afm,LT2(Taal)=$P(Rec,"`",2)
 .Set:$L(LT1(Taal))>24 LT1(Taal)=$P(Rec,"`"),LT2(Taal)=Afm_$S($L($P(Rec,"`",2)):", ",1:"")_$P(Rec,"`",2)
 .Set LT3(Taal)=""
 Else  Do  ; Deur, Kaderdeur, Hoekdeur, Passtuk
 .Set ReeksO=$P(^RES("FOLTEC","PI","REEKS","D",Reeks),"`",2)
 .Set FrontO=$G(^RES("FOLTEC","PI",$S(Type="PS":"PANEEL",Type="FPM":"PANEEL",1:"FRONTDTL"),"D",Type,Taal))
 .Set Afm=Hoogte_"x"_Breedte_"mm"
 .Set LT1(Taal)=ReeksO_", "_Afm,LT2(Taal)=""
 .Set:$L(LT1(Taal))>24 LT1(Taal)=ReeksO,LT2(Taal)=Afm
 .Set LT2(Taal)=LT2(Taal)_$S($L(LT2(Taal)):", ",1:"")_FrontO
 .Set OldReeks=$$OLDREEKS(Reeks),LT3(Taal)=""
 .If $L(OldReeks) Set LT3(Taal)=$S(Taal="N":"Vroegere reeks",1:"Auparavant série")_" : "_OldReeks
 Quit
 
 ;Leverancier omschrijving
LEVTXT 
 New Taal,KleurO,Afm,Rec,ReeksO,FrontO
 Set Taal="N"
 If BasisTyp="G" Do
 .Set (LevT1,LevT2)=""
 Else  If BasisTyp="A" Do
 .Set Rec=^RES("FOLTEC","PI","ACCESSOIRE","D",Type,Taal)
 .Set KleurO=$P(^RES("FOLTEC","PI","KLEUR","D",Kleur),"`",2)
 .Set LevT1=$P(Rec,"`")_", "_KleurO
 .Set LevT2=$P(Rec,"`",2)
 Else  If BasisTyp="P" Do  ;Panelen zonder passtuk
 .Set ReeksO=""
 .Set Rec=^RES("FOLTEC","PI","PANEEL","D",Type,Taal)
 .Set KleurO=$P(^RES("FOLTEC","PI","KLEUR","D",Kleur),"`",2)
 .Set Afm="H:"_Hoogte_"xB:"_Breedte_$S(Type="PL"!("\EP\ER\EO\DP\DR\DO\"[(D_Type_D)):"x"_$P(Params,";"),1:"")_"mm"
 .Set:"\EP\ER\EO\DP\DR\DO\ES\"[(D_Type_D) Afm=Afm_" R="_$P(Params,";",2)
 .Set LevT1=$P(Rec,"`")_", "_KleurO_", "_Afm,LevT2=$P(Rec,"`",2)
 .Set:$L(LevT1)>45 LevT1=$P(Rec,"`")_", "_KleurO,LevT2=Afm_$S($L($P(Rec,"`",2)):", ",1:"")_$P(Rec,"`",2)
 Else  Do  ; Deur, Kaderdeur, Hoekdeur, Passtuk
 .Set ReeksO=$P(^RES("FOLTEC","PI","REEKS","D",Reeks),"`",2)
 .Set FrontO=^RES("FOLTEC","PI","FRONTDTL","D",Type,Taal)
 .Set KleurO=$P(^RES("FOLTEC","PI","KLEUR","D",Kleur),"`",2)
 .Set Afm="H:"_Hoogte_"xB:"_Breedte_"mm"
 .Set LevT1=ReeksO_", "_KleurO_", "_Afm,LevT2=""
 .Set:$L(LevT1)>45 LevT(1)=ReeksO_", "_KleurO,LevT2=Afm
 .Set LevT2=LevT2_$S($L(LevT2):", ",1:"")_FrontO
 Quit
 
LEVREF 
 If BasisTyp="G" Do
 .Set LevRef=""
 Else  If BasisTyp="A" Do
 .Set LevRef=Reeks_"-"_Kleur_"-"_Type
 Else  If BasisTyp="P" Do
 .Set LevRef=Reeks_"-"_Kleur_"-"_Type
 Else  Do
 .Set LevRef=$$REEKS(BasisTyp,Reeks,Type)_"-"_Kleur_"-"_Code
 Quit
 
PRIJS(FromPRNr,Reeks,Kleur,BasisTyp,Hoogte,Breedte,Type,Code,KLNr,NoSa)  
 Set Rec=$$BRUPRIJS($G(FromPRNr),Reeks,Kleur,BasisTyp,Hoogte,Breedte,Type,Code)
 Quit $P($$NETPRIJS($P(Rec,D,1),KLNr,Reeks,$P(Rec,D,3),$G(NoSa)),D)
 
BRUPRIJS(FromPRNr,Reeks,Kleur,BasisTyp,Hoogte,Breedte,Type,Code)  
 New NewRec,SAKPrijs,AKPrijs,ExtraF,VKPrijs
 Set:$G(FromPRNr)="" FromPRNr=11822
 Do FETCHPR^UTILI(FromPRNr,"NewRec")
 Do PRIJS2
 Set NetPrijs=""
 Quit FromPRNr_D_AKPrijs_D_VKPrijs
 
NETPRIJS(FromPRNr,KLNr,Reeks,VKPrijs,NoSa) 
 ;New KLId,BN,Munt,Kort1,Kort2,HG,GR,SG,ChkGR
 Set:$G(FromPRNr)="" FromPRNr=11822
 Set:$G(NoSa)="" NoSa="N"
 Set KLId=^KK1(KLNr)
 Set BN=$P(^KKL(KLId,2),D,5)
 If BN Quit "Brutto"
 Set (Kort1,Kort2)=""
 Set Munt=$P(^KKL(KLId,0),D,11)
 Set:NoSa="S" Kort1=$P(^KKL(KLId,2),D,25)
 Set:Kort1="" Kort1=$P(^KKL(KLId,2),D,3)
 Set (HG,GR,SG)=""
 For  Set HG=$O(^KLPUTZ(NoSa,KLNr,HG)) Quit:HG=""  Quit:HG["DE" 
 If $L(HG) Do
 .Do KORT($G(^KLPUTZ(NoSa,KLNr,HG,0,0,0,0)))
 .Set ChkGR=Reeks\100*100
 .For  Set GR=$O(^KLPUTZ(NoSa,KLNr,HG,GR)) Quit:GR=""  Quit:$E(GR,7,9)=ChkGR
 If $L(GR) Do
 .Do KORT($G(^KLPUTZ(NoSa,KLNr,HG,GR,0,0,0)))
 .For  Set SG=$O(^KLPUTZ(NoSa,KLNr,HG,GR,SG)) Quit:SG=""  Quit:$E(SG,12,14)=Reeks
 Do:$L(SG) KORT($G(^KLPUTZ(NoSa,KLNr,HG,GR,SG,0,0)))
 If Kort1?1A Do
 .Set Key=$O(^KPR(FromPRNr,"J")) Quit:$E(Key)'="J"
 .Set Vork=$P(^KPR(FromPRNr,Key),D,27)
 .Set Kort1=Vork*$P("0\0\-100\-10\0\25\50\75\100",D,$F("CPLRSBG",Kort1)+1)/100
 Set NetPrijs=$J(VKPrijs*(100-Kort1/100)*(100-Kort2/100),0,$$MUNT^vhRtn1(Munt,4))
 Quit NetPrijs_D_Kort1_D_Kort2
 
KORT(Rec) 
 Quit:Rec=""
 Set Kort1=$P(Rec,D,1)
 Set Kort2=$P(Rec,D,2)
 Quit
 
PRIJS2 ;Uitgebreid met schaduw aankoopprijs voor winstherrekening toe te laten
 ;De schaduwprijs bevindt zich naast de aankoopprijs met een ";" gescheiden
 Set Opp=Hoogte*Breedte/1000000
 B:Type="HL"!(Type="K")
 If BasisTyp="G" Do
 .Set (AKPrijs,SAKPrijs)=0
 Else  If BasisTyp="A" Do
 .Set AKPrijs=$P(^RES("FOLTEC","PI","ACCESSOIRE","D",Type),"`",4)
 .Set SAKPrijs=$S(AKPrijs[";":$P(AKPrijs,";",2),1:AKPrijs),AKPrijs=$P(AKPrijs,";")
 .;Als de kleur klopt dan wordt de derde piece van de prijs genomen als schaduw prijs
 .If ";"_$P(^RES("FOLTEC","PI","ACCESSOIRE","D",Type),"`",7)_";"[(";"_Kleur_";"),$P($P(^RES("FOLTEC","PI","ACCESSOIRE","D",Type),"`",4),";",3) Do
 ..Set SAKPrijs=$P($P(^RES("FOLTEC","PI","ACCESSOIRE","D",Type),"`",4),";",3)
 Else  If BasisTyp="P" Do
 .Set AKPrijs=$P(^RES("FOLTEC","PI","PANEEL","D",Type),"`",4)
 .Set SAKPrijs=$S(AKPrijs[";":$P(AKPrijs,";",2),1:AKPrijs),AKPrijs=$P(AKPrijs,";")
 .Set:Kleur="MDF" AKPrijs=AKPrijs-20,SAKPrijs=SAKPrijs-20 ; zonder folie
 .Set AKPrijs=$J(AKPrijs*$S(Code=99:1.1,1:1)*Opp,0,2)
 .Set SAKPrijs=$J(SAKPrijs*$S(Code=99:1,1:1)*Opp,0,2)
 Else  Do  ; Deur, DeurKader, Hoekdeur, Passtuk
 .Set ExtraF=$P(^RES("FOLTEC","PI","FRONTDTL","D",Type),"`",4) ; Extra voor bv. kaderdeur
 .Set SExtraF=$S(ExtraF[";":$P(ExtraF,";",2),1:ExtraF),ExtraF=$P(ExtraF,";")
 .If Type="FPM" Do
 ..Set AKPrijs=$P(^RES("FOLTEC","PI","PASSTUK","D",Type),"`",4)
 ..Set SAKPrijs=$S(AKPrijs[";":$P(AKPrijs,";",2),1:AKPrijs),AKPrijs=$P(AKPrijs,";")
 ..Set AKPrijs=$J((AKPrijs)+ExtraF,0,2) ; Hoogte onafhankelijk
 ..Set SAKPrijs=$J((SAKPrijs)+SExtraF,0,2)
 ..;Set:AKPrijs<30 AKPrijs=30 Set:SAKPrijs<30 SAKPrijs=30
 .Else  Do
 ..Set AKPrijs=$P(^RES("FOLTEC","PI","REEKS","D",Reeks),"`",4)
 ..Set SAKPrijs=$S(AKPrijs[";":$P(AKPrijs,";",2),1:AKPrijs),AKPrijs=$P(AKPrijs,";")
 ..Set:Kleur="MDF" AKPrijs=AKPrijs-20,SAKPrijs=SAKPrijs-20 ; zonder folie
 ..Set AKPrijs=AKPrijs*Opp,SAKPrijs=SAKPrijs*Opp
 ..Set AKPrijs=$J(AKPrijs*$S(Code=99:1.1,1:1)+ExtraF,0,2),SAKPrijs=$J(SAKPrijs*$S(Code=99:1,1:1)+SExtraF,0,2)
 Set VKPrijs=AKPrijs/$$MUNTPAR^vhRtn1($P(NewRec("J"),D,17),1)*(100-$P(NewRec("J"),D,9)/100)*(100+$P(NewRec("J"),D,21)/100)/(100-$P(NewRec("J"),D,24)/100)
 Set VKPrijs=$$ROUND^KPRIJS(VKPrijs)
 Quit
 
GEWICHT Set Opp=Hoogte*Breedte/1000000
 If BasisTyp="G" Do
 .Set Gewicht=0
 Else  If BasisTyp="A" Do
 .Set Gewicht=$P(^RES("FOLTEC","PI","ACCESSOIRE","D",Type),"`",5)
 Else  If BasisTyp="P" Do
 .Set Gewicht=$P(^RES("FOLTEC","PI","PANEEL","D",Type),"`",5)*Opp
 Else  Do  ; Deur, Deurkader, Hoekdeur, Passtuk
 .Set Gewicht=$P(^RES("FOLTEC","PI","REEKS","D",Reeks),"`",5)*Opp 
 Set Gewicht=+$J(Gewicht,0,0)
 Quit
 
KLASSIF(BasisTyp,Reeks,Type) 
 Set Reeks=$$REEKS(BasisTyp,Reeks,Type)
 Set (Key,SG)=$E($P(NewRec("I"),D,3),1,4)
 For  Set SG=$O(^KPSG1(SG)) Quit:$E(SG,1,4)'=Key!($E(SG,12,14)=Reeks)
 If $E(SG,12,14)'=Reeks Quit
 Set KKey=$P(^KPSG1(SG),D,6)
 Set GR=$$GETSORT^KLASS(KKey,2)
 Quit
 
CLEAN Set $P(NewRec(0),D,6)="" ; Ligging
 Set $P(NewRec(0),D,12,14)=D_D ; Beginstock,FysStock
 Set $P(NewRec(0),D,16)="" ; Laatste beweging
 Set $P(NewRec(0),D,17)="" ; Bestelling
 Set $P(NewRec(0),D,20)="" ; Schaduwkorttekst
 Set $P(NewRec(0),D,21)="" ; Schaduw sectie
 Set $P(NewRec(1),D,21)="" ; Gem Weekverkoop
 Set $P(NewRec(1),D,23)="" ; Gewogen gem. weekverkoop
 Set $P(NewRec(1),D,9)="" ; Inventaris fysstock
 Set $P(NewRec(2),D,3)="" ; Schad PPL
 Set $P(NewRec(2),D,4)="" ; Schad Korting
 Set $P(NewRec(2),D,5)="" ; Schad Vork
 Set $P(NewRec(2),D,6)="" ; Schad Winst
 Set $P(NewRec(2),D,7)="" ; Schad Cif
 Set $P(NewRec(2),D,9)="" ; Reservatie
 Quit
 
SHOW() New R,Save,KorT
 Set KortT=$P(NewRec(0),D)
 If $E(KortT,1,4)="D600",$L($G(Type)) Do  Quit:$D(Save) Save
 .Set R=$G(^RES("FOLTEC","PI","ACCESSOIRE","D",Type))
 .If R'["Lichtlijst",R'["Kroonlijst" Quit
 .Set Save=$$^vhTXTPOP("FOLTEC","BGONIEGEL",,KortT,LT1("N"),LT2("N"),$P(^KLE(^KL1(6428),0),D,2))
 .Set Save=0
 Quit:$G(Optie)'["S" 1
 Set Save=$$^vhTXTPOP("FOLTEC","BGOPEN",,KortT,LT1("N"),LT2("N"),AKPrijs_" ("_SAKPrijs_") "_$P(NewRec("J"),D,17),VKPrijs_" BEF",$ZU(5)'["ADM"!1)
 Quit Save
 
SAVE 
 If '$$CHECKKT^PRODUKT2(KortT) Set NOK=$$^vhTXTPOP("FOLTEC","KORTEXIST","",KortT) Quit
 Set NewPRNr=$$NEXTID^PRODUKT()
 Set IdentNr=$$IDENTNR^PRODUKT(NewPRNr)
 Set $P(NewRec(2),D,25)=IdentNr
 For I=0:1:8 Set ^KPR(NewPRNr,I)=NewRec(I)
 Set:$D(NewRec("G")) ^KPR(NewPRNr,"G")=NewRec("G") ; Generische node
 Set ^KPR(NewPRNr,"I")=""
 Set ^KPR(NewPRNr,"I1")=NewRec("I")
 Set ^KPR(NewPRNr,"J")=""
 Set ^KPR(NewPRNr,"J"_$P(NewRec("J"),D))=NewRec("J")
 ;Set:$L(TypeKey) ^RES("FOLTEC","PI","TYPE","D",TypeKey)=TypeRec
 ;Set:$L(TypeKey) ^FOLTEC("T",0,TypeKey)=TypeRec
 ;Indexen
 Do RECALC^PRODUKT2(NewPRNr)
 Do BLDIND^PRODUKT2(NewPRNr)
 Do:$P(NewRec(2),D,3) ONE^PRSCALC(NewPRNr,0,"H") ; Indien schaduw aankoopprijs ingevuld dan herrekenen
 Do ZEND^EWPR(NewPRNr)
 Quit
 
FRONT(Hoogte) 
 Quit:Hoogte<251 "L"
 Quit:Hoogte<451 "T"
 Quit "D"
 
BLDIND 
 New
 Do INIT^vhTERMINA
 Kill ^FOLTEC("IT")
 Set KLNr=""
 For  Set KLNr=$O(^FOLTEC("T",KLNr)) Quit:KLNr=""  Do
 .Set Afm=""
 .For  Set Afm=$O(^FOLTEC("T",KLNr,Afm)) Quit:Afm=""  Do
 ..Set R=^FOLTEC("T",KLNr,Afm),Kode=$P(R,D,2)
 ..Set Type=$TR(Afm,"1234567890x/",""),R=$TR(Afm,Type,""),Hoogte=$P(R,"x"),Breedte=$P(R,"x",2)
 ..Set R=Hoogte_D_Breedte_D_Type
 ..Set ^FOLTEC("IT",KLNr,Kode)=R
 Quit
 
OLDREEKS(NewReeks) 
 New Piece,OldReeks,NewR,OldR
 Set NewR="\623\624\625\634\635\636\637\641\642\643\644\645\646\652\653\654\656\"
 Set OldR="\713\715\716\717\701\706\714\705\707\711\712\709\708\723\718\720\719\"
 If NewR[(D_NewReeks_D) Do
 .Set Piece=$F(NewR,D_NewReeks)-1/4+1
 .Set OldReeks=$P(OldR,D,Piece)
 Quit $G(OldReeks)
 
REEKS(BasisTyp,Reeks,Type) 
 If BasisTyp="S",Type="FPM" Set Reeks=$E(Reeks)_$TR($J("",$L(Reeks)-1)," ",0)
 Quit Reeks
 
CHKAFM(PRNr,Modify,Clear) 
 Set Modify=$G(Modify,0),Clear=$G(Clear,0)
 If '$D(PRNr) New (Modify,Clear) Do
 .New Modify,Clear
 .Do INIT^vhTERMINA
 .Set (PRNr,OnePRNr,FCount,OCount,MCount)=0
 Else  New R,OnePRNr,OTypAfm,NTypAfm,Afm,FolTyp Set OnePRNr=1
 For  Set:'OnePRNr PRNr=$O(^KPR(PRNr)) Quit:PRNr=""  Do  Quit:OnePRNr
 .Quit:'$D(^KPR(PRNr,"J6092"))
 .Set R=^KPR(PRNr,0)
 .Quit:R["generisch"
 .Quit:R["Folieblad"
 .Quit:R["Prijslijst"
 .Quit:R["Map Folietec"
 .Quit:R[("DEKPLAAT")
 .Quit:R[("MAN "_PRNr)
 .Set KortTxt=$P(R,D)
 .Set:'OnePRNr FCount=FCount+1
 .Set R=^KPR(PRNr,3)
 .If Clear Set $P(R,D,20)="",^KPR(PRNr,3)=R Write:'OnePRNr !,PRNr Quit:'Modify
 .Set OTypAfm=$P(R,D,20),Afm=$$CALCAFM(PRNr),(FolTyp,NTypAfm)=""
 .If $L(Afm) Set FolTyp=$$FOLTYP(PRNr) If $L(FolTyp) Set NTypAfm=FolTyp_Afm
 .If $L(OTypAfm),'OnePRNr Set OCount=OCount+1
 .If $L(NTypAfm) Quit:OTypAfm=NTypAfm  Quit:FolTyp=""
 .Write !,PRNr,?10,KortTxt,?40,OTypAfm,?60,NTypAfm
 .If OTypAfm="",NTypAfm="" Quit
 .If Modify Set $P(R,D,20)=NTypAfm,^KPR(PRNr,3)=R Set:'OnePRNr MCount=MCount+1
 If 'OnePRNr Write !!,"Folietec  : ",FCount,!,"Ingevuld  : ",OCount,!,"Gewijzigd : ",MCount,#
 Quit
 
CALCAFM(PRNr,Node,Piece) 
 New R,Afm,Hoogte,Breedte,FolTyp,BasisTyp,Type
 Set Node=$G(Node),Piece=$G(Piece),Afm="",FolTyp=$$FOLTYP(PRNr),BasisTyp=$P(FolTyp,";"),Type=$P(FolTyp,";",2)
 If BasisTyp="A" Set Afm=$P(^RES("FOLTEC","PI","ACCESSOIRE","D",Type),"`",6)
 Else  Do
 .If Node="",Piece="" Do
 ..Set R=$G(^KPR(PRNr,"G"))
 ..If $P(R,D,4),$P(R,D,5) Set Afm=$P(R,D,4)_"x"_$P(R,D,5),R=""
 .If $L(Afm)
 .Else  Do
 ..Set:Node="" Node=4 Set:Piece="" Piece=1
 ..Set R=$P(^KPR(PRNr,Node),D,Piece)
 .If R["H:",R["x",R["B:",R["mm" Do
 ..Set R="H:"_$TR($P(R,"H:",2)," ","")
 ..If $L(R,"x")=3 Do  Quit
 ...Set Hoogte=$P(R,"H:",2),Hoogte=$P(Hoogte,"x")
 ...Set Breedte=$P(R,"B:",2),Breedte=$P(Breedte,"x")
 ...If Hoogte,Hoogte?.N,Breedte,Breedte?.N Do
 ....Set Afm=Hoogte_"x"_Breedte
 ..Set Hoogte=$P(R,"H:",2),Hoogte=$P(Hoogte,"x")
 ..Set Breedte=$P(R,"B:",2),Breedte=$P(Breedte,"mm")
 ..If Hoogte,Hoogte?.N,Breedte,Breedte?.N Set Afm=Hoogte_"x"_Breedte
 .Else  If R["H:",R["x",R["B:" Do
 ..Set R="H:"_$TR($P(R,"H:",2)," ","")
 ..If $L(R,"x")=3 Do  Quit
 ...Set Hoogte=$P(R,"H:",2),Hoogte=$P(Hoogte,"x")
 ...Set Breedte=$P(R,"B:",2),Breedte=$P(Breedte,"x")
 ...If Hoogte,Hoogte?.N,Breedte,Breedte?.N Do
 ....Set Afm=Hoogte_"x"_Breedte
 ..Set Hoogte=$P(R,"H:",2),Hoogte=$P(Hoogte,"x")
 ..Set Breedte=$P(R,"B:",2)
 ..If Hoogte,Hoogte?.N,Breedte,Breedte?.N Set Afm=Hoogte_"x"_Breedte
 .Else  If R[" x ",R["mm" Do
 ..Set Hoogte=$P(R," x "),Hoogte=$P(Hoogte," ",$L(Hoogte," "))
 ..Set Breedte=$P(R," x ",2),Breedte=$P(Breedte,"mm")
 ..If Hoogte,Hoogte?.N,Breedte,Breedte?.N Do
 ...Set Afm=Hoogte_"x"_Breedte
 .Else  If $L(R,"x")=3 Do
 ..Set Hoogte=$P(R,"x"),Hoogte=$P(Hoogte," ",$L(Hoogte," "))
 ..Set Breedte=$P(R,"x",2)
 ..If Hoogte,Hoogte?.N,Breedte,Breedte?.N Do
 ...Set Afm=Hoogte_"x"_Breedte
 .Else  If $L(R,"x")=4 Do
 ..Set Hoogte=$P(R,"x"),Hoogte=$P(Hoogte," ",$L(Hoogte," "))
 ..Set Breedte=$P(R,"x",2)
 ..If Hoogte,Hoogte?.N,Breedte,Breedte?.N Do
 ...Set Afm=Hoogte_"x"_Breedte
 .Else  If R["x",R["mm" Do
 ..Set Hoogte=$P(R,"x"),Hoogte=$P(Hoogte," ",$L(Hoogte," "))
 ..Set Breedte=$P(R,"x",2),Breedte=$P(Breedte,"mm")
 ..If Hoogte,Hoogte?.N,Breedte,Breedte?.N Do
 ...Set Afm=Hoogte_"x"_Breedte
 .Set Afm=$TR(Afm," ","")
 .If Afm="",Node=4,Piece=1 Set Afm=$$CALCAFM(PRNr,Node,2)
 Quit Afm
 
FOLTYP(PRNr,Node,Piece,Taal) 
 New I,R,FolTyp,BasisTyp,Type,Ref
 Set Node=$G(Node,4),Piece=$G(Piece,2),Taal=$G(Taal,"N")
 Set Ref=$P(^KPR(PRNr,Node),D,Piece),(BasisTyp,Type)=""
 For  Set Type=$O(^RES("FOLTEC","PI","FRONTDTL","D",Type)) Quit:Type=""  Do  Quit:$L(BasisTyp)
 .Set R=$P(^RES("FOLTEC","PI","FRONTDTL","D",Type,Taal),"`")
 .Quit:R'=Ref
 .Set BasisTyp=""
 .Set:R="Ladefront" BasisTyp="D"
 .Set:R="Face tiroir" BasisTyp="D"
 .Set:R="Ladefront zonder binnenfrezing" BasisTyp="D"
 .Set:R="Face tiroir sans lisse" BasisTyp="D"
 .Set:R="Deur/lade front" BasisTyp="D"
 .Set:R="Porte/Face tiroir" BasisTyp="D"
 .Set:R="Deur" BasisTyp="D"
 .Set:R="Porte" BasisTyp="D"
 .Set:R="Kader voor glasdeur" BasisTyp="K"
 .Set:R="Cadre pour porte vitrine" BasisTyp="K"
 .Set:R="Spijlraamdeur" BasisTyp="R"
 .Set:R="Cadre à croisillons" BasisTyp="R"
 .Set:R="Monsterdeur" BasisTyp="D"
 .Set:R="Porte échantillon" BasisTyp="D"
 .Set:R="Hoekdeur links (rechts rechtafgekant)" BasisTyp="H"
 .Set:R="Porte d'angle gauche" BasisTyp="H"
 .Set:R="Hoekdeur rechts (links rechtafgekant)" BasisTyp="H"
 .Set:R="Porte d'angle droite" BasisTyp="H"
 .Set:R="Mondo links" BasisTyp="H"
 .Set:R="Mondo à gauche" BasisTyp="H"
 .Set:R="Mondo rechts" BasisTyp="H"
 .Set:R="Mondo à droite" BasisTyp="H"
 .Set:R="Passtuk" BasisTyp="S"
 .Set:R="Fileur" BasisTyp="S"
 .Set:R="Fantasiepasstuk" BasisTyp="S"
 .Set:R="Fileur Fantaisie" BasisTyp="S"
 .Set:R="Eindpaneel" BasisTyp="P"
 .Set:R="Panneau d'habillage" BasisTyp="P"
 If Type="" Do
 .Set BasisTyp=""
 .For  Set Type=$O(^RES("FOLTEC","PI","ACCESSOIRE","D",Type)) Quit:Type=""  Do  Quit:$L(BasisTyp)
 ..Set R=$P(^RES("FOLTEC","PI","ACCESSOIRE","D",Type,Taal),"`")
 ..Quit:R'=Ref
 ..Set BasisTyp="A"
 .Quit:$L(BasisTyp)
 .Set:$P($P(Ref," "),",")="Eindpaneel" BasisTyp="P",Type="EP"
 Set FolTyp=BasisTyp_$S($L(Type):";",1:"")_Type
 If $L(FolTyp) Set FolTyp=FolTyp_";"
 Else  If Node=4 Set FolTyp=$$FOLTYP(PRNr,0,2)
 Else  If Node=0 Set FolTyp=$$FOLTYP(PRNr,3,21,"F")
 Quit FolTyp