RPLSCHAD ;Raadplegen Schaduw Prijsvergelijk [ 06/21/2002  3:37 PM ]
 
DISP(KLNr,Input) 
 New I1
 Set Input=$G(Input,"&")
 Goto:VTB=U4&($G(RPLSCHAD)=KLNr) COMMAND
 Set Setting=$G(RPLSCHAD)    
 If +$G(^RPLSCHAD)+14>+$H Set Setting=$P(^RPLSCHAD,D,2,99)
 If Input="&"!(Input="!"&($O(^RPLSCHAD(""))'="")) Do
 .Set VTB=U4
 .Do INIT
 .Set Tijd=$P($H,",",2)
 .Do KIF^RPLKL,SA1^RPLKL1
 .Set:Input?1(1"&",1"!") DisplayOld=(Input="!")
 .If Input="&" Do FETCH(KLNr,0) Set RplOldSchad="" Kill RPLOLDSCHAD
 .If Input="!" Do FETCH(KLNr,1) Set RPLOLDSCHAD=1,RplOldSchad="O"
 .Do INIT
 .Do SA^RPLKL1
 .Do COMMAND 
 .Set $P(Setting,D)=KLNr
 .Set RPLSCHAD=Setting
 .Set ^RPLSCHAD=+$H_D_RPLSCHAD
 Else  Set R=""
 Quit
 
COMMAND
 For  Do  Quit:Input'=""
 .Do REFRESH
 .Set Input=$$SCROLL^vhLIST(.RPLSCHAD)
 .;If Input="COM" Do MENU^RPLKL4
 .If Input="SPEC" Do SPEC
 .If Input="LW",RPLSCHAD("SELECT") Do:'$G(RPLOLDSCHAD) LQTY Set Input=""
 .If Input="LV",RPLSCHAD("SELECT") Do:'$G(RPLOLDSCHAD) LAKTIEF Set Input=""
 .If Input="LN" Do:'$G(RPLOLDSCHAD) LNIEUW Set Input=""
 .If (Input="G")||(Input="+") Do ToggleMaatwerkCumul() Set Input=""
 .If Input="OPK" Do:'$G(RPLOLDSCHAD) OPKUIS Set Input=""
 .If Input="X" Do:'$G(RPLOLDSCHAD) SETTING Set Input=""
 .If Input="U" Do:'$G(RPLOLDSCHAD) KLPUTZ("S") Set Input=""
 .If Input="&"!(Input="!"),Input'=U4 Do  Set Input=""
 ..If Input="!",$O(^RPLSCHAD(""))="" Quit
 ..Do SA1^RPLKL1
 ..Kill ^HULP($J,"K"_KLNr,"SPV"),^HULP($J,"K"_KLNr,"SPVC"),^HULP($J,"K"_KLNr,"SPVS")
 ..Set:Input?1(1"&",1"!") DisplayOld=(Input="!")
 ..If Input="&" Do FETCH(KLNr,1) Set RplOldSchad="" Kill RPLOLDSCHAD
 ..If Input="!" Do FETCH(KLNr,1) Set RPLOLDSCHAD=1,RplOldSchad="O"
 ..Do INIT,ADD^vhScherm(5,sScr("ROW"))
 ..Set (VTB,U4)=Input
 ..Do SA^RPLKL1
 .If Input="&"!(Input="!"),$$ASK^vhWACHTW("VPMINAP") Do  Set Input=""
 ..New rplschad
 ..Merge rplschad=RPLSCHAD
 ..Set (SCHMARGE,SchMarge)='$G(SCHMARGE),SchMarge=$S(SchMarge:"M",1:"")
 ..Do INIT,ADD^vhScherm(5,sScr("ROW"))
 ..Set RPLSCHAD("OFFSET")=rplschad("OFFSET"),RPLSCHAD("SELECT")=rplschad("SELECT")
 .If Input="PRINT" Do
 ..If $D(VTB),$D(U4),VTB=U4 Quit
 ..Do PRINT
 ..Set Input=""
 Set R=Input
 Quit
 
INIT 
 If '$L(Setting) Do
 .Set $P(Setting,D,2,99)=$$CALCDATE^vhLib.DataTypes($H,"M",-12)
 .Set $P(Setting,D,3,99)=$$CALCDATE^vhLib.DataTypes($H,"M",-1)
 Do INIT^vhLIST("RPLSCHAD","LIJST"_$G(SchMarge)_$G(RplOldSchad),.RPLSCHAD)
 Set RPLSCHAD(5)=132,DL(1)="RPLSCHAD"
 Set MaatwerkCumul=1
 Quit
 
 ;^RPLSCHAD("K"_KLNr,"SPVC",PRNr,"OP")=6.60\EUR\H\6.60\0\\G\K\1\H1\100\1\.0317\.066\.066
 ;^RPLSCHAD("K"_KLNr,"SPVC",PRNr,"P")=34547\0.328.490.3\ 70.1503   ABD  V1000  NI\1\01CH04ACC03AKA/BL 701 503 0ABDV1000NI 
 ;^RPLSCHAD("K"_KLNr,"SPVC",PRNr,"S")=19000\19000\19000\
 ;^RPLSCHAD("K"_KLNr,"SPVS",SortKey)=PRNr
FETCH(KLNr,KillC) 
 New Tot,Cnt,Rec,Cnt,SortKey,PRNr,Rec
 Set Input=$G(Input,"&"),Set=""
 Set:$P(Setting,D,2) $P(Set,D)=$$EXTDATE^vhLib.DataTypes($P(Setting,D,2),"DM4")_" "
 Set:$P(Setting,D,3) $P(Set,D,2)=$$EXTDATE^vhLib.DataTypes($P(Setting,D,3),"DM4")_" "
 Set $P(Set,D,4,10)=$P(Setting,D,4,10)
 Set:$P(Setting,D,5) $P(Set,D,5)=$$GETSORT^KLASS($P(Setting,D,5))
 Set:$P(Setting,D,7) $P(Set,D,7)=$$GETSORT^KLASS($P(Setting,D,7))
 ; Opbouw cache
 Kill:KillC ^HULP($J,"K"_KLNr,"SPVC"),^HULP($J,"K"_KLNr,"SPVS")
 If '$D(^HULP($J,"K"_KLNr,"SPVC")) Do
 .If 'DisplayOld Do
 ..Set PRNr=0
 ..For  Set PRNr=$O(^KSTKL(KLNr,PRNr)) Quit:PRNr=""  Do CACHEONE(KLNr,PRNr)
 .If DisplayOld Do
 ..Merge ^HULP($J,"K"_KLNr,"SPVC")=^RPLSCHAD("K"_KLNr,"SPVC")
 ..Merge ^HULP($J,"K"_KLNr,"SPVS")=^RPLSCHAD("K"_KLNr,"SPVS")
 Do MERGE(KLNr)
 Quit
 
MERGE(KLNr)
 ; Berekenen van de vgl huidig <-> nieuw
 Kill ^HULP($J,"K"_KLNr,"SPV")
 Set Cnt=0
 Set SortKey=""
 Kill Tot,TotGen
 For  Set SortKey=$O(^HULP($J,"K"_KLNr,"SPVS",SortKey)) Quit:SortKey=""  Do
 . Set Rec=^HULP($J,"K"_KLNr,"SPVS",SortKey),PRNr=$P(Rec,D)
 . If '$D(^KPR(PRNr)) Kill ^HULP($J,"K"_KLNr,"SPVC",PRNr) Quit
 . Set Rec=$$CALCONE(KLNr,Rec)
 . Quit:Rec=""
 . Set GenTyp=$P($$GENTYP^HAD(PRNr),"\",1,2)
 . If "-"[GenTyp||'$G(MaatwerkCumul) Do ; std product -> individueel opnemen in lijst
 . . Set ^HULP($J,"K"_KLNr,"SPV",$I(Cnt))=Rec
 . Else  Do ; afgeleid product -> cumuleren
 . . For I=9,10,14,15,24,25 Set TotGen(GenTyp,I)=$G(TotGen(GenTyp,I))+$P(Rec,D,I) ; LSTORE
 . For I=14,15,24,25 Set Tot(I)=$G(Tot(I))+$P(Rec,D,I) ; LSTORE
 ; Toevoegen cummul van afgeleide producten
 Set GenTyp=""
 For  Set GenTyp=$O(TotGen(GenTyp)) Quit:GenTyp=""  Do
 . Set Rec=D_D_"Groep : "_$P(GenTyp,"\")_$S($P(GenTyp,"\",2)="":"",1:"-"_$P(GenTyp,"\",2))
 . For I=9,10,14,15,24,25 Set $P(Rec,D,I)=$G(TotGen(GenTyp,I)) ; LSTORE
 . Set $P(Rec,D,11)=" ",$P(Rec,D,21)=" "
 . Set ^HULP($J,"K"_KLNr,"SPV",$I(Cnt))=Rec
 ; Totaal
 For I=14,15,24,25 Set $P(Tot,D,I)=$G(Tot(I)) ; LSTORE
 Set $P(Tot,D,11)=" ",$P(Tot,D,21)=" "
 Set ^HULP($J,"K"_KLNr,"SPV")=Tot
 
 Do ADD^vhScherm(5,sScr("ROW"))
 Quit
 
LSTORE(Old,New) 
 New I,Tot
 Set Tot=^HULP($J,"K"_KLNr,"SPV")
 For I=14,15,24,25 Set $P(Tot,D,I)=$P(Tot,D,I)-$P(Old,D,I)+$P(New,D,I)
 Set ^HULP($J,"K"_KLNr,"SPV")=Tot
 Quit
 
CACHEONE(KLNr,PRNr) 
 New Build
 Quit:'$D(^KPR(PRNr)) ; Bestaat niet
 Quit:$P(^KPR(PRNr,1),D,25)=1 ; Non Aktief (beperkt actief wel tonen)
 Quit:($P(^KPR(PRNr,0),D,3)'="")&&($P(^KPR(PRNr,0),D,3)'?4.7N) ; Generisch. Moederproduct
 Quit:##class(BL.Flow.Proxy.pxPrijsLijst).CheckProd2009(KLNr,PRNr)=-1
 
 Set Build=$$CACHEBLD(KLNr,PRNr)
 Do:'Build CACHEREM(KLNr,PRNr)
 Quit
 
CACHEREM(KLNr,PRNr) 
 New SortKey
 Quit:'$D(^HULP($J,"K"_KLNr,"SPVC",PRNr))
 Set SortKey=$P(^HULP($J,"K"_KLNr,"SPVC",PRNr,"P"),D,5)
 Kill ^HULP($J,"K"_KLNr,"SPVS",SortKey)
 Kill ^HULP($J,"K"_KLNr,"SPVC",PRNr)
 Quit
 
 ; Setting = KLNr\Begin $H\End $H\Niveau VanKlas\VanKlas\Nivea TotKlas\TotKlas\Lever\Kode Prijsl inbegrepen (1)
CACHEBLD(KLNr,PRNr) 
 New SRec,PRec,OQty,FQgt,NQty,SortKey
 Set SRec=$G(^KSTKL(KLNr,PRNr,0)) Quit:SRec="" 0
 Quit:$P(SRec,D,8)&'$P(Set,D,9) 0  ; Verwijderd uit prijsvgl.
 Do FETCHPR^UTILI(PRNr,"PRec")
 Quit:$P(PRec(1),D,25)=1 0 ; Non Aktief (beperkt actief wel tonen)
 If $P(Set,D,8),$P(PRec("J"),D)'=$P(Set,D,8) Quit 0  ; Leverancier
 If $P(Set,D,5),$P(PRec("I"),D,$P(Set,D,4))'=$P(Set,D,5),$P(PRec("I"),D,$P(Set,D,4))']$P(Set,D,5) Quit 0 ; Van Klassificatie
 If $P(Set,D,7) I $E($P(PRec("I"),D,$P(Set,D,6)),1,$L($P(Set,D,7))-1)]$P(Set,D,7) Quit 0 ; Tot Klassificatie
 Set OQty=$P(SRec,D,9)
 Set FQty=$$KLANT^STAT(KLNr,PRNr,$P(Set,D,1),$P(Set,D,2),1)
 Set:OQty="" OQty=FQty
 Quit:OQty="" 0 ; Zonder aantal niet opnemen  
 Set NQty=OQty
 Set SortKey=$$SORTKEY^PRODUKT(PRNr)
 Set ^HULP($J,"K"_KLNr,"SPVC",PRNr,"P")=PRNr_D_$P(PRec(2),D,25)_D_$P(PRec(0),D)_D_$P(PRec(1),D,20)_D_SortKey
 Set ^HULP($J,"K"_KLNr,"SPVC",PRNr,"S")=FQty_D_OQty_D_NQty_D_$P(SRec,D,8)
 Set ^HULP($J,"K"_KLNr,"SPVC",PRNr,"OP")=$$KLANTPR^KPRIJS(KLNr,PRNr)
 Set ^HULP($J,"K"_KLNr,"SPVS",SortKey)=PRNr
 If $G(FetchAndStoreOld) Do
 . Set ^HULP($J,"K"_KLNr,"SPVC",PRNr,"OPS")=$$KLANTPR^KPRIJS(KLNr,PRNr,"S")
 Quit 1
 
CALCONE(KLNr,PRNr) 
 New Rec,FQty,OQty,NQty,OVKP,NVKP,OAKP,NAKP,OOmz,NOmz,OMarg,NMarg,KodPl
 Merge Rec=^HULP($J,"K"_KLNr,"SPVC",PRNr)
 Quit:'$D(Rec) ""
 Set KodPl=$P($G(^KSTKL(KLNr,PRNr,0)),D,8)
 Set OQty=$P(Rec("S"),D,2)
 Set NQty=$P(Rec("S"),D,3)
 ; Old
 If "N"[KodPl Do
 . Set OPrijs=Rec("OP")
 . Set OVKP=$P(OPrijs,D,14) ;/$S($P(OPrijs,D,3)="H":100,1:1)*$P(OPrijs,D,9)
 . Set OAKP=$P(OPrijs,D,13)
 . Set OOmz=OVKP*OQty
 . Set OMarg=OVKP-OAKP*OQty
 Else  Do
 . Set (OPrijs,OVKP,OAKP,OOmz,OMarg)=""
 ; New
 If "S"[KodPl Do
 . New NoSa
 . Set NoSa=$S(DisplayOld:"N",1:"S")
 . If NoSa="S",$$IsActief^KLPUTZ2("S")="B",'$$IsActief^KLPUTZ2("S",QU(1)) Set NoSa="N" ; De schaduw is beperkt actief
 . Set NPrijs=$$KLANTPR^KPRIJS(KLNr,PRNr,NoSa)
 . Set NVKP=$P(NPrijs,D,14) ;/$S($P(NPrijs,D,3)="H":100,1:1)*$P(NPrijs,D,9)
 . Set NAKP=$P(NPrijs,D,13)
 . Set NOmz=NVKP*NQty
 . Set NMarg=NVKP-NAKP*NQty
 Else  Do
 . Set (NPrijs,NVKP,NAKP,NOmz,NMarg)=""
 If $P(Rec("S"),D,4) Set (NQty,OQty)="N/O",(OPrijs,NPrijs)=" \\\",(NOmz,OOmz,OMarg,NMarg)=""
 ; Return record
 Set Rec=$P(Rec("P"),D,1,4)
 Set $P(Rec,D,9)=$P(Rec("S"),D)
 Set $P(Rec,D,10)=OQty_D_$P(OPrijs,D,1,3)_D_OOmz_D_OMarg
 Set $P(Rec,D,20)=NQty_D_$P(NPrijs,D,1,3)_D_NOmz_D_NMarg
 Quit Rec
 
PERC(Rec) 
 New Perc,I
 Set Perc=""
 For I=1,2 Set:$P(Rec,D,13+I) $P(Perc,D,I)=$P(Rec,D,23+I)/$P(Rec,D,13+I)-1
 Quit Perc
 
REFRESH Quit:sRT>sRB
 New FL
 Kill RPLSCHAD("MAX")
 Do WRITE^vhLIST(.RPLSCHAD)
 Do RESET^vhScherm
 Quit
 
SPEC ;Special menu
 Do CALLSPEC^vhMenu(+RPLSCHAD("SET")+RPLSCHAD("SELECT")-RPLSCHAD("OFFSET")_";"_50,"RPLSCHADED")
 Set:Input="SPEC" Input=""
 Quit
 
LNIEUW ; Bijvoegen produkt
 New Rec,PRNr          
 Do STORE^vhTERMINA()
 Set PRNr=$$SELECT^PRODUKT6()
 Do REFRESH^vhTERMINA()
 Quit:'PRNr
 If $P($G(^KSTKL(KLNr,PRNr,0)),D,8) Do  ;Terug aktiveren
 .Do AKTIEF(KLNr,PRNr)
 Else  Do  ; Indien nog niet bestaande
 .Do QTY(KLNr,PRNr)
 .Quit:'$D(^KSTKL(KLNr,PRNr,0))
 .Set $P(^KSTKL(KLNr,PRNr,0),D,7)=1 ; Niet opnemen in VERKOOPANALYSE
 .Set:'$D(^KSTKL(KLNr,PRNr,$$EXTDATE^vhLib.DataTypes($H,"DM4")_" ")) ^KSTKL(KLNr,PRNr,$$EXTDATE^vhLib.DataTypes($H,"DM4")_" ")=""
 Quit:'$D(^KSTKL(KLNr,PRNr,0))
 Do INIT,FETCH(KLNr,1)
 Quit
 
LQTY ; Wijzigen fiktief aantal en update scherm
 New Rec,NRec,PRNr
 Set Rec=$G(^HULP($J,"K"_KLNr,"SPV",RPLSCHAD("SELECT")))
 Set PRNr=$P(Rec,D,1) Quit:'PRNr
 Do QTY(KLNr,PRNr)
 Do CACHEONE(KLNr,PRNr)
 Set NRec=$$CALCONE(KLNr,+Rec)
 Set ^HULP($J,"K"_KLNr,"SPV",RPLSCHAD("SELECT"))=NRec
 Do LSTORE(Rec,NRec),REFRESH^vhLIST(.RPLSCHAD,"H",2)
 If NRec="" Do
 .Do DELETE^vhLISTE(.RPLSCHAD)
 Else  Do
 .Do LINE^vhLIST(.RPLSCHAD,RPLSCHAD("SELECT"))
 Set Input=""
 Quit
 
QTY(KLNr,PRNr) ; Wijzigen van het fiktief aantal
 New R,FiktAant
 Do STORE^vhTERMINA()
 Set FP=2201 Write @F,@F1
 Set FiktAant=$P($G(^KSTKL(KLNr,PRNr,0)),D,9)
 Set FiktAant=$$ASKL^vhINP("RPLKL","VKAPLFIKT")
 If FiktAant?.N Do
 .Set R=$G(^KSTKL(KLNr,PRNr,0))
 .If '$L($P(R,D,1)),'FiktAant Quit:'$D(^KSTKL(KLNr,PRNr,0)) 
 .Set $P(R,D,9)=FiktAant,^KSTKL(KLNr,PRNr,0)=R
 .If '$L($P(R,D,1)),'FiktAant Do AKTIEF(KLNr,PRNr)
 Do REFRESH^vhTERMINA()
 Quit
 
LAKTIEF ; Alleen op NON-aktief zetten en update lijst
 New Rec,NRec,PRNr,Old
 Set Rec=$G(^HULP($J,"K"_KLNr,"SPV",RPLSCHAD("SELECT")))
 Set PRNr=$P(Rec,D,1) Quit:'PRNr
 Set Old=$G(^KSTKL(KLNr,PRNr,0))
 Do AKTIEF(KLNr,PRNr)
 Quit:Old=$G(^KSTKL(KLNr,PRNr,0))  ; Niet veranderd
 Do CACHEONE(KLNr,PRNr)
 Set NRec=$$CALCONE(KLNr,PRNr)
 Set ^HULP($J,"K"_KLNr,"SPV",RPLSCHAD("SELECT"))=NRec
 Do LSTORE(Rec,NRec),REFRESH^vhLIST(.RPLSCHAD,"H",2)
 If NRec="" Do
 .Do DELETE^vhLISTE(.RPLSCHAD)
 Else  Do
 .Do LINE^vhLIST(.RPLSCHAD,RPLSCHAD("SELECT"))
 Quit
 
AKTIEF(KLNr,PRNr) ; Opnemen of niet opnemen van een produkt in de prijsvergelijk
 New R,KodPl,X
 Quit:'$D(^KSTKL(KLNr,PRNr,0))
 Set R=^KSTKL(KLNr,PRNr,0),KodPl=$P(R,D,8)
 ;If '$L($P(R,D,1)) Do  Quit
 .Set X=$$^vhTXTPOP("RPLSCHAD","VERWIJDER")
 .Kill:X ^KSTKL(KLNr,PRNr) ; Fiktief produkt
 Set X=$$^vhTXTPOP("RPLSCHAD","AKTIEF",,$S(KodPl:"NIET OPNEMEN",KodPl="N":"ALLEEN HUIDIG",KodPl="S":"ALLEEN SCHADUW",1:"OPNEMEN"),$P($G(^KPR(PRNr,0),"*** onbekend ***"),D))
 Quit:X="" ; Annuleer
 Set $P(R,D,8)=$S(X="O":"",X="N":1,X="H":"N",1:X) ; Translatie ingave naar storage
 Set ^KSTKL(KLNr,PRNr,0)=R
 Quit
 
ISAKTIEF(KLNr,PRNr) ; Aktief of niet aktief van een produkt in de prijsvergelijk
 New R,KodPl
 If $D(^KSTKL(KLNr,PRNr,0)) Set R=^KSTKL(KLNr,PRNr,0) If $L($P(R,D,1)) Set KodPl='$P(R,D,8)
 Quit $G(KodPl)
 
PRIJSL() ; Opgeroepen van uit ^vhINP
 N R,KFA
 S R=$G(^KSTKL(KLNr,PRNr,0)),KFA=$P(R,D,9)
 I KFA S FP=2301 W @F,"Huidig = ",KFA
 Q ""
 
KLPUTZ(NoSa) 
 New Locals
 Set Locals("KC")=KC,Locals("NoSa")=$G(NoSa,"S"),Locals("LdSwitch")="O"
 Do NCOL^RPLKL(80)
 Do DO^vhPROGRAM("VERWERK^KLPUTZ(KC,NoSa)","","",0)
 Do KIF^RPLKL,SA1^RPLKL1
 Do FETCH(KLNr,0)
 Do SA^RPLKL1
 Quit
 
OPKUIS Do KLANT^KBSBORS(KLNr)
 Do SA1^RPLKL1
 Do FETCH(KLNr,1)
 Do SA^RPLKL1
 Quit
 
ToggleMaatwerkCumul()
	Set MaatwerkCumul='$G(MaatwerkCumul)
	Do SA1^RPLKL1
	Do MERGE(KLNr)
	Do SA^RPLKL1
	Quit
	
SETTING Do EDIT^vhScherm("RPLSCHADS","","","","","",3)
 Quit:'%SC
 Do SA1^RPLKL1
 Do INIT,FETCH(KLNr,1)
 Do SA^RPLKL1
 Quit
 
PRINT New PrintSet
 Set PrintSet("VAN")=$P(Setting,D,2)
 Set PrintSet("TOT")=$P(Setting,D,3)
 Set PrintSet("KLASVAN")=$P(Setting,D,5)
 Set PrintSet("KLASTOT")=$P(Setting,D,7)
 Set PrintSet("KLASNIV")=$P(Setting,D,6)
 Set PrintSet("LEVER")=$P(Setting,D,8)
 Set PrintSet("VERSCHIL")=""
 Set PrintSet("MARGE")=0 ; Marge mag niet afgedrukt worden op de lijst (PV 29.06.2004)
 Do ONE^KPLKPUTZ(KLNr,.PrintSet)
 Quit
 
SAVEOLD
	Write @F11,@F1,@FMTI," Vasthouden huidigprijsvergelijk : ",QN,@FMTi
	Write !!!,"In Raadplegen klanten kan het oude prijsvergelijk bekeken worden. "
	Write !,"Dit programma berekent het huidig prijsvergelijk"
	Write !,"en slaat het op voor latere raadpleging"
	Write !!!,"Doorgaan met verwijderen van de oude data en met de nieuwe prijsvlg te vullen"
	Write !,"J[]=berekenen " Read K
	Quit:$E($ZCVT(K,"U"))'="J"
 	Do FetchEnStoreOld
 	Quit
 	
 ; Vóórdat er nieuwe prijzen (schaduw -> normaal) worden gecopieerd, moet de oude prijsvergelijk vastgehouden worden zodanig dat die via "!" kan worden opgereoepn in RPLKL
FetchEnStoreOld
 New R,Setting,KlKey,KLNr,FetchAndStoreOld
 Set KlKey=0,Setting=^RPLSCHAD
 Kill ^HULP($J),^RPLSCHAD
 Set ^RPLSCHAD=Setting
 Set Setting=$P(Setting,D,2,99)
 ;Set EindDatum=$$CALCDATE^vhLib.DataTypes($H,"M",-1)
 ;Set BeginDatum=$$CALCDATE^vhLib.DataTypes(EindDatum,"M",-11)
 ;Set Setting=D_BeginDatum_D_EindDatum
 Set DisplayOld=0
 Set FetchAndStoreOld=1
 Set KlKey=0
 For  Set KlKey=$O(^KKL(KlKey)) Quit:KlKey=""  Do
 . Write !,KlKey
 . Set R=^KKL(KlKey,0),KLNr=$P(R,D)
 . Write ?40,KLNr
 . Do FETCH(KLNr,0)
 Write !!,"Merge ^RPLSCHAD=^HULP($J)",!
 Hang 2
 Merge ^RPLSCHAD=^HULP($J)
 Kill ^HULP($J)
 Quit
 
CONTROLEOVERDRACHT
	Write @F11,@F1,@FMTI," Controle van de prijsoverdracht : ",QN,@FMTi
	Write !!!,"De opgeslagen schaduwprijzen controleren met de huidige prijzen (na overdracht). "
	Write !,"J[]=vergelijken " Read K
	Quit:$E($ZCVT(K,"U"))'="J"
 	Do CompareAlleKlanten
 	Quit
 
CompareAlleKlanten
 ; Uit te voeren nadat er nieuwe prijzen (schaduw -> normaal) worden gecopieerd
 Set KlKey=0
 Set (CumulCnt,KlantCnt)=0
 Set KlKey=0
 Set Dev=$$OPEN^vhDEV(,"Controle prijsoverdracht.txt","W","T")
 Use Dev
 Write "KLNr	PRNr	KortTekst	HuidigeVKP	OudeSchaduwVKP	HuidigeCifPPL	OudeSchaduwCifPPL",!
 For  Set KlKey=$O(^KKL(KlKey)) Quit:KlKey=""  Do
 . Set R=^KKL(KlKey,0),KLNr=$P(R,D)
 . Set Cnt=$$CompareKlant(Dev,KLNr)
 . Set CumulCnt=CumulCnt+Cnt
 . Set KlantCnt=KlantCnt+1
 Do CLOSE^vhDEV(Dev)
 If CumulCnt Do
 . Write !!,"Er zijn ",CumulCnt," verschillen gevonden"
 . Write !,"bij ",KlantCnt," klanten"
 . Write !!,"Gelieve het export bestand te controleren"
 Else  Do
 . Write !!,"Prima, er zijn geen verschillen gevonden !"
 Write !!,"Druk [enter] om verder te gaan"
 r k
 Quit
 
CompareKlant(Dev,KLNr)
	Set PRNr=""
	Set Cnt=0
	For  Set PRNr=$O(^RPLSCHAD("K"_KLNr,"SPVC",PRNr)) Quit:PRNr=""  Do
	 . Set PrijsN=$$KLANTPR^KPRIJS(KLNr,PRNr,"N")
	 . Set PrijsS=$G(^RPLSCHAD("K"_KLNr,"SPVC",PRNr,"OPS"))
	 . Quit:+$J($P(PrijsN,D,14),0,4)=+$J($P(PrijsS,D,14),0,4)
	 . Set Cnt=Cnt+1
	 . Use Dev
	 . Write KLNr,*9,PRNr,*9,$P(^KPR(PRNr,0),D,1),*9,$P(PrijsN,D,14),*9,$P(PrijsS,D,14),*9,$P(PrijsN,D,13),*9,$P(PrijsS,D,13),!
	Quit Cnt