DCMBON ;AFDRUKKEN MAGAZIJNBONS [ 05/15/2003  11:12 AM ]
 ;
 ; Het afdrukken van een magazijnbon kan met volgende oproep --> Do PRINT^DCMBON(BONNr)
 ;
VERWERK(FromNr,Sessie) 
 New BONNr
 Do INIT
 Set BONNr=$S(FromNr:FromNr-1,1:FromNr)
 For  Set BONNr=$O(^HULP($J,"P",Sessie,BONNr)) Quit:BONNr=""  Do PRINT(BONNr,$S(Sessie="X":"K",1:Sessie),1)
 Quit
 ;
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
 ;
 ; Afdruk body
BODY 
 New B,R,I,BCount,OLNr,KortComp
 New Aantal,KortText,IdentNr,Ligging,LevRef
 New HoofdGr,Groep,SubGroep
 Set BCount=0,HoofdGr=""
 For  Set HoofdGr=$O(^HULP($J,"M",HoofdGr)) Quit:HoofdGr=""  Do
 .Set Groep=""
 .For  Set Groep=$O(^HULP($J,"M",HoofdGr,Groep)) Quit:Groep=""  Do
 ..Set SubGroep=""
 ..For  Set SubGroep=$O(^HULP($J,"M",HoofdGr,Groep,SubGroep)) Quit:SubGroep=""  Do
 ...Set KortComp=""
 ...For  Set KortComp=$O(^HULP($J,"M",HoofdGr,Groep,SubGroep,KortComp)) Quit:KortComp=""  Do
 ....If HoofdGr="~T",Groep="~T",SubGroep="~T",KortComp="~T" Quit
 ....Set R=^HULP($J,"M",HoofdGr,Groep,SubGroep,KortComp)
 ....Set IdentNr=$P(R,D),KortText=$P(R,D,2),Aantal=$P(R,D,3),Ligging=$P(R,D,4),LevRef=$P(R,D,5)
 ....Set R=IdentNr_"`4\"_KortText_"`18\"_$$FN(Aantal,0)_"``53\"_Ligging_"`56"
 ....Do BLOCK(R)
 ....If $L(LevRef) Set R=LevRef_"`18" Do BLOCK(R)
 ....Do PASTEB(L("M","B"),1)
 If $TR(C(PCount,LCount),"| ","")="" Kill C(PCount,LCount) Set LCount=LCount-1
 Quit
 ;
 ; Afdruk hoofding
HEADER 
 New T
 Do CACHE(L("M","F"))
 Do CACHE(L("M","B"))
 Set T=$$TXT("Ident")
 Do PASTE(PCount,LCount,T,4,"","")
 Set T=$$TXT("Art")
 Do PASTE(PCount,LCount,T,18,"","")
 Set T=$$TXT("Aant")
 Do PASTE(PCount,LCount,T,"",52,"")
 Set T=$$TXT("Ligg")
 Do PASTE(PCount,LCount,T,56,"","")
 Do CACHE(L("M","S"))
 Quit
 ;
 ; Afdruk titel (volgende blazijden)
