PVPUTZ2 ;Prijsuitzonderingen [ 02/22/2002  8:23 AM ]
 ;
 ; Ophalen in cache
BLDALL(NoSa) 
 Set NoSa=$G(NoSa,"N")
 For  Set KLNr=$O(^KLPUTZ(NoSa,KLNr)) Quit:KLNr=""  Do  
 .Lock +^KLPUTZ("N",KLNr)
 .Do FETCH(KLNr)
 .Do DELOBJ(KLNr)
 .Do SAVE(KLNr)
 .Lock -^KLPUTZ("N",KLNr)
 Quit
FETCH 
 New R,HoofdGr,Groep,SubGroep,PRNr,Next,SortKey
 Kill ^HULP(%J,"KEY")
 Set HoofdGr=""
 For  Set HoofdGr=$O(^KLPUTZ(NoSa,KLNr,HoofdGr)) Quit:HoofdGr=""  Do
 .Set Groep=""
 .For  Set Groep=$O(^KLPUTZ(NoSa,KLNr,HoofdGr,Groep)) Quit:Groep=""  Do
 ..Set SubGroep=""
 ..For  Set SubGroep=$O(^KLPUTZ(NoSa,KLNr,HoofdGr,Groep,SubGroep)) Quit:SubGroep=""  Do
 ...Set PRNr=""
 ...For  Set PRNr=$O(^KLPUTZ(NoSa,KLNr,HoofdGr,Groep,SubGroep,PRNr)) Quit:PRNr=""  Do
 ....If PRNr,'$D(^KPR(PRNr)) Kill ^KLPUTZ(NoSa,KLNr,HoofdGr,Groep,SubGroep,PRNr) Quit
 ....Set Next=""
 ....For  Set Next=$O(^KLPUTZ(NoSa,KLNr,HoofdGr,Groep,SubGroep,PRNr,Next)) Quit:Next=""  Do
 .....Set R=^KLPUTZ(NoSa,KLNr,HoofdGr,Groep,SubGroep,PRNr,Next)
 .....If PRNr Set $P(R,D,4)=PRNr,SortKey=$$SORTKEY^PRODUKT(PRNr)
 .....Else  Set SortKey=HoofdGr If Groep'=0 Set SortKey=Groep If SubGroep'=0 Set SortKey=SubGroep
 .....Set R=SortKey_D_HoofdGr_D_Groep_D_SubGroep_D_PRNr_D_Next_D_R
 .....Set ^HULP(%J,"KEY",SortKey,Next)=R
 Quit
 
DELOBJ(KLNr,NoSa) 
 New KHS,KGS,KSS,PRNr,Next
 Set KHS=""
 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 Next=""
 ....For  Set Next=$O(^KLPUTZ(NoSa,KLNr,KHS,KGS,KSS,PRNr,Next)) Quit:Next=""  Do
 .....Kill ^KLPUTZ(NoSa,KLNr,KHS,KGS,KSS,PRNr,Next)
 .....Kill ^KLPUTZ("I"_NoSa,KHS,KGS,KSS,PRNr,KLNr)
 Do STORE^LOG("KLUTZ",KLNr,"V",NoSa)
 Quit
 
 ;
 ; Wegschrijven van de cache
SAVE(NoSa) 
 Quit:'IsChanged
 Set IsChanged=0
 New HoofdGr,Groep,SubGroep,PRNr,SortKey,Next,Count
 ; Verwijder oude  uit ^KLPUTZ
 Do DELOBJ(KLNr,NoSa,1)
 ; Kopieer Nieuwe in ^KLPUTZ
 Set SortKey=""
 For  Set SortKey=$O(^HULP(%J,"KEY",SortKey)) Quit:SortKey=""  Do
 .Set Next="",Count=-1
 .For  Set Next=$O(^HULP(%J,"KEY",SortKey,Next)) Quit:Next=""  Do
 ..Set R=^HULP(%J,"KEY",SortKey,Next),Count=Count+1
 ..If 'Count,$P(R,D,11)!$P(R,D,12)!$P(R,D,13)!$P(R,D,14) Set Count=Count+1
 ..Set HoofdGr=$P(R,D,2),Groep=$P(R,D,3),SubGroep=$P(R,D,4),PRNr=$P(R,D,5)
 ..Set ^KLPUTZ(NoSa,KLNr,HoofdGr,Groep,SubGroep,PRNr,Count)=$P(R,D,7,99)
 ..Set ^KLPUTZ("I"_NoSa,HoofdGr,Groep,SubGroep,PRNr,KLNr)=""
 ..If 'Count Do
 If $G(Intern) Job ONE^KKAA15(KLNr)
 Do STORE^LOG("KLUTZ",KLNr,"N",NoSa)
 Quit
 ;
 ; Raadplegen produkt
