cwSTKLPR ; Correctie verkoopstatistiek december 2002 [ 12/18/2002  4:54 PM ]
 ;
 New
 Do LOW^%HL
 Kill ^kstkl,^kstpr
 Do INIT,VERWERK
 Do HIGH^%HL
 Quit
 ;
INIT 
 Set Q="K"
 Do ^cA604
 Quit
 ;
VERWERK 
 New KLNr,PRNr
 Set KLNr=""
 For  Set KLNr=$O(^KFA1("F",KLNr)) Quit:KLNr=""  Do
 .Set Date=-59138
 .For  Set Date=$O(^KFA1("F",KLNr,Date),-1) Quit:Date=""  Do
 ..Quit:-Date<59139  Quit:-Date>59169
 ..Set FANr=""
 ..For  Set FANr=$O(^KFA1("F",KLNr,Date,FANr)) Quit:FANr=""  Do
 ...Set BONNr="U"
 ...For  Set BONNr=$O(^KFA("F",FANr,BONNr)) Quit:BONNr=""  Do
 ....Set ULNr=100
 ....For  Set ULNr=$O(^KFA("F",FANr,BONNr,ULNr)) Quit:ULNr=""  Do KSTKLPR(KLNr,FANr,BONNr,ULNr)
 .For PRNr=33013,51766,82867 Do:$D(^KSTKL(KLNr,PRNr,"2002.12 ")) ECOPACK(KLNr,PRNr)
 Quit
 ;
KSTKLPR(KLNr,FANr,BONNr,ULNr) 
 New R,PRNr,Aantal,AantKom,StukPr,Netto,LineRnd,SpPrice,Pariteit,FaktDate,Maand
 New Munt,OmzLPr,OmzAPr,OmzVPr
 Set R=^KFA("F",FANr,BONNr,ULNr),PRNr=$P(R,D,2)
 If PRNr,$D(^KPR(PRNr)) Do
 .Set Aantal=$P(R,D,3),Netto=$P(R,D,9),LineRnd=$P(R,D,21)
 .Set OmzLPr=$P(R,D,32),OmzAPr=$P(R,D,33),OmzVPr=$P(R,D,34)
 .Set SpPrice=$P(R,D,26) S:SpPrice="=" SpPrice=""
 .Set StukPr=$J(Netto/Aantal*$P("1\100\1000",D,$F("EHM",$E(LineRnd,1))-1),0,2)
 .Set AantKom=0 Set:$P($P(R,D,28),";")="KOM" AantKom=Aantal
 .Set R=^KFA("F",FANr,0,0),Pariteit=$P(R,D,4),Munt=$P(R,D,5),FaktDate=$P(R,D,6)
 .Set Maand=$$EXTDATE^vhDTyp($$INTDATE^vhDTyp(FaktDate),"DM4")_" "
 .Set:'Pariteit Pariteit=1 Set:Munt="" Munt=$$FADEF^vhRtn1()
 .Set Marge=OmzVPr-OmzAPr
 .Do KSTKL(KLNr,0,Maand,FaktDate,StukPr,LineRnd,Munt,Pariteit,SpPrice,Aantal,OmzVPr,Marge,AantKom,OmzLPr)
 .Do KSTKL(KLNr,PRNr,Maand,FaktDate,StukPr,LineRnd,Munt,Pariteit,SpPrice,Aantal,OmzVPr,Marge,AantKom,OmzLPr)
 .Do KSTPR(PRNr,0,Maand,FaktDate,StukPr,LineRnd,Munt,Pariteit,SpPrice,Aantal,OmzVPr,Marge,AantKom,OmzLPr)
 .Do KSTPR(PRNr,KLNr,Maand,FaktDate,StukPr,LineRnd,Munt,Pariteit,SpPrice,Aantal,OmzVPr,Marge,AantKom,OmzLPr)
 Quit
 ;
KSTKL(KLNr,PRNr,Maand,FaktDate,StukPr,LineRnd,Munt,Pariteit,SpPrice,Aantal,OmzVPr,Marge,AantKom,OmzLPr) 
 New R
 Do:PRNr
 .Set R=^KSTKL(KLNr,PRNr,0)
 .Set $P(R,D)=FaktDate,$P(R,D,2)=StukPr,$P(R,D,3)=LineRnd,$P(R,D,4)=$S(Munt="BF":"",1:Munt)
 .Set $P(R,D,5)=Pariteit,$P(R,D,6)=SpPrice
 .Set ^kstkl(KLNr,PRNr,0)=R
 Set R=$G(^kstkl(KLNr,PRNr,Maand)),$P(R,D,7)=$P(R,D,7)
 Set $P(R,D)=$P(R,D)+Aantal,$P(R,D,2)=$P(R,D,2)+1
 Set $P(R,D,3)=$P(R,D,3)+OmzVPr,$P(R,D,4)=$P(R,D,4)+Marge
 Set $P(R,D,5)=$P(R,D,5)+AantKom,$P(R,D,6)=$P(R,D,6)+OmzLPr
 Set ^kstkl(KLNr,PRNr,Maand)=R
 Quit
 ;
KSTPR(PRNr,KLNr,Maand,FaktDate,StukPr,LineRnd,Munt,Pariteit,SpPrice,Aantal,OmzVPr,Marge,AantKom,OmzLPr) 
 New R
 Do:KLNr
 .Set R=^KSTPR(PRNr,KLNr,0)
 .Set $P(R,D)=FaktDate,$P(R,D,2)=StukPr,$P(R,D,3)=LineRnd,$P(R,D,4)=$S(Munt="BF":"",1:Munt)
 .Set $P(R,D,5)=Pariteit,$P(R,D,6)=SpPrice
 .Set ^kstpr(PRNr,KLNr,0)=R
 Set R=$G(^kstpr(PRNr,KLNr,Maand)),$P(R,D,7)=$P(R,D,7)
 Set $P(R,D)=$P(R,D)+Aantal,$P(R,D,2)=$P(R,D,2)+1
 Set $P(R,D,3)=$P(R,D,3)+OmzVPr,$P(R,D,4)=$P(R,D,4)+Marge
 Set $P(R,D,5)=$P(R,D,5)+AantKom,$P(R,D,6)=$P(R,D,6)+OmzLPr
 Set ^kstpr(PRNr,KLNr,Maand)=R
 Quit
 ;
ECOPACK(KLNr,PRNr) 
 New I,R,r
 For I=0,"2002.12 " Set ^kstkl(KLNr,PRNr,I)=^KSTKL(KLNr,PRNr,I)
 Set R=^KSTKL(KLNr,PRNr,"2002.12 "),r=$G(^kstkl(KLNr,0,"2002.12 "))
 Set $P(r,D)=$P(r,D)+$P(R,D),$P(r,D,2)=$P(r,D,2)+$P(R,D,2)
 Set $P(r,D,3)=$P(r,D,3)+$P(R,D,3),$P(r,D,4)=$P(r,D,4)+$P(R,D,4)
 Set $P(r,D,5)=$P(r,D,5)+$P(R,D,5),$P(r,D,6)=$P(r,D,6)+$P(R,D,6)
 Set ^kstkl(KLNr,0,"2002.12 ")=r
 Do:'$D(^kstpr(PRNr))
 .Set KLNr=""
 .For  Set KLNr=$O(^KSTPR(PRNr,KLNr)) Quit:KLNr=""  Do
 ..Quit:'$D(^KSTPR(PRNr,KLNr,"2002.12 "))
 ..For I=0,"2002.12 " Set ^kstpr(PRNr,KLNr,I)=^KSTPR(PRNr,KLNr,I)
 Quit
 ;
CONTROL 
 Do INIT
 Do LOW^%HL
 ;Open 117
 ;Use 117
 Do chkstkl
 Do CHKSTKL
 Do chkstpr
 Do CHKSTPR
 ;Close 117
 Do HIGH^%HL
 Quit
 ;
chkstkl 
 New KLNr,PRNr,Maand
 Write !!!,"Kontrole ^kstkl met ^KSTKL"
 Set KLNr=0
 For  Set KLNr=$O(^kstkl(KLNr)) Quit:KLNr=""  Do
 .Set PRNr=""
 .For  Set PRNr=$O(^kstkl(KLNr,PRNr)) Quit:PRNr=""  Do
 ..Set Maand=""
 ..For  Set Maand=$O(^kstkl(KLNr,PRNr,Maand)) Quit:Maand=""  Do
 ...Set r=^kstkl(KLNr,PRNr,Maand),$P(r,D,40)=$P(r,D,40)
 ...Set Zr=$ZR
 ...Set R=$G(^KSTKL(KLNr,PRNr,Maand)),$P(R,D,40)=$P(R,D,40)
 ...Quit:r=R
 ...Write !!,Zr,"=",r,!,$ZR,"=",R
 Write #
 Quit
 ;
CHKSTKL 
 New KLNr,PRNr,Maand,KBTim,Node0
 Write !!!,"Kontrole ^KSTKL met ^kstkl"
 Set KLNr=0,Maand="2002.12 "
 For  Set KLNr=$O(^KSTKL(KLNr)) Quit:KLNr=""  Do
 .Set PRNr="",(KBTim,Node0)=0
 .For  Set PRNr=$O(^KSTKL(KLNr,PRNr)) Quit:PRNr=""  Do
 ..If '$D(^KSTKL(KLNr,PRNr,Maand)),'$D(^kstkl(KLNr,PRNr,Maand)) Quit
 ..Set R=$G(^KSTKL(KLNr,PRNr,Maand)),$P(R,D,40)=$P(R,D,40)
 ..Set Zr=$ZR
 ..Set r=$G(^kstkl(KLNr,PRNr,Maand)),$P(r,D,40)=$P(r,D,40)
 ..Quit:R=r
 ..Set:$TR(r,D,"")="" r=""
 ..If 'PRNr Set Node0=Node0+$P(R,D,3)-$P(r,D,3)
 ..;If r="",PRNr Set KBTim=KBTim+$P(R,D,3)
 ..If PRNr Set KBTim=KBTim+$P(R,D,3)-$P(r,D,3)
 ..Write !!,Zr,"=",R,!,$ZR,"=",r
 .Write:KBTim !!,"Kabouter Tim = ",$P(^KKL(^KK1(KLNr),0),D,2)," ---> ",KBTim\1
 .If Node0 Write !,"Node 0       ---> ",Node0\1 Write:Node0\1=(KBTim\1) " <--- = kabouter Tim"
 Write #
 Quit
 ;
chkstpr 
 New PRNr,KLNr,Maand
 Write !!!,"Kontrole ^kstpr met ^KSTPR"
 Set PRNr=0
 For  Set PRNr=$O(^kstpr(PRNr)) Quit:PRNr=""  Do
 .Set KLNr=""
 .For  Set KLNr=$O(^kstpr(PRNr,KLNr)) Quit:KLNr=""  Do
 ..Set Maand=""
 ..For  Set Maand=$O(^kstpr(PRNr,KLNr,Maand)) Quit:Maand=""  Do
 ...Set r=^kstpr(PRNr,KLNr,Maand),$P(r,D,40)=$P(r,D,40)
 ...Set Zr=$ZR
 ...Set R=$G(^KSTPR(PRNr,KLNr,Maand)),$P(R,D,40)=$P(R,D,40)
 ...Quit:r=R
 ...Write !!,Zr,"=",r,!,$ZR,"=",R
 Write #
 Quit
 ;
CHKSTPR 
 New PRNr,KLNr,Maand,KBTim,Node0
 Write !!!,"Kontrole ^KSTPR met ^kstpr"
 Set (PRNr,KBTim,Node0)=0,Maand="2002.12 "
 For  Set PRNr=$O(^KSTPR(PRNr)) Quit:PRNr=""  Do
 .Set KLNr=""
 .For  Set KLNr=$O(^KSTPR(PRNr,KLNr)) Quit:KLNr=""  Do
 ..If '$D(^KSTPR(PRNr,KLNr,Maand)),'$D(^kstpr(PRNr,KLNr,Maand)) Quit
 ..Set R=$G(^KSTPR(PRNr,KLNr,Maand)),$P(R,D,40)=$P(R,D,40)
 ..Set Zr=$ZR
 ..Set r=$G(^kstpr(PRNr,KLNr,Maand)),$P(r,D,40)=$P(r,D,40)
 ..Quit:R=r
 ..Set:$TR(r,D,"")="" r=""
 ..If 'KLNr Set Node0=Node0+$P(R,D,3)-$P(r,D,3)
 ..;If r="",KLNr Set KBTim=KBTim+$P(R,D,3)
 ..If KLNr Set KBTim=KBTim+$P(R,D,3)-$P(r,D,3)
 ..Write !!,Zr,"=",R,!,$ZR,"=",r
 Write:KBTim !!,"Kabouter Tim ---> ",KBTim\1
 If Node0 Write !,"Node 0       ---> ",Node0\1 Write:Node0\1=(KBTim\1) " <--- = kabouter Tim"
 Write #
 Quit
 ;
COPY 
 Set Q="K"
 Do ^cA604
 Write @F11,@F1
 Set FP=1501
 Write @F
 Write "Bent u zeker dat u ^kstkl en ^kstpr naar ^KSTKL en ^KSTPR wenst te copieren ?"
 Read !,"Ja[] = copieren : ",R
 Do:R="Ja"
 .Do CLEANC,CLEANP
 .Write !,"Merge ^KSTKL=^kstkl"
 .Merge ^KSTKL=^kstkl
 .Write !,"Merge ^KSTPR=^kstpr"
 .Merge ^KSTPR=^kstpr
 Quit
 ;
CLEANC 
 New KLNr,PRNr
 Write !,"Kill ^KSTKL(KLNr,PRNr,""2002.12 "")"
 Set KLNr=0
 For  Set KLNr=$O(^KSTKL(KLNr)) Quit:KLNr=""  Do
 .Set PRNr=""
 .For  Set PRNr=$O(^KSTKL(KLNr,PRNr)) Quit:PRNr=""  Kill ^KSTKL(KLNr,PRNr,"2002.12 ")
 Quit
 ;
CLEANP 
 New PRNr,KLNr
 Write !,"Kill ^KSTPR(PRNr,KLNr,""2002.12 "")"
 Set PRNr=0
 For  Set PRNr=$O(^KSTPR(PRNr)) Quit:PRNr=""  Do
 .Set KLNr=""
 .For  Set KLNr=$O(^KSTPR(PRNr,KLNr)) Quit:KLNr=""  Kill ^KSTPR(PRNr,KLNr,"2002.12 ")
 Quit
 ;