DCSBON ;AFDRUKKEN LEVERINGSBONS (samenvatting) [ 11/18/2003  2:07 PM ]
 ;
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,BONNr,OLNr,PRNr,Next,IsOrgal
 New ORDNr,BonDat,OrdRef,Paste,OrgalRef,Lijnen
 Set HalProd=0
 Set BCount=0
 For Next=1:1 Quit:'$D(^HULP(%J,Next))  Do
 .Set R=^HULP(%J,Next)
 .Quit:'$P(R,D)
 .Set BONNr=$P(R,D,2),IsOrgal=$$ISORGAL^FLOW("L",BONNr),(Lijnen,Orders)=0
 .Set R=^KUL(KLNr,"F",BONNr,1),BonDat=$P(R,D,2),VerzWijz=$P($P(R,D,7),"#",2)
 .Set BedrPort=BedrPort+$P($P(R,D,13),"#"),Gewicht=Gewicht+$P($P(R,D,13),"#",3)
 .Set Munt=$P(R,D,18) Set:Munt="" Munt=$$FADEF^vhRtn1()
 .Do:$L($P(R,D,30))
 ..For I=1:1:$L($P(R,D,30),";") Do
 ...Quit:";"_VerpTyp_";"[(";"_$P($P(R,D,30),";",I)_";")
 ...Set:$L(VerpTyp) VerpTyp=VerpTyp_";"
 ...Set VerpTyp=VerpTyp_$P($P(R,D,30),";",I)
 .Set OLNr=100
 .For  Set OLNr=$O(^KUL(KLNr,"F",BONNr,OLNr)) Quit:'OLNr  Do
 ..Set R=^KUL(KLNr,"F",BONNr,OLNr)
 ..Set Lijnen=Lijnen+("\KF6\KF1925\"[(D_$P($P(R,D,17),"#")_D))
 ..Set:$P(R,D,17)="KF5" Orders=Orders+1
 .Set Orders=D_$S(Orders>1:"s",1:"")
 .Do MERGERVP,BONREF(BONNr,BonDat,IsOrgal,Lijnen)
 .Set OLNr=100
 .For  Set OLNr=$O(^KUL(KLNr,"F",BONNr,OLNr)) Quit:'OLNr  Do
 ..Set R=^KUL(KLNr,"F",BONNr,OLNr),PRNr=$P(R,D,2)
 ..If PRNr,'HalProd,$D(^KPR(PRNr,"J6332")) Set HalProd=1
 ..Set Paste=$$SBON^DCDETAIL(BONNr,OLNr,IsOrgal)
 ..Do:Paste
 ...Set R=$O(^KUL(KLNr,"F",BONNr,OLNr))
 ...If R Set R=^KUL(KLNr,"F",BONNr,R) Quit:$P(R,D,17)'="KF5"
 ...Do PASTEB(L("B","B"),1)
 .If $D(B) Do PASTEB(L("B","B"),1)
 If $D(B) Do 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 bonreferentie
BONREF(BONNr,BonDat,IsOrgal,Lijnen) 
 New R,Date
 Set R=$$TXT("Bon")_" "_$$FN(BONNr,0)_"- "_BonDat
 Set:IsOrgal R=R_" "_$$TXT("Orgal")
 Set R=R_$J("",40-$L(R))_"`5`44`B\"_$$FN(Lijnen,0)_"``78"
 Do:BCount BLOCK("") Do BLOCK(R)
 Quit
 ;
 ; Afdruk orderreferentie
ORDREF(ORDNr,OrdRef,OrgalRef) 
 Set $P(Orders,D)=$P(Orders,D)+1
 Set R=$$TXT("Order"_$P(Orders,D,2)) Set:Orders>1 R=$J("",$L(R))
 Set R=R_" "_$$FN(ORDNr,0)
 If $L(OrdRef) Set R=R_"- "_OrdRef
 Set:$L(OrgalRef) OrgalRef=$S(IsOrgal:"",1:"Comm: ")_OrgalRef,R=R_" - "_OrgalRef
 Set R=R_$J("",66-$L(R))_"`5`59`C"
 Do BLOCK(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("Lijnen")
 Do PASTE(PCount,LCount,T,"",77,"")
 If $D(L("B","S")) Do CACHE(L("B","S"))
 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,"",79,"")
 ;Set C(PCount,LCount)=P("D",1)_C(PCount,LCount); Bidirectioneel afgezet
 Quit
 ;
 ; Afdruk afsluiting (laatste blad)
LFOOTER 
 Do CACHE(L("A","L"))
 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
 ;
 ; Afdruk van de voorwaarden
VOORW 
 New B,I,R,R1,T,BCount,Naam,Land,Pariteit,Opmerk,LTemp,VPerfoT,VerpTxt
 Set VPerfoT=VPerfo
 New VPerfo
 Set BCount=0
 Do RECUPVP
 Set VerpTxt=0
 Set KlantInd=^KK1(KLNr),R=^KKL(KlantInd,0),Naam=$P(R,D,2),Land=$$LAND^vhRtn1($P(R,D,8))
 Set R=^KKL(KlantInd,5),Opmerk=""
 For I=3:1:5 If $L($P(R,D,I)) Set:$L(Opmerk) Opmerk=Opmerk_D Set Opmerk=Opmerk_$P(R,D,I)
 If Land'="BE",Netto Do  ; Waarde
 .Set Pariteit=$$MUNT^vhRtn1(Munt,,12)
 .Set Netto=$$FN(Netto*Pariteit,$$MUNT^vhRtn1(,4))
 .Set T=$$TXT("Waarde")
 .Set T=T_D_Netto_$$MUNT^vhRtn1(,1)_"`"_($L(T)+4)
 .Do BLOCK(T),BLOCK("")
 Set T="" If $L(Opmerk) For I=1:1:$L(Opmerk,D) Do  ; Opmerkingen
 .Set T=$P(Opmerk,D,I)
 .Do BLOCK(T_"`3")
 If $L(T) Do BLOCK("")
 Set T=$$TXT("Lever") ; Verzendwijze
 Set R=T_"`3``U\:`"_($L(T)+3)_D_VerzWijz_"`"_($L(T)+5)
 Do BLOCK(R)
 Do BLOCK("")
 Set T=$$TXT("Verpak") ; Verpakking
 For I=1:1:$L(VerpTyp,";") Do
 .Quit:'$L($P(VerpTyp,";",I))
 .Kill R
 .Set R(1)=$G(^RES("VERPAK","PI","TYPE","D",$P(VerpTyp,";",I),Taal))
 .Quit:R(1)=""
 .Do GETWRAP^vhBIGEDIT("R",76-$L(T),.R,"G","~","")
 .Set VerpTxt=VerpTxt+1
 .Merge VerpTxt(VerpTxt)=R
 Do:VerpTxt
 .Set R=T_"`3``U\:`"_($L(T)+3)
 .For VerpTxt=1:1:VerpTxt Do
 ..For I=1:1 Quit:'$D(VerpTxt(VerpTxt,I))  Do
 ...Set:$L(R) R=R_D Set R=R_$P(VerpTxt(VerpTxt,I),"`",5)_"`"_($L(T)+5)
 ...Do BLOCK(R)
 ...Set R=""
 .Do BLOCK("")
 Do MEMO^DCALG("S")
 Kill R ; Tekst op bon
 Set R(1)=^RES("DC","PI","DCSBON","D","ONTVANGST",Taal)
 Do:$L(R(1))
 .Do GETWRAP^vhBIGEDIT("R",76,.R,"G","~","")
 .For R=1:1:R Set T=$P(R(R),"`",5) Do BLOCK(T)
 .Do BLOCK("")
 If BedrPort!Gewicht Do
 .Set T=""
 .If BedrPort!Gewicht Set Gewicht=$$FN(Gewicht,1),T=Gewicht_"kg"
 .Do BLOCK(T),BLOCK("")
 If B(BCount)="" Kill B(BCount) Set BCount=BCount-1
 Set LTemp=L("B","S") If P("Type")="CA"!(P("Type")="BL")!(P("Type")="TK") Kill L("B","S")
 If LCount+BCount+2>MaxLines Do FOOTER,TITEL,HEADER
 Set L("B","S")=LTemp
 ;Set C(PCount,LCount)=C(PCount,LCount)_P("D",0); Bidirectioneel afgezet
 If P("Type")'="CA",P("Type")'="BL",P("Type")'="TK" For I=LCount+1:1:MaxLines-2-BCount Do CACHE(L("B","B"))
 If '$D(RecupVp) Do CACHE(L("V","F"))
 If $D(RecupVp) Do CACHE(L("R","F"))
 ;Set C(PCount,LCount)=P("D",1)_C(PCount,LCount); Bidirectioneel afgezet
 Do PASTEB(L("V","B"))
 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
 Set SelPrint='$D(Print)
 If SelPrint Do SELPRINT^DCPRINT("?") Quit:'$D(Print)
 Do INIT
 Set KLNr=^HULP(%J)
 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,HEADER,BODY,VOORW,LFOOTER,PPRINT
 Do:SelPrint CLOSE^vhPRINTER
 Kill ^HULP(%J,"S"),^HULP(%J,"A")
 Quit
 ;
 ; Initialisatie
INIT 
 New I,R,KLNr,BONNr
 Set Document="S"
 Do VH^DCINIT,PINIT^DCINIT,LINIT^DCINIT("S")
 If '$D(PageLen)!'$D(V) Do FINIT^DCINIT("S")
 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)
 .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
 ;
 ; 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 ;OVERZICHT LEVERING\APERCU DE LIVRAISON\LIEFERSCHEIN\DELIVERY NOTE
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
TLijnen ;Posities\Posit.\Posities\Posities
TOrder ;Order\Commande\Auftr\Order
TOrders ;Orders\Commandes\Auftr\Orders
TWaarde ;Waarde\Valeur\Wert\Value
TLever ;Levering\Livraison\Lieferung\Delivery
TKont ;KONTANT\AU COMPTANT\KONTANT\KONTANT
TOrgal ;ORGALUX\ORGALUX\ORGALUX\ORGALUX
TVerpak ;Verpakking\Emballage\Verpackung\Packing
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