KLPUTZ6 ;Overbrengen van alle produkten in de verkoopanalyze naar NoSa met behoud van de huidige prijzen. [ 04/21/95  4:34 PM ]
 Quit
TRANS ; Bulo - Van Vaek &  Moorkens - Lefevere
 
COPY(KLNr,ToKLNr,NoSa) 
 Do DELOBJ^KLPUTZ2(ToKLNr,NoSa)
 Set (KHS,KGS,KSS,PRNr,VolgNr)=0
 For  Set KHS=$O(^KLPUTZ(NoSa,KLNr,KHS)) Quit:KHS=""  Do
 .For  Set KGS=$O(^KLPUTZ(NoSa,KLNr,KHS,KGS)) Quit:KGS=""  Do
 ..For  Set KSS=$O(^KLPUTZ(NoSa,KLNr,KHS,KGS,KSS)) Quit:KSS=""  Do
 ...For  Set PRNr=$O(^KLPUTZ(NoSa,KLNr,KHS,KGS,KSS,PRNr)) Quit:PRNr=""  Do
 ....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)
 .....Set ^KLPUTZ(NoSa,ToKLNr,KHS,KGS,KSS,PRNr,VolgNr)=Rec
 .....Set ^KLPUTZ("I"_NoSa,KHS,KGS,KSS,PRNr,ToKLNr)=""
 Quit
 
 
CONV(KLNr,NoSa) 
 Quit:KLNr=1042
 Quit:KLNr=1327
 Quit:KLNr=3105
 Quit:KLNr=11708
 Quit:KLNr=2852
 New SaNo,KHS,KGS,KSS,KortT,PHS,PGS,PSS,Opmerking,Prijs,Key,OVerkP,NLijstP,MuntPar,NAankP,NKort,Nkort1,NKort2
 Set SaNo=$S(NoSa="S":"N",1:"S")
 Do DELOBJ^KLPUTZ2(KLNr,NoSa)
 Set Kodex=$P(^KKL(^KK1(KLNr),2),D,3)
 Set Kodex=.30*$P(";1;.75;.50;.25;0",";",$F("GBSRL",Kodex))
 Set (KHS,KGS,KSS,KortT)=0
 For  Set KHS=$O(^KKAAP(KLNr,KHS)) Quit:KHS=""  Do
 .For  Set KGS=$O(^KKAAP(KLNr,KHS,KGS)) Quit:KGS=""  Do
 ..For  Set KSS=$O(^KKAAP(KLNr,KHS,KGS,KSS)) Quit:KSS=""  Do
 ...For  Set KortT=$O(^KKAAP(KLNr,KHS,KGS,KSS,KortT)) Quit:KortT=""  Do
 ....Set PRNr=$P(^(KortT),D,15)
 ....Set Key=$O(^KPR(PRNr,"I")) Quit:$E(Key)'="I"
 ....Set Key=^KPR(PRNr,Key)
 ....Set PHS=$P(Key,D,1),PGS=$P(Key,D,2),PSS=$P(Key,D,3)
 ....Set Prijs=$$KLANTPR^KPRIJS(KLNr,PRNr,SaNo)
 ....Set OVerkP=$P(Prijs,D,1) ; Oude verkoop prijs
 ....Set OKort=1-(100-$P(Prijs,D,5)/100*(100-$P(Prijs,D,6)/100))
 ....Set Prijs=$$KLANTPR^KPRIJS(KLNr,PRNr,NoSa)
 ....Set NLijstP=$P(Prijs,D,4) ; Nieuwe lijstprijs
 ....Set NAankP=$P(Prijs,D,13)
 ....Set MuntPar=$P(Prijs,D,9)
 ....b:PRNr=3129
 ....Set Opmerking=""
 ....Set:$P(Prijs,D,8) Opmerking=";KAT"
 ....If $D(^KLPUTZ(SaNo,KLNr,PHS,PGS,PSS,PRNr)) Set Opmerking=";EXIST"
 ....Set NKort1=0,NKort2=""
 ....Set:NLijstP (NKort1,NKort)=+$J(1-(OVerkP/NLijstP),0,10)
 ....If NKort<0 Set NKort1=0,NKort2="",Opmerking=Opmerking_";NEG"
 ....If OVerkP*MuntPar<NAankP Set Opmerking=Opmerking_";AANK"
 ....If NKort-OKort>.0001 Set Opmerking=Opmerking_";MEER"
 ....If OKort-NKort>.0001 Set Opmerking=Opmerking_";MINDER"
 ....Set NKort2=""
 ....If NKort>Kodex Set NKort1=Kodex,NKort2=+$J(1-(1-NKort/(1-NKort1)),0,10)
 ....Set NKort1=NKort1*100
 ....Set:'NKort2 Nkort2=""
 ....Set:NKort2 NKort2=NKort2*100
 ....Set ^KLPUTZ(NoSa,KLNr,PHS,PGS,PSS,PRNr,0)=NKort1_D_NKort2_D_$E(Opmerking,2,999)
 ....Set ^KLPUTZ("I"_NoSa,PHS,PGS,PSS,PRNr,KLNr)=""
 ;
 ; Uitzonderingen op produktnivo ook kopieren
 Set (KHS,KGS,KSS,PRNr,VolgNr)=0
 For  Set KHS=$O(^KLPUTZ(SaNo,KLNr,KHS)) Quit:KHS=""  Do
 .For  Set KGS=$O(^KLPUTZ(SaNo,KLNr,KHS,KGS)) Quit:KGS=""  Do
 ..For  Set KSS=$O(^KLPUTZ(SaNo,KLNr,KHS,KGS,KSS)) Quit:KSS=""  Do
 ...Set PRNr=0
 ...For  Set PRNr=$O(^KLPUTZ(SaNo,KLNr,KHS,KGS,KSS,PRNr)) Quit:PRNr=""  Do
 ....Set VolgNr=0
 ....Quit:$D(^KLPUTZ(NoSa,KLNr,KHS,KGS,KSS,PRNr))
 ....Set Key=$O(^KPR(PRNr,"I")) Quit:$E(Key)'="I"
 ....Set Key=^KPR(PRNr,Key)
 ....Set PHS=$P(Key,D,1),PGS=$P(Key,D,2),PSS=$P(Key,D,3)
 ....Set Prijs=$$KLANTPR^KPRIJS(KLNr,PRNr,SaNo)
 ....Set OVerkP=$P(Prijs,D,1) ; Oude verkoop prijs
 ....Set OKort=1-(100-$P(Prijs,D,5)/100*(100-$P(Prijs,D,6)/100))
 ....Set Prijs=$$KLANTPR^KPRIJS(KLNr,PRNr,NoSa)
 ....Set NLijstP=$P(Prijs,D,4) ; Nieuwe lijstprijs
 ....Set NAankP=$P(Prijs,D,13)
 ....Set MuntPar=$P(Prijs,D,9)
 ....Set Opmerking=";N/V"
 ....Set:$P(Prijs,D,8) Opmerking=Opmerking_";KAT"
 ....If $D(^KLPUTZ(SaNo,KLNr,PHS,PGS,PSS,PRNr)) Set Opmerking=Opmerking_";EXIST"
 ....Set NKort1=0,NKort2=""
 ....Set:NLijstP (NKort1,NKort)=+$J(1-(OVerkP/NLijstP),0,10)
 ....If NKort<0 Set NKort1=0,NKort2="",Opmerking=Opmerking_";NEG"
 ....If OVerkP*MuntPar<NAankP Set Opmerking=Opmerking_";AANK"
 ....If NKort-OKort>.0001 Set Opmerking=Opmerking_";MEER"
 ....If OKort-NKort>.0001 Set Opmerking=Opmerking_";MINDER"
 ....Set NKort2=""
 ....If NKort>Kodex Set NKort1=Kodex,NKort2=+$J(1-(1-NKort/(1-NKort1)),0,10)
 ....Set NKort1=NKort1*100
 ....Set:'NKort2 Nkort2=""
 ....Set:NKort2 NKort2=NKort2*100
 ....Set ^KLPUTZ(NoSa,KLNr,PHS,PGS,PSS,PRNr,0)=NKort1_D_NKort2_D_$E(Opmerking,2,999)
 ....Set ^KLPUTZ("I"_NoSa,PHS,PGS,PSS,PRNr,KLNr)=""
 
 Quit
 
 
