KAKA8 G 1 ;ARTIKEL/KLANT ANALYSE OPBOUW van het AKANAL bestand; [ 11/03/2003  4:20 PM ]
 ; Dit is een BATCH programma dat 's nachts kan draaien
 ;
1 S $ZT="^cA406"
 LOCK +^AKANAL:5 E  Q
 KILL ^AKANAL
 SET PR=1
10 Do INIT
 SET PR=$N(^KPR(PR)) G:PR=-1 YZ
 If $$ISSTOVK(PR) Do
 .Do CALC  ;MOVK(PR)
 Else  If $$ISSTOVM(PR) Do
 .Do KOVM(PR)
 Else  Do CALC
 Goto 10
 
ISSTOVK(MPRNr) 
 ;Q 0 ; aangepast door PV op 22-10-03
 New R,IsStOvK
 Set R=$G(^KPR(MPRNr,0)),IsStOvK=$P(R,D,23)="S"
 Quit IsStOvK
 
ISSTOVM(KPRNr) 
 New R,IsStOvM,MPRNr
 Set IsStOvM=0,MPRNr=""
 For  Set MPRNr=$O(^PRLINK("IKM",KPRNr,MPRNr)) Quit:MPRNr=""  Set IsStOvM=$$ISSTOVK(MPRNr)  Quit:IsStOvM
 Quit IsStOvM
 
MOVK(MPRNr) 
 New %,R,SortKey,KPRNr,KortTxt,Faktor,IsEuro
 Set IsEuro=$$ISEURO^vhRtn1()
 Set KC=0,BP=$J(FBP-.01,0,2)_" ",BP=$N(@Q4)
 Do:'(BP=-1!(BP]LBP))
 .Set PR=MPRNr,(TKA,TKL,TKO)=0
 .For  Set KC=$O(@Q3) Quit:KC=""  Do
 ..Set BP=0,X=@Q4,DLP=$P(X,D,1)
 ..For  Set BP=$N(@Q4) Quit:BP=-1!(BP]LBP)  Set X=^(BP),TKA=TKA+$P(X,D),TKL=TKL+$P(X,D,2),TKO=TKO+$P(X,D,3)
 .Do VERDEEL(MPRNr,.KPRNr)
 .Set KPRNr=""
 .For  Set KPRNr=$O(^PRLINK("D",MPRNr,KPRNr)) Quit:KPRNr=""  Do
 ..Set KortTxt=$P(^KPR(KPRNr,0),D),SortKey=$$SORTKEY^PRODUKT(KPRNr)
 ..Set R=KPRNr(KPRNr),Faktor=$P(R,D),%=$P(R,D,3)
 ..Set ^AKANAL(MPRNr,SortKey)="MOK\"_KPRNr_D_KortTxt_D_(Faktor*TKA)_D_TKL_D_DLP_"\\\\\\"_$J(TKO*%/100,0,$S(IsEuro:4,1:2))
 .Quit:'$D(^AKANAL(MPRNr))
 .Set ^AKANAL(MPRNr)="MOK"
 .Set AK(1)="^AKANAL(MPRNr",DL(1)="AK"
 .Do RL^PROC1
 Quit
 
KOVM(KPRNr) 
 New %J
 Set %J=$$%J^vhRtn1()
 Kill ^HULP(%J)
 Do CUMUL(KPRNr,%J)
 New PR,Q3,Q4
 Set PR=KPRNr,Q3="^HULP(%J,KC)",Q4="^HULP(%J,KC,BP)"
 Do CALC
 Kill ^HULP(%J)
 Quit
 
CUMUL(KPRNr,%J) 
 New %,I,R,MPRNr,KLNr,Faktor,MRec,KRec,Maand,IsEuro
 Set IsEuro=$$ISEURO^vhRtn1()
 Merge ^HULP(%J)=^KSTPR(KPRNr)
 Set MPRNr=""
 For  Set MPRNr=$O(^PRLINK("IKM",KPRNr,MPRNr)) Quit:MPRNr=""  Do
 .Do VERDEEL(MPRNr,.KPRNr)
 .Set R=KPRNr(KPRNr),Faktor=$P(R,D),%=$P(R,D,3)
 .Set KLNr=""
 .For  Set KLNr=$O(^KSTPR(MPRNr,KLNr)) Quit:KLNr=""  Do
 ..Set ^HULP(%J,KLNr,0)=$P(^KSTPR(MPRNr,KLNr,0),D),Maand=0
 ..For  Set Maand=$O(^KSTPR(MPRNr,KLNr,Maand)) Quit:Maand=""  Do
 ...Set MRec=^KSTPR(MPRNr,KLNr,Maand),KRec=$G(^HULP(%J,KLNr,Maand))
 ...Set $P(KRec,D)=$P(KRec,D)+($P(MRec,D)*Faktor),$P(KRec,D,2)=$P(KRec,D,2)+$P(MRec,D,2)
 ...For I=3:1:6 Set $P(KRec,D,I)=$J($P(KRec,D,I)+($P(MRec,D,I)*%/100),0,$S(IsEuro:4,1:2))
 ...Set ^HULP(%J,KLNr,Maand)=KRec
 Quit
 
VERDEEL(MPRNr,KPRNr) 
 New R,PRNr,Faktor,Bedrag
 Set PRNr="",Bedrag=0
 For  Set PRNr=$O(^PRLINK("D",MPRNr,PRNr)) Quit:PRNr=""  Do
 .Set Faktor=$P(^PRLINK("D",MPRNr,PRNr),D),R=$$PROD^KPRIJS(PRNr,0,0,"")
 .Set KPRNr(PRNr)=Faktor_D_($P(R,D,14)*Faktor),Bedrag=Bedrag+$P(KPRNr(PRNr),D,2)
 Do:Bedrag
 .Set PRNr=""
 .For  Set PRNr=$O(KPRNr(PRNr)) Quit:PRNr=""  Do
 ..Set R=KPRNr(PRNr),$P(R,D,3)=$P(R,D,2)/Bedrag*100,KPRNr(PRNr)=R
 Quit
 