RPLPR 
 New R,PRNr
 Quit:'$D(^HULP(%J,"WL",KLPUTZ(6)))
 Set R=^HULP(%J,"WL",KLPUTZ(6)),PRNr=$P(R,D,5) Quit:'PRNr
 Set Locals("PARAM")=PRNr,Locals("PR")=PRNr
 Do XECUTE^vhPROGRAM("Set K=$$RAADPL^PRODUKT(PR,"""",1)")
 Do ADD^vhScherm(1,24)
 Quit
 ;
 ; Raadplegen klant
RPLKL 
 Quit:$D(Extern)
 Set Locals("PARAM")=KLNr,Locals("KC")=KLNr
 Do XECUTE^vhPROGRAM("Set K=$$RAADPL^KLANT(KC,"""",1)")
 Do ADD^vhScherm(1,24)
 Quit
 ;
 ; Tonen van de marge
MARGE(Check) 
 New R
 Set Kode=$G(Kode)
 If $G(Check) Set:$$ASK^vhWACHTW("MANAGER") Kode='Kode
 Do DISPLAY^vhScherm("KLPUTZ","","","",7)
 Quit
 ;
LOCK(KLNr,NoSa) 
 New %TC,T,IK
 Do ADD^vhLock("^KLPUTZ(NoSa,KLNr)")
 If '%TC Do
 .Set T=$P("U\Schaduw u",D,NoSa="S"+1)_"itzonderingen van klant "_$P(^KKL(^KK1(KLNr),0),D,2)
 .Do LDISP^vhLock("^KLPUTZ(NoSa,KLNr)",T)
 Quit %TC
 ;
 ; Reorganisatie van het niveau
RLEVEL(SortKey,OldNext) 
 New R,RTemp,Next,Count,Old,New,NewNext,Reorg
 Set RTemp=^HULP(%J,"KEY",SortKey,OldNext)
 Set Count=-1,Next=""
 For  Set Next=$O(^HULP(%J,"KEY",SortKey,Next)) Quit:Next=""  Do
 .Set R=^HULP(%J,"KEY",SortKey,Next),Count=Count+1,$P(R,D,6)=Count,Old(Count)=R
 .If '$P(R,D,11),'$P(R,D,12),'$P(R,D,13),'$P(R,D,14) Set New("Z",0,Next)=R
 .Else  Set New("Z",1,Next)=R
 Set Count=-1,Next=""
 For  Set Next=$O(New("Z",0,Next)) Quit:Next=""  Set R=New("Z",0,Next),Count=Count+1,$P(R,D,6)=Count,New(Count)=R
 For  Set Next=$O(New("Z",1,Next)) Quit:Next=""  Set R=New("Z",1,Next),Count=Count+1,$P(R,D,6)=Count,New(Count)=R
 Kill New("Z")
 Set (Reorg,Next)=""
 For  Set Next=$O(New(Next)) Quit:Next=""  Set R=New(Next) If R'=Old(Next) Set Reorg=1
 Set NewNext=OldNext
 If Reorg Do
 .Set Rebuild=1
 .Kill ^HULP(%J,"KEY",SortKey)
 .Set Next=""
 .For  Set Next=$O(New(Next)) Quit:Next=""   Do
 ..Set R=New(Next),^HULP(%J,"KEY",SortKey,Next)=R
 ..If $P(R,D,1,5)=$P(RTemp,D,1,5),$P(R,D,7,99)=$P(RTemp,D,7,99) Set NewNext=Next
 Quit NewNext
 ;
 ; Aktiveren van het bestand
AKTIV(NoSa,Intern) 
 New K
 Set Intern=$G(Intern)
 If 'Intern Write @F11,@F1,@FMTI,"Aktiveren prijsuitzonderingen klanten - ",QN,@FMTi
 If $G(NoSa)="" Set NoSa="N"
 If NoSa'="N",NoSa'="S" Quit
 If 'Intern Set FP=172 Write @F,@FMTB,$P(" Normale \ Schaduw ",D,NoSa="S"+1),@FMTb
 For  Do  Quit:K=""
 .Set K=$$KEYL^vhINP("KLPUTZ","AKTIV")
 .If $L(K) Set ^KLPUTZ("A"_NoSa)=$F("DA",K)-2
 Quit
 ;
SKIPKLAS(R) 
 If '$D(Beperk) Quit 0
 If Beperk="H" Quit '$D(Beperk($P(R,D)))
 If Beperk="G" Quit '$D(Beperk($P(R,D,2)))
 If Beperk="S" Quit '$D(Beperk($P(R,D,3)))
 Quit 0
 ;