pv1 ;NEW PROGRAM [ 10/30/2001  4:21 PM ]
MACHINE d ^cA604
 Set PRNr=""
 For  Set PRNr=$O(^KPR(PRNr)) Q:PRNr=""  Do
 .Q:$D(^KPR(PRNr,"J5810"))  ; Burbi
 .Set WPC=25
 .Set GR="X"
 .Set I=$O(^KPR(PRNr,"I")) 
 .If $E(I)="I" Set GR=$P(^KPR(PRNr,I),D,2)
 .Quit:GR["MAG"  ;!($E(GR,3,4)'="ZZ")
 .;Set $P(^KPR(PRNr,2),D,6)=WPC
 .;Set $P(^KPR(PRNr,2),D,5)=10
 .;Set $P(^KPR(PRNr,1),D,19)="L"
 .Set I=$O(^KPR(PRNr,"J")) 
 .Quit:$E(I)'="J" 
 .Set Rec=^KPR(PRNr,I)
 .Quit:$P(Rec,D,12)=""&($P(Rec,D,11)="")
 .Quit:$P(Rec,D,10)'=""
 .Write !!,GR," ",$P(^KPR(PRNr,0),D)
 .Write !,Rec
 .Set $P(Rec,D,10)=20
 .;Set $P(Rec,D,11)=1
 .;Set $P(Rec,D,12)=1
 .;Write !,Rec
 .;Set ^KPR(PRNr,I)=Rec
 Quit
 
OMZ3 k  s Q="K"
 d ^cA604
 Set PRNr=""
 Set (Aant,Cnt,TMarg,TOmz)=0
 For  Set PRNr=$O(^KPR(PRNr)) Q:PRNr=""  Do
 .Q:'$D(^KPR(PRNr,"J5005"))
 .Q:$P(^KPR(PRNr,1),D,25)
 .Set KLNr=0
 .For  Set KLNr=$O(^KSTPR(PRNr,KLNr)) Quit:KLNr=""  Do
 ..;Write !,PRNr," ",KLNr,"  ",VKPrijs,"  ",SVKPrijs
 ..Set (KLAant,KLHOmz,KLROmz,KLHMarg,KLRMarg)=0
 ..Set Maand="1996.07 "
 ..For  Set Maand=$O(^KSTPR(PRNr,KLNr,Maand)) Quit:Maand=""!(Maand]"1997.07 ")  Do
 ...Set Rec=^(Maand)
 ...Set KLAant=KLAant+$P(Rec,D,1)
 ..Quit:'KLAant
 ..Set Cnt=$G(Cnt)+1
 ..Set Rec=$$KLANTPR^KPRIJS(KLNr,PRNr)
 ..Set AKPrijs=$P(Rec,D,13)
 ..Set VKPrijs=$P(Rec,D,14)
 ..Set TMarg=TMarg+(KLAant*(VKPrijs-AKPrijs))
 ..Set TOmz=TOmz+(KLAant*VKPrijs)
 ..;For Put=30,22.5,15 Do
 ..Set SKort1=15,Put=1
 ..If $D(^PRKS(PRNr)) Set SKort1=22.5,Put=2
 ..If $P(^KKL(^KK1(KLNr),0),D,21)<10 Set SKort1="",Put=3
 ..Do
 ...Set SRec=$$KLANTPR^PVPRIJS(KLNr,PRNr,"N")
 ...Set SAKPrijs=$P(SRec,D,13)
 ...Set SVKPrijs=$P(SRec,D,14)
 ...;W !,$P(Rec,D)," ",$P(SRec,D)
 ...If $P(Rec,D)'>$P(SRec,D) Do 
 ....Set FCnt(Put)=$G(FCnt(Put))+1
 ....Set FMarg(Put)=$G(FMarg(Put))+(KLAant*(VKPrijs-AKPrijs))
 ....Set FOmz(Put)=$G(FOmz(Put))+(KLAant*VKPrijs)
 ....;W "*"
 ...Else  Do
 ....Set HMarg(Put)=$G(HMarg(Put))+(KLAant*(VKPrijs-AKPrijs))
 ....Set HOmz(Put)=$G(HOmz(Put))+(KLAant*VKPrijs)
 ....Set SMarg(Put)=$G(SMarg(Put))+(KLAant*(SVKPrijs-SAKPrijs))
 ....Set SOmz(Put)=$G(SOmz(Put))+(KLAant*SVKPrijs)
 ....Set Cnt(Put)=$G(Cnt(Put))+1
 w !
 zw HOmz,HMarg
 w !
 zw FOmz,FMarg
 w !
 zw TOmz,TMarg
 w !
 zw SOmz,SMarg
 w !
 zw Cnt,FCnt
 Quit
 
OMZ2 k  s Q="K"
 d ^cA604
 Set PRNr=""
 Set (Aant,Cnt,TMarg,TOmz)=0
 For  Set PRNr=$O(^KPR(PRNr)) Q:PRNr=""  Do
 .Q:'$D(^KPR(PRNr,"J5005"))
 .Q:$P(^KPR(PRNr,1),D,25)
 .Set KLNr=0
 .For  Set KLNr=$O(^KSTPR(PRNr,KLNr)) Quit:KLNr=""  Do
 ..;Write !,PRNr," ",KLNr,"  ",VKPrijs,"  ",SVKPrijs
 ..Set (KLAant,KLHOmz,KLROmz,KLHMarg,KLRMarg)=0
 ..Set Maand="1996.07 "
 ..For  Set Maand=$O(^KSTPR(PRNr,KLNr,Maand)) Quit:Maand=""!(Maand]"1997.07 ")  Do
 ...Set Rec=^(Maand)
 ...Set KLAant=KLAant+$P(Rec,D,1)
 ..Quit:'KLAant
 ..Set Cnt=$G(Cnt)+1
 ..Set Rec=$$KLANTPR^KPRIJS(KLNr,PRNr)
 ..Set AKPrijs=$P(Rec,D,13)
 ..Set VKPrijs=$P(Rec,D,14)
 ..Set TMarg=TMarg+(KLAant*(VKPrijs-AKPrijs))
 ..Set TOmz=TOmz+(KLAant*VKPrijs)
 ..;For Put=30,22.5,15 Do
 ..Set SKort1=""
 ..If $P(^KKL(^KK1(KLNr),0),D,21)>10 Set SKort1=15
 ..Do
 ...Set SRec=$$KLANTPR^PVPRIJS(KLNr,PRNr,"N")
 ...Set SAKPrijs=$P(SRec,D,13)
 ...Set SVKPrijs=$P(SRec,D,14)
 ...;W !,$P(Rec,D)," ",$P(SRec,D)
 ...If $P(Rec,D)'>$P(SRec,D) Do 
 ....Set FCnt(Put)=$G(FCnt(Put))+1
 ....Set FMarg(Put)=$G(FMarg(Put))+(KLAant*(VKPrijs-AKPrijs))
 ....Set FOmz(Put)=$G(FOmz(Put))+(KLAant*VKPrijs)
 ....;W "*"
 ...Else  Do
 ....Set HMarg(Put)=$G(HMarg(Put))+(KLAant*(VKPrijs-AKPrijs))
 ....Set HOmz(Put)=$G(HOmz(Put))+(KLAant*VKPrijs)
 ....Set SMarg(Put)=$G(SMarg(Put))+(KLAant*(SVKPrijs-SAKPrijs))
 ....Set SOmz(Put)=$G(SOmz(Put))+(KLAant*SVKPrijs)
 w !
 zw HOmz,HMarg
 w !
 zw FOmz,FMarg
 w !
 zw TOmz,TMarg
 w !
 zw SOmz,SMarg
 w !
 zw Cnt,FCnt
 Quit
 
OMZ1 d ^cA604
 Set PRNr=""
 Set (Aant,SOmz,SMarg,HOmz,ROmz,HMarg,RMarg)=0
 For  Set PRNr=$O(^KPR(PRNr)) Q:PRNr=""  Do
 .Q:'$D(^KPR(PRNr,"J5005"))
 .Q:$P(^KPR(PRNr,1),D,25)
 .Set KLNr=0
 .For  Set KLNr=$O(^KSTPR(PRNr,KLNr)) Quit:KLNr=""  Do
 ..Set Rec=$$KLANTPR^KPRIJS(KLNr,PRNr)
 ..Set AKPrijs=$P(Rec,D,13)
 ..Set VKPrijs=$P(Rec,D,14)
 ..Set Rec=$$KLANTPR^KPRIJS(KLNr,PRNr,"S")
 ..Set SAKPrijs=$P(Rec,D,13)
 ..Set SVKPrijs=$P(Rec,D,14)
 ..Set (KLAant,KLHOmz,KLROmz,KLHMarg,KLRMarg)=0
 ..Set Maand="1996.07 "
 ..For  Set Maand=$O(^KSTPR(PRNr,KLNr,Maand)) Quit:Maand=""!(Maand]"1997.07 ")  Do
 ...Set Rec=^(Maand)
 ...Set KLAant=KLAant+$P(Rec,D,1)
 ...Set ROmz=ROmz+$P(Rec,D,3)
 ...Set RMarg=RMarg+$P(Rec,D,4)
 ..Set HMarg=HMarg+(KLAant*(VKPrijs-AKPrijs))
 ..Set HOmz=HOmz+(KLAant*VKPrijs)
 ..Set SMarg=SMarg+(KLAant*(SVKPrijs-SAKPrijs))
 ..Set SOmz=SOmz+(KLAant*SVKPrijs)
 w !
 zw HOmz,HMarg
 w !
 zw ROmz,RMarg
 w !
 zw SOmz,SMarg
 w !
 Quit