TITEL 
 New BonDat,KlantInd,R,T,Blank,Titel,Allign
 New Aanspr,Naam,Woonpl,Land,Beloofd,LevAdr
 Do PPRINT
 Set PCount=PCount+1,(LCount,LevAdr)=0
 Set R=^KUL(KLNr,"F",BONNr,1),BonDat=$TR($P(R,D,2),".","-")
 Set Beloofd=$S($L($P(R,D,16)):$S($P(R,D,23)="N":"N",1:"B"),1:"")
 Set KlantInd=^KK1(KLNr),R=^KKL(KlantInd,0)
 If +$G(^KUL(KLNr,"F",BONNr,3)) Set R=^KUL(KLNr,"F",BONNr,3),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,40,"","")
 Do PASTE(PCount,Blank,Woonpl,40,"","")
 Set Titel=$$TXT($S(BonTyp="M":"Monst",1:"MagBon")),Allign=$L(Titel)
 Set T=$$TXT("Date") Set:$L(T)>Allign Allign=$L(T)
 Do PASTE(PCount,Blank,T,2,"","")
 Do PASTE(PCount,Blank,BonDat,Allign+4,"","")
 Set T=Titel_$J("",Allign-$L(Titel)+2)_$TR($FN(BONNr,","),",",".") Set:$L(Beloofd) T=T_" "_Beloofd
 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 BonDat,KlantInd,R,T,Blank,Titel,Allign,Beloofd
 New Aanspr,Naam,Straat,PostNr,Woonpl,Land,Telefoon,LevAdr
 Set PCount=PCount+1,(LCount,LevAdr)=0
 Set R=^KUL(KLNr,"F",BONNr,1),BonDat=$TR($P(R,D,2),".","-")
 Set Beloofd=$S($L($P(R,D,16)):$S($P(R,D,23)="N":"N",1:"B"),1:"")
 Set KlantInd=^KK1(KLNr),R=^KKL(KlantInd,0)
 Set KlantInd=^KK1(KLNr),R=^KKL(KlantInd,0),Telefoon=$P(R,D,13)
 If +$G(^KUL(KLNr,"F",BONNr,3)) Set R=^KUL(KLNr,"F",BONNr,3),LevAdr=1
 Set Naam=$P(R,D,2),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))
 For Blank=1:1:7 Do CACHE("")
 Do PASTE(PCount,Blank-3,Telefoon,48,"","")
 Set T=$$TXT("TelNr")
 Do PASTE(PCount,Blank-3,T,40,"","")
 Set:'LevAdr T=$$FIRMANM^DCALG("K",KLNr)
 Set:LevAdr T=$$FIRMANM^DCALG(,,Naam,Aanspr,Land)
 Do PASTE(PCount,Blank-2,T,40,"","")
 Do PASTE(PCount,Blank-1,Straat,40,"","")
 Do PASTE(PCount,Blank,PostNr_"   "_Woonpl,40,"","")
 Set Titel=$$TXT($S(BonTyp="M":"Monst",1:"MagBon")),Allign=$L(Titel)
 Set T=$$TXT("Date") Set:$L(T)>Allign Allign=$L(T)
 Do PASTE(PCount,Blank,T,2,"","")
 Do PASTE(PCount,Blank,BonDat,Allign+4,"","")
 Set T=Titel_$J("",Allign-$L(Titel)+2)_$TR($FN(BONNr,","),",",".") Set:$L(Beloofd) T=T_" "_Beloofd
 Do PASTE(PCount,Blank-2,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("M","B"))
 Do CACHE(L("M","L"))
 Set T=" "_$$TXT("Vervt")_" "
 Do PASTE(PCount,LCount,T,"",78,"")
 Set C(PCount,LCount)=P("D",1)_C(PCount,LCount)
 Quit
 ;
 ; Afdruk afsluiting (laatste blad)
LFOOTER 
 New R,Beloofd
 Do CACHE(L("M","L"))
 If $D(^HULP($J,"M","~T","~T","~T","~T")) Do
 .Set R="Nota : zie leveringsbon voor tekst"
 .Do CACHE(""),CACHE(""),PASTE(PCount,LCount,R,2,"","B")
 Set Beloofd=$P(^KUL(KLNr,"F",BONNr,1),D,16)
 If $L(Beloofd) Do
 .Set R=$C(27)_"[@"_$C(4)_$C(0)_$C(0)_$C(0)_$C(18)_$C(2)_$C(27)_":"
 .Set R=R_$$TXT("Beloofd")_" "_Beloofd
 .Set R=R_$C(18)_$C(27)_"[@"_$C(4)_$C(0)_$C(0)_$C(0)_$C(17)_$C(1)
 .Do CACHE(""),CACHE(""),PASTE(PCount,LCount,R,2,"","B")
 Quit
 ;
 ; Produktlijnen filteren
FETCHPR 
 New B,R,I,J,OLNr,PRNr,Aantal,KortText,IdentNr,Ligging,KortComp,LevRef,Kom,LEVNr,ContrRef
 New HoofdGr,Groep,SubGroep
 Kill ^HULP($J,"M")
 Set OLNr=100
 For  Set OLNr=$O(^KUL(KLNr,"F",BONNr,OLNr)) Quit:'OLNr  Do
 .Set R=^KUL(KLNr,"F",BONNr,OLNr)
 .If $P($P(R,D,17),"#")="KF11" Set ^HULP($J,"M","~T","~T","~T","~T")="Nota : zie leveringsbon voor tekst"
 .If $P($P(R,D,17),"#")="KF1925" Set R=$P(R,D,20)_D_$P(R,D,5)_D_$P(R,D,3)_"\Speciaal",^HULP($J,"M","~M","~M","~M",OLNr)=R
 .Set PRNr=$P(R,D,2) Quit:PRNr'?4.7N  Quit:'$D(^KPR(PRNr))
 .Set Aantal=$P(R,D,3) Quit:'Aantal
 .Set Kom=$P($P(R,D,28),";")="KOM",ContrRef=$P(R,D,13)
 .Do BOOM
 .;Verwerking deelprodukten nog te doen (zie ^KFDULA)
 Quit
 ;
 ; Ragnschikken volgens boom
