CEURUTZ ;OPBOUWEN UITZONDERINGEN VOOR PRIJSVERSCHILLEN ;[ 06/26/2001  9:31 AM ]
 ;
T1 ;Dit programma gaat voor alle klanten,
T2 ;voor het volledige produktenassortiment dat zij afnemen,
T3 ;de huidige prijzen berekenen en deze vergelijken met de prijs
T4 ;welke werd opgeslagen.
T5 ; 
T6 ;Indien verschillend, dan wordt er een uitzondering op produktniveau
T7 ;opgezet zodat de huidige prijs gelijk is aan de gestokeerde prijs.
T20 ;- = hernemen   g = go
T21 ;Klanten verwerkt :
T25 ;De opbouw van het bestand ^KPHPR is nog niet afgewerkt;[] = ok
T26 ;Bestand laatst opgemaakt op : 
 ;
 Write @F11,@F1
 Set FP=202
 Write @F,@F4,$P($T(+1),";",2),@F5
 If '$D(^KPHPR(0)) Do
 .Set FP=2303
 .Write @F,@F1,$P($T(T25),U,2),!?2,$P($T(T25),U,3)
 .Do IK^PROC1
 Else  Do
 .Set R=$$GO
 .Quit:R="-"
 .Set FP=2403
 .Write @F,@F1,$P($T(T21),U,2)
 .Kill ^KLPUTZ("T"),^KLPUTZ("IT")
 .Merge ^KLPUTZ("T")=^KLPUTZ("N"),^KLPUTZ("IT")=^KLPUTZ("IN")
 .Set (T,t,KlantId)=0
 .For  Set KlantId=$O(^KKL(KlantId)) Quit:KlantId=""  Do
 ..Set R=^KKL(KlantId,0),KLNr=$P(R,D),KlNaam=$P(R,D,2),T=T+1
 ..If '(T#10) Set FP=2422 Write @F,@F1,T,"   (",KLNr," ",KlNaam,")"
 ..Set PRNr=0
 ..For  Set PRNr=$O(^KSTKL(KLNr,PRNr)) Quit:PRNr=""  Do
 ...Quit:'$D(^KPR(PRNr))
 ...Set R=$$KLANTPR^KPRIJS(KLNr,PRNr)
 ...Quit:'$D(^KPHPR(KLNr,PRNr))
 ...Set K=^KPHPR(KLNr,PRNr)
 ...Quit:+$P(R,D)=+$P(K,D,3)
 ...Set X=$O(^KPR(PRNr,"I")) Set:$E(X)="I" X=^KPR(PRNr,X)
 ...Set HoofdGr=$P(X,D),Groep=$P(X,D,2),SubGroep=$P(X,D,3)
 ...Set %Kort=1-($P(K,D,3)/$P(R,D,4))*100
 ...Set ^KLPUTZ("N",KLNr,HoofdGr,Groep,SubGroep,PRNr,0)=%Kort_"\0\\"_PRNr_"\\\"
 ...Set ^KLPUTZ("IN",HoofdGr,Groep,SubGroep,PRNr,KLNr)=""
 Quit
 ;
GO() 
 New I,K,R
 For I=1:1 Set K=$P($T(@("T"_I)),U,2) Quit:K=""
 Set FP=23-I-1*100+3
 Write @F,$P($T(T26),U,2),^KPHPR(0)
 Set FP=23-I*100+1
 Write @F
 For I=1:1 Set K=$P($T(@("T"_I)),U,2) Quit:K=""  Write !?2,K
 Write !!?2,$P($T(T20),U,2)
 For  D IK^PROC1 Quit:R="-"  Quit:R="G"
 Quit R
 ;