KLEXP ;Klantgeg export voor VTW's ;[ 11/07/2001  1:34 PM ]
 ;
 ; Agenda format : Pagesetup 66%
 ; A4 formaat : Pagesetup 92%
 ; Printer instellinen : Courier 10
 ;
 If '$D(Q) S Q="K" D ^cA604,INIT^vhTERMINA
 Set FP=202
 Write @F11,@F1,@F,@F4,$P($T(+1),U,2),@F5
 Set SELK=0
SELECT Do KP^KSEL Quit:K="-"
REGIO Set Regio="" If $P($G(B(120)),D,2)=3 Set Regio=$P(B(120),D)
 If 'Regio Set Regio=$$PI^vhPOPUP("C;C","Z1-KO","Selecteer regio","KLANT","REGIO")
 Set FP=1603 Write @F,@F1,"Regio : ",$S('Regio:"Alle",1:"R"_$E(100+Regio,2,3)_" "_$P(^RES("KLANT","PI","REGIO","D",Regio),"`",2))
 Set KLTyp=$$PI^vhPOPUP("C;C","Z1-KO","Selecteer klanttype","KLANT","TYPE")
 Set:KLTyp="-"!(KLTyp=".") KLTyp=""
 Set FP=1703 Write @F,@F1,"Klant type : ",$S('$L(KLTyp):"Alle",1:" "_$P(^RES("KLANT","PI","TYPE","D",KLTyp),"`",2))
SORT Set FP=1801 Write @F,@F1 Set Sort="A",Sort=$$ASKL^vhINP("KLEXP","SORT")
 If Sort="-" Goto SELECT:$P($G(B(120)),D,2)=3,REGIO
 Set FP=1803 Write @F,@F1,"Sort  : ",$P("Land + Gemeente + Naam\Klant\Postkode\Telefoon\Kodex",D,$F("APTK",Sort))
 Set Rubriek="",Rubriek=$$ASKL^vhINP("KLEXP","RUBRIEK") Goto SORT:Rubriek="-"
 Set FP=1903 Write @F,@F1,"Afdruktype : ",Rubriek,$S(Rubriek="O":" zonder telefoon met omzet",Rubriek="C":" met telefoon, contactpers en omzet",Rubriek="+":" klant van en omzet",1:" met straat en telefoon zonder omzet")
 If Regio Set B(120)=Regio_"\3\\\REGIO"
 Else  Kill B(120)
 ;
 Kill ^HULP($J)
 Set (TKlant,SKlant)=0,FP=2001
 Write @F,@F1,!!!,"Klanten verwerkt :"
 For  Set KL=$O(@Q0) Quit:KL=""!(KL]KLX)  Do
 .If '(TKlant#100) Set FP=2320 Write @F,TKlant,"/",SKlant
 .Set TKlant=TKlant+1
 .Do ^KKCHKKL Quit:'OK
 .Set Rec=^KKL(KL,0),Rec2=^KKL(KL,2)
 .If Regio Quit:Regio'=$P(Rec,D,20)
 .;Quit:$$LAND^vhRtn1($P(^KKL(KL,0),D,8))'="NL" ; bepaald land
 .Set Type=$$GetKlantType^KLANT5($P(KL," ",2))
 .If $L(KLTyp) Quit:KLTyp'=Type
 .Quit:"0Z"[Type
 .Quit:$P(Rec2,D,10)  ; NonAktief
 .Set SKlant=SKlant+1
 .Set Key=KL Set:Sort="P" Key=$P(Rec,D,6)_Key Set:Sort="T" Key=$$UPTRIMAN^vhRtn1($P(Rec,D,13))_Key
 .If Sort="K" Set K=$P(Rec2,D,3),K=$F("CPLRSBG",K) Set:K K=K-1 Set Key=K_Key
 .Set:Sort="" Key=$$UPTRIMAN^vhRtn1($P(Rec,D,8))_$$UPTRIMAN^vhRtn1($P(Rec,D,7))_$$UPTRIMAN^vhRtn1($P(Rec,D,2))_Key
 .Set PrijsKL=$P(";CONS;PLUS;LIJST;RABAT;SPIL ;BASIS;GROOT",";",$F("CPLRSBG",$P(Rec2,D,3)))_$S($D(^KLPUTZ("N",$P(Rec,D,1))):" +",1:"")
 .Set (KlantVan,Omzet)=""
 .If $L(Rubriek) Do
 ..Set Begin=$$EXTDATE^vhDTyp($$CALCDATE^vhDTyp($H,"M","-12"),"DM4")_" "
 ..Set Einde=$$EXTDATE^vhDTyp($$CALCDATE^vhDTyp($H,"M","-1"),"DM4")_" "
 ..Set Omzet=$$KLANT^STAT($P(Rec,D),"",Begin,Einde,3)
 ..Set KLNr=$P(^KKL(KL,0),D),KlantVan=##class(BL.Derde.Klant.Relaties).KlantVan(KLNr)
 ..If $LL(KlantVan) Do
 ...Set KlantVan=$$ListToPieces^vhLib(KlantVan,", ")
 ...For I=1:1:$L(KlantVan,", ") Do
 ....Set KLNr=$P(KlantVan,", ",I)
 ....If $L(KLNr),$D(^KK1(KLNr)) Set $P(KlantVan,", ",I)=$P(^KKL(^KK1(KLNr),0),D,2)
 .Set PostBus=0
 .If "\POSTBUS\PB\Postbus\P.O.\BOX\"[(D_$P($P(Rec,D,5)," ")_D),$E($O(^KKL(KL,"L")))="L" Do
 ..Set ARec=^($O(^KKL(KL,"L"))),$P(Rec,D,5)=$P(ARec,D,5),$P(Rec,D,7)=$P(ARec,D,7)
 ..Set PostBus=1
 .Set ^HULP($J,Key)=$P(Rec,D,1,13)_D_Type_D_PrijsKL_D_Omzet_D_KlantVan_D_$P(^KKL(KL,2),D,11)_D_$P(^KKL(KL,0),D,20)
 .If '$L(Rubriek),Sort="T" Do
 ..Set LevAdr="L" Set:PostBus LevAdr=$O(^KKL(KL,LevAdr))
 ..For  Set LevAdr=$O(^KKL(KL,LevAdr)) Quit:$E(LevAdr)'="L"  Do
 ...Set ARec=^KKL(KL,LevAdr)
 ...Quit:$P(ARec,D,13)=""
 ...Set AKey=$$UPTRIMAN^vhRtn1($P(ARec,D,13))_$$UPTRIMAN^vhRtn1($P(ARec,D,2))
 ...Set $P(ARec,D,2)=".. "_$P(ARec,D,2),^HULP($J,AKey)=$P(ARec,D,1,13)_"\.\......."
 Set FP=2001 Write @F,@F1
 Do INIT^PROC($S(Rubriek="O":"KLEXP3",Rubriek="C":"KLEXP4",Rubriek="+":"KLEXP2",1:"KLEXP"),"KLEXP")
 Set KLEXP(11)="Klanten van "_$S('Regio:"alle ",1:"")_"regio"_$S('Regio:"'s",$D(^KSEKT(Regio_" ")):" "_^KSEKT(Regio_" "),1:"")
 Set:$L(Sort) KLEXP(11)=KLEXP(11)_D_"Sort : "_$P("\Klant\Postkode\Telefoon\Kodex",D,$F("APTK",Sort))
 If Rubriek="+" Set KLEXP(5)=127
 Else  If Rubriek="O" Set KLEXP(5)=63
 Else  If Rubriek="C" Set KLEXP(5)=125
 Else  Set KLEXP(5)=93,KLEXP(4)="86;5;3;73;1;82"
 Do RL^PROC1
 Do ^OUTPUT("MTPS")
 Kill ^HULP($J)
 Quit
 ;