FOLTECL ;FolieTec deuren (Lakdraagfolie)[ 02/21/2003  1:09 PM ]
 ;
 ; Bevat het order lakprodukten (kleur F00)
ISLAKORD(ORDNr) 
 New R,KLNr,OLNr,PRNr,KortTxt
 Set LAKOrd=0,KLNr=$P(^KO1(ORDNr,"F"),D),OLNr=100
 For  Set OLNr=$O(^KOD(KLNr,"F",ORDNr,OLNr)) Quit:OLNr=""  Do  Quit:LAKOrd
 .Set R=^KOD(KLNr,"F",ORDNr,OLNr),PRNr=$P(R,D,2)
 .Quit:'PRNr  Quit:'$D(^KPR(PRNr))
 .Set R=^KPR(PRNr,0),KortTxt=$P(R,D)
 .If $E(KortTxt)="D" Set LAKOrd=$E(KortTxt,22,25)=" F00"
 Quit LAKOrd
 ;
 ; Welke lakwerkkleuren bevat order ...
LAKRAL(ORDNr) 
 New R,KLNr,OLNr,PRNr,KortTxt,Ral,LakRal
 Set Ral=D,KLNr=$P(^KO1(ORDNr,"F"),D),OLNr=100
 For  Set OLNr=$O(^KOD(KLNr,"F",ORDNr,OLNr)) Quit:OLNr=""  Do
 .Set R=^KOD(KLNr,"F",ORDNr,OLNr),PRNr=$P(R,D,2),LakRal=$P(R,D,4)
 .Quit:'PRNr  Quit:'$D(^KPR(PRNr))
 .Set R=^KPR(PRNr,0),KortTxt=$P(R,D)
 .If $E(KortTxt)="D",$E(KortTxt,22,25)=" F00",Ral'[(D_$P(LakRal,"#")_D) Set Ral=Ral_$P(LakRal,"#")_D
 Quit Ral
 ;
 ; Bevat lakorder ... lakwerkkleuren
