cwPRYSL ;AFDRUKKEN PRIJSLIJSTEN [ 11/29/2003   8:10 AM ]
 ;
 ; Het afdrukken van een prijslijst kan met volgende oproep --> Do PRINT^DCPRYSL(KLNr)
 ;
VERWERK() 
 Quit
 ;
 ; Numerieke formatering
FN(Number,Fraction,Format) 
 If '$D(Format) Set Format="T."
 Quit $$EXTNUM^vhDTyp(Number,0,Format,Fraction)
 ;
 ; Ophalen taalafhankelijke tekst
TXT(Ref,Piece) 
 If '$D(Piece) Set Piece=2
 Quit $P($P($T(@("T"_Ref)),U,Piece),D,$F("NFDE",Taal)-1)
 ;
 ; Verwerking blok B in C
PASTEB(R,AddBlank) 
 If $D(AddBlank),AddBlank,BCount,B(BCount)'="",LCount+BCount+1'=MaxLines Do BLOCK("")
 If LCount+BCount+1>MaxLines Do FOOTER,TITEL,HEADER
 For BCount=1:1:BCount Do
 .Do CACHE(R)
 .Set B=B(BCount) For I=$L(B,D):-1:1 Do
 ..Set T=$P(B,D,I)
 ..If $L(T,U)=1 Set T=T_";3"
 ..Do PASTE(PCount,LCount,$P(T,U),$P(T,U,2),$P(T,U,3),$P(T,U,4))
 Set BCount=0
 Kill B
 Quit
 ;
 ; Opbouwen local B welke later als een geheel in C zal verwerkt worden
BLOCK(R) 
 Set BCount=BCount+1,B(BCount)=R
 Quit
 ;
 ; Opbouwen lijn in de local C om er later de data in te plaatsen
CACHE(R) 
 Set LCount=LCount+1
 Set C(PCount,LCount)=R
 Quit
 ;
 ; Plaats data op een lijn in de local C
PASTE(Page,Line,Text,BPos,EPos,Attr) 
 New T,I,X
 Set T=Text Quit:T=""
 If Attr'["T" Set Attr=Attr_"T"
 If $L(Attr) For I=1:1:$L(Attr) Do
 .If $E(Attr,I)="T" Set T=$TR(T,P("T","F"),P("T","T")) Quit
 .Set T=P($E(Attr,I),1)_T
 .If $E(Attr,I)'="Q"!'$G(Prefs("NLQ")) Set T=T_P($E(Attr,I),0)
 If BPos,EPos Set $E(C(Page,Line),BPos,EPos)=T Quit
 If BPos Set $E(C(Page,Line),BPos,BPos+$L(Text)-1)=T Quit
 Set $E(C(Page,Line),EPos-$L(Text)+1,EPos)=T
 Quit
 ;
 ; Afdruk body
BODY 
 New B,R,I,BCount,KortComp,HoofdGr,Groep,SubGroep,TSubGrp,PRNr
 Set BCount=0,HoofdGr=""
 For  Set HoofdGr=$O(^HULP($J,"PL",HoofdGr)) Quit:HoofdGr=""  Do
 .Set Groep=""
 .For  Set Groep=$O(^HULP($J,"PL",HoofdGr,Groep)) Quit:Groep=""  Do
 ..Set SubGroep=""
 ..For  Set SubGroep=$O(^HULP($J,"PL",HoofdGr,Groep,SubGroep)) Quit:SubGroep=""  Do
 ...Set KortComp=""
 ...For  Set KortComp=$O(^HULP($J,"PL",HoofdGr,Groep,SubGroep,KortComp)) Quit:KortComp=""  Do
 ....Set PRNr=^HULP($J,"PL",HoofdGr,Groep,SubGroep,KortComp)
 ....Do PRODPRSL^DCDETAIL(PRNr,SubGroep),PASTEB(L("B","B"),1)
 Kill C(PCount,LCount) Set LCount=LCount-1
 If $D(B) Do PASTEB(L("B","B"),1)
 Quit
 ;
 ; Afdruk hoofding (volgende bladzijden)