WINST d ^cA604
 Set PRNr=""
 For  Set PRNr=$O(^KPR(PRNr)) Q:PRNr=""  Do
 .Q:$D(^KPR(PRNr,"J5810"))  ; Burbi
 .Set WPC=40
 .Set SG="X"
 .Set I=$O(^KPR(PRNr,"I")) 
 .If $E(I)="I" Set SG=$P(^KPR(PRNr,I),D,3)
 .If SG["2XX/BL"!(SG["4XX/BL")!(SG["550/BL") S WPC=36 ;Write !,$P(^KPR(PRNr,0),D)
 .If $D(^KPR(PRNr,"J5005")) Do  ; BLUM ES nakijken
 ..Set Rec=$$CALCBLUM(PRNr)
 ..Write:$P(Rec,D,5)'=""&($P(^KPR(PRNr,0),D)'["*DO*") !,PRNr," ",$P(^KPR(PRNr,0),D)_"  "_Rec
 ..Set:$P(Rec,D,5)="N"!($P(Rec,D,5)="B") WPC=$P(Rec,D,7)
 .;Set $P(^KPR(PRNr,2),D,6)=WPC
 .;Set $P(^KPR(PRNr,2),D,5)=20
 Quit
KSPRIJSL ; Alle KS klanten in de schaduw op PRIJSLIJST zetten
 D INIT^vhTERMINA
 Set KLId=0
 Write @F11,@F1
 For  Set KLId=$O(^KKL(KLId)) Q:KLId=""  Do
 .Set Rec2=^KKL(KLId,2)
 .Quit:$P(Rec2,D,25)'="P"
 .Set Rec=^KKL(KLId,3)
 .Write !!,KLId,"   ",$P(Rec2,D,25),!,Rec
 .Set $P(Rec,D,3)="00"
 .Write !,Rec
 .Set ^KKL(KLId,3)=Rec
 Quit
 
CALCBLUM(PRNr,NoSa) 
 Set NoSa=$G(NoSa,"N")
 Set IDNr=$P(^KPR(PRNr,2),D,25)
 Set BLID="0"_$TR($E(IDNr,2,99),".","")
 Set BLKLNr=212250
 Set BPrijs=$P(^KPR(PRNr,"J5005"),D,18)
 If $D(^PRPUTZ("N",PRNr)) Do
 .Set KLNr=$O(^PRPUTZ("N",PRNr,""))
 .Set BLKLNr=$P(^PRPUTZ("N",PRNr,KLNr,0),D)
 Set BLPrijs=$$PRIJS^BLPRGEG(BLID,BPrijs,BLKLNr)
 Set BLPrijs=$P(BLPrijs,D,1,6)
 If $P(BLPrijs,D,5)="" Quit BLPrijs_D_40_D_20 ; Geen ES
 ; Terugrekenen van de winst voor SOPR en DO's
 ; Nakijken of NIET-SOPR produkt bestaat
 If $E(IDNr)>0,$E(IDNr)<8 Set NSIDNr=BLID If $D(^KPR2(NSIDNr_" ")) Do
 ; later uitwerken naar NoSa
 Else  Do
 b
 Set BLRec=^BLProd("D",BLID)
 Set Bruto=$P(BLRec,D,10) ; APrijs
 Set:BPrijs&$P(BLRec,D,11) Bruto=$P(BLRec,D,11) ; BPrijs
 Set ESNet=$S($P(BLPrijs,D,5)="N":$P(BLPrijs,D,4),1:$P(BLPrijs,D,6)*(1-$P(BLPrijs,D,3)))*3
 Set Lijstprijs=Bruto*(1-0.458)/(1-0.40)*3
 Set Korting=$J(1-(ESNet/Lijstprijs)*100,0,4)
 Quit BLPrijs_D_Korting_D_20
 
SHADKL Set KLId=0
 For  Set KLId=$O(^KKL(KLId)) Quit:KLId=""  Do
 .Set PrijsKl=$P(^KKL(KLId,2),D,3)
 .Set NwReg=$P(^KKL(KLId,0),D,21)
 .Set NonAkt=$P(^KKL(KLId,2),D,10)
 .Set IP=NwReg>0&(NwReg<4)!(NwReg=8)
 .Set $P(^KKL(KLId,2),D,25)=$S(NonAkt:"",PrijsKl="":"",'IP:"L",PrijsKl="G":"G",PrijsKl="B":"S",1:"L")
 .W !,$J(KLId,30),$S(NonAkt:" N ",1:"   "),$J(NwReg,2)," ",IP," ",PrijsKl," ",$P(^KKL(KLId,2),D,25)
 Q
 
KLBURB Set KLId=0
 For  Set KLId=$O(^KKL(KLId)) Quit:KLId=""  Do
 .Set KLNr=$P(^KKL(KLId,0),D,1)
 .Set PrijsKl=$P(^KKL(KLId,2),D,3)
 .Set GR="",SG="",PR="",VolgNr=""
 .For  Set GR=$O(^KLPUTZ("N",KLNr,"11DE ",GR)) Quit:GR=""  Do
 ..For  Set SG=$O(^KLPUTZ("N",KLNr,"11DE ",GR,SG)) Quit:SG=""  Do
 ...For  Set PR=$O(^KLPUTZ("N",KLNr,"11DE ",GR,SG,PR)) Quit:PR=""  Do
 ....Merge ^KLPUTZ("S",KLNr,"11DE ",GR,SG,PR)=^KLPUTZ("N",KLNr,"11DE ",GR,SG,PR)
 .....Set ^KLPUTZ("IS","11DE ",GR,SG,PR,KLNr)=^KLPUTZ("IN",KLNr,"11DE ",GR,SG,PR,KLNr) 
 .Quit:'$D(^KKAAP(KLNr,"11DE "))
 .If '$D(^KLPUTZ("N",KLNr,"11DE ",0)) Do
 ..Set ^KLPUTZ("S",KLNr,"11DE ",0,0,0,0)=$S(PrijsKl="G":30,PrijsKl="R":7.5,PrijsKl="S":15,PrijsKl="B":22.5,1:0)_D_D_"Added PV"
 ..Set ^KLPUTZ("IS","11DE ",0,0,0,KLNr)=""
 Quit
 
KSPROD K  d INIT^vhTERMINA
 For  Do  Quit:PRNr'?4.5N 
 .Set PRNr=$$SELECT^PRODUKT6()
 .Quit:PRNr'?4.5N
 .Set ^PRKS(PRNr)=""
 Quit
IMPORT 
 Set File="D:\MAC FILES\PV\KSKL.TXT"
 For Dev=54:-1:51 Open Dev:(File:"R"):0 Quit:$T
 If '$T Set Error=12 Quit
 Use Dev
 Set Ok=1
 Set Cnt=0
 For  Read Lijn Quit:$ZC=-1  Do
 .Set Cnt=Cnt+1
 .Set KLNr=$E($$UPTRIMAN^vhRtn1(Lijn),1,4)
 .If $D(^PVKSKL(KLNr)) Write !,"DUBBEL ",Lijn
 .Set ^PVKSKL(KLNr)=$P(Lijn,$C(9),2)
 Close Dev
CHKKL SEt KLId=0,Cnt=0,Gedaan=0
 r K
 For  Set KLId=$O(^KKL(KLId)) Quit:KLId=""  Do
 .Set KLNr=$P(^KKL(KLId,0),D)
 .Set Regio=$P(^KKL(KLId,0),D,20)
 .If Regio'=1,Regio'=2,Regio'=3,Regio'=8 Do  Quit
 ..;Write !,"KS ",KLId,"  ",Regio
 ..Set $P(^KKL(KLId,2),D,25)="L"
 ..Do DELSHAD
 .Set PrijsKL=$E($$UPTRIMAN^vhRtn1($P($G(^PVKSKL(KLNr)),D)))
 .If "LSG4"'[PrijsKL Write !,"Klant heeft foutieve prijsklasse ",PrijsKL,"  ",KLId
 .IF $P(^KKL(KLId,2),D,10) Do CLEAN Q
 .If PrijsKL=4 Set Gedaan=Gedaan+1 Quit
 .Set Cnt=Cnt+1
 .If PrijsKL="" Set PrijsKL="L" Write !,"Komt niet voor in EXCEL ",KLId
 .Set Deur=$O(^KLPUTZ("S",KLNr,""))
 .If Deur'="",(Deur'="11DE ")  Write !,"Klant heeft uitzonderingen ",KLId
 .Do DELSHAD
 .Set $P(^KKL(KLId,2),D,25)=PrijsKL
 Write "~~~"
 
DELSHAD 
 New KHS,KGS,KSS,PRNr,Next
 Set NoSa="S"
 Set KHS=""
 For  Set KHS=$O(^KLPUTZ(NoSa,KLNr,KHS)) Quit:KHS=""  Do:KHS'["DE"
 .Set KGS=""
 .For  Set KGS=$O(^KLPUTZ(NoSa,KLNr,KHS,KGS)) Quit:KGS=""  Do
 ..Set KSS=""
 ..For  Set KSS=$O(^KLPUTZ(NoSa,KLNr,KHS,KGS,KSS)) Quit:KSS=""  Do
 ...Set PRNr=""
 ...For  Set PRNr=$O(^KLPUTZ(NoSa,KLNr,KHS,KGS,KSS,PRNr)) Quit:PRNr=""  Do
 ....Kill ^KLPUTZ(NoSa,KLNr,KHS,KGS,KSS,PRNr)
 ....Kill ^KLPUTZ("I"_NoSa,KHS,KGS,KSS,PRNr,KLNr)
 Quit
 
CLEAN Set Deur=$O(^KLPUTZ("S",KLNr,""))
 If Deur'="" Write !,"NON-aktieve klant heeft uitzonderingen ",KLId
 D DELOBJ^KLPUTZ(KLNr,"S") Q
 Q
DELOPM 
 New KHS,KGS,KSS,PRNr,Next
 Set KLNr=""
 Set NoSa="S"
 Set KHS=""
 For  Set KLNr=$O(^KLPUTZ(NoSa,KLNr)) Quit:KLNr=""  For  Set KHS=$O(^KLPUTZ(NoSa,KLNr,KHS)) Quit:KHS=""  Do
 .Set KGS=""
 .For  Set KGS=$O(^KLPUTZ(NoSa,KLNr,KHS,KGS)) Quit:KGS=""  Do
 ..Set KSS=""
 ..For  Set KSS=$O(^KLPUTZ(NoSa,KLNr,KHS,KGS,KSS)) Quit:KSS=""  Do
 ...Set PRNr=""
 ...For  Set PRNr=$O(^KLPUTZ(NoSa,KLNr,KHS,KGS,KSS,PRNr)) Quit:PRNr=""  Do
 ....Set VolgNr=""
 ....For  Set VolgNr=$O(^KLPUTZ(NoSa,KLNr,KHS,KGS,KSS,PRNr,VolgNr)) Quit:VolgNr=""  Do
 .....Set Rec=^KLPUTZ(NoSa,KLNr,KHS,KGS,KSS,PRNr,VolgNr)
 .....Quit:$P(Rec,D,3)=""
 .....Write !,Rec
 .....Set $P(Rec,D,3)=""
 .....Write Rec
 .....Set ^KLPUTZ(NoSa,KLNr,KHS,KGS,KSS,PRNr,VolgNr)=Rec
 Quit