TRLEVBON ;NEW PROGRAM [ 11/08/2003   8:27 PM ]
 Do INIT
 Do EDIT^vhScherm("TRLEVBON")
 Do CALCDTM(BHPer,EHPer,BVPer,EVPer)
 Do DISPLAY^vhScherm("TRLEVBON")
 Set Dev=0
 Set Dev=$$OPEN^vhDEV(,"TRANSLEV.TXT","W","A")  Quit:0[Dev
 Set FP=2101 Write @F,"Klanten verwerkt :"
 Use:0'[Dev Dev
 Do HEADERS
 Do MAIN
 Close:0'[Dev Dev 
 Quit 
 
 
INIT Set Datum=$$CALCDATE^vhLib.DataTypes($H,"M",-0) ; referentie maan +1
 Set (BHPer,EHPer,BVPer,EVPer)="" 
 Set BHPer=$$CALCDATE^vhLib.DataTypes(Datum,"M",-12)
 Set EHPer=$$CALCDATE^vhLib.DataTypes(Datum,"M",-1)
 Set BVPer=$$CALCDATE^vhLib.DataTypes(Datum,"M",-24)
 Set EVPer=$$CALCDATE^vhLib.DataTypes(Datum,"M",-13)
 Set KlantNr=0 
 Set Periode=""
 Set Dev=0
 Set First=""
 Set Glob="^KFA1"
 Kill Cumul
 Quit
 
 
CALCDTM(BHDtm,EHDtm,BVDtm,EVDtm) 
 ;Bereken de eerste en de laatste dag van de maand 
 Set FDay=-$$CALCDATE^vhLib.DataTypes(BHDtm,"M","FD") 
 Set LDay=-$$CALCDATE^vhLib.DataTypes(EHDtm,"M","LD") 
 Set VFDay=-$$CALCDATE^vhLib.DataTypes(BVDtm,"M","FD") 
 Set VLDay=-$$CALCDATE^vhLib.DataTypes(EVDtm,"M","LD") 
 Set FMnd=$$EXTDATE^vhLib.DataTypes(BHDtm,"DM4")_" "
 Set LMnd=$$EXTDATE^vhLib.DataTypes(EHDtm,"DM4")_" "
 Set VFMnd=$$EXTDATE^vhLib.DataTypes(BVDtm,"DM4")_" " 
 Set VLMnd=$$EXTDATE^vhLib.DataTypes(EVDtm,"DM4")_" "
 Quit
 
 
MAIN    
 New rec,Uitz,KLCnt,KLId
 ;Set KlantNr=1004
 Set KLCnt=0
 Set KLId=0
 For  Set KLId=$O(^KKL(KLId)) Quit:KLId=""  Do
 . Set KlantNr=$P(^KKL(KLId,"0"),D,1)
 . Do FAKTUREN(KlantNr)
 . Do STATISTK(KlantNr)
 . Do WRITEFLE
 Quit
 
 
FAKTUREN(KlantNr) 
 Set KLCnt=KLCnt+1
 If '(KLCnt#10) Use 0 Set FP=2120 Write @F,KLCnt Use Dev
 ;Huidige Periode
 Kill Cumul
 Set (FakCnt,LevCnt,LijnCnt)=0 
 Do WRITEKL(KlantNr)  
 Set Day=LDay-1
 For  Set Day=$O(@Glob@("F",KlantNr,Day)) Quit:Day=""!(Day>FDay)  Do
 . Set First=1
 . Set FAKNr=""
 . Set Periode="Huidige"
 . For  Set FAKNr=$O(@Glob@("F",KlantNr,Day,FAKNr)) Quit:FAKNr=""  Do
 .. Do ONE($E(Glob,1,$L(Glob)-1),FAKNr,KlantNr,Periode) 
 . Set First=0
 ;Vorige Periode
 Set Day=VLDay-1
 For  Set Day=$O(@Glob@("F",KlantNr,Day)) Quit:Day=""!(Day>VFDay)  Do
 . Set First=1
 . Set FAKNr=""
 . Set Periode="Vorige"
 . For  Set FAKNr=$O(@Glob@("F",KlantNr,Day,FAKNr)) Quit:FAKNr=""  Do
 .. Do ONE($E(Glob,1,$L(Glob)-1),FAKNr,KlantNr,Periode) 
 . Set First=0
 Quit
 
 
STATISTK(KlantNr) 
 New PRNr,HG,VSTAT,HSTAT,rec,Stat,I
 Set PRNr=0
 ; We berekend ook het totaal omdat producten kunnen verwijderd worden en also kan er op product nivo omzet verdwijnen
 Set $P(Tot,D,2,3)=$$KLANT^STAT(KlantNr,0,FMnd,LMnd,"3,4")
 Set $P(Tot,D,5,6)=$$KLANT^STAT(KlantNr,0,VFMnd,VLMnd,"3,4")
 For  Set PRNr=$O(^KSTKL(KlantNr,PRNr)) Quit:PRNr=""  Do
 . Set HG=$$CHECKHG(PRNr) 
 . Set rec=$G(Cumul(HG))
 . Set HSTAT=$$KLANT^STAT(KlantNr,PRNr,FMnd,LMnd,"3,4")
 . Set VSTAT=$$KLANT^STAT(KlantNr,PRNr,VFMnd,VLMnd,"3,4")
 . Set $P(rec,D,2)=$P(rec,D,2)+$P(HSTAT,D,1)
 . Set $P(rec,D,3)=$P(rec,D,3)+$P(HSTAT,D,2)
 . Set $P(rec,D,5)=$P(rec,D,5)+$P(VSTAT,D,1)
 . Set $P(rec,D,6)=$P(rec,D,6)+$P(VSTAT,D,2)
 . Set Cumul(HG)=rec
 . ; De gecumuleerde gegeven per hoofdgroep worden afgetrokken van het totaal
 . Set $P(Tot,D,2)=$P(Tot,D,2)-$P(HSTAT,D,1)
 . Set $P(Tot,D,3)=$P(Tot,D,3)-$P(HSTAT,D,2)
 . Set $P(Tot,D,5)=$P(Tot,D,5)-$P(VSTAT,D,1)
 . Set $P(Tot,D,6)=$P(Tot,D,6)-$P(VSTAT,D,2)
 Set Chk=0
 For I=2,3,5,6 Set:$S($P(Tot,D,I)<0:-1,1:1)*$P(Tot,D,I)>0.01 Chk=1
 Quit:'Chk ; Er blijft niet over van Tot dus niet opslaan in 99XX
 ; Het restant van Tot opslaan in Cumul
 For I=2,3,5,6 Set $P(Cumul("99XX "),D,I)=$P($G(Cumul("99XX ")),D,I)+$P(Tot,D,I)
 Quit 
 
 
HEADERS 
 ;Schrijf headers naar bestand
 Write "Programma:TRLEVBON, Huidig=",$$EXTDATE^vhLib.DataTypes(BHPer,"DM"),"-",$$EXTDATE^vhLib.DataTypes(EHPer,"DM")," Vorig=",$$EXTDATE^vhLib.DataTypes(BVPer,"DM"),"-",$$EXTDATE^vhLib.DataTypes(EVPer,"DM")
 Write $TR("KLNr,Klant,PostNr,Gemeente,Land,Kodex,Type,Aktiviteit,Regio,Verantw.Int.,#FaktH,#LevBonH,#FaktV,#LevBonV",",",$C(9))
 Write $TR(",HG,#FaktLnH,OmzetH,MargeH,#FaktLnV,OmzetV,MargeV",",",$C(9)),!
 Quit
        
ONE(Glob,FAKNr,KlantNr,Periode) 
 kill Temp         
 If Periode="Huidige"  Do
 . Set p1=11
 . Set p2=12
 Else  do 
 . Set p1=13
 . Set p2=14
 ;Enkel de eerste keer berekenen 
 If First  Do
 . Set fakt=$G(Cumul("00KL ")) 
 . Set $P(fakt,D,p1)=$P(fakt,D,p1)+1               ;FakCnt
 . Set Cumul("00KL ")=fakt 
 Set BONNr="U"
 For  Set BONNr=$O(@Glob@("F",FAKNr,BONNr)) Quit:BONNr=""  Do
 . Set BonDat=$$INTDATE^vhLib.DataTypes($P(@Glob@("F",FAKNr,BONNr,1),D,2),"DK")
 . ;Als er een bondatum is, slaag deze op in Temp
 . Set:BonDat Temp(BonDat)=""
 . Set LNr=100
 . For  Set LNr=$O(@Glob@("F",FAKNr,BONNr,LNr)) Quit:LNr=""  Do
 .. ;Quit als de lijn een textlijn is 
 .. Set line=$P(@Glob@("F",FAKNr,BONNr,LNr),D,17)
 .. Quit:line'["KF6"&(line'["KF1925")
 .. Set rec=@Glob@("F",FAKNr,BONNr,LNr)
 .. Set:line["KF6" HG=$$CHECKHG($P(rec,D,2))
 .. Quit:line["KF1925" ;tijdelijk PV
 .. Set:line["KF1925" HG="99XX "
 .. Set lijn=$G(Cumul(HG)) 
 .. If Periode="Huidige"  Do
 ... Set $P(lijn,D,1)=$P(lijn,D,1)+1            ;LijnCnt
 ... ;Set $P(lijn,D,2)=$P(lijn,D,2)+$P(rec,D,33) ;Aankoopprijs
 ... ;Set $P(lijn,D,3)=$P(lijn,D,3)+$P(rec,D,34) ;Verkoopprijs
 .. Else  Do
 ... Set $P(lijn,D,4)=$P(lijn,D,4)+1            ;LijnCnt
 ... ;Set $P(lijn,D,5)=$P(lijn,D,5)+$P(rec,D,33) ;Aankoopprijs
 ... ;Set $P(lijn,D,6)=$P(lijn,D,6)+$P(rec,D,34) ;Verkoopprijs
 .. Set Cumul(HG)=lijn
 Set BonDat=0 
 ;Voor alle Datums in Temp verhoog LevCnt
 ;Enkel de eerste keer berekenen 
 If First  Do
 . Set lev=$G(Cumul("00KL ")) 
 . For  Set BonDat=$O(Temp(BonDat)) Quit:BonDat=""  Do 
 .. Set $P(lev,D,p2)=$P(lev,D,p2)+1               ;LevCnt
 . Set Cumul("00KL ")=lev 
 Quit
 
 
WRITEKL(KlantNr)  
 Set Uitz=""
 Set klant=$G(Cumul("00KL ")) 
 Set KlantKey=$P(^KK1(KlantNr),D,1)
 Set rec=^KKL(KlantKey,0)
 Set $P(klant,D,1)=KlantNr                        ;Klant nummer
 Set $P(klant,D,2)=$P(rec,D,2)                    ;Klant naam
 Set $P(klant,D,9)=$$GETREGIO(KlantNr)            ;Regio
 Set $P(klant,D,7)=$$GetKlantType^KLANT5(KlantNr) ;Type
 Set:$D(^KLPUTZ("N",KlantNr)) Uitz="(+)"
 Set $P(klant,D,6)=$P(^KKL(KlantKey,2),D,3)_Uitz ;Kodex
 Set $P(klant,D,8)=$P(^KKL(KlantKey,1),D,11)    ;Aktiviteit
 Set $P(klant,D,5)=$$LAND^vhRtn1($P(rec,D,8),2)  ;Land 
 Set tklant=rec
 If ($$UPTRIMAN^vhRtn1($P(rec,D,6))["POSTBUS")  Do
 . Set tmp=$O(^KKL(KlantKey,"L"))
 . Set:$E(tmp)="L" tklant=^KKL(KlantKey,tklant)
 Set $P(klant,D,3)=$P(tklant,D,6)               ;PostNr
 Set $P(klant,D,4)=$P(tklant,D,7)               ;Woonplaats
 Set $P(klant,D,10)=$$USERNAME^vhUSER($$INTVW^KLOPV(KlantNr))
 Set $P(klant,D,11)="0"
 Set $P(klant,D,12)="0"
 Set $P(klant,D,13)="0"
 Set $P(klant,D,14)="0"
 Set Cumul("00KL ")=klant 
 Quit
 
GETREGIO(KlantNr) 
 New KlantKey,Regio,OVDR
 Set KlantKey=$P($G(^KK1(KlantNr)),D,1)
 Quit +$P(^KKL(KlantKey,0),D,20) ; Tijdelijk PV
 Do:$L(KlantKey)
 . Set OVDR=$P(^KKL(KlantKey,2),D,17)
 . If OVDR  Do 
 .. Set Regio=$$GETREGIO(OVDR)
 . Else  Do
 .. Set Regio=+$P(^KKL(KlantKey,0),D,20)
 Quit $g(Regio)
 
CHECKHG(PRNr) 
 New HG,node,HGnode,ret
 Set HG=""
 Set node=$O(^KPR(PRNr,"I")) 
 Set:$E(node)="I" HG=$P(^KPR(PRNr,node),D,1)
 If $E(node)'="I"  Do 
 . Set node=$O(^KPRO(PRNr,"I")) 
 . Set:$E(node)="I" HG=$P(^KPRO(PRNr,node),D,1)
 Set HGnode="" 
 For  Set HGnode=$O(^KPHG1(HGnode)) Quit:HGnode=""  Do  Quit:ret=HG
 . Set ret="99XX "
 . If $E(HGnode,3,4)=$E(HG,3,4) Set ret=HG
 Quit ret 
 
 
WRITEFLE 
 New HG,I,ChkSom
 Set HG="00KL "
 For  Set HG=$O(Cumul(HG)) Quit:HG=""  Do
 . Set ChkSom=0
 . For I=1:1:$L(Cumul(HG),D) Set ChkSom=ChkSom+$P(Cumul(HG),D,I)
 . Quit:ChkSom=0
 . ;Set:$P(Cumul(HG),D,2) $P(Cumul(HG),D,2)=$P(Cumul(HG),D,3)-$P(Cumul(HG),D,2)
 . ;Set:$P(Cumul(HG),D,5) $P(Cumul(HG),D,5)=$P(Cumul(HG),D,6)-$P(Cumul(HG),D,5)
 . Write $TR(Cumul("00KL "),D,$c(9)),$C(9),HG,$C(9),$TR($TR(Cumul(HG),D,$c(9)),".",","),!
 . Set $P(Cumul("00KL "),D,11)=0
 . Set $P(Cumul("00KL "),D,12)=0
 . Set $P(Cumul("00KL "),D,13)=0
 . Set $P(Cumul("00KL "),D,14)=0
 Quit