HEADER 
 New T
 Do CACHE(L("B","F"))
 Do CACHE(L("B","B"))
 Set T=$$TXT("Art")
 Do PASTE(PCount,LCount,T,(5-VPerfo),"","")
 Set T=$$TXT($S(Prefs("NoSa")>1:"OldPri",1:"Prijs"))
 If KlMunt'="MTL" Set T=T_" "_KlMunt
 Do PASTE(PCount,LCount,T,"",(61-VPerfo),"")
 If Prefs("NoSa")>1 Do
 .Set T=$$TXT("NewPri")
 .If KlMunt'="MTL" Set T=T_" "_KlMunt
 .Do PASTE(PCount,LCount,T,"",(79-VPerfo),"")
 If NetBrutP Do
 .Do CACHE(L("B","B"))
 .Set T=$$TXT("Kort")
 .Do PASTE(PCount,LCount,T,"",(61-VPerfo),"")
 .If Prefs("NoSa")>1 Do PASTE(PCount,LCount,T,"",(79-VPerfo),"")
 Do CACHE(L("B","S"))
 Quit
 ;
 ; Afdruk hoofding (eerste blad)
FHEADER 
 New T,LTemp
 Set BCount=0,LTemp=L("B","F")
 Set T="" For I=1:1:5 Do  ; Openingstekst op prijslijst
 .If $G(^KSTKL(0,Taal,I))="" Quit
 .Set T=^KSTKL(0,Taal,I)
 .Set T=T_";5;;BN"
 .Do BLOCK(T)
 If $L(T) Do
 .Set L("B","F")=L("B","T","F")
 .Do CACHE(L("T","F")),CACHE(L("T","B")),PASTEB(L("T","B"),1)
 Do HEADER
 Set L("B","F")=LTemp
 Quit
 ;
 ; Afdruk titel (volgende blazijden)
TITEL 
 New KlantInd,R,T,Blank,Titel,Allign
 New Aanspr,Naam,Woonpl
 Do PPRINT
 Set PCount=PCount+1,LCount=0
 Set KlantInd=^KK1(KLNr),R=^KKL(KlantInd,0)
 Set Naam=$P(R,D,2),Aanspr=$P(R,D,4),Woonpl=$P(R,D,7)
 For Blank=1:1:6 Do CACHE("")
 Set T="" If $L(Aanspr) Set T=Aanspr_" "
 Set T=T_Naam Do PASTE(PCount,Blank-1,T,40,"","")
 Do PASTE(PCount,Blank,Woonpl,40,"","")
 Set Titel=$$TXT("PrijsL"),Allign=$L(Titel)
 Set T=$$TXT("Date") Set:$L(T)>Allign Allign=$L(T)
 Do PASTE(PCount,Blank,T,2,"","")
 Do PASTE(PCount,Blank,DT,Allign+4,"","")
 Set T=Titel
 Do PASTE(PCount,Blank-1,T,2,"","B")
 If PCount>1 Do
 .Set T=$$TXT("Vervg")_" ("_(PCount-1)_")"
 .Do PASTE(PCount,Blank,T,"",79,"")
 Quit
 ;
 ; Afdruk titel (eerste blad)
FTITEL 
 New KlantInd,R,T,Blank,Titel,Allign
 New Aanspr,Naam,Toenaam,Straat,PostNr,Woonpl,Land
 Set PCount=PCount+1,LCount=0
 Set KlantInd=^KK1(KLNr),R=^KKL(KlantInd,0)
 Set Naam=$P(R,D,2),Toenaam=$P(R,D,3),Aanspr=$P(R,D,4)
 Set Straat=$P(R,D,5),PostNr=$P(R,D,6),Woonpl=$P(R,D,7)
 Set Land=$P(R,D,8) If Land="" Set Land="B"
 For Blank=1:1:16 Do CACHE("") If Blank<10 Do PASTE(PCount,Blank,VH(Blank),2,"","")
 Set T="" If $L(Aanspr) Set T=Aanspr_" "
 Set T=T_Naam Do PASTE(PCount,Blank-6,T,40,"","")
 If '$L(Toenaam) Do
 .Do PASTE(PCount,Blank-5,Straat,40,"","")
 .Do PASTE(PCount,Blank-3,PostNr_"   "_Woonpl,40,"","")
 .If "B"'[Land Do PASTE(PCount,Blank-2,^BA(1,Land,0,Taal),40,"","")
 If $L(Toenaam) Do
 .Do PASTE(PCount,Blank-5,Toenaam,40,"","")
 .Do PASTE(PCount,Blank-4,Straat,40,"","")
 .Do PASTE(PCount,Blank-2,PostNr_"   "_Woonpl,40,"","")
 .If "B"'[Land Do PASTE(PCount,Blank-1,^BA(1,Land,0,Taal),40,"","")
 Set Titel=$$TXT("PrijsL"),Allign=$L(Titel)
 Set T=$$TXT("Date") Set:$L(T)>Allign Allign=$L(T)
 Do PASTE(PCount,Blank-1,T,2,"","")
 Do PASTE(PCount,Blank-1,DT,Allign+4,"","")
 Set T=Titel
 Do PASTE(PCount,Blank-3,T,2,"","B")
 Quit
 ;
 ; Afdruk afsluiting (eerste bladzijden)