ALL Set KLNr=0     
 For  Set KLNr=$O(^KLPUTZ("N",KLNr)) Quit:'KLNr  Do CONV(KLNr,"S")
 Quit
 
        
ALLOMS ; Wissen van alle texten in de schaduw
 D ^cA604
 Set KLNr=0     
 For  Set KLNr=$O(^KLPUTZ("S",KLNr)) Quit:'KLNr  Do CLEAROMS(KLNr,"S")
 Quit
 
CLEAROMS(KLNr,NoSa) ; Wissen van de teksten
 Set (KHS,KGS,KSS,PRNr,VolgNr)=""
 For  Set KHS=$O(^KLPUTZ(NoSa,KLNr,KHS)) Quit:KHS=""  Do
 .For  Set KGS=$O(^KLPUTZ(NoSa,KLNr,KHS,KGS)) Quit:KGS=""  Do
 ..For  Set KSS=$O(^KLPUTZ(NoSa,KLNr,KHS,KGS,KSS)) Quit:KSS=""  Do
 ...For  Set PRNr=$O(^KLPUTZ(NoSa,KLNr,KHS,KGS,KSS,PRNr)) Quit:PRNr=""  Do
 ....For  Set VolgNr=$O(^KLPUTZ(NoSa,KLNr,KHS,KGS,KSS,PRNr,VolgNr)) Quit:VolgNr=""  Do
 .....Set $P(^KLPUTZ(NoSa,KLNr,KHS,KGS,KSS,PRNr,VolgNr),D,3)=""
 Quit