CHKRAL(ORDNr) 
 New ChkRal
 Set ChkRal='$$ISLAKORD(ORDNr)
 Set:'ChkRal ChkRal=$$LAKRAL(ORDNr)'["\\"
 Quit ChkRal
 ;
 ; Is order ... volledig gelakt
ISGELAKT(ORDNr) 
 New R,IsGelakt,KLNr,OLNr,PRNr,TOENr
 If $$ISLAKORD(ORDNr) Do
 .Set IsGelakt=1,KLNr=$P(^KO1(ORDNr,"F"),D),OLNr=100
 .For  Set OLNr=$O(^KOD(KLNr,"F",ORDNr,OLNr)) Quit:OLNr=""  Do  Quit:'IsGelakt
 ..Set R=^KOD(KLNr,"F",ORDNr,OLNr),PRNr=$P(R,D,2),TOENr=$P(R,D,27)
 ..Quit:'PRNr  Quit:'$D(^KPR(PRNr,"J6267"))
 ..Set:TOENr IsGelakt=0
 Quit $G(IsGelakt,1)
 ;
 ; Invullen lakwerktypes en kleuren (Local)
LAKWERK(ORDNr,Buttons) 
 New I,R,Input,IsLAKOrd,LakRal,LakWerk,KLNr,OLNr,PRNr,KortTxt,Count,RalKode,LakKode,List
 Set Buttons=$G(Buttons)
 If $$ISLAKORD(ORDNr) Do
 .Set LakRal=$$LAKRAL(ORDNr)
 .Do STORE^vhTERMINA()
 .Set KLNr=$P(^KO1(ORDNr,"F"),D),OLNr=100,Count=0
 .For  Set OLNr=$O(^KOD(KLNr,"F",ORDNr,OLNr)) Quit:OLNr=""  Do
 ..Set R=^KOD(KLNr,"F",ORDNr,OLNr),PRNr=$P(R,D,2)
 ..Set LakRal=$P(R,D,4),RalKode=$P(LakRal,"#"),LakKode=$P(LakRal,"#",2)
 ..Quit:'PRNr  Quit:'$D(^KPR(PRNr))
 ..Set R=^KPR(PRNr,0),KortTxt=$P(R,D)
 ..Quit:$E(KortTxt)'="D"  Quit:$E(KortTxt,22,25)'=" F00"
 ..Set Count=Count+1,LakWerk(Count)=OLNr_D_RalKode_D_LakKode_D_PRNr
 .Do INIT^vhLIST("FOLTEC","LAKWERK",.List)
 .For I=1:1 Quit:'$D(LakWerk(I))  Set R=LakWerk(I) If $P(R,D,2)="" Set List("SELECT")=I Kill List("OFFSET") Quit
 .If $L(Buttons) For I=1:1 Quit:'$D(List("B",I))  Set $P(List("B",I),"`",3)=$P("H",D,Buttons'[$P(List("B",I),"`",2))
 .Do WRITE^vhLIST(.List)
 .For  Do  Quit:Input="O"  Quit:Input="A"
 ..Set Input=$$SCROLL^vhLIST(.List)
 ..If Input="W" Do WIJZIG(.LakWerk,.List)
 ..If Input="V" Do WIJZIG(.LakWerk,.List,1)
 .Do:Input="O" SAVELAK(.LakWerk)
 .Do REFRESH^vhTERMINA()
 Quit
 ;
 ; Wijzig lakwerktypes en kleuren (Local)
WIJZIG(LakWerk,List,Order) 
 New I,R,RalKode,LakKode,PRNr
 Set Order=$G(Order)
 Set (RalKode,LakKode)=""
 If 'Order Set R=LakWerk(List("SELECT")),RalKode=$P(R,D,2),LakKode=$P(R,D,3) Set:'Order PRNr=$P(R,D,4)
 Set R=$S($L(RalKode):"EDIT",1:"NIEUW")_"^vhScherm(""FLOWRAL"",,,,,,3)"
 Do @R
 If %SC Do
 .For I=$S(Order:1,1:List("SELECT")):1 Quit:'$D(LakWerk(I))  Do  Quit:'Order
 ..Set R=LakWerk(I),$P(R,D,2)=RalKode,$P(R,D,3)=LakKode,LakWerk(I)=R
 .For I=List("SELECT"):1 Quit:'$D(LakWerk(I))  Set R=LakWerk(I) If $P(R,D,2)="" Set List("SELECT")=I Kill List("OFFSET") Quit
 .Set $P(List("B",1),"`",3)=""
 .Do WRITE^vhLIST(.List)
 Quit
 ;
 ; Opslaan lakwerktypes en kleuren in het order
SAVELAK(LakWerk) 
 New R,Count,LakRal,OLNr,RalKode,LakKode
 For Count=1:1 Quit:'$D(LakWerk(Count))  Do
 .Set R=LakWerk(Count),OLNr=$P(R,D),RalKode=$P(R,D,2),LakKode=$P(R,D,3),PRNr=$P(R,D,4)
 .Set LakRal=RalKode
 .If $L(LakRal),LakRal'=0,$L(LakKode) Set LakRal=LakRal_"#"_LakKode
 .Set R=^KOD(KLNr,"F",ORDNr,OLNr)
 .Quit:$P(R,D,4)=LakRal
 .Set $P(R,D,4)=LakRal,^KOD(KLNr,"F",ORDNr,OLNr)=R
 Quit
 ;
CLOSE(ORDNr) 
 New R,KLNr,Closed
 Set KLNr=$P(^KO1(ORDNr,"F"),D)
 Set R=^KOD(KLNr,"F",ORDNr,1),Closed=$P(R,D,22)
 If 'Closed Do
 .If '$$CHKRAL^FOLTECL(ORDNr) Do LAKWERK(ORDNr,"OVW")
 .Do SORT(ORDNr,,,1),WL^PROC,LAKTOE(ORDNr)
 Quit
 ;
SORT(ORDNr,First,Last,InsText) 
 New R,%J,KLNr,Taal,OLNr,Count,PRNr,Key,Next,PakketNr,BlockId,OLUNr,LEVNr,TOENr,TLNr
 New LakRal,RalKode,LakKode,LakCount,LakOmsch,Closed
 Set KLNr=$P(^KO1(ORDNr,"F"),D)
 Set R=^KOD(KLNr,"F",ORDNr,1),Closed=$P(R,D,22)
 Quit:Closed  Quit:$O(^KOD(KLNr,"F",ORDNr,100))=""  Quit:'$$ISLAKORD(ORDNr)
 Set %J=$$%J^vhRtn1()
 Kill ^HULP(%J)
 Set:'$G(First) First=101 Set:'$G(Last) Last=$O(^KOD(KLNr,"F",ORDNr,""),-1)
 Set InsText=$G(InsText)
 Set OLNr=First-1,Count=0,OLUNr=""
 Set R=^KKL(^KK1(KLNr),0),Taal=$P(R,D,9) Set:"NF"'[Taal Taal="N"
 For  Set OLNr=$O(^KOD(KLNr,"F",ORDNr,OLNr)) Quit:OLNr>Last!'OLNr  Do
 .Set R=^KOD(KLNr,"F",ORDNr,OLNr),PRNr=$P(R,D,2),BlockId=$P(R,D,18)
 .If PRNr Do
 ..Set OLUNr=$P(R,D,15),PakketNr=$P(R,D,31) Set:'PakketNr PakketNr=999999
 ..Do KWNODE^FLOWORD(KLNr,ORDNr,OLNr)
 .If $P(BlockId,";",2)="P",$P(BlockId,";",3)=OLUNr Do  Quit
 ..Merge ^HULP(%J,$J(Count,3)_$J(PakketNr,7)_" "_Key_" "_OLNr)=^KOD(KLNr,"F",ORDNr,OLNr)
 ..Kill ^KOD(KLNr,"F",ORDNr,OLNr)
 .If 'PRNr Set Count=Count+1,Key="",PakketNr=$P(R,D,31)
 .Else  Do
 ..Set LakRal=$P(R,D,4),RalKode=$P(LakRal,"#"),LakKode=$P(LakRal,"#",2)
 ..Set LakCount="" Set:$L(LakKode) LakCount=$P(^RES("FOLTEC","PI","LAKKODE","D",LakKode),"`")
 ..Set Key=$J(RalKode,10)_$J(LakCount,1)_$J(LakKode,4)
 .Merge ^HULP(%J,$J(Count,3)_$J(PakketNr,7)_" "_Key_" "_OLNr)=^KOD(KLNr,"F",ORDNr,OLNr)
 .Kill ^KOD(KLNr,"F",ORDNr,OLNr)
 Set (Next,LakRal)="",OLNr=100
 For  Set Next=$O(^HULP(%J,Next)) Quit:Next=""  Do
 .Set OLNr=OLNr+1
 .Set R=^HULP(%J,Next)
 .If InsText,$L($TR($P(R,D,4),"#","")),LakRal'=$P(R,D,4) Do
 ..Set LakRal=$P(R,D,4),RalKode=$P(LakRal,"#"),LakKode=$P(LakRal,"#",2)
 .Merge ^KOD(KLNr,"F",ORDNr,OLNr)=^HULP(%J,Next)
 .Set R=^KOD(KLNr,"F",ORDNr,OLNr),PRNr=$P(R,D,2),TOENr=$P(R,D,27),TLNr=$P(R,D,28)
 .If PRNr Do
 ..Do SWNODE^FLOWORD(KLNr,ORDNr,OLNr) 
 ..Quit:'TOENr  Quit:'TLNr
 ..Set LEVNr=$P($G(^KTO1(TOENr)),D)
 ..Quit:'LEVNr
 ..Set R=^KTO(LEVNr,TOENr,TLNr)
 ..Set $P(R,D,28)=OLNr,^KTO(LEVNr,TOENr,TLNr)=R
 ..If $D(^KTOK(LEVNr,TOENr,TLNr)) Set R=^KTOK(LEVNr,TOENr,TLNr),$P(R,D,5)=OLNr,^KTOK(LEVNr,TOENr,TLNr)=R
 Set ^KOD(KLNr,"F",ORDNr,0)=OLNr+1
 Kill ^HULP(%J)
 Do FETCHDET^FLOWORD
 Quit
 ;
LAKTOE(ORDNr) 
 New R,KLNr,OLNr,PRNr,LakRal,RalKode,LakKode,PRNrs,LakPRNr,TempOLNr,Aantal,Count
 New Closed
 Set KLNr=$P(^KO1(ORDNr,"F"),D)
 Set R=^KOD(KLNr,"F",ORDNr,1),Closed=$P(R,D,22)
 Quit:Closed  Quit:$O(^KOD(KLNr,"F",ORDNr,100))=""  Quit:'$$ISLAKORD(ORDNr)
 Set OLNr=100,LakRal=""
 For  Set OLNr=$O(^KOD(KLNr,"F",ORDNr,OLNr)) Quit:OLNr=""  Do
 .Set R=^KOD(KLNr,"F",ORDNr,OLNr),PRNr=$P(R,D,2),Aantal=$P(R,D,3)
 .Quit:'PRNr
 .If $P(R,D,4)="",LakRal="" Quit
 .If LakRal'=$P(R,D,4) Do
 ..If $L(LakRal),$D(PRNrs) Do
 ...Set RalKode=$P(LakRal,"#"),LakKode=$P(LakRal,"#",2)
 ...Set LakPRNr=$$BLDAFGL(RalKode,LakKode,.PRNrs)
 ...Set LakPRNr($O(LakPRNr(""),-1)+1)=LakPRNr_D_1_D_TempOLNr
 ..Set TempOLNr=OLNr
 ..Kill PRNrs
 .Set LakRal=$P(R,D,4)
 .If $L(LakRal) Do
 ..For Count=1:1 Quit:'$D(PRNrs(Count))  Quit:$P(PRNrs(Count),D)=PRNr
 ..Set PRNrs(Count)=PRNr_D_($P($G(PRNrs(Count)),D,2)+Aantal)
 If $L(LakRal),$D(PRNrs) Do
 .Set RalKode=$P(LakRal,"#"),LakKode=$P(LakRal,"#",2)
 .Set LakPRNr=$$BLDAFGL(RalKode,LakKode,.PRNrs)
 .Set LakPRNr($O(LakPRNr(""),-1)+1)=LakPRNr_D_1_D_TempOLNr
 Do INSORD(.LakPRNr)
 Quit
 ;
INSORD(LakPRNr) 
 New R,Next,PRNr,OLNr,Aantal,Prijs,Korting1,Korting2,LevTerm,LEVNr,CorLevT,LevLevT,Taal
 Set Next=""
 For  Set Next=$O(LakPRNr(Next),-1) Quit:Next=""  Do
 .Set R=LakPRNr(Next),PRNr=$P(R,D),OLNr=$P(R,D,3)
 .Set $P(R,D,2,99)=$P(R,D,2),LakPRNr(Next)=R
 .Quit:'PRNr
 .Set R=$$KLANTPR^KPRIJS(KLNr,PRNr)
 .Set Prijs=$P(R,D),Korting1=$P(R,D,5),Korting2=$P(R,D,6)
 .Set R=$O(^KPR(PRNr,"J")),R=^KPR(PRNr,R),LEVNr=$P(R,D),LevLevT=$P(R,D,7)
 .Set R=^KLE(^KL1(LEVNr),2),CorLevT=$P(R,D,16)
 .Set LevTerm=$$EXTDATE^vhDTyp($H+(CorLevT*7)+(LevLevT+1*7),"DW")
 .Set Aantal=1
 .Do PINSERT^FLOWORD("B",OLNr,PRNr,Aantal,Prijs,Korting1,Korting2,LevTerm)
 .Set R=^KKL(^KK1(KLNr),0),Taal=$P(R,D,9) Set:"NF"'[Taal Taal="N"
 .Set R="",$P(R,D,35)=D,$P(R,D,5)="ªBªU"_$S(Taal="F":"FINITION",1:"AFWERKING")_"ªbªu : "
 .Set $P(R,D,17)="KF11#1",$P(R,D,18)=$P($H,",",2)_";T;;OWBF"
 .Do TINSERT^FLOWORD("B",OLNr,R)
 Quit
 ;
GETAFM(PRNr) 
 New R,Afm
 Set Afm=""
 If $D(^KPR(PRNr)) Do
 .Set R=$P(^KPR(PRNr,0),D)
 .Quit:$E(R)'="D"  Quit:$E(R,22,25)'=" F00"
 .Set Afm=$P($P(^KPR(PRNr,3),D,20),";",3)
 Quit Afm
 ;
CALCOPP(PRNrs) 
 New R,PRNr,Hoogte,Breedte,Next,Opp,Afm,Aantal
 Set Opp=0,Next=""
 For  Set Next=$O(PRNrs(Next)) Quit:Next=""  Do
 .Set R=PRNrs(Next),PRNr=$P(R,D),Aantal=$P(R,D,2)
 .Set Afm=$$GETAFM(PRNr),Hoogte=$P(Afm,"x"),Breedte=$P(Afm,"x",2)
 .Set Opp=Opp+(Hoogte*Breedte/1000000*Aantal)
 Quit Opp
 ;
 ;Opbouw van een afgeleid product
BLDAFGL(RalKode,LakKode,PRNrs) 
 New R,GenPRNr,NewRec,NewPRNr
 Set GenPRNr=31678
 Do BUILD
 Quit:'$D(NewRec) ""
 Set $P(NewRec(0),D,3)=GenPRNr
 Do SAVE
 Quit $G(NewPRNr)
 ;
BUILD 
 New I,KortTxt,LangTxt,Opp,LevTxt,LevRef,AKPrijs
 Set:$G(GenPRNr)="" GenPRNr=30093
 Do FETCHPR^UTILI(GenPRNr,"NewRec")
 For I=1:1:8 Set:'$D(NewRec(I)) $P(NewRec(I),D,26)=""
 Do CLEAN
 Set Opp=$$CALCOPP(.PRNrs)
 Set KortTxt=$$KORTTXT(RalKode,LakKode)
 Do LANGTXT("N",RalKode,LakKode,Opp),LANGTXT("F",RalKode,LakKode,Opp)
 Do LEVTXT(RalKode,LakKode,.PRNrs,Opp)
 Do LEVREF
 Do PRIJS(LakKode,Opp)
 Set $P(NewRec(0),D,1)=KortTxt
 Set $P(NewRec(0),D,2)=LangTxt(1,"N")
 Set $P(NewRec(0),D,11)=$E(LangTxt(2,"N"),1,45)
 Set $P(NewRec(1),D,22)=LangTxt(1,"F")
 Set $P(NewRec(3),D,21)=$E(LangTxt(2,"F"),1,45)
 For I=1:1:3 Quit:'$D(LevTxt(I))  Set $P(NewRec(4),D,I)=LevTxt(I)
 For I=4:1:6 Quit:'$D(LevTxt(I))  Set $P(NewRec(5),D,I-3)=LevTxt(I)
 For I=7:1:13 Quit:'$D(LevTxt(I))  Set $P(NewRec(4),D,I-3)=LevTxt(I)
 For I=14:1:20 Quit:'$D(LevTxt(I))  Set $P(NewRec(5),D,I-10)=LevTxt(I)
 Set $P(NewRec("J"),D,3)=LevRef
 Set $P(NewRec("J"),D,19)=AKPrijs
 Set NewRec("G")=D_Opp
 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
 ;
KORTTXT(RalKode,LakKode) 
 New KortTxt
 Set KortTxt="LAK......"_RalKode,$E(KortTxt,22,25)=LakKode
 Quit KortTxt
 ;
LANGTXT(Taal,RalKode,LakKode,Opp) 
 New R
 Set LangTxt(1,Taal)=$G(^RES("FOLTEC","PI","LAKKODE","D",LakKode,Taal))
 Set LangTxt(2,Taal)=RalKode_" Opp "_$$EXTNUM^vhDTyp(Opp,0,".",$L($P(Opp,".",2)))_" m2"
 Quit
 ;
LEVTXT(RalKode,LakKode,PRNrs,Opp) 
 New R,Count,Next,PRNr,Aantal,Hoogte,Breedte,BasisTyp,Type,LAantal,LHoogte,LBreedte,LType,Separ,Sort
 Set (Count,LAantal,LHoogte,LBreedte,LType)=0
 Set R=$G(^RES("FOLTEC","PI","LAKKODE","D",LakKode,"L")) Set:$L(R) R=R_" " Set R=R_RalKode
 Set:$L(R) Count=Count+1,LevTxt(Count)=R
 Set Next=""
 For  Set Next=$O(PRNrs(Next)) Quit:Next=""  Do
 .Set R=PRNrs(Next),PRNr=$P(R,D),Aantal=$P(R,D,2),R=$$GETAFM(PRNr),Hoogte=$P(R,"x"),Breedte=$P(R,"x",2)
 .Quit:Hoogte=""  Quit:Breedte=""
 .Set R=$P(^KPR(PRNr,3),D,20),BasisTyp=$P(R,";"),Type=$P(R,";",2)
 .If $L(Type) Do
 ..Set R=$G(^RES("FOLTEC","PI",$S(BasisTyp="A":"ACCESSOIRE",1:"FRONTDTL"),"D",Type))
 ..Set:$L($P(R,"`",3)) Type=$E($P(R,"`",3),1,2)
 .Set R=Aantal_D_Hoogte_D_Breedte_D_Type
 .Set Sort="Sort(1000000+Hoogte,1000000+Breedte,$S(Type="""":""~"",1:Type))"
 .Set $P(R,D)=$P(R,D)+$P($G(@Sort),D)
 .Set @Sort=R
 .Set:$L($P(R,D))>LAantal LAantal=$L($P(R,D))
 .Set:$L(Hoogte)>LHoogte LHoogte=$L(Hoogte)
 .Set:$L(Breedte)>LBreedte LBreedte=$L(Breedte)
 .Set:$L(Type)>LType LType=$L(Type)
 Set Hoogte=""
 For  Set Hoogte=$O(Sort(Hoogte)) Quit:Hoogte=""  Do
 .Set Breedte=""
 .For  Set Breedte=$O(Sort(Hoogte,Breedte)) Quit:Breedte=""  Do
 ..Set Type=""
 ..For  Set Type=$O(Sort(Hoogte,Breedte,Type)) Quit:Type=""  Do
 ...Set R=Sort(Hoogte,Breedte,Type),Count=Count+1,LevTxt(Count)=R
 If Count For Count=1:1:Count Do
 .Set R=LevTxt(Count)
 .Quit:$L(R,D)=1
 .Set Aantal=$P(R,D),Hoogte=$P(R,D,2),Breedte=$P(R,D,3),Type=$P(R,D,4)
 .Set R=$J(Aantal,LAantal)_" x "_$J(Hoogte,LHoogte)_"x"_$J(Breedte,LBreedte)_" - "_Type_$J("",LType-$L(Type))
 .Set LevTxt(Count)=R
 If Count Do
 .Set MaxCount=Count,Separ=""
 .For Count=1:1 Quit:'$D(LevTxt(Count))  Do
 ..Set R=LevTxt(Count)
 ..Quit:$L(R,"x")'=3  Quit:$L(R,"-")'=2  ;Quit:'$D(LevTxt(MaxCount\2+Count))
 ..Set:$D(LevTxt(MaxCount\2+Count)) Separ=" | "
 ..Set LevTxt(Count)=LevTxt(Count)_Separ
 ..Quit:'$D(LevTxt(MaxCount\2+Count))
 ..Set LevTxt(Count)=LevTxt(Count)_LevTxt(MaxCount\2+Count)
 ..Kill LevTxt(MaxCount\2+Count)
 If Opp Set Count=$O(LevTxt(""),-1)+1,LevTxt(Count)="Totale opp "_$$EXTNUM^vhDTyp(Opp,0,".",$L($P(Opp,".",2)))_" m2"
 Quit
 ;
LEVREF 
 Set LevRef=""
 Quit
 ;
PRIJS(LakKode,Opp) 
 New M2Prijs
 Set M2Prijs=$P($G(^RES("FOLTEC","PI","LAKKODE","D",LakKode)),"`",4)
 Set AKPrijs=M2Prijs*Opp
 Quit
 ;
SAVE 
 New I,X,KortTxt,Som,IdentNr
 Set NewPRNr=$$NEXTID^PRODUKT()
 Set KortTxt=$P(NewRec(0),D),$E(KortTxt,5,9)=NewPRNr_$J("",5-$L(NewPRNr)),$P(NewRec(0),D)=KortTxt
 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")
 ;Indexen
 Do RECALC^PRODUKT2(NewPRNr)
 Do BLDIND^PRODUKT2(NewPRNr)
 Do Gemaakt^PRODUKT2(NewPRNr)
 Do ZEND^EWPR(NewPRNr)
 Quit
 ;