DCDBON ;AFDRUKKEN LEVERINGSBONS (cosilidatie) [ 09/04/2003  11:35 AM ]
 ;
FN(Number,Fraction,Format) 
 Quit $$FN^DCALG(Number,Fraction,$G(Format))
 ;
PASTEB(R,AddBlank) 
 New NewPage
 Set NewPage="Do FOOTER^"_$ZN_",TITEL^"_$ZN_",HEADER^"_$ZN
 Do PASTEB^DCALG(R,NewPage,$G(AddBlank))
 Quit
 ;
BLOCK(R) 
 Do BLOCK^DCALG(R)
 Quit
 ;
CACHE(R) 
 Do CACHE^DCALG(R)
 Quit
 ;
PASTE(Page,Line,Text,BPos,EPos,Attr) 
 Do PASTE^DCALG(Page,Line,Text,BPos,EPos,Attr)
 Quit
 ;
PASTER(Value,From,To) 
 Do PASTER^DCALG(Value,From,To)
 Quit
 ;
 ; Afdruk body
BODY 
 New B,R,BCount,SortKey,PRNr,Aantal,KortTxt,IdentNr,KlantRef
 Set BCount=0,SortKey=""
 For  Set SortKey=$O(^HULP(%J,"D",SortKey)) Quit:SortKey=""  Do
 .Set R=^HULP(%J,"D",SortKey),PRNr=$P(R,D),Aantal=$P(R,D,2)
 .Set R=^KPR(PRNr,0),KortTxt=$P(R,D),R=^KPR(PRNr,2),IdentNr=$P(R,D,25)
 .Do KLANTREF^DCPROD("DCALG",21)
 .Set R=KortTxt_"`5"_D_IdentNr_"`33"_D_$$FN(Aantal,0)_"``55"_D_KlantRef_"`58`"
 .Do BLOCK(R),PASTEB(L("B","B"),1)
 Quit
 ;
 ; Opmaken van de gezamelijke recupereerbare verpakking
MERGERVP 
 New R,PRNr,SaldoDat
 Set PRNr=""
 For  Set PRNr=$O(^KUL(KLNr,"F",BONNr,"VP",PRNr)) Quit:PRNr=""  Do
 .Set R=^KUL(KLNr,"F",BONNr,"VP",PRNr)
 .Set:$P(R,D,2)>$P($G(RecupVp(PRNr)),D,2) RecupVp(PRNr)=R
 Quit
 ;
 ; Afdruk hoofding
HEADER 
 New T
 If $D(VPerfoT) New VPerfo Set VPerfo=VPerfoT
 Do CACHE(L("B","F"))
 Do CACHE(L("B","B"))
 Set T=$$TXT("Art")
 Do PASTE(PCount,LCount,T,5,"","")
 Set T=$$TXT("Ident")
 Do PASTE(PCount,LCount,T,33,"","")
 Set T=$$TXT("Aant")
 Do PASTE(PCount,LCount,T,"",54,"")
 Set T=$$TXT("KlRef")
 Do PASTE(PCount,LCount,T,58,"","")
 If $D(L("B","S")) Do CACHE(L("B","S"))
 Quit
 ;
 ; Afdruk hoofding eerste blad
FHEADER 
 New T,BONNr,BONNrs,LTemp
 If $D(VPerfoT) New VPerfo Set VPerfo=VPerfoT
 Set (BONNr,BONNrs)=""
 For  Set BONNr=$O(^HULP(%J,"B",BONNr)) Quit:BONNr=""  Set BONNrs=BONNrs_", "_$$EXTNUM^vhLib.DataTypes(BONNr,0,".","")
 Set $E(BONNrs,1,2)=""
 Do CACHE(L("T","F"))
 Do CACHE(L("T","B"))
 Set T=$$TXT("Consol")
 For  Quit:$L(T)>64  Quit:'$L(BONNrs)  Set T=T_$P(BONNrs,", ")_", ",BONNrs=$P(BONNrs,", ",2,99)
 Set $E(T,$L(T)-1,$L(T))=""
 Do PASTE(PCount,LCount,T,5,"","")
 For  Quit:'$L(BONNrs)  Do
 .Set T=$P(BONNrs,", ",1,8),BONNrs=$P(BONNrs,", ",9,99)
 .Do CACHE(L("T","B"))
 .Do PASTE(PCount,LCount,T,5,"","")
 Set LTemp=L("B","F"),L("B","F")=L("B","FV")
 Do HEADER
 Set L("B","F")=LTemp
 Quit
 ;
 ; Afdruk titel (volgende blazijden)
