korting ;Klant korting ;[ 11/29/2003   8:15 AM ]
 ;
 ; Normale lijnkorting
KORTPC(KLNr,PRNr,NoSa,RefDat,Aantal,LevTerm) 
 Goto kortpc ;:$ZU(5)="LVH,DEV"
 New HG,GR,SG,X
 If $G(NoSa)="" Set NoSa="N"
 If NoSa'="N",NoSa'="S" Quit ""
 If '$D(^KLPUTZ(NoSa,KLNr)) Q "\\"
 Set (HG,GR,SG)=" ",X=$O(^KPR(PRNr,"I"))
 If $E(X,1)="I" Set X=^KPR(PRNr,X),HG=$P(X,D),GR=$P(X,D,2),SG=$P(X,D,3)
 If $D(^KLPUTZ(NoSa,KLNr,HG,GR,SG,PRNr,0)) Quit $P(^KLPUTZ(NoSa,KLNr,HG,GR,SG,PRNr,0),D,1,2)_"\P"
 If $D(^KLPUTZ(NoSa,KLNr,HG,GR,SG,0,0)) Quit $P(^KLPUTZ(NoSa,KLNr,HG,GR,SG,0,0),D,1,2)_"\S"
 If $D(^KLPUTZ(NoSa,KLNr,HG,GR,0,0,0)) Quit $P(^KLPUTZ(NoSa,KLNr,HG,GR,0,0,0),D,1,2)_"\G"
 If $D(^KLPUTZ(NoSa,KLNr,HG,0,0,0,0)) Quit $P(^KLPUTZ(NoSa,KLNr,HG,0,0,0,0),D,1,2)_"\H"
 Quit "\\"
 ;
 ; Normale lijnkorting (nieuwe versie)
