KLHFUTZ ;Klant prijsuitzondering bij gebruik HALFFABRIKATEN [ 11/24/2003 3:16 PM ] ;Als een klant op halffabrikaten een uitzondering heeft dan dient er voor het afgewerkt eindproduct ook een uitzondering geplaatst worden. CHECK(KLNr,HGChk,NoSa) ; Controle of de klant uitz. heeft op een bep. hoofdgroep Quit 0 New HG,GR,SG,PR,KLId,Check Set:$G(NoSa)="" NoSa="N" Set KLId=^KK1(KLNr) Set Codex=$P(^KKL(KLId,2),D,3) ; Niet voor prijslijst klanten If NoSa="S",$P(^KKL(KLId,2),D,25)'="" Set Codex=$P(^KKL(KLId,2),D,25) Quit:Codex="P" 0 Set HG="" For Set HG=$O(^KLPUTZ(NoSa,KLNr,HG)) Quit:HG="" Quit:HG[HGChk Set Check=HG[HGChk Quit:'Check Check ; Bij sommige klanten mag er geen herrekening zijn hierbij moet de NOBXRECALC in de BX uitzondering geplaatst worden Set:$G(^KLPUTZ(NoSa,KLNr,HG,0,0,0,0))["NOBXRECALC" Check=0 Set (GR,SG,PR)="" For Set GR=$O(^KLPUTZ(NoSa,KLNr,HG,GR)) Quit:GR="" Do . Set:Check&&($G(^KLPUTZ(NoSa,KLNr,HG,GR,0,0,0))["NOBXRECALC") Check=0 . For Set SG=$O(^KLPUTZ(NoSa,KLNr,HG,GR,SG)) Quit:SG="" Do .. Set:Check&&($G(^KLPUTZ(NoSa,KLNr,HG,GR,SG,0,0))["NOBXRECALC") Check=0 .. For Set PR=$O(^KLPUTZ(NoSa,KLNr,HG,GR,SG,PR)) Quit:PR="" Do ... Set:Check&&($G(^KLPUTZ(NoSa,KLNr,HG,GR,SG,PR,0))["NOBXRECALC") Check=0 Quit Check RECALC(DocTyp,DocNr,Debug) q ; DocTyp= "OD" of "OF" Set DocTyp=$S($L($G(DocTyp))=2:DocTyp,$E(DocNr)=5:"OF",1:"OD") If DocTyp="OD" Do . Set KLNr=$P(^KO1(DocNr,"F"),D) . Set DocRef=$NA(^KOD(KLNr,"F",DocNr)) Else Do . Set KLNr=$P(^KOFKL1(DocNr,"F"),D) . Set DocRef=$NA(^KOFKL(KLNr,"F",DocNr)) Set LijnNr=100 For Set LijnNr=$O(@DocRef@(LijnNr)) Quit:LijnNr="" Do . Set Rec=@DocRef@(LijnNr) . Set PRNr=$P(Rec,D,2) . Quit:PRNr'?4.7N . Do CALC^KLHFUTZ(KLNr,PRNr,$G(Debug)) . If $G(Debug) Write "Druk op " R K Do WARN^vhTXTPOP("Bij alle producten zijn de uitzonderingen aangepast~Het offerte/order met via de applicatie herrekene") Quit CALC(KLNr,PRNr,Debug) ; Berekenen of er een uitzondering moet toegepast worden New NoSa,HFCode,KLId,WUKost,Cif,DB,Kort,Som,Prijs,LPrijs,Prijs2,RecPrijs,RecI Set RecI=$O(^KPR(PRNr,"I")) Set RecI=^KPR(PRNr,$O(^KPR(PRNr,"I"))) Set Debug=$G(Debug) Write:Debug @FS132 Set NoSa="N" Set HFCode="" Set KLId=^KK1(KLNr) ;Quit:"P"[$P(^KKL(KLId,2),D,3) Quit:'$D(^KPR(PRNr,"J6332")) Quit:'$$HasHalfFabr^PRBS(PRNr) Set WUKost=$P($G(^KPR(PRNr,"G")),D,11) ; Werkuren kost Set RecJ=^KPR(PRNr,"J6332") Set Cif=$P(RecJ,D,21) Set DB=$P(RecJ,D,24) Set GenPRNr=$P(^KPR(PRNr,0),D,3) Set Kort=$P($$KORTPC^KORTING(KLNr,GenPRNr),D,1,2) Write:Debug "Cif=",Cif," DB=",DB," Kort=",Kort,! Set Kort=1-((100-$P(Kort,D,1)/100)*(100-$P(Kort,D,2)/100))*100 Set Som=0 Write:Debug "Halfabrikaten" For Set HFCode=$O(^PRBS("BS",PRNr,HFCode)) Quit:HFCode="" Do . Quit:$P(^PRBS("BS",PRNr,HFCode),D,3)'="H" ; Geen halffabrikaat . Set Prijs=$$CALCVP(KLNr,PRNr,HFCode,Cif,DB,Kort) . Set Som=Som+Prijs Write:Debug !,"Maakkost" Set Prijs=$$VKPHF(PRNr,Cif,DB,Kort,WUKost) Write:Debug " HFPrijs:",Prijs Write:Debug !,"-----" Set Som=Som+Prijs Set RecI=^KPR(PRNr,$O(^KPR(PRNr,"I"))) Set Korting=$P($G(^KLPUTZ(NoSa,KLNr,$P(RecI,D,1),$P(RecI,D,2),$P(RecI,D,3),PRNr,0)),D,1) Do If Korting Do ; Bestaande uitzondering verwijderen .Do:'$G(Debug) WARN^vhTXTPOP("De oude uitzondering met als "_Korting_" wordt verwijderd") .Do DELUTZ(KLNr,PRNr,NoSa) Set RecPrijs=$$KLANTPR^KPRIJS(KLNr,PRNr) Set Prijs=$P(RecPrijs,D,14) Set LPrijs=$P(RecPrijs,D,15) Write:Debug !,"Som:",Som," Defaultprijs:",Prijs If Prijs-Som>.1!(Prijs-Som<-.1) Do ; Te hoge prijs, groter dan 10 eurocent . Set Korting=$J(1-(Som/LPrijs)*100-.04999,0,1) ; afgerond naar beneden . If Debug Do .. Write !,"Korting:",Korting .. Write " ... Wachten op " .. R K .. Write !,@FS80 . If Korting>(DB-8) Do Quit ; Dekkingsbijdrage wordt te klein .. Do WARN^vhTXTPOP("De in te stellen korting "_Korting_" is te groot, verwittig ICT") . Do WARN^vhTXTPOP("De uitzondering "_Korting_" wordt ingesteld") . Do PUTUTZ(KLNr,PRNr,Korting,NoSa) Else Do . If Debug Do .. Write:Debug !,"Geen korting, prijs OK" .. Write " ... Wachten op " .. R K .. Write !,@FS80 Quit CALCVP(KLNr,PRNr,HFCode,Cif,DB,Kort) ;Bereken van de verkoopprijs van het halffabrikaat als los product New HFPRNr,HFRec,HFRecD,HFPRNr,HFQty,Rec15,Prijs,DimHF,NetLen,Prijs2,RecPrijs Set HFRec=^PRBS("BS",PRNr,HFCode) Set HFRecD=$G(^PRBS("BS",PRNr,HFCode,"D")) Set HFPRNr=$P(HFRec,D,1) Set HFQty=$P(HFRec,D,2) Set Rec15=$G(^KPR(HFPRNr,15)) Write:Debug !,HFPRNr," ",$P(^KPR(HFPRNr,0),D)," " If "PRBDHO;PRBDHZ;PRRUGHS;PRVPCP;PRVPZW;PRVPOD;PRVULSTUK"[$P(HFCode,".") Do . ; Geen std. BESLAG producten . Set Prijs=$$VKPHF(HFPRNr,Cif,DB,Kort) . Write:Debug " Prijs:",Prijs . Write:Debug " *geen std*" Else Do ; Beslag producten . Set RecPrijs=$$KLANTPR^KPRIJS(KLNr,HFPRNr) . Set Prijs=+$J($P(RecPrijs,D,14),0,4) . Set Prijs2=$$VKPHF(HFPRNr,Cif,DB,Kort) . Set Prijs2=$S($P(RecPrijs,D,3)="H":+$J(Prijs2+.0000499,0,4),1:+$J(Prijs2+.00499,0,2)) . Write:Debug " VKPLos:",Prijs . Write:Debug " ",$S(+Prijs'=+Prijs2:"?",1:"=") . Write:Debug " HFPrijs",Prijs2 Set DimHF=$P(HFRecD,D,3) ; Lengte incl. uitval If DimHF Do ; Dimensie afhankelijke prijs . Set NetLen=$P(Rec15,D,7) . Set Prijs=Prijs*DimHF/NetLen Write:Debug " VKPLen:",Prijs Quit Prijs*HFQty VKPHF(HFPRNr,Cif,DB,Kort,CiffPPL) ; Berekenen van de verkoopprijs ; CiffPPL is optioneel New Prijs Set:'$D(CiffPPL) CiffPPL=$P(^KPR(HFPRNr,$O(^KPR(HFPRNr,"J"))),D,23) Write:Debug " CifPPL:",CiffPPL Set Prijs=CiffPPL*(100+Cif/100)/(100-DB/100)*(100-Kort/100) Quit $J(Prijs,0,4) PUTUTZ(KLNr,PRNr,Kort,NoSa) ; Creatie van de uitzondering in KLPUTZ New Rec,RecI Set RecI=^KPR(PRNr,$O(^KPR(PRNr,"I"))) Set Rec=Kort Set $P(Rec,D,3)="TBX corr" Set $P(Rec,D,11)=$H Set ^KLPUTZ(NoSa,KLNr,$P(RecI,D,1),$P(RecI,D,2),$P(RecI,D,3),PRNr,0)=Rec Set ^KLPUTZ("I"_NoSa,$P(RecI,D,1),$P(RecI,D,2),$P(RecI,D,3),PRNr,KLNr)="" Quit DELUTZ(KLNr,PRNr,NoSa) ; Verwijderen van de uitzondering in KLPUTZ New Rec,RecI Set RecI=^KPR(PRNr,$O(^KPR(PRNr,"I"))) Kill ^KLPUTZ(NoSa,KLNr,$P(RecI,D,1),$P(RecI,D,2),$P(RecI,D,3),PRNr,0) Kill ^KLPUTZ("I"_NoSa,$P(RecI,D,1),$P(RecI,D,2),$P(RecI,D,3),PRNr,KLNr) Quit