TITEL 
 New KlantInd,R,T,Blank,Titel,VPerfo
 New Aanspr,Naam,Woonpl,Land,LevAdr
 Do PPRINT
 Set PCount=PCount+1,(LCount,LevAdr)=0
 Set KlantInd=^KK1(KLNr),R=^KKL(KlantInd,0)
 If +$G(^HULP(%J,"A")) Set R=^HULP(%J,"A"),LevAdr=1
 Set Naam=$P(R,D,2),Aanspr=$P(R,D,4),Woonpl=$P(R,D,7)
 Set Land=$$LAND^vhRtn1($P(R,D,8))         
 For Blank=1:1:6 Do CACHE("")
 Set:'LevAdr T=$$FIRMANM^DCALG("K",KLNr)
 Set:LevAdr T=$$FIRMANM^DCALG(,,Naam,Aanspr,Land)
 Do PASTE(PCount,Blank-1,T,43,"","")
 Do PASTE(PCount,Blank,Woonpl,43,"","")
 Set Titel=$$TXT("Overz")
 Set T=$$TXT("Date")_" "_OVZDat
 Do PASTE(PCount,Blank,T,2,"","")
 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,BetVw,TCount,VPerfo
 New Aanspr,Naam,Toenaam,Straat,PostNr,Woonpl,Land,BtwNr,Telefoon,LevAdr
 Set PCount=PCount+1,(LCount,LevAdr)=0
 Set KlantInd=^KK1(KLNr),R=^KKL(KlantInd,0),Telefoon=$P(R,D,13),BtwNr=$$BTWNR^DCALG($P(R,D,16)),BetVw=$P(R,D,18)
 If +$G(^HULP(%J,"A")) Set R=^HULP(%J,"A"),LevAdr=1
 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=$$LAND^vhRtn1($P(R,D,8))
 Do VHPB^DCALG(PCount,.Blank)
 If BetVw="" Set T=$$TXT("Kont") Do PASTE(PCount,1,T,39,"","B")
 Do PASTE(PCount,AdresPos-6,Telefoon,51,"","")
 Set T=$$TXT("TelNr")
 Do PASTE(PCount,AdresPos-6,T,43,"","")
 If $L(BtwNr) Do
 .Do PASTE(PCount,AdresPos-5,BtwNr,51,"","")
 .Set T=$$TXT("Btw")
 .Do PASTE(PCount,AdresPos-5,T,43,"","")
 Set:'LevAdr T=$$FIRMANM^DCALG("K",KLNr)
 Set:LevAdr T=$$FIRMANM^DCALG(,,Naam,Aanspr,Land)
 If KLNr=8545,$L(T),$L(Toenaam) Set R=T,T=Toenaam,Toenaam=R
 Do PASTE(PCount,AdresPos,T,43,"","")
 If '$L(Toenaam) Do
 .Do PASTE(PCount,AdresPos+1,Straat,43,"","")
 .Do PASTE(PCount,AdresPos+3,PostNr_"   "_Woonpl,43,"","")
 .If Land'="BE" Do PASTE(PCount,AdresPos+4,$$LAND^vhRtn1(Land,2,Taal),43,"","")
 If $L(Toenaam) Do
 .Do PASTE(PCount,AdresPos+1,Toenaam,43,"","")
 .Do PASTE(PCount,AdresPos+2,Straat,43,"","")
 .Do PASTE(PCount,AdresPos+4,PostNr_"   "_Woonpl,43,"","")
 .If Land'="BE" Do PASTE(PCount,AdresPos+5,$$LAND^vhRtn1(Land,2,Taal),43,"","")
 Set Titel=$$TXT("Overz")
 Set T=$$TXT("Date")_" "_OVZDat
 Do PASTE(PCount,Blank-1,T,2,"","")
 Set TCount=2
 Set TCount=TCount+1,T=Titel
 Do PASTE(PCount,Blank-TCount,T,2,"","B")
 Do VHPD^DCALG(PCount,.Blank,.VH)
 Quit
 ;
 ; Afdruk afsluiting (eerste bladzijden)
FOOTER 
 ;Set C(PCount,LCount)=C(PCount,LCount)_P("D",0); Bidirectioneel afgezet
 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,"",78,"")
 ;Set C(PCount,LCount)=P("D",1)_C(PCount,LCount); Bidirectioneel afgezet
 Quit
 ;
 ; Afdruk afsluiting (laatste blad)
LFOOTER 
 New B,I,R,R1,T,BCount,Naam,Land,Pariteit,Opmerk,LTemp,VPerfoT,VerpTxt
 Set VPerfoT=VPerfo
 New VPerfo
 Set BCount=0
 Do RECUPVP
 If '$D(RecupVp) Do CACHE(L("A","L"))
 If $D(RecupVp) Do CACHE(L("R","F")),PASTEB(L("V","B"))
 Quit
 ;
