VKASGR1 G INIT ;BEHEER VERKOOPANALYZE OP SUBGROEP (MODULE OPBOUW HULPBESTAND) [ 08/16/2002  4:27 PM ]
T1 ;VM=Vorige maand, $P van SRECORD begint op 1
 ;HBJ=Huidig BJ tot en met vorige maand, $P van SRECORD begint op 8
 ;VBJ=Vorig BJ tot en met de vorige maand van vorig boekjaar, $P van SRECORD begint op 15
 ;VVBJ=Volledig vorig boekjaar, $P van SRECORD begint op 22
 ;HM=Lopende huidige maand, $P van SRECORD begintl op 29
 ; Het volgend record wordt opgebouwd voor elk telbare subgroep
SRECORD ;Aantal\FaktLijnen\Omzet\Marge\OmzetLijstprijs\\\
 
T3 ;Voor elke klant wordt het totaal bijgehouden
 ;voor dezelfde periodes als de gegevens van de subgroep
KRECORD ;\FaktLijnen\Omzet\Marge\OmzetLijstprijs\\\
 ;Op $P 1 staat het Aantal maanden dat verstreken is van het BJ / 12
 ;Op $P 8 staat het Totaal omzet HBJ / Totaal omzet VVBJ
 ;Op $P 15 staat het Totaal omzet VBJ / Totaal omzet VVBJ
 