kortpc 
 New I,R,Korting,Korting1,Korting2,DTyp,HoofdGr,Groep,SubGroep,Niveau,GrootVp,OptMin,OptPlus,OptKort
 New PrijsKl,KlantInd
 If $G(NoSa)="" Set NoSa="N"
 If NoSa'="N",NoSa'="S" Quit ""
 If $G(Aantal),'$$HEEFTUTZ(KLNr,PRNr,NoSa),$$ISKLPR^KS(KLNr,PRNr,"",NoSa) Do  Quit Korting
 .New R,KsKvp,KsGvp
 .Set R=$O(^KPR(PRNr,"J")),R=^KPR(PRNr,R),KsKvp=$P(R,D,11),KsGvp=$P(R,D,12)
 .Set Korting=$$KSKORT^KPRIJS(PRNr,$S(Aantal'<KsGvp:0,Aantal<KsKvp:"E",1:"K"),NoSa)_D_D
 Set KlantInd=^KK1(KLNr),R=^KKL(KlantInd,2),PrijsKl=$P(R,D,3)
 If NoSa="S",$L($P(R,D,25)) Set PrijsKl=$P(R,D,25)
 Set R=$$PROD^KPRIJS(PRNr,PrijsKl,"","","","",NoSa),Korting=$P(R,D,5),OptKort=""
 If '$D(^KLPUTZ(NoSa,KLNr)) Quit Korting_D_D
 Set Aantal=$G(Aantal),LevTerm=$G(LevTerm),DTyp="" If LevTerm'?.N Set DTyp="DW"
 If '$D(RefDat) Set RefDat=$G(RefDat)
 Else  Set:RefDat'?.N RefDat=$$INTDATE^vhDTyp(RefDat) If 'RefDat Set RefDat=+$H
 If $L(DTyp) Set LevTerm=$$INTDATE^vhDTyp(LevTerm,DTyp)
 If DTyp["W" Set LevTerm=$$CALCDATE^vhDTyp(LevTerm,"W","FD")
 Set (HoofdGr,Groep,SubGroep)=" ",I=$O(^KPR(PRNr,"I"))
 If $E(I,1)="I" Set R=^KPR(PRNr,I),HoofdGr=$P(R,D),Groep=$P(R,D,2),SubGroep=$P(R,D,3)
 Set GrootVp=0,I=$O(^KPR(PRNr,"J"))
 If $E(I,1)="J" Set R=^KPR(PRNr,I),GrootVp=$P(R,D,16)
 Set (Korting1,Korting2,Niveau)="",$P(OptMin,U,3)=U,$P(OptPlus,U,3)=U
 If Korting1="",'Korting2,$D(^KLPUTZ(NoSa,KLNr,HoofdGr,Groep,SubGroep,PRNr,0)) Do FETCHKPC(HoofdGr,Groep,SubGroep,PRNr,0)
 ;Set Aantal=""
 Do OPTKPC(HoofdGr,Groep,SubGroep,PRNr)
 If Korting1="",'Korting2,$D(^KLPUTZ(NoSa,KLNr,HoofdGr,Groep,SubGroep,0,0)) Do FETCHKPC(HoofdGr,Groep,SubGroep,0,0)
 Set Aantal=""
 Do OPTKPC(HoofdGr,Groep,SubGroep,0)
 If Korting1="",'Korting2,$D(^KLPUTZ(NoSa,KLNr,HoofdGr,Groep,0,0,0)) Do FETCHKPC(HoofdGr,Groep,0,0,0)
 Do OPTKPC(HoofdGr,Groep,0,0)
 If Korting1="",'Korting2,$D(^KLPUTZ(NoSa,KLNr,HoofdGr,0,0,0,0)) Do FETCHKPC(HoofdGr,0,0,0,0)
 Do OPTKPC(HoofdGr,0,0,0)
 If Korting1="",'Korting2 Set Korting1=Korting
 Quit Korting1_D_Korting2_D_Niveau_D_OptPlus_D_OptMin_D_OptKort
 ;
 ; optionele kortingen
OPTKPC(H,G,S,P) 
 New Next
 If Aantal="",LevTerm="" Quit
 If LevTerm="" New LevTerm Set LevTerm=+$H
 Set Next=0
 For  Set Next=$O(^KLPUTZ(NoSa,KLNr,H,G,S,P,Next)) Quit:Next=""  Do
 .Set R=^KLPUTZ(NoSa,KLNr,H,G,S,P,Next)
 .If '$P(R,D,5),'$P(R,D,6),'$P(R,D,7),'$P(R,D,8) Quit
 .Do FETCHKPC(H,G,S,P,Next)
 Quit
 ;
 ; vergelijk optionele kortingen
FETCHKPC(H,G,S,P,N) 
 New I,R,Fetch,Plus,Min
 Set Fetch=1,R=^KLPUTZ(NoSa,KLNr,H,G,S,P,N),$P(Plus,U,3)=U,$P(Min,U,3)=U
 If $P(R,D,5),'P Quit
 If $P(R,D,5) Do  ; minimum aantal stuks of verpakkingen
 .If 'P Set Fetch=0 Quit
 .If $P(R,D,5)*$S(P:1,1:GrootVp)>Aantal Set Fetch=0,$P(Min,U,3)="A"
 .Else  Set $P(Plus,U,3)="A"
 If $L(RefDat) Do
 .If $L(LevTerm),$P(R,D,6) Do  ; minimum leverweken
 ..If $P(R,D,6)*7+RefDat>LevTerm Set Fetch=0,$P(Min,U,4)="L"
 ..Else  Set $P(Plus,U,4)="L"
 .If $P(R,D,7),'$P(R,D,8) Do  ; geldig vanaf
 ..If RefDat<$P(R,D,7) Set Fetch=0,$P(Min,U)="V"
 ..Else  Set $P(Plus,U)="V"
 .If $P(R,D,8),'$P(R,D,7) Do  ; geldig tot
 ..If RefDat>$P(R,D,8) Set Fetch=0,$P(Min,U,2)="T"
 ..Else  Set $P(Plus,U,2)="T"
 .If $P(R,D,7),$P(R,D,8) Do  ; geldig van-tot
 ..If RefDat<$P(R,D,7)!(RefDat>$P(R,D,8)) Set Fetch=0,$P(Min,U,1,2)="V;T"
 ..Else  Set $P(Plus,U,1,2)="V;T"
 If Korting1+Korting2<($P(R,D)+$P(R,D,2))!'$L(Korting1) Do
 .If 'Fetch Do  Quit
 ..For I=1:1:4 If $L($P(Min,U,I)) Set $P(OptMin,U,I)=$P(Min,U,I)
 .Set Korting1=$P(R,D),Korting2=$P(R,D,2)
 .If N,$P(R,D,5) Set OptKort="O"
 .For I="P","S","G","H" If @I'=0 Set Niveau=I Quit
 Quit
 ;
 ; Optionele lijnkorting
DISPKORT(KLNr,PRNr,NoSa,RefDat,Aantal,LevTerm,OldKort1,OldKort2,ManPrijs,Display) 
 ; Display : 0 = niet
 ;           1 = enkel de niet gehaalde optonele kortingen
 ;           2 = ook de vergelijking van de gekozen korting met de beste
 New I,R,X,Y,DTyp,HoofdGr,Groep,SubGroep,GrootVp,Korting1,Korting2,NewKort1,NewKort2,OptKort
 Set OldKort1=$G(OldKort1),OldKort2=$G(OldKort2),ManPrijs=$G(ManPrijs)
 ;If ManPrijs="*"!(ManPrijs="=") Quit OldKort1_D_OldKort2
 If $G(NoSa)="" Set NoSa="N"
 If NoSa'="N",NoSa'="S" Quit OldKort1_D_OldKort2
 Set Aantal=$G(Aantal),LevTerm=$G(LevTerm),DTyp="" If LevTerm'?.N Set DTyp="DW"
 Set Display=$G(Display)
 If '$D(RefDat) Set RefDat=$G(RefDat)
 Else  Set:RefDat'?.N RefDat=$$INTDATE^vhDTyp(RefDat) If 'RefDat Set RefDat=+$H
 If $L(DTyp) Set LevTerm=$$INTDATE^vhDTyp(LevTerm,DTyp)
 If DTyp["W" Set LevTerm=$$CALCDATE^vhDTyp(LevTerm,"W","FD")
 Set R=$$KORTPC(KLNr,PRNr,NoSa,RefDat,Aantal,LevTerm) 
 If $TR($P(R,D,5),";","")="" Quit $P(R,D,1,2)_D_$P(R,D,6)
 Set (NewKort1,Korting1)=$P(R,D),(NewKort2,Korting2)=$P(R,D,2),OptKort=$P(R,D,6)
 Set (HoofdGr,Groep,SubGroep)=" ",I=$O(^KPR(PRNr,"I"))
 If $E(I,1)="I" Set R=^KPR(PRNr,I),HoofdGr=$P(R,D),Groep=$P(R,D,2),SubGroep=$P(R,D,3)
 Set GrootVp=0,I=$O(^KPR(PRNr,"J"))
 If $E(I,1)="J" Set R=^KPR(PRNr,I),GrootVp=$P(R,D,16)
 Set Y=1
 Do OPTDSP(HoofdGr,Groep,SubGroep,PRNr)
 Set Aantal=""
 Do OPTDSP(HoofdGr,Groep,SubGroep,0)
 Do OPTDSP(HoofdGr,Groep,0,0)
 Do OPTDSP(HoofdGr,0,0,0)
 If Display Do
 .Set Y=$P("geen optionele\beste",D,$L(OptKort)+1)
 .Set Y="\\Selekteer een korting  - = "_Y_$J("",14-$L(Y))_"|K1 %|K2 %|M aant| Lt|Geld van|Geld tot\\\KORTINGDSP\"
 .Set $P(Y(1),D,1,2)=NewKort1_D_NewKort2
 .Set $P(Y(1),D,3)=$P("Geen optionele korting\Beste korting",D,$L(OptKort)+1)
 .Set Y(0)=$O(Y(""),-1)
 .Do ^POP
 .If X Set Y=Y(X),Korting1=$P(Y,D),Korting2=$P(Y,D,2)
 .Set FP=sRT*100+1 Write @F,@F1
 If Korting1+Korting2'=(NewKort1+NewKort2) Do
 .Set OptKort=$S($P(Y,D,5)="":"",1:"O") Quit:Display'=2
 .Set FP=2001 Write @F,@F1,"De gekozen korting ",$$FMTKORT(Korting1,Korting2),"% is "
 .Write $P("kleiner\groter",D,Korting1+Korting2>(NewKort1+NewKort2)+1)
 .Write " dan de beste korting ",$$FMTKORT(NewKort1,NewKort2),"%."
 .Set R=$$KEYL^vhINP("KORTING","BEWGEKKORT")
 .If $L(R) Set Korting1=NewKort1,Korting2=NewKort2,OptKort=""
 .Set:sRT>20 sRT=20 Set FP=sRT*100+1 Write @F,@F1
 Quit Korting1_D_Korting2_D_OptKort
 ;
 ; optionele kortingen
OPTDSP(H,G,S,P) 
 New Next
 If Aantal="",LevTerm="" Quit
 If LevTerm="" New LevTerm Set LevTerm=+$H
 Set Next=""
 For  Set Next=$O(^KLPUTZ(NoSa,KLNr,H,G,S,P,Next)) Quit:Next=""  Do
 .Set R=^KLPUTZ(NoSa,KLNr,H,G,S,P,Next)
 .If '$P(R,D,5),'$P(R,D,6),'$P(R,D,7),'$P(R,D,8) Quit
 .Do FETCHDSP(H,G,S,P,Next)
 Quit
 ;
 ; vergelijk optionele kortingen
FETCHDSP(H,G,S,P,N) 
 New I,R,Fetch
 Set Fetch=0,R=^KLPUTZ(NoSa,KLNr,H,G,S,P,N),$P(R,D,3)=""
 If $P(R,D,5),'P Quit
 If Aantal,$P(R,D,5) Do  ; aantal
 .If $P(R,D,5)*$S(P:1,1:GrootVp)>Aantal Do
 ..Set Fetch=1
 ..Do OPMERK($S(P:"A",1:"P"),"<",$P(R,D,5))
 If $L(RefDat) Do
 .If $L(LevTerm),$P(R,D,6),$P(R,D,6)*7+RefDat>LevTerm Do  ; leverweken
 ..Set Fetch=1
 ..Do OPMERK("L","<",$P(R,D,6))
 .If $P(R,D,7),RefDat<$P(R,D,7) Do  ; geldig vanaf
 ..Set Fetch=1
 ..Do OPMERK("V","<",$P(R,D,7))
 .If $P(R,D,8),RefDat>$P(R,D,8) Do  ; geldig tot
 ..Set Fetch=1
 ..Do OPMERK("T",">",$P(R,D,8))
 If Korting1+Korting2'>($P(R,D)+$P(R,D,2)) Do
 .If +Korting1=+$P(R,D),+Korting2=+$P(R,D,2) Set Y(1)=R
 .Else  If Fetch Set Y=Y+1,Y(Y)=R
 Quit
 ;
 ; Klassificatiekortingen
KLASKORT(KLNr,RefDat,Display,DataRef,Start,FetExec,SetExec,KortTyp) 
 Set KLNr=$G(KLNr),RefDat=$G(RefDat),Display=$G(Display),DataRef=$G(DataRef),Start=$G(Start)
 Set FetExec=$G(FetExec),SetExec=$G(SetExec),KortTyp=$G(KortTyp)
 Do KLASKORT^KORTING2(KLNr,RefDat,Display,DataRef,Start,FetExec,SetExec,KortTyp)
 Quit
 ;
OPMERK(Reden,Vergel,Waarde) 
 If Reden="V"!(Reden="T") Set Waarde=$$EXTDATE^vhDTyp(Waarde)
 If Reden="L" Set Waarde=$$EXTDATE^vhDTyp(Waarde*7+$H,"DW")
 Set Reden=$P("Aantal\Verpakkingen\Leverweek\Leverdatum\Leverdatum",D,$F("APLVT",Reden)-1)
 If $L($P(R,D,3)) Set $P(R,D,3)=$P(R,D,3)_" "
 Set $P(R,D,3)=$P(R,D,3)_Reden_Vergel_Waarde
 Quit
 ;
 ; Formateer korting
FMTKORT(Korting1,Korting2,Length) 
 New Korting
 Set Korting1=$G(Korting1),Korting2=$G(Korting2),Length=$G(Length),Korting=""
 If Korting1["#" Set Korting2=$P(Korting1,"#",2),Korting1=$P(Korting1,"#")
 If Korting1 Set Korting=$$EXTNUM^vhDTyp(Korting1,Length,"",1)
 If Korting2 Set Korting=Korting_" + "_$$EXTNUM^vhDTyp(Korting2,Length,"",1)
 Quit Korting
 ;
HEEFTUTZ(KLNr,PRNr,NoSa,Nivo,IncOpt) 
 ;Nivo : H,G,S of P ook mogelijk is 1,2,3,4, default=H (=1)
 ;       Een nivo van H betekent dat nivo's G, S en P ook meetellen
 ;       Een nivo van P betekent dat nivo's H, G en S NIET meetellen
 ;IncOpt : 1 = Optionele utz tellen mee, default=0
 New I,R,HG,GR,SG,Chk
 If $G(NoSa)="" Set NoSa="N"
 Set:$G(Nivo)="" Nivo="H"
 Set:"HGSP"[Nivo Nivo=$F("HGSP",Nivo)-1
 Set:'Nivo!(Nivo>4) Nivo=1
 Set IncOpt=$G(IncOpt)
 Set I=$O(^KPR(PRNr,"I"))
 Quit:$E(I,1)'="I" 0
 Set R=^KPR(PRNr,I)
 Set HG=$P(R,D),GR=$P(R,D,2),SG=$P(R,D,3)
 Quit:'$D(^KLPUTZ(NoSa,KLNr)) 0
 Set Chk=0
 If Nivo<2 Set Chk=$$UTZOPT($NA(^KLPUTZ(NoSa,KLNr,HG,0,0,0)),IncOpt)
 If 'Chk,Nivo<3 Set Chk=$$UTZOPT($NA(^KLPUTZ(NoSa,KLNr,HG,GR,0,0)),IncOpt)
 If 'Chk,Nivo<4 Set Chk=$$UTZOPT($NA(^KLPUTZ(NoSa,KLNr,HG,GR,SG,0)),IncOpt)
 If 'Chk Set Chk=$$UTZOPT($NA(^KLPUTZ(NoSa,KLNr,HG,GR,SG,PRNr)),IncOpt)
 Quit Chk
 ;
UTZOPT(Ref,IncOpt) 
 New Chk,VolgNr,Rec
 Set Chk=0
 Set VolgNr=""
 For  Set VolgNr=$O(@Ref@(VolgNr)) Quit:VolgNr=""  Do  Quit:Chk
 .If IncOpt Set Chk=1
 .Else  Do  ; Nakijken of een UTZ is zonder opties op Levertermijn en Aantal
 ..Set Rec=@Ref@(VolgNr)
 ..Quit:$P(Rec,D,5)!$P(Rec,D,6) ; Heeft optie op aantal en/of levertermijn
 ..If $P(Rec,D,7),$P(Rec,D,7)>$H Quit  ; Nog niet geldig
 ..If $P(Rec,D,8),$P(Rec,D,8)<$H Quit  ; Vervallen
 ..Set Chk=1 ; geldige uitz zonder opties
 Quit Chk