BOOM 
 Set R=^KPR(PRNr,0),KortText=$P(R,D),Ligging=$P(R,D,6)
 If $L(Ligging) For I=$L(Ligging):-1:2 Set $E(Ligging,I)="."_$E(Ligging,I)
 Set R=^KPR(PRNr,2),IdentNr=$P(R,D,25)
 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)
 Set R="",J=$O(^KPR(PRNr,"J")) If $E(J)="J",$D(Lever($E(J,2,9))) Set R=^KPR(PRNr,J)
 Set LevRef=$P(R,D,3),LEVNr=$E(J,2,9)
 Set KortComp=$$COMPR^PRODUKT(PRNr)
 If $L(ContrRef) Do
 .Set R=$$UPTRIMAN^vhRtn1(ContrRef)
 .If R["CONTRACT" Set Ligging=$$TXT("Contr")_$P(ContrRef,"CONTRACT",2)
 .If R["CONTRAT" Set Ligging=$$TXT("Contr")_$P(ContrRef,"CONTRAT",2)
 If LEVNr=5810 Set KortComp=KortComp_Kom Set:'Kom Ligging=$$TXT("ServSt")
 Set KortComp=KortComp_ContrRef
 If $D(^HULP($J,"M",HoofdGr,Groep,SubGroep,KortComp)) Do
 .Set R=^HULP($J,"M",HoofdGr,Groep,SubGroep,KortComp)
 .Set $P(R,D,3)=$P(R,D,3)+Aantal
 Else  Set R=IdentNr_D_KortText_D_Aantal_D_Ligging_D_LevRef
 Set ^HULP($J,"M",HoofdGr,Groep,SubGroep,KortComp)=R
 Quit
 ;
 ; Afdrukken van een bladzijde
PPRINT 
 Do PPRINT^DCPRINT(PCount)
 Kill C(PCount)
 Quit
 ;
 ; Opbouwen local C en afdrukken van de faktuur
PRINT(BONNr,Sessie,Init) 
 New KLNr,KlantInd,Taal,Lever,BonTyp
 New C,PCount,LCount
 If '$G(Init) Do INIT
 Set PCount=0 For Lever=5004,5156,5763,5944 Set Lever(Lever)=""
 Set R=^KU1(BONNr,"F"),KLNr=$P(R,D)
 Set Taal="N"
 Set R=^KUL(KLNr,"F",BONNr,1),BonTyp=$P(R,D,25)
 Do FETCHPR Quit:'$D(^HULP($J,"M"))
 Do FTITEL,HEADER,BODY,LFOOTER,PPRINT
 Kill ^HULP($J,"M")
 Quit
 ;
 ; Initialisatie
INIT 
 If '$D(L) Do LINIT^DCINIT("M")
 If '$D(P) Do PINIT^DCINIT
 If '$D(PageLen)!'$D(V) Do FINIT^DCINIT("M")
 Write P("D",1)
 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)
 ;
TMagBon ;MAGAZIJNBON\MAGAZIJNBON\MAGAZIJNBON\MAGAZIJNBON
TMonst ;MONSTER MAGAZIJN\MONSTER MAGAZIJN\MONSTER MAGAZIJN\MONSTER MAGAZIJN
TDate ;Datum\Date\Datum\Date
TTelNr ;Tel.nr.\No.Tel.\Tel.nr.\Tel.nbr
TVervg ;vervolg\suite\fortsetzung\continue
TVervt ;vervolgt\à suivre\fortgesetzt\t.b.continued
TIdent ;Identnummer\No identif\Identnummer\Identnummer
TArt ;Artikel\Article\Artikel\Article
TAant ;Aantal\Quant.\Menge\Quant.
TLigg ;Ligging\Situe\Lagerpl.\Situated
TServSt ;Service stock\Stock\Service stock\Service stock
TContr ;Contract\Contrat\Contract\Contract
TBeloofd ;Beloofd voor\Beloofd voor\Beloofd voor\Beloofd voor