ONE(PR) ; Een produkt behandelen
 N I,FBP,LBP,STARTTIJD,TPA,TPL,TPO,TPM,Q0,Q1,Q2,Q3,Q4,Q5,SW3,R,A,FDM,LDM
 N X,KC,BP,PC,PID,SPPL,SPLP,SPVK,SUMC,KL,KN,KV,KYW,KPL,KKN,UMC,AFA,PLP,PK1,PK2
 N PKP,UPAR,USP,AFE,UEP,TKA,TKL,TKO,TKM,DLP,LPR,LFA,KVV,U26,UU26,AK
 Do INIT
 Set:'$G(PR) PR=$$SELECT^PRODUKT6()
 Quit:'PR
 Kill ^AKANAL(PR)
 If $$ISSTOVK(PR) Do
 .Do CALC  ;MOVK(PR)
 Else  If $$ISSTOVM(PR) Do
 .Do KOVM(PR)
 Else  Do CALC
 Quit
 
INIT If '$D(Q) Do  Set $ZT="^cA406"
 .New PR
 .Set Q="K" DO ^cA604
 Set FBP=DJ-1_"."_DM,LBP=DJ_"."_DM_" "
 SET STARTTIJD=DT_" "_TD
 SET (TPA,TPL,TPO,TPM)=0
 SET Q0="^KK1(KC)",Q1="^KKL(KL,0)",Q3="^KSTPR(PR,KC)",Q4="^KSTPR(PR,KC,BP)",Q5="^KPR(PR,0)",SW3=6
 Quit
 
    
CALC ; Ophalen en kopieren van de produktgegevens
 K A S A(0)=@Q5 FOR I=1:1:SW3-1 SET A(I)=$G(^(I))
 F I="I","J" S X=$N(^(I)) S:$E(X,1)=I A(I)=^(X)
 S KC=0,BP=$J(FBP-.01,0,2)_" ",BP=$N(@Q4) Q:BP=-1!(BP]LBP)  S PC=$P(A(0),D,1),PID=$P(A(2),D,25) S (TPA,TPL,TPO,TPM)=0
 S SPPL=$P(A(1),D,19),X="" S:$D(A("J")) X=A("J") S SPLP=$P(X,D,25),SPVK=$P(X,D,26),SUMC=$P(X,D,17)
 ; LOOP van de verschillende klanten
 F  S KC=$N(@Q3) Q:KC=-1  D
 .S BP=$J(FBP-.01,0,2)_" ",BP=$N(@Q4)
 .Q:BP=-1!(BP]LBP)
 .I '$D(@Q0) K @Q3 Q
 .; Ophalen van de klantgegevens
 .S KL=^(KC),X=@Q1,KN=$P(X,D,2),KV=$P(X,D,11),X=^(2),KPL=$P(X,D,3),KKN=$P(X,D,5) S:KV="" KV=$$FADEF^vhRtn1()
 .S KYW=$$GetKlantType^KLANT5(KC)
 .; Huidige prijs berekening
 .S R=$$KLANTPR^KPRIJS(KC,PR)
 .S UEP=$P(R,D,1),UMC=$P(R,D,2),AFA=$P(R,D,3),PLP=$P(R,D,4),PK1=$P(R,D,5),PK2=$P(R,D,6)
 .S PKP=$P(R,D,8),UPAR=$P(R,D,9),USP=$P(R,D,10),AFE=$P(R,D,11)
 .I KKN S UEP=$J(UEP,0,2)
 .; Sommeren van de historiek gegevens per klant
 .S BP=0,X=@Q4,DLP=$P(X,D,1),LPR=$P(X,D,2),LFA=$E($P(X,D,3),1),KVV=$P(X,D,4) S:KVV="" KVV=$$FADEF^vhRtn1()
 .S BP=0,X=@Q4,U26=$P(X,D,6),(TKA,TKL,TKO,TKM)=0,BP=$J(FBP-.01,0,2)_" "
 .F  S BP=$N(^(BP)) Q:BP=-1!(BP]LBP)  S X=^(BP),TKA=TKA+$P(X,D,1),TKL=TKL+$P(X,D,2),TKO=TKO+$P(X,D,3) S TKM=TKM+$P(X,D,4)
 .; Sommeren van de totalen per produkt
 .S TPA=TPA+TKA,TPL=TPL+TKL,TPO=TPO+TKO,TPM=TPM+TKM
 .S ^AKANAL(PR,$S(TKA<0:9000000000-TKA,1:1999999999-TKA)_KL)=KL_D_KC_D_KN_D_TKA_D_TKL_D_DLP_D_U26_D_LPR_D_KVV_D_UEP_D_KVV_D_TKO_D_LFA
 Q:'$D(^AKANAL(PR))  SET (KL,UU26)=""
 S ^AKANAL(PR)=TPA_D_TPL_D_TPO_D_TPM 
 SET AK(1)="^AKANAL(PR",DL(1)="AK" D RL^PROC1
 QUIT
 ;
YZ SET FDM="01"_"/"_$P(FBP,".",2)_"/"_$P(FBP,".",1)
 SET LDM=DD_"/"_$P(LBP,".",2)_"/"_$P(LBP,".",1)
 DO ^cA105 SET ^AKANAL=FDM_D_LDM_D_"Gesommeerde Periode : "_FBP_"->"_LBP_" Rekentijd Begin : "_STARTTIJD_" End : "_TD
 QUIT
 ;