FOOTER 
 Set C(PCount,LCount)=C(PCount,LCount)_P("D",0)
 For I=LCount+1:1:MaxLines-1 Do CACHE(L("B","B"))
 Do CACHE(L("B","L"))
 Set T=" "_$$TXT("Vervt")_" "
 Do PASTE(PCount,LCount,T,"",(79-VPerfo),"")
 Set C(PCount,LCount)=P("D",1)_C(PCount,LCount)
 Quit
 ;
 ; Afdruk afsluiting (laatste blad)
LFOOTER 
 Do CACHE(L("A","L"))
 Quit
 ;
 ; Afdruk van de voorwaarden
VOORW 
 New B,I,R,R1,T,BCount,Land,%KontKrt,TKontKrt,BetVw,LeverVw,%Algem
 Set BCount=0
 Set KlantInd=^KK1(KLNr),R=^KKL(KlantInd,0),Land=$P(R,D,8),%KontKrt=$P(R,D,17),BetVw=$P(R,D,18)
 Set R=^KKL(KlantInd,2),TKontKrt=$P(R,D,2)
 Set R=^KKL(KlantInd,3),LeverVw=$P(R,D,3)
 If Prefs("%Met") Do  ; Met percentage
 .Set %Algem=0 If TotOmzH Set %Algem=TotOmzS-TotOmzH/TotOmzH*100
 .Set %Algem=$S(%Algem>0:"+",1:"")_$TR($FN(%Algem,",",1),",.",".,")
 .Set T=$$TXT("Afw1")_$$TXT("Afw2")_$$TXT("Afw3")_$$TXT("Afw4")_$$TXT("Afw5",2)
 .Set T=T_$$EXTDATE^vhDTyp($$CALCDATE^vhDTyp($$INTDATE^vhDTyp(Prefs("Periode","Begin"),"DM"),"M","FD"))
 .Set T=T_$$TXT("Afw5",3)
 .If Prefs("Periode","Einde")=(DJ_"."_DM_" ") Set T=T_$TR(DT,".","-")
 .Else  Set T=T_$$EXTDATE^vhDTyp($$CALCDATE^vhDTyp($$INTDATE^vhDTyp(Prefs("Periode","Einde"),"DM"),"M","LD"))
 .Set T=T_$$TXT("Afw5",4)_%Algem_" %"
 .Do WRAP^cRtn((77-VPerfo),"T","",.I)
 .For I=1:1:I Do BLOCK(I(I)_";3;;B")
 .Do BLOCK("")
 Set R=$$LEVVW^KLANT(LeverVw,Taal) ; Leveringsvoorwaarde
 If $L(R) Do
 .Set T=$$TXT("LevVw")
 .Set R=T_";3;;U\:;"_($L(T)+3)_D_R
 .For I=1:1:$L(R,"#") Set $P(R,"#",I)=$P(R,"#",I)_U_($L(T)+5)
 .For I=1:1:$L(R,"#") Do BLOCK($P(R,"#",I))
 .Do BLOCK("")
 Set T=$$TXT("BetVw") ; Betalingsvoorwaarde
 Set R=$$BETVW^KLANT(BetVw,%KontKrt,TKontKrt,"",Taal)
 Set R=T_";3;;U\:;"_($L(T)+3)_D_R
 For I=1:1:$L(R,"#") Set $P(R,"#",I)=$P(R,"#",I)_U_($L(T)+5)
 For I=1:1:$L(R,"#") Do BLOCK($P(R,"#",I))
 Do BLOCK("")
 If Land="NL" Do BLOCK($P($T(TVwNl1),U,2)),BLOCK($P($T(TVwNl2),U,2)),BLOCK("") ; Export
 If B(BCount)="" Kill B(BCount) Set BCount=BCount-1
 If LCount+BCount+2>MaxLines Do FOOTER,TITEL,HEADER
 Set C(PCount,LCount)=C(PCount,LCount)_P("D",0)
 If P("Type")'="CA" For I=LCount+1:1:MaxLines-2-BCount Do CACHE(L("B","B"))
 Do CACHE(L("V","F"))
 Set C(PCount,LCount)=P("D",1)_C(PCount,LCount)
 Do PASTEB(L("V","B"))
 Quit
 ;
 ; Selekteren en rangschikken van de produkten
