PRIJSCTR ;Controleren of dat voor bep. klanten bep. produkten onder de aankoopprijs verkocht worden. [ 11/07/2001  3:38 PM ]
 If '$D(Q) Set Q="K" Do ^cA604,INIT^vhTERMINA
 Write @F11,@F1,@FMTI," Prijs controle - "_QN," ",@FMTi
 Write !!,"Dit programma gaat de verkoopprijzen vgl. tov de aankoopprijs"
 Write !,"De aankoopprijs kan vermeerderd worden met een in te geven percentage"
 Set Y="20\Produkt selectie :"
SEL1 Do ^KPSELQ
 Quit:K="-"
SEL2 Set LevNr=$$ASKL^vhINP("PRIJSCTR","LEVER")
 Quit:LevNr="."  Goto SEL1:LevNr="-"
 Set:$L(LevNr) LevNr=$$SELECT^LEVER(1,"","Beperkt tot Leverancier : ",LevNr)
 Quit:LevNr="."  Goto SEL1:LevNr="-"
 Set:'LevNr LevNr=""
 Set FP=1301
 Write @F,@F1,"Leverancier : "_$S(LevNr:LevNr_" "_$P(^KLE(^KL1(LevNr),0),D,2),1:"Geen beperking")
SEL3 Set NoSa=$$ASKL^vhINP("PRIJSCTR","NOSA")
 Quit:NoSa="."  Goto SEL2:NoSa="-"
 Set:NoSa="" NoSa="N"
 Set FP=1501 Write @F,@F1,"Prijzen : "_$S(NoSa="N":"Normaal",1:"Schaduw")
 If NoSa="S" Do
 .New Txt
 .Set Txt(1)="U bent er zeker van dat ook de SCHADUW PRIJSUITZONDERINGEN"
 .Set Txt(2)="volledig zijn ingevuld !"
 .Set Txt=$$WILD^vhTXTPOP("","","Txt")
 Set Perc=$$ASKL^vhINP("PRIJSCTR","PERCENT")
 Quit:Perc="."  Goto SEL3:Perc="-"
 Set Perc=$TR(Perc,",",".")
 Set FP=1701 Write @F,@F1,"Min. Marge : "_Perc_"%"
 Set Perc=1/(1-(Perc/100))
 ; Loop
 Set %J=$$%J^vhRtn1()
 Kill ^HULP(%J)
 Set KLNr=""
 Set (KLCnt,KLChk)=0
 Set FP=2401 Write @F,@F1,"Klanten verwerkt : "
 For  Set KLNr=$O(^KKAAP(KLNr)) Quit:KLNr=""  Do
 .Do KLANT(KLNr)
 .Set:Mod KLChk=KLChk+1
 .Set KLCnt=KLCnt+1
 .If KLCnt#10=0 Set FP=2420 Write @F,KLChk,"/",KLCnt
 If '$D(^HULP(%J)) Do  Quit
 .New Txt
 .Set Txt(1)="Geen verkoopprijzen gevonden die lager liggen dan de aankoopprijs"
 .Set Txt=$$WILD^vhTXTPOP("","","Txt")
 ;Afdrukken HULP bestand
 
 Do INIT^PROC("PRIJSCTR")
 Do PRINT^OUTPUT(.PRIJSCTR,"SP")
 Quit
 
KLANT(KLNr) 
 Set Mod=0
 Set (KHS,KGS,KSS,KT)="",Cnt=0
 For  Set KHS=$O(^KKAAP(KLNr,KHS)) Quit:KHS=""  Do
 .Quit:KHS'=HG&(KHS']HG)  Quit:KHS'=HGX&(KHS]HGX)
 .For  Set KGS=$O(^KKAAP(KLNr,KHS,KGS)) Quit:KGS=""  Do
 ..Quit:KGS'=GR&(KGS']GR)  Quit:KGS'=GRX&(KGS]GRX)
 ..For  Set KSS=$O(^KKAAP(KLNr,KHS,KGS,KSS)) Quit:KSS=""  Do
 ...Quit:KSS'=SG&(KSS']SG)  Quit:KSS'=SGX&(KSS]SGX)
 ...For  Set KT=$O(^KKAAP(KLNr,KHS,KGS,KSS,KT)) Quit:KT=""  Do
 ....Set PRNr=$P(^(KT),D,15)
 ....If $G(LevNr) Quit:'$D(^KPR(PRNr,"J"_LevNr))
 ....Set Prijs=$$KLANTPR^KPRIJS(KLNr,PRNr)
 ....Quit:'$P(Prijs,D,13)  ; Gratis zonder prijs
 ....Quit:$P(Prijs,D,13)*Perc<+$P(Prijs,D,14)
 ....Set Mod=1
 ....Set Marg=99
 ....Set:$P(Prijs,D,14) Marg=1-($P(Prijs,D,13)/$P(Prijs,D,14))*100
 ....Set ^HULP(%J,^KK1(KLNr)_$$SORTKEY^PRODUKT(PRNr))=KLNr_D_PRNr_D_Marg_D_Prijs
 Quit