INIT S Q="K" D ^cA604
 S MemH=$H
 s EM=$$CALCDATE^vhLib.DataTypes($H,"M",-1,"MD")
 S JH=$$EXTDATE^vhLib.DataTypes(EM,"J4")
 S EM=$$EXTDATE^vhLib.DataTypes(EM,"MN")
 S:EM<7 EM=EM+12 ; Einde maand = Vorige maand
 S:EM>12 JH=JH-1 ; Vorig boekjaar
 S BBM=07,EBM=18 ; Begin boekjaar, einde volledig boekjaar
 ;Quit:$P($G(^VKASGR),"\",5)=($S(EM>12:JH+1,1:JH)_"."_$TR($J($S(EM>12:EM-12,1:EM),2)," ","0"))
 ;D KLANT(1680),KLANT(11708)  Q
 Set KC=0 For  Set KC=$O(^KSTKL(KC)) Quit:'KC  Do KLANT(KC)
 Set BBM=JH_"."_$TR($J(BBM,2)," ","0")
 Set EM=$S(EM>12:JH+1,1:JH)_"."_$TR($J($S(EM>12:EM-12,1:EM),2)," ","0")
 Set ^VKASGR=$$EXTDATE^vhLib.DataTypes(MemH,"DK")_D_$$EXTTIME^vhLib.DataTypes(MemH)_D_$$EXTTIME^vhLib.DataTypes($H)_D_BBM_D_EM_D_"Verkoopanalyze per subgroep (excl NIET TELBARE) Periode : Van "_BBM_" tot "_EM
 Quit
 ; Opmaken totalen per subgroep
KLANT(KC) 
 Do FETCH
 Do VERDEEL
 Do SAVE
 Quit
 
FETCH K HULP
 S PC=0 F  S PC=$O(^KSTKL(KC,PC)) Q:'PC  D
 .Quit:'$D(^KPR(PC))
 .S R=$O(^KPR(PC,"I"))
 .Quit:$E(R)'="I"
 .S R=^KPR(PC,R)
 .S HG=$P(R,D,1),GR=$P(R,D,2),SG=$P(R,D,3)
 .S TelB='$P(^KPR(PC,1),D,7)
 .Quit:'$L(HG)!'$L(GR)!'$L(SG)
 .For MN=BBM:1:EM Do ADD(JH-1,MN,3) ; Berekening vorig boekjaar tot de huidige maand van vorig boekjaar
 .For MN=BBM:1:EBM Do ADD(JH-1,MN,4) ; Berekening volledig vorig boekjaar
 .For MN=BBM:1:EM Do ADD(JH,MN,2) ; Berekening huidig boekjaar tot de huidige maand
 .Do ADD(JH,EM,1) ; Berekening huidige maand van huidig boekjaar
 .Do:EM<18 ADD(JH,EM+1,5) ; Berekening huidige maand van huidig boekjaar
 .Do:EM=18 ADD(JH+1,7,5) ; Berekening huidige maand van huidig boekjaar
 Quit
 
ADD(JR,MN,Part) 
 Set:MN>12 JR=JR+1,MN=MN-12
 S:$L(MN)=1 MN="0"_MN
 S R=$G(^KSTKL(KC,PC,JR_"."_MN_" "))
 Quit:R=""
 Set S=$G(HULP(HG,GR,SG,Part))
 Set:TelB $P(S,D,1)=$P(S,D,1)+$P(R,D,1) 
 Set:TelB $P(S,D,2)=$P(S,D,2)+$P(R,D,2)
 Set $P(S,D,3)=$P(S,D,3)+$P(R,D,3)
 Set $P(S,D,4)=$P(S,D,4)+$P(R,D,4)
 Set $P(S,D,5)=$P(S,D,5)+$P(R,D,6)
 Set HULP(HG,GR,SG,Part)=S
 Quit
 ;
 ; Verdeling niet-telbare, verdeelbare subgroepen
VERDEEL S HGX="" F  S HGX=$O(HULP(HGX)) Q:HGX=""  D
 .S GRX="" F  S GRX=$O(HULP(HGX,GRX)) Q:GRX=""  D
 ..S SGX="" F  S SGX=$O(HULP(HGX,GRX,SGX)) Q:SGX=""  D
 ...S Part="" F  S Part=$O(HULP(HGX,GRX,SGX,Part)) Q:Part=""  D
 ....S OMZ=$P(HULP(HGX,GRX,SGX,Part),D,3) Q:'$D(^KPSG1(SGX))!'OMZ  S K=^(SGX) Q:'$P(K,D,5) 
 ....;W !!,HGX,GRX,SGX,Part,$C(9),OMZ
 ....S AANT=0
 ....S HGY="" F  S HGY=$O(^KPSG1(SGX,HGY)) Q:HGY=""  D
 .....S GRY="" F  S GRY=$O(^KPSG1(SGX,HGY,GRY)) Q:GRY=""  D
 ......S SGY="" F  S SGY=$O(^KPSG1(SGX,HGY,GRY,SGY)) Q:SGY=""  I $D(HULP(HGY,GRY,SGY,Part)) S:$P(HULP(HGY,GRY,SGY,Part),D,1)>0 AANT=AANT+$P(HULP(HGY,GRY,SGY,Part),D,1)
 ....If 'AANT Do REST Quit
 ....S HGY="" F  S HGY=$O(^KPSG1(SGX,HGY)) Q:HGY=""  D
 .....S GRY="" F  S GRY=$O(^KPSG1(SGX,HGY,GRY)) Q:GRY=""  D
 ......S SGY="" F  S SGY=$O(^KPSG1(SGX,HGY,GRY,SGY)) Q:SGY=""  D
 .......I '$D(HULP(HGY,GRY,SGY,Part)) Q
 .......;W !,"-->",HGY,GRY,SGY,!,"  >",K
 .......S:$P(HULP(HGY,GRY,SGY,Part),D,1)>0 K=HULP(HGY,GRY,SGY,Part),$P(K,D,3)=$P(K,D,3)+(OMZ*$P(K,D,1)/$S(AANT:AANT,1:1)),HULP(HGY,GRY,SGY,Part)=K
 .......;W !,"  >",K
 Quit
REST 
 S K=$G(HULP("99ZZ "," "," ",Part)),$P(K,D,3)=$P(K,D,3)+OMZ,HULP("99ZZ "," "," ",Part)=K
 Quit
 ;
 ; Opslaan van de HULP in global
SAVE Kill ^VKASGR(KC)
 Set Tot=""
 S HG="" F  S HG=$O(HULP(HG)) Q:HG=""  D
 .S GR="" F  S GR=$O(HULP(HG,GR)) Q:GR=""  D
 ..S KGT=1 I $D(^KPGR1(GR)) S KGT=$P(^(GR),D,5)
 ..S SG="" F  S SG=$O(HULP(HG,GR,SG)) Q:SG=""  D
 ...S KST=1 I $D(^KPSG1(SG)) S KST=$P(^(SG),D,5) I 'KST S KST=KGT
 ...Q:KST&(HG'="99ZZ ")
 ...Set R=""
 ...For Part=1:1:5 Do
 ....Set Key=Part*7-6
 ....Set T=$S($D(HULP(HG,GR,SG,Part)):HULP(HG,GR,SG,Part),1:"\\\\\\") 
 ....Set $P(R,D,Key)=T
 ....Set $P(Tot,"\",Key+1)=$P(Tot,"\",Key+1)+$P(T,"\",2)
 ....Set $P(Tot,"\",Key+2)=$P(Tot,"\",Key+2)+$P(T,"\",3)
 ....Set $P(Tot,"\",Key+3)=$P(Tot,"\",Key+3)+$P(T,"\",4)
 ....Set $P(Tot,"\",Key+4)=$P(Tot,"\",Key+4)+$P(T,"\",5)
 ...S ^VKASGR(KC,HG,GR,SG)=R
 Quit:Tot=""
 Set $P(Tot,"\")=EM-6/12*100
 If $P(Tot,"\",24) Do
 .Set $P(Tot,"\",8)=$P(Tot,"\",10)/$P(Tot,"\",24)*100
 .Set $P(Tot,"\",15)=$P(Tot,"\",17)/$P(Tot,"\",24)*100
 Else  Set $P(Tot,"\",8)=9999.9,$P(Tot,"\",15)=9999.9
 Set ^VKASGR(KC)=Tot
 Quit
 ;
 ;
YZ K HULP($J),HG,GR,SG,PC,PR,FAC,VEC,UG,UGK,UO,UA,UF,UEP,B,NIV Q
 ;
 Q
Z X ^cZ Q
ZZ ; 10.01.92 -  9 u 00