FETCHPR 
 New B,R,I,J,PRNr,KortText,KortComp,HoofdGr,Groep,SubGroep,Omzet,Periode
 Kill ^HULP($J,"PL")
 Set (PRNr,Omzet)=0
 For  Set PRNr=$O(^KSTKL(KLNr,PRNr)) Quit:PRNr=""  Do
 .Set Periode=$O(^KSTKL(KLNr,PRNr,Prefs("Periode","Begin")),-1)
 .Set Periode=$O(^KSTKL(KLNr,PRNr,Periode)) Quit:Periode=""!(Periode]Prefs("Periode","Einde"))
 .Set R=^KSTKL(KLNr,PRNr,0) Quit:$P(R,D,13)
 .Set Periode=$O(^KSTKL(KLNr,PRNr,Prefs("Periode","Begin")),-1)
 .For  Set Periode=$O(^KSTKL(KLNr,PRNr,Periode)) Quit:Periode=""!(Periode]Prefs("Periode","Einde"))  Do
 ..Set R=^KSTKL(KLNr,PRNr,Periode),Omzet=Omzet+$P(R,D,3)
 .Do BOOM
 If Omzet<Prefs("Omzet","OnderGr")!(Omzet>Prefs("Omzet","BovenGr")) Kill ^HULP($J,"PL")
 Quit
 ;
 ; Ragnschikken volgens boom
BOOM 
 Quit:'$D(^KPR(PRNr))
 Set R=^KPR(PRNr,0),KortText=$P(R,D)
 Set R=" \ \ ",I=$O(^KPR(PRNr,"I")) If $E(I)="I" Set R=^KPR(PRNr,I)
 Set HoofdGr=$P(R,D),Groep=$P(R,D,2),SubGroep=$P(R,D,3)
 Quit:$$BEPERK()
 Set KortComp=$$COMPR^PRODUKT(PRNr)
 Set ^HULP($J,"PL",HoofdGr,Groep,SubGroep,KortComp)=PRNr
 Quit
 ;
 ; Nazicht beperking
BEPERK() 
 If '$D(Prefs("Beperk")) Quit 0
 If Prefs("Beperk")="H" Quit '$D(Prefs("Beperk",HoofdGr))
 If Prefs("Beperk")="G" Quit '$D(Prefs("Beperk",Groep))
 If Prefs("Beperk")="S" Quit '$D(Prefs("Beperk",SubGroep))
 Quit 0
 ;
 ; Afdrukken van een bladzijde
PPRINT 
 Do PPRINT^DCPRINT(PCount)
 Kill C(PCount)
 Quit
 ;
 ; Opbouwen local C en afdrukken van de prijslijst
PRINT(KLNr,R) ; R="BeginPer\EindPer\Beperk\PrintSGr\NLQ\Schaduw\MetVerg\%Met\OmzOndGr\OmzBovGr"
 New KlantInd,Taal,NetBrutP,KlMunt,TotOmzH,TotOmzS
 New B,C,PCount,LCount,Prefs
 If '$D(R) Set R=""
 Set Prefs("Periode","Begin")=$P(R,D) If Prefs("Periode","Begin")="" Set Prefs("Periode","Begin")=^KSTKL(0,0,1)
 Set Prefs("Periode","Einde")=$P(R,D,2) If Prefs("Periode","Einde")="" Set Prefs("Periode","Einde")=DJ_"."_DM
 Set Prefs("Periode","Begin")=Prefs("Periode","Begin")_" ",Prefs("Periode","Einde")=Prefs("Periode","Einde")_" "
 Set Prefs("SubGroep")=$P(R,D,4),Prefs("NLQ")=$P(R,D,5),Prefs("NoSa")=$P(R,D,6)+$P(R,D,7)+$P(R,D,8),Prefs("%Met")=$P(R,D,8)
 Set Prefs("Omzet","OnderGr")=$P(R,D,9),Prefs("Omzet","BovenGr")=$P(R,D,10)
 If Prefs("Omzet","BovenGr")="" Set Prefs("Omzet","BovenGr")=1000000000
 If $L($P(R,D,3)) Do
 .Set R=$TR($P(R,D,3),"`",D),Prefs("Beperk")=$P(R,D)
 .For I=2:1 Quit:$P(R,D,I)=""  Set Prefs("Beperk",$P(R,D,I))=""
 Set (PCount,TotOmzH,TotOmzS)=0
 Set KlantInd=^KK1(KLNr),R=^KKL(KlantInd,0)
 Set KlMunt=$P(R,D,11) If "BF"[KlMunt Set KlMunt="BEF"
 Set Taal=$P(R,D,9) If Taal="" Set Taal="N"
 Set R=^KKL(KlantInd,2),NetBrutP=$P(R,D,5)
 Do INIT
 Set R="",Prefs("Beperk")="H"
 For  Set R=$O(^KPHG(R)) Q:R=""  If $E(R,3,4)'="AL" Set Prefs("Beperk",R)=""
 If Prefs("NLQ") Write P("Q",1)
 Do FETCHPR Quit:'$D(^HULP($J,"PL"))
 Do FTITEL,FHEADER,BODY,VOORW,LFOOTER,PPRINT
 Write P("Q",0)
 Kill ^HULP($J,"PL")
 Quit
 ;
 ; Initialisatie
INIT 
 If '$D(VH) Do VH^DCINIT
 If '$D(P) Do PINIT^DCINIT
 If '$D(L) Do LINIT^DCINIT("P")
 If '$D(PageLen) Do FINIT^DCINIT("P")
 Write P("D",1)
 Quit
 ;
TPrijsL ;PRIJSLIJST\PRIX COURANT\PREISLISTE\PRICE LIST
TDate ;Datum\Date\Datum\Date
TVervg ;vervolg\suite\fortsetzung\continue
TVervt ;vervolgt\a suivre\fortgesetzt\t.b.continued
TArt ;Artikel\Article\Artikel\Article
TPrijs ;Prijs\Prix\Preis\Price
TOldPri ;Oude prijs\Prix ancien\Alte preis\Old price
TNewPri ;Nieuwe pr.\Prix Nouv.\Neue preis\New price
TKort ;Korting\Remise\Rabat\Discount
TAfw1 ;De gemiddelde prijsafwijking\La difference moyenne\Ihre durchschnittliche\De gemiddelde prijsafwijking
TAfw2 ; met betrekking tot uw\ des prix concernant votre\ preisabweichung\ met betrekking tot uw
TAfw3 ; totale omzet gerealiseerd\ chiffre d'affaires realise\ im vergleich zu\ totale omzet gerealiseerd
TAfw4 ; in de periode\ dans la periode\ ihrem umsatz\ in de periode
TAfw5 ; van \ du \ von \ van ; tot \ jusqu'au \ bis \ tot ; bedraagt \ se monte a \ betraegt \ brdraagt 
TVwNl1 ;Verkopen en leveringen in Nederland volgens BELUNED-condities, gedeponeerd
TVwNl2 ;bij de Kamer van Koophandel en Fabrieken te 's Gravenhage onder nummer 1287.
TLevVw ;Leveringsvoorwaarde\Conditions de livraison\Lieferbedingung\Betalingsvoorwaarde
TBetVw ;Betalingsvoorwaarde\Conditions de paiement\Zahlungsbedingung\Betalingsvoorwaarde
TKlRef ;Uw ref\Votre ref\Ihre ref\Uw ref