RECUPVP 
 New RVPPRNr,Saldo,SaldoOp,AantGel,Fixed,SortKey,VPerfo
 If $D(RecupVp) Do
 .Set VPerfo=1 If P("Type")'="CA",P("Type")'="BL" Set VPerfo=2
 .Set R=L("R","B")
 .Set T=$$TXT("RVP")
 .Do PASTER(T,4,"")
 .Set T=$$TXT("RVPSOp")
 .Do PASTER(T,31+VPerfo,"")
 .Set T=$$TXT("RVPSal")
 .Do PASTER(T,"",57+VPerfo)
 .Set T=$$TXT("RVPGel")
 .Do PASTER(T,"",67+VPerfo)
 .Set T=$$TXT("RVPTer")
 .Do PASTER(T,"",77+VPerfo)
 .Do BLOCK(R_"`1")
 .Do BLOCK(L("R","S")_"`1")
 .Set RVPPRNr=""
 .For  Set RVPPRNr=$O(RecupVp(RVPPRNr)) Quit:RVPPRNr=""  Do
 ..Set SortKey=$$SORTKEY^PRODUKT(RVPPRNr),RVPPRNr(SortKey)=RVPPRNr
 .Set SortKey=""
 .For  Set SortKey=$O(RVPPRNr(SortKey)) Quit:SortKey=""  Do
 ..Set RVPPRNr=RVPPRNr(SortKey),R=RecupVp(RVPPRNr)
 ..Set Saldo=$P(R,D),SaldoOp=$P(R,D,2),AantGel=$P(R,D,3),Fixed=$P(R,D,4)
 ..Set R=^KPR(RVPPRNr,0),KortTxt=$P(R,D)
 ..Set R=L("R","B")
 ..Do PASTER(KortTxt,4,""),PASTER($$FMTDT^vhLib.DataTypes(SaldoOp,"DK4"),31+VPerfo,"")
 ..Do PASTER($$EXTNUM^vhLib.DataTypes(Saldo,0,".",0),"",59) Do:Fixed="?" PASTER(".......","",67+VPerfo)
 ..Do PASTER($S(AantGel>0:$$EXTNUM^vhLib.DataTypes(AantGel,0,".",0)_$S(Fixed="?":Fixed,1:""),1:"......."),"",67+VPerfo)
 ..Do PASTER($S(AantGel<0:$$EXTNUM^vhLib.DataTypes(AantGel,0,"-.",0)_$S(Fixed="?":Fixed,1:""),1:"......."),"",77+VPerfo)
 ..Do BLOCK(R_"`1")
 .Do BLOCK(L("R","L")_"`1")
 Quit
 ;
 ; Afdrukken van een bladzijde
PPRINT 
 Do PPRINT^DCPRINT(PCount)
 Kill C(PCount)
 Quit
 ;
 ; Opbouwen local C en afdrukken van de bon
PRINT(%J) 
 New KLNr,KlantInd,Taal,Netto,Optie,HalProd,Gewicht,BedrPort,VerpTyp,OVZDat,Document,Orders,SelPrint
 New C,PCount,LCount,VH,P,L,VerzWijz,Munt,RecupVp,lbKenAnk
 Set SelPrint='$D(Print)
 If SelPrint Do SELPRINT^DCPRINT("?") Quit:'$D(Print)
 Do INIT
 Set KLNr=$G(^HULP(%J))
 Do:KLNr
 .Do SORT
 .Set KlantInd=^KK1(KLNr),R=^KKL(KlantInd,0)
 .If +$G(^HULP(%J,"A")) Set R=^HULP(%J,"A")
 .Set Taal=$P(R,D,9) If Taal="" Set Taal="N"
 .Do FTITEL,FHEADER,BODY,LFOOTER,PPRINT
 .Set lbKenAnk=""
 .Do:$LL(lbKenAnk) PRINT^DCKENANK(lbKenAnk)
 Do:SelPrint CLOSE^vhPRINTER
 Kill ^HULP(%J,"B"),^HULP(%J,"D")
 Quit
 ;
 ; Initialisatie
INIT 
 New I,R,KLNr,BONNr
 Set Document="D"
 Do VH^DCINIT,PINIT^DCINIT,LINIT^DCINIT("D")
 If '$D(PageLen)!'$D(V) Do FINIT^DCINIT("D")
 Write P("D",1)
 Set (Netto,Gewicht,BedrPort,PCount)=0,(VerpTyp,OVZDat)=""
 Kill ^HULP(%J,"S")
 For I=1:1 Set R=$G(^HULP(%J,I)) Quit:R=""  Do
 .Quit:'$P(R,D)
 .Set BONNr=$P(R,D,2)
 .Quit:$$ISORGAL^FLOW("L",BONNr)
 .Set R=^KU1(BONNr,"F"),KLNr=$P(R,D),R=^KUL(KLNr,"F",BONNr,1),R=$$INTDATE^vhLib.DataTypes($P(R,D,2))
 .Set:R<OVZDat!'OVZDat OVZDat=R
 .Quit:$G(^HULP(%J))
 .Set ^HULP(%J)=KLNr
 .If +$G(^KUL(KLNr,"F",BONNr,3)) Set R=^KUL(KLNr,"F",BONNr,3),^HULP(%J,"A")=R
 Set OVZDat=$$EXTDATE^vhLib.DataTypes(OVZDat)
 Quit
 ;
SORT 
 New I,R,BONNr,BLNr,PRNr,SortKey,Aantal,KPRNr,Factor
 Kill ^HULP(%J,"B"),^HULP(%J,"D")
 For I=1:1 Set R=$G(^HULP(%J,I)) Quit:R=""  Do
 .Quit:'$P(R,D)
 .Set BONNr=$P(R,D,2)
 .Quit:$$ISORGAL^FLOW("L",BONNr)
 .Set $P(R,D,10)=1,^HULP(%J,I)=R
 .Set ^HULP(%J,"B",BONNr)="",BLNr=100
 .For  Set BLNr=$O(^KUL(KLNr,"F",BONNr,BLNr)) Quit:'BLNr  Do
 ..Set R=^KUL(KLNr,"F",BONNr,BLNr),PRNr=$P(R,D,2)
 ..Quit:'PRNr
 ..Set Aantal=$P(R,D,3)
 ..If $D(^PRLINK("D",PRNr)),$$AANTKIND^PRLINK(PRNr)>1,'$$ISORGAL^PRODUKT2(PRNr) Do
 ...Set KPRNr=""
 ...For  Set KPRNr=$O(^PRLINK("D",PRNr,KPRNr)) Quit:KPRNr=""  Do
 ....Set R=^PRLINK("D",PRNr,KPRNr),Factor=$P(R,D)
 ....Set SortKey=$$SORTKEY^PRODUKT(KPRNr),R=$G(^HULP(%J,"D",SortKey))
 ....Set $P(R,D)=KPRNr,$P(R,D,2)=$P(R,D,2)+(Aantal*Factor),^HULP(%J,"D",SortKey)=R
 ..Else  Do
 ...Set SortKey=$$SORTKEY^PRODUKT(PRNr),R=$G(^HULP(%J,"D",SortKey))
 ...Set $P(R,D)=PRNr,$P(R,D,2)=$P(R,D,2)+Aantal,^HULP(%J,"D",SortKey)=R
 .Do MERGERVP
 Quit
 ;
 ; 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)
 ;
TOverz ;CONSOLIDATIE\CONSOLIDATION\LIEFERSCHEIN\CONSOLIDATION
TBon ;BON\BON\LIEFERSCHEIN\NOTE
TDate ;Datum\Date\Datum\Date
TTelNr ;Tel nr.\No. tel\Tel nr.\Tel nbr
TBtw ;BTW nr.\No. TVA\BTW nr.\VAT nbr
TVervg ;vervolg\suite\fortsetzung\continue
TVervt ;vervolgt\à suivre\fortgesetzt\t.b.continued
TArt ;Artikel\Article\Artikel\Article
TIdent ;Identnummer\No identif\Identnummer\Identnummer
TAant ;Aantal\Quant.\Menge\Quant.
TKlRef ;Uw ref\Votre ref\Ihre ref\Uw ref
TKont ;KONTANT\AU COMPTANT\KONTANT\KONTANT
TRVP ;Recupereerbare verpakking\Emballage récupérable\Zurück zu fordern Verpack\Recupereerbare verpakking
TRVPSOp ;Saldo op\Solde\Offenstehend am\Saldo op
TRVPSal ;Saldo\Solde\Offenst.\Saldo
TRVPGel ;Geleverd\Livrée\Gelief.\Geleverd
TRVPTer ;Terug\Retour\Zurück\Terug  
TConsol ;Deze verzamellijst bevat volgende leveringen: \Deze verzamellijst bevat volgende leveringen: \Deze verzamellijst bevat volgende leveringen: \Deze verzamellijst bevat volgende leveringen: