KLPUTZ ;Prijsuitzonderingen [ 11/24/2003  10:19 AM ]  ; Compiled June 2, 2004 09:52:03
 ;
N Set NoSa="N" Goto DO
S Set NoSa="S" Goto DO
 ;
DO Do VERWERK("",NoSa)
 Quit
 ;
VERWERK(KLNr,NoSa) 
 New KLPUTZ,Extern,Kode,IsChanged,PrijsKl,KlMunt,IsHandel,NetBrut,DLogTop
 Write @F11,@F1,@FMTI,"Prijsuitzonderingen klanten - ",QN,@FMTi
 Quit:'$$ASK^vhWACHTW("UITZONDERINGEN","","",0)
 If $G(NoSa)="" Set NoSa="N"
 If NoSa'="N",NoSa'="S" Quit
 Set FP=172 Write @F,@FMTB,$P(" Normale \ Schaduw ",D,NoSa="S"+1),@FMTb
 Set DLogTop=0,%J=$$%J^vhRtn1()
 Kill ^HULP(%J)
 Set Input=$G(Input),KLNr=$G(KLNr) If KLNr Set Extern=1
 For  Do  Quit:KLNr="-"!$G(Extern)  If $L(Input)=1,"-,"[Input Quit
 .If '$D(Extern) Set KLNr=$$SELECT^KLANT6() Quit:KLNr="-"
 .Do LDINIT(1)
 .If $$LOCK^KLPUTZ2(KLNr,NoSa) Do INITKL,FETCH^KLPUTZ2,BUILDSL(),COMMAND
 .Do REMOVE^vhLock("^KLPUTZ(NoSa,KLNr)")
 Kill ^HULP(%J)
 Quit
 ;
COMMAND 
 For  Do  If $L(Input)=1,"-,K"[Input Quit
 .Do REFRESH
 .Do SL^PROC
 .Set Input=R
 .If R="COM" Do CALL^vhMenu("KLPUTZ","F*")
 .If Input="PRINT" Do PRINT(KLNr,"",NoSa,1)
 .If Input="M" Do MARGE^KLPUTZ2(1)
 .If Input="-",$$ASKSAVE()'="-" Do ASKSCHAD,SAVE^KLPUTZ2(NoSa) Quit:Input="-"
 .If Input="K",'$D(Extern),$$ASKSAVE(1)'="-" Do ASKSCHAD,SAVE^KLPUTZ2(NoSa) Quit:Input="K"
 .If Input="Q" Do COPYTO(NoSa)
 .If Input="C" Do COPY(KLNr,"",NoSa,1)
 .If Input="S" Do NOSA
 .If $L(Input)=1,"ALGTO"[Input Do LMODIFY(Input)
 .If Input="ENTER" For  Do LMODIFY() Quit:$G(Move)=""  Do  Set DL(2)=$S(Move=")":"DO",1:"UP") Do ML^PROC Kill DL(2)
 .If Input="N" Do LNIEUW
 .If Input="D" Do LDUPLI
 .If Input="P" Do RPLPR^KLPUTZ2
 .If Input="R" Do RPLKL^KLPUTZ2
 .If Input="V" Do LDELETE
 .If Input="X" Do DELETE
 .If Input="B" Do LDINIT()
 .Set Input=""
 Quit
 ;
 ; Opbouw scroll-lijst
BUILDSL(SelKey,SelNext) 
 New Count,HoofdGr,Groep,SubGroep,PRNr,SortKey,Next
 Kill ^HULP(%J,"WL")
 Set Count=0,(HoofdGr,Groep,SubGroep,PRNr,SortKey)=""
 For  Set SortKey=$O(^HULP(%J,"KEY",SortKey)) Quit:SortKey=""  Do
 .Set Next=""
 .For  Set Next=$O(^HULP(%J,"KEY",SortKey,Next)) Quit:Next=""  Do
 ..Set R=^HULP(%J,"KEY",SortKey,Next)
 ..If HoofdGr=$P(R,D,2) Set $P(R,D,2)=""
 ..Else  Set HoofdGr=$P(R,D,2)
 ..If Groep=$P(R,D,3) Set $P(R,D,3)=""
 ..Else  Set Groep=$P(R,D,3)
 ..If SubGroep=$P(R,D,4) Set $P(R,D,4)=""
 ..Else  Set SubGroep=$P(R,D,4)
 ..If PRNr=$P(R,D,5) Set $P(R,D,5)=""
 ..Else  Set PRNr=$P(R,D,5)
 ..Set Count=Count+1,^HULP(%J,"WL",Count)=R
 ..If SortKey=$G(SelKey),Next=$G(SelNext) Set KLPUTZ(6)=Count Kill KLPUTZ(7)
 Set:$D(KLPUTZ(9)) KLPUTZ(9)=Count
 Quit
 ;
 ; Nieuwe lijn
LNIEUW  
 New I,R,HoofdGr,Groep,SubGroep,PRNr,Next,SortKey
 Set PRNr=$$SELECT^PRODUKT6() Quit:'PRNr
 Set SortKey=$$SORTKEY^PRODUKT(PRNr)
 Set R="" If $E($O(^KPR(PRNr,"I")))="I" Set R=^($O(^KPR(PRNr,"I")))
 Set HoofdGr=$P(R,D),Groep=$P(R,D,2),SubGroep=$P(R,D,3)
 Set Next=$$SORTNEXT(%J,SortKey)
 Set I=SortKey
 If $D(^HULP(%J,"KEY",I))
 Else  Set I=SubGroep If $D(^HULP(%J,"KEY",I))
 Else  Set I=Groep If $D(^HULP(%J,"KEY",I))
 Else  Set I=HoofdGr
 If $D(^HULP(%J,"KEY",I)) Set R=$P(^($O(^HULP(%J,"KEY",I,""))),D,7,8)
 Else  Set R=""
 Set $P(R,D,4)=PRNr
 Set R=SortKey_D_HoofdGr_D_Groep_D_SubGroep_D_PRNr_D_Next_D_R
 Do NIEUW(R)
 Quit
 ;
 ; Dupliceer lijn
LDUPLI  
 New I,R,HoofdGr,Groep,SubGroep,PRNr,Next,SortKey
 Quit:'$D(^HULP(%J,"WL",KLPUTZ(6)))
 Set PRNr=$P(^HULP(%J,"WL",KLPUTZ(6)),D,10)
 Set SortKey=$$SORTKEY^PRODUKT(PRNr)
 Set R="" If $E($O(^KPR(PRNr,"I")))="I" Set R=^($O(^KPR(PRNr,"I")))
 Set HoofdGr=$P(R,D),Groep=$P(R,D,2),SubGroep=$P(R,D,3)
 Set Next=$$SORTNEXT(%J,SortKey)
 Set R=$P(^HULP(%J,"WL",KLPUTZ(6)),D,7,99)
 Set $P(R,D,4)=PRNr
 Set R=SortKey_D_HoofdGr_D_Groep_D_SubGroep_D_PRNr_D_Next_D_R
 Do NIEUW(R)
 Quit
 ;
 ; Verwerk nieuwe lijn
NIEUW(R)  
 New Next,SortKey,%SC,OldSel,OldOff
 Set OldSel=KLPUTZ(6),OldOff=KLPUTZ(7)
 Set SortKey=$P(R,D),Next=$P(R,D,6),^HULP(%J,"KEY",SortKey,Next)=R
 Do BUILDSL(SortKey,Next),WL^PROC
 Do DETAIL("N")
 Set R=^HULP(%J,"WL",KLPUTZ(6)),SortKey=$P(R,D),Next=$P(R,D,6)
 If '%SC Do
 .Kill ^HULP(%J,"KEY",SortKey,Next)
 .Set KLPUTZ(6)=OldSel,KLPUTZ(7)=OldOff
 .Do ADD^vhScherm(KLPUTZ(3),24)
 Do BUILDSL(SortKey,Next)
 Quit
 ;
 ; Wijzigen van een lijn
LMODIFY(Field) 
 New %SC
 Quit:'$D(^HULP(%J,"WL",KLPUTZ(6)))
 Do DETAIL("E"_$G(Field))
 Quit
 ;
 ; Verwerk detail (nieuw, dupl, editeer, ...)
DETAIL(Mode) 
 New sFL,Rec,PRNr,OldPRNr,Korting1,Korting2,Opmerk,MinAant,MinWeek,GeldVan,GeldTot,User,MinVerp,GrOrde
 New Niveau,OldNiv,LijstPr,KlantPr,VerkPr,Munt,Eenheid,Vork,%Vork,%Winst,KatProd,GrootVp,GrootPr,LevTerm
 New I,K,R,N,HoofdGr,Groep,SubGroep,SortKey,Next,Pariteit,Field,Rebuild,ModOpen,WildCardInput,WildCard,CallBack
 Set Field=$E(Mode,2,9),Mode=$E(Mode)
 If '$L(Field) Set DL(2)=KLPUTZ(3),DL(3)=$P(^SD("D","KLPUTZD"),D)-DL(2) Do PL^PROC Kill DL(2),DL(3)
 Set Rec=^HULP(%J,"WL",KLPUTZ(6)),SortKey=$P(Rec,D),Next=$P(Rec,D,6),PRNr=$P(Rec,D,10)
 Set R=^HULP(%J,"KEY",SortKey,Next)
 Set Niveau="H" If 0'[$P(R,D,3) Set Niveau="G" If 0'[$P(R,D,4) Set Niveau="S" If 0'[$P(R,D,5) Set Niveau="P"
 Set OldNiv=Niveau,Korting1=$P(Rec,D,7),Korting2=$P(Rec,D,8),Opmerk=$P(Rec,D,9)
 Set MinAant=$P(Rec,D,11),MinWeek=$P(Rec,D,12),GeldVan=$P(Rec,D,13),GeldTot=$P(Rec,D,14),MinVerp=$P(Rec,D,18)
 Set GrOrde=$P(Rec,D,19),WildCardInput=$P(Rec,D,20),WildCard=$P(Rec,D,21),CallBack=$P(Rec,D,22)
 If PRNr,'$D(^KPR(PRNr)) Set PRNr=0
 If 'PRNr Set PRNr=$$FINDPROD(%J,SortKey,Next)
 If PRNr Do
 . Set OldPRNr=PRNr
 . Do FETCHPR()
 . If Mode="N" Set ModOpen=0 Do NIEUW^vhScherm("KLPUTZD")
 . If $E(Mode)="E" Do
 . . If '$L(Field) Do EDIT^vhScherm("KLPUTZD","","","","",$L($G(Move))) Quit
 . . If Field="A" Do FIELD^vhScherm("KLPUTZD",$S(MinVerp:"MINVERP",1:"MINAANT"))
 . . If Field="L" Do FIELD^vhScherm("KLPUTZD","MINLEVT")
 . . If Field="G" Do FIELD^vhScherm("KLPUTZD","GELDVAN")
 . . If Field="T" Do FIELD^vhScherm("KLPUTZD","GELDTOT")
 . . If Field="O" Do FIELD^vhScherm("KLPUTZD","OPMERK")
 . If %SC Do
 . . Set IsChanged=1,Rebuild=0,User=$G(QU)
 . . Set (WildCard,CallBack)=""
 . . If Niveau="P" Do
 . . . Set:$P(Rec,D,10)'=PRNr $P(Rec,D,5)=PRNr
 . . . Set WildCardInput=""
 . . Else  If WildCardInput?1"§".E Do ; PatternMatch op korttekst rechtstreeks ingegeven
 . . . Set WildCard=$E(WildCardInput,2,999)
 . . Else  If WildCardInput?1"@".E  Do ; Callback via (KLNr,PRNr) met een boolean als resultaat
 . . . Set CallBack=$E(WildCardInput,2,999)
 . . . If CallBack'["`" Set CallBack="F`"_CallBack_"^KLPUTZCallBacks"
 . . Else  If $L(WildCardInput) Do ; PatternMatch op korttekst via WildCardToPattern conversie
 . . . Set WildCard=$$UPCASE^vhRtn1($$WildCardToPattern^vhLib(WildCardInput,1))
 . . Set $P(Rec,D,7,22)=Korting1_D_Korting2_D_Opmerk_D_PRNr_D_MinAant_D_MinWeek_D_GeldVan_D_GeldTot_D_+$H_";"_User_"\\\"_MinVerp_D_GrOrde_D_WildCardInput_D_WildCard_D_CallBack
 . . If Niveau'=OldNiv!(PRNr'=OldPRNr) Do MLEVEL
 . . Set ^HULP(%J,"WL",KLPUTZ(6))=Rec,SortKey=$P(Rec,D),Next=$P(Rec,D,6)
 . . Set R=^HULP(%J,"KEY",SortKey,Next)
 . . Set $P(R,D,7,99)=$P(Rec,D,7,99) If Niveau="P" Set $P(R,D,5)=PRNr
 . . Set ^HULP(%J,"KEY",SortKey,Next)=R
 . . Do DDUBBELS Set Next=$$RLEVEL^KLPUTZ2(SortKey,Next)
 . . If Rebuild Do BUILDSL(SortKey,Next),ADD^vhScherm(KLPUTZ(3),24)
 Else  Do
 . Do WARN^vhTXTPOP("Geen producten binnen deze classificatie,~gelieve deze lijn te verwijderen","")
 . Do ADD^vhScherm(KLPUTZ(3),24)
 If Mode="E",$L($G(Move)),"()"[Move Quit
 If $L(Field) Do EL^PROC
 Set KLPUTZ(4)=$P(^LD("D","KLPUTZ"),"`",10) Set:'KLPUTZ(4) KLPUTZ(4)=24-KLPUTZ(3)+1
 Quit:'$D(KLPUTZ(7))
 If KLPUTZ(9)-KLPUTZ(4)<1,KLPUTZ(7)'=1 Set KLPUTZ(7)=1 Do ADD^vhScherm(KLPUTZ(3),24) Quit
 If KLPUTZ(9)-KLPUTZ(4)>0,KLPUTZ(7)>(KLPUTZ(9)-KLPUTZ(4)+1) Do  Quit
 .Set KLPUTZ(7)=KLPUTZ(9)-KLPUTZ(4)+1
 .Do ADD^vhScherm(KLPUTZ(3),24)
 Do EL^PROC
 Quit
 ;
 ; Verwijder een lijn
LDELETE 
 New R,SortKey
 Quit:'$D(^HULP(%J,"WL",KLPUTZ(6)))
 Set K=$$KEYL^vhINP("KLPUTZ","DELLINE")
 Quit:K'="V"
 Set R=^HULP(%J,"WL",KLPUTZ(6)),SortKey=$P(R,D),Next=$P(R,D,6)
 Kill ^HULP(%J,"KEY",SortKey,Next)
 Do BUILDSL()
 If KLPUTZ(6)>1,'$D(^HULP(%J,"WL",KLPUTZ(6))) Do
 .Set KLPUTZ(6)=KLPUTZ(6)-1
 .If KLPUTZ(7)>KLPUTZ(6) Set KLPUTZ(7)=KLPUTZ(6)
 Do ADD^vhScherm(KLPUTZ(6)+KLPUTZ(3)-KLPUTZ(7),24)
 Set IsChanged=1
 Quit
 ;
 ; Verwijder alle uitzonderingen van een klant
DELETE 
 Do DL^PROC
 Set K=$$ASKL^vhINP("KLPUTZ","DELALL")
 If K="" Do EL^PROC Quit
 Kill ^HULP(%J)
 Set FP=KLPUTZ(3)*100+1 Write @F,@F1
 Set IsChanged=1
 Quit
 ;
 ; Geef volgende voor een bepaald niveau
SORTNEXT(%J,SortKey) 
 New Next
 Set Next=$O(^HULP(%J,"KEY",SortKey,""),-1)
 Quit $S(Next="":0,1:Next+1)
 ;
 ; Ophalen produktinfo met eventeel redisplay
FETCHPR(Display) 
 New R,PrijsKl
 Do FETCHPR^UTILI(PRNr,"sFL")
 Set KatProd=$P(sFL(1),D,19),LevTerm=$P(sFL("J"),D,7)+1,GrootVp=$P(sFL("J"),D,16)
 If $P(sFL(1),D,20) Set LevTerm=0
 Set %Winst=$P(sFL("J"),D,24),%Vork=$P(sFL("J"),D,27)
 If NoSa="S" Set:$L($P(sFL(2),D,5)) %Vork=$P(sFL(2),D,5) Set:$L($P(sFL(2),D,6)) %Winst=$P(sFL(2),D,6)
 Set (Munt,Eenheid,LijstPr,KlantPr,VerkPr,Vork)="",PrijsKl=$$PRIJSKL^KLANT(KLNr,PRNr,NoSa)
 Set R=$$PROD^KPRIJS(PRNr,PrijsKl,0,KlMunt,NetBrut,IsHandel,NoSa,,GrOrde),KlantPr=$P(R,D)
 Set R=$$PROD^KPRIJS(PRNr,%Winst,0,KlMunt,0,IsHandel,NoSa,,GrOrde),CifPPL=$P(R,D,13)
 Set R=$$PROD^KPRIJS(PRNr,%Winst,0,$$FADEF^vhRtn1(),0,IsHandel,NoSa,,GrOrde),CfPPLFaM=$P(R,D,13)
 Set R=$$PROD^KPRIJS(PRNr,%Vork,0,KlMunt,NetBrut,IsHandel,NoSa,,GrOrde),GrootPr=$P(R,D)
 Set R=$$PROD^KPRIJS(PRNr,$S(Korting1="":PrijsKl,1:Korting1),Korting2,KlMunt,NetBrut,IsHandel,NoSa,,GrOrde,'Korting1)
 Set VerkPr=$P(R,D),Munt=$P(R,D,2),Eenheid=$P(R,D,3),LijstPr=$P(R,D,4)
 Set Korting1=$P(R,D,5),Korting2=$P(R,D,6),Pariteit=$P(R,D,9)
 Set R=$$PROD^KPRIJS(PRNr,$S(Korting1="":PrijsKl,1:Korting1),Korting2,$$FADEF^vhRtn1(),NetBrut,IsHandel,NoSa,,GrOrde)
 Set VkPrFaM=$P(R,D),MargeFaM=VkPrFaM-CfPPLFaM
 Set Marge=VerkPr-CifPPL,Vork=LijstPr-GrootPr
 If $G(Display) Do PAINT^vhScherm
 Quit
 ;
 ; Geef produkt voor een bepaald niveau
FINDPROD(%J,SortKey,Next) 
 New R,HoofdGr,Groep,SubGroep,PRNr
 Set R=^HULP(%J,"KEY",SortKey,Next),HoofdGr=$P(R,D,2),Groep=$P(R,D,3),SubGroep=$P(R,D,4)
 Set:0[Groep Groep=$O(^KPH(HoofdGr,"")) Set:0[SubGroep SubGroep=$O(^KPH(HoofdGr,Groep,""))
 Set PRNr="" Set:$L($O(^KPH(HoofdGr,Groep,SubGroep,"  ",""))) PRNr=^($O(^KPH(HoofdGr,Groep,SubGroep,"  ","")))
 Quit PRNr
 ;
 ; Wijzigen van niveau
MLEVEL 
 New Delete
 Set Rebuild=1,SortKey=$P(Rec,D),Next=$P(Rec,D,6),R=^HULP(%J,"KEY",SortKey,Next)
 Kill ^HULP(%J,"KEY",SortKey,Next)
 Set HoofdGr=$P(sFL("I"),D),Groep=$P(sFL("I"),D,2),SubGroep=$P(sFL("I"),D,3)
 If Niveau'="P" Set PRNr=0 If Niveau'="S" Set SubGroep=0 If Niveau'="G" Set Groep=0
 If PRNr Set SortKey=$$SORTKEY^PRODUKT(PRNr)
 Else  Set SortKey=HoofdGr If Groep'=0 Set SortKey=Groep If SubGroep'=0 Set SortKey=SubGroep
 Set Next=$$SORTNEXT(%J,SortKey),$P(Rec,D)=SortKey,$P(Rec,D,6)=Next
 Set $P(R,D,1,6)=SortKey_D_HoofdGr_D_Groep_D_SubGroep_D_PRNr_D_Next,^HULP(%J,"KEY",SortKey,Next)=R
 Set I=SortKey,Delete=0
 For  Set I=$O(^HULP(%J,"KEY",I)) Quit:$E(I,1,$L(SortKey)-1)'=$E(SortKey,1,$L(SortKey)-1)!Delete  Do
 .Set N=""
 .For  Set N=$O(^HULP(%J,"KEY",I,N)) Quit:N=""!Delete  Do
 ..Set R=^HULP(%J,"KEY",I,N)
 ..If 'IsHandel Set PRNr=$P(R,D,5) If PRNr Set KatProd=$P(^KPR(PRNr,1),D,19) Quit:$L(KatProd)
 ..Set Delete=$$CHECKVAL(R,Rec,"+7\+8\+11\+12\+13\+14")
 If Delete Do
 .Set K=$$KEYL^vhINP("KLPUTZ","LEVEL")
 .Set Delete=K="J"
 Quit:'Delete
 Set I=SortKey
 For  Set I=$O(^HULP(%J,"KEY",I)) Quit:$E(I,1,$L(SortKey)-1)'=$E(SortKey,1,$L(SortKey)-1)  Do
 .Set N=""
 .For  Set N=$O(^HULP(%J,"KEY",I,N)) Quit:N=""  Do
 ..Set R=^HULP(%J,"KEY",I,N)
 ..If 'IsHandel Set PRNr=$P(R,D,5) If PRNr Set KatProd=$P(^KPR(PRNr,1),D,19) Quit:$L(KatProd)
 ..If $$CHECKVAL(R,Rec,"+7\+8\+11\+12\+13\+14") Kill ^HULP(%J,"KEY",I,N)
 Quit
 ;
 ; Verwijderen van dubbels
DDUBBELS 
 Set N=""
 For  Set N=$O(^HULP(%J,"KEY",SortKey,N)) Quit:N=""  Do
 .Set R=^HULP(%J,"KEY",SortKey,N)
 .If N'=Next,$$CHECKVAL(R,Rec,"+11\+12\+13\+14\20") Kill ^HULP(%J,"KEY",SortKey,N) Set Rebuild=1
 Quit
 ;
 ; Init klant
INITKL 
 Set IsChanged=0
 Do FETCHKL^UTILI(KLNr,"sFL")
 Set KlMunt=$P(sFL(0),D,11),NetBrut=$P(sFL(2),D,5)
 Set IsHandel=$$IsHandel^KLANT5(KLNr)
 Set PrijsKl=$$PRIJSKL^KLANT(KLNr,,NoSa)
 Quit
 ;
REFRESH 
 If sRT<(KLPUTZ(3)-1) Do DISPLAY^vhScherm("KLPUTZ","","","H")
 Kill DL(2) If sRT'<KLPUTZ(3) Set DL(2)=sRT
 If sRT<(KLPUTZ(3)+KLPUTZ(4)) Do WL^PROC
 Kill DL(2)
 Do RESET^vhScherm
 Quit
 ;
 ; Overschakelen van normaal naar schauw en omgekeerd
NOSA 
 If '$$LOCK^KLPUTZ2(KLNr,$P("N\S",D,NoSa="N"+1)) Quit
 If $$ASKSAVE(1)="-" Quit
 Do SAVE^KLPUTZ2(NoSa)
 Do REMOVE^vhLock("^KLPUTZ(NoSa,KLNr)")
 Set NoSa=$P("N\S",D,NoSa="N"+1)
 Do LDINIT(1)
 Do INITKL,FETCH^KLPUTZ2,BUILDSL()
 Quit
 ;
COPYTO(NoSa) ; Copieren van de uitzondering in ^HULP naar een andere klant
 Quit:$$ASKSAVE(1)="-"
 Do:IsChanged SAVE^KLPUTZ2(NoSa)
 New KLNr
 Set KLNr=$$SELECT^KLANT6(1,,"Copieren naar klant : ")
 Quit:'KLNr
 Quit:'$$LOCK^KLPUTZ2(KLNr,$P("N\S",D,NoSa="N"+1))
 Set IsChanged=1
 Do SAVE^KLPUTZ2(NoSa)
 Do REMOVE^vhLock("^KLPUTZ(NoSa,KLNr)")
 Do WARN^vhTXTPOP("Gecopieerd naar klant "_KLNr_" "_$P(^KKL(^KK1(KLNr),0),D,2),"COPIEREN NAAR")
 Quit
 ; Kopieer normaal naar schauw en omgekeerd
COPY(FromKl,ToKl,NoSa,Intern) 
 Do COPY^KLPUTZ4($G(FromKl),$G(ToKl),$G(NoSa),$G(Intern)) 
 Quit
 ;
 ; Vergelijk bepaalde waarden
CHECKVAL(Rec1,Rec2,Pieces) 
 New I,Operand,Piece,Test
 For I=1:1:$L(Pieces,D) Do  Quit:'Test
 .Set Piece=$P(Pieces,D,I),Operand=""
 .If Piece'?.N Set Operand=$E(Piece),Piece=$E(Piece,2,9)
 .Xecute "Set $P(Rec1,D,Piece)="_Operand_""""_$P(Rec1,D,Piece)_""""
 .Xecute "Set $P(Rec2,D,Piece)="_Operand_""""_$P(Rec2,D,Piece)_""""
 .Set Test=$P(Rec1,D,Piece)=$P(Rec2,D,Piece)
 Quit Test
 ;
 ; Herreken wijzigbare prijsgegevens
RECALC(Kt1,Kt2,Vkp,GO) 
 New R
 If $D(GO) Do
 .Set GrOrde=GO
 .Do FETCHPR()
 Else  Do
 .If '$D(Vkp) Do
 ..If 'Kt1,Kt2 Set (Kt1,Korting1,X)=Kt2,(Kt2,Korting2)=""
 ..Set VerkPr=$P($$PROD^KPRIJS(PRNr,Kt1,Kt2,KlMunt,NetBrut,IsHandel,NoSa,,GrOrde,'Kt1),D)
 ..Set VkPrFaM=$P($$PROD^KPRIJS(PRNr,Kt1,Kt2,$$FADEF^vhRtn1(),NetBrut,IsHandel,NoSa,,GrOrde),D)
 .If $D(Vkp) Do
 ..Set Korting1=1-(Vkp/LijstPr)*100,Korting2=0,VerkPr=Vkp,VkPrFaM=Vkp/$$MUNTPAR^vhRtn1(Munt,2,NoSa)
 ..If %Vork,Korting1>%Vork Set Korting2=1-(Vkp/(LijstPr*(100-%Vork))*100)*100,Korting1=%Vork
 Set MargeFaM=VkPrFaM-CfPPLFaM
 Set Marge=VerkPr-CifPPL
 Do:Marge'>0 PUTATTR^vhScherm("MARGEFAM","","K") Do:Marge>0 REMATTR^vhScherm("MARGEFAM","","K")
 If "\C\P\"'[(D_$$PRIJSKL^KLANT(KLNr,PRNr,NoSa)_D) Set R=$$CHKPRIJS^KPRIJS(PRNr,LijstPr,VerkPr,1,1,CifPPL)
 Do:$D(GO) PUT^vhScherm("LIJSTPR",LijstPr),PUT^vhScherm("KLANTPR",KlantPr)
 Do PUT^vhScherm("KORTING1",Korting1),PUT^vhScherm("KORTING2",Korting2)
 Do PUT^vhScherm("VERKPR",VerkPr),PUT^vhScherm("MARGEFAM",MargeFaM)
 Do:$D(GO) PUT^vhScherm("CFPPLFAM",CfPPLFaM),PUT^vhScherm("GROOTPR",GrootPr),PUT^vhScherm("WINST",%Winst)
 Quit
 ;
 ; Bepalen korting1 uit codex
KORTING1(K) 
 If $L(K),"CPLRSBG"[K Set K=$P($$PROD^KPRIJS(PRNr,K,0,KlMunt,NetBrut,IsHandel,NoSa,,GrOrde),D,5)
 Quit +K
 ;
 ; Vraag om de gegevens te bewaren
ASKSAVE(NoExit) 
 Set K=$$SAVE^vhINP(1,IsChanged,$G(NoExit))
 Set K=$S(K="-":"J",K=".":"N",1:"-") Set:K="N" IsChanged=0
 Quit K
 ;
ASKSCHAD 
 If NoSa="N",IsChanged,$G(^KLPUTZ("AS")),$$ASKL^vhINP("KLPUTZ","ASKSCHAD")="J" Set Input="S"
 Quit
 ;
LDINIT(New) 
 New Temp
 Set LdSwitch=$G(LdSwitch)
 If $G(New) Set LdSwitch=$P("O",D,$L(LdSwitch)+1) Do ADD^vhScherm(2,24)
 Else  Set Temp(6)=KLPUTZ(6),Temp(7)=KLPUTZ(7) Do ADD^vhScherm(KLPUTZ(3),24)
 Do INIT^PROC("KLPUTZ"_$P("O",D,$L(LdSwitch)+1),"KLPUTZ")
 If $D(Temp) Set KLPUTZ(6)=Temp(6),KLPUTZ(7)=Temp(7)
 Set LdSwitch=$P("O",D,$L(LdSwitch)+1)
 Quit
 ;
PRINT(FromKl,ToKl,NoSa,Intern) 
 New MaxKort
 Set MaxKort=""
 Do PRINT^KLPUTZ3($G(FromKl),$G(ToKl),$G(NoSa),$G(Intern)) 
 Quit
 ;
 ; Aktiveren van het bestand
AKTIV(NoSa,Intern) 
 Do AKTIV^KLPUTZ2($G(NoSa),$G(Intern))
 Quit
 ;
DELOBJ(KLNr,NoSa,Skip) 
 Set Skip=$G(Skip)
 Do DELOBJ^KLPUTZ2(KLNr,NoSa,Skip) 
 Quit
 ;
 ; Klant heeft een uitzondering?
 ; Niveau: 1 = HoofdGroep, 2 = Groep, 3 = SubGroep, 4 = product
HeeftUitzondering(KLNr,PRNr,Niveau,NoSa)
 New HeeftUitzondering,KKey,HoofdGroep,Groep,SubGroep
 If $G(NoSa)="" Set NoSa="N"
 If NoSa'="N",NoSa'="S" Quit 0
 Set KKey=$$KKEY^KLASS(PRNr)
 Set HoofdGroep=$$GETSORT^KLASS(KKey,1)
 Set:Niveau>1 Groep=$$GETSORT^KLASS(KKey,2)
 Set:Niveau>2 SubGroep=$$GETSORT^KLASS(KKey,3)
 Set:Niveau=1 HeeftUitzondering=''$D(^KLPUTZ(NoSa,KLNr,HoofdGroep))
 Set:Niveau=2 HeeftUitzondering=''$D(^KLPUTZ(NoSa,KLNr,HoofdGroep,Groep))
 Set:Niveau=3 HeeftUitzondering=''$D(^KLPUTZ(NoSa,KLNr,HoofdGroep,Groep,SubGroep))
 Set:Niveau=4 HeeftUitzondering=''$D(^KLPUTZ(NoSa,KLNr,HoofdGroep,Groep,SubGroep,PRNr))
 Quit +$G(HeeftUitzondering)
 ;