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
 .If Input="&" Do FETCH(KLNr,0) Set RplOldSchad="" Kill RPLOLDSCHAD
 .If Input="!" Do FETCH(KLNr,1,Input) 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="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")
 ..If Input="&" Do FETCH(KLNr,1) Set RplOldSchad="" Kill RPLOLDSCHAD
 ..If Input="!" Do FETCH(KLNr,1,Input) 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^vhDTyp($H,"M",-12)
 .Set $P(Setting,D,3,99)=$$CALCDATE^vhDTyp($H,"M",-1)
 Do INIT^vhLIST("RPLSCHAD","LIJST"_$G(SchMarge)_$G(RplOldSchad),.RPLSCHAD)
 Set RPLSCHAD(5)=132,DL(1)="RPLSCHAD"
 Quit
 
FETCH(KLNr,KillC,Input) 
 New Tot,Cnt,Rec,Cnt,SortKey,PRNr,Rec
 Set Input=$G(Input,"&"),Set=""
 Set:$P(Setting,D,2) $P(Set,D)=$$EXTDATE^vhDTyp($P(Setting,D,2),"DM4")_" "
 Set:$P(Setting,D,3) $P(Set,D,2)=$$EXTDATE^vhDTyp($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 Input="&" Do
 ..Set PRNr=0
 ..For  Set PRNr=$O(^KSTKL(KLNr,PRNr)) Quit:PRNr=""  Do CACHEONE(KLNr,PRNr)
 .If Input="!" Do
 ..Merge ^HULP($J,"K"_KLNr,"SPVC")=^RPLSCHAD("K"_KLNr,"SPVC")
 ..Merge ^HULP($J,"K"_KLNr,"SPVS")=^RPLSCHAD("K"_KLNr,"SPVS")
 ; Berekenen van de vgl huidig <-> nieuw
 Kill ^HULP($J,"K"_KLNr,"SPV")
 Set Cnt=0
 Set SortKey=""
 Kill Tot
 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 Cnt=Cnt+1
 .Set Rec=$$CALCONE(KLNr,Rec,Input)
 .Quit:Rec=""
 .Set ^HULP($J,"K"_KLNr,"SPV",Cnt)=Rec
 .For I=14,15,24,25 Set Tot(I)=$G(Tot(I))+$P(Rec,D,I) ; LSTORE
 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) ; Non Aktief
 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) 0 ; Non Aktief
 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
 Quit 1
 
CALCONE(KLNr,PRNr,Input) 
 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($G(Input)="!":"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^vhDTyp($H,"DM4")_" ")) ^KSTKL(KLNr,PRNr,$$EXTDATE^vhDTyp($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
 
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
 New R,Setting,KlKey,KLNr
 Set KlKey=0,Setting=^RPLSCHAD
 Kill ^HULP($J),^RPLSCHAD
 Set KlKey=0,^RPLSCHAD=Setting
 Set Setting=$P(Setting,D,2,99)
 Set Setting=D_$$INTDATE^vhDTyp("2007.09","DM")_D_$$INTDATE^vhDTyp("2008.08","DM")
 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