DCALG ;AFDRUKKEN DOKUMENTEN (print algemene routines) [ 06/12/2003  11:44 AM ]
 ;
 ; Numerieke formatering
FN(Number,Fraction,Format) 
 If $G(Format)="" Set Format="T."
 Quit $$EXTNUM^vhLib.DataTypes(Number,0,Format,Fraction)
 ;
 ; Ophalen taalafhankelijke tekst (nieuwe versie 02.2007)
TaalTekst(Program,LijnRef,Taal,Piece)
 Set Program=$G(Program,$ZN),Taal=$G(Taal,"N"),Piece=$G(Piece,2)
 Set R="T"_$S(Piece="*":Taal,1:"")_LijnRef_"^"_Program
 Xecute "Set R=$T("_R_")"
 Quit $S(Piece="*":$P(R,U,2),1:$P($P(R,U,Piece),D,$F("NFDE",Taal)-1))
 ;
 ; Ophalen taalafhankelijke tekst
TXT(Ref,Prog,Piece) 
 New R
 If '$D(Taal) New Taal Set Taal="N"
 Set Prog=$G(Prog) Set:Prog="" Prog=$ZN
 If '$D(Piece) Set Piece=2
 Set R="T"_$S(Piece="*":Taal,1:"")_Ref_"^"_Prog
 Xecute "Set R=$T("_R_")"
 Quit $S(Piece="*":$P(R,U,2),1:$P($P(R,U,Piece),D,$F("NFDE",Taal)-1))
 ;
PASTEB(R,NewPage,AddBlank,RBlock,RCache,RPaste) 
 New I
 Set RBlock=$G(RBlock,"BLOCK"),RCache=$G(RCache,"CACHE")
 Set RPaste=$G(RPaste,"PASTE")
 If '$D(DataRef) New DataRef Set DataRef="C"
 If $D(Lines),BCount>(MaxLines-Lines("T","N")-Lines("H")-Lines("F")) Do BSPLIT
 If $G(AddBlank),BCount,B(BCount)'="",LCount+BCount+1'=MaxLines Do @(RBlock_"("""")")
 If LCount+BCount+1>MaxLines Xecute NewPage
 For BCount=1:1:BCount Do
 .Do @(RCache_"(R)")
 .Set B=B(BCount) For I=$L(B,D):-1:1 Do
 ..Set T=$P(B,D,I)
 ..If $L(T,"`")=1 Set T=T_"`3"
 ..Do @(RPaste_"(PCount,LCount,$P(T,""`""),$P(T,""`"",2),$P(T,""`"",3),$P(T,""`"",4))")
 Set BCount=0
 Kill B
 Quit
 ;
BSPLIT 
 New I,BTemp
 Set BCount=MaxLines-LCount-1
 For I=MaxLines-LCount:1 Quit:'$D(B(I))  Set BTemp(I-BCount)=B(I) Kill B(I)
 Do PASTEB(R,NewPage,AddBlank,RBlock,RCache,RPaste)
 Merge B=BTemp
 Set BCount=$O(B(""),-1)
 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) 
 If '$D(DataRef) New DataRef Set DataRef="C"
 Set LCount=LCount+1
 Set @DataRef@(PCount,LCount)=R
 Quit
 ;
 ; Plaats data op een lijn in de local C
PASTE(Page,Line,Text,BPos,EPos,Attr) 
 If '$D(DataRef) New DataRef Set DataRef="C"
 If '$D(VPerfo) New VPerfo Set VPerfo=0
 Set:$L(BPos) BPos=BPos+VPerfo Set:$L(EPos) EPos=EPos+VPerfo
 New T,I,X
 Set T=Text Quit:T=""
 If Attr'["T" Set Attr=Attr_"T"
 If Attr["N" Set Attr=$TR(Attr,"NT","")
 If '($L(T,"ª")#2) Do
 .If $L(T,"ªB")'=$L(T,"ªb") Do
 ..If $L(T,"ªB")>$L(T,"ªb") Set T=T_P("B",0)
 ..If $L(T,"ªB")<$L(T,"ªb") Set T=P("B",1)_T
 .If $L(T,"ªU")'=$L(T,"ªu") Do
 ..If $L(T,"ªU")>$L(T,"ªu") Set T=T_P("U",0)
 ..If $L(T,"ªU")<$L(T,"ªu") Set T=P("U",1)_T
 For  Quit:T'["ª"  Do
 .New Attr
 .Set Attr=$E($P(T,"ª",2))
 .Set T=$P(T,"ª")_P($$UPCASE^vhRtn1(Attr),$S($A(Attr)<97:1,1:0))_$E($P(T,"ª",2,99),2,999)_"  "
 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(@DataRef@(Page,Line),BPos,EPos)=T
 } ElseIf BPos {
	Set $E(@DataRef@(Page,Line),BPos,BPos+$L(Text)-1)=T 
 }Else {
	Set $E(@DataRef@(Page,Line),EPos-$L(Text)+1,EPos)=T
 }
 Quit
 ;
 ; Plaats data in de string R
PASTER(Value,From,To) 
 If 'To Set To=From+$L(Value)-1
 If 'From Set From=To-$L(Value)+1
 Set $E(R,From,To)=Value
 Quit
 ;
 ; Firmanaam
 ; Aanspr = Z -> zonder aanspreking
FIRMANM(RefTyp,RefNr,Naam,Aanspr,Land) 
 New R,FirmaNm
 Set RefTyp=$G(RefTyp),RefNr=$G(RefNr),Naam=$G(Naam),Aanspr=$G(Aanspr),Land=$G(Land)
 If RefTyp="D" Set:Naam="" Naam=RefNr
 Else  If RefNr Do
 .If $L(Naam),$L(Aanspr),$L(Land) Quit
 .If RefTyp="K" Set R=^KKL(^KK1(RefNr),0)
 .Else  Set R=^KLE(^KL1(RefNr),0)
 .Set:Naam="" Naam=$P(R,D,2)
 .Set:Aanspr="" Aanspr=$P(R,D,4)
 .Set:Land="" Land=$P(R,D,8)
 Set Land=$$LAND^vhRtn1(Land)
 Set:"Zz"[Aanspr Aanspr=""
 If $L(Aanspr) Do
 .If Land="DE" Set FirmaNm=Naam_" "_Aanspr
 .Else  Set FirmaNm=Aanspr_" "_Naam
 Else  Set FirmaNm=Naam
 Quit FirmaNm
 ;
 ; Formateren BTW nummer
BTWNR(K) 
 New U3,SWBTW
 Set U3=K
 If $L(K) Do S1^cA248
 Quit U3
 ;
 ; Korting opmaken
KORTING(Korting) 
 New Korting1,Korting2
 Set Korting1=$P(Korting,"#"),Korting2=$P(Korting,"#",2),Korting=""
 If Korting1 Set Korting=$TR($$FN(Korting1,1)," ","")_"%"
 If Korting2 Set Korting=Korting_"+"_$J($TR($$FN(Korting2,1)," ",""),4)_"%"
 Quit Korting
 ;
 ; Omschrijving
OMSCHR(Nr) 
 New R
 Set R=""
 If $L(@("Omschr"_Nr)) Set R="   "_@("Omschr"_Nr)_$J("",45-$L(@("Omschr"_Nr)))_"`2`41`CT"
 Quit R
 ;
MEMO(Document) 
 New R,X,Memo,MemRef,MemSort,Count,I
 Do MEMOFill
 Do MEMOSorted
 Quit
MEMOFill
 Set MemRef=""
 For  Set MemRef=$O(^RES("DC","PI","MEMO","D",MemRef)) Quit:MemRef=""  Do
 .Set R=^RES("DC","PI","MEMO","D",MemRef)
 .Quit:(";"_$P(R,"`",4)_";")'[(";"_Document_";")           ; Deze tekst mag niet voor dit document
 .If $L($P(R,"`",3)) Xecute "Set X="_$P(R,"`",3) Quit:'X   ; Deze tekst mag niet onder bepaalde voorwaarde
 .If $P(R,"`",5) Quit:$P($H,",")<$P(R,"`",5)               ; Begintijdstip is nog niet bereikt voor deze tekst
 .If $P(R,"`",6) Quit:$P($H,",")>$P(R,"`",6)               ; Eindtijdstip is reeds verstreken voor deze tekst
 .Set Memo("S",$P(R,"`"))=MemRef
 Quit
 
MEMOSorted 
 New Attr,MemoWrap
 Set MemSort="",Count=0
 For  Set MemSort=$O(Memo("S",MemSort)) Quit:MemSort=""  Do
 .Set MemRef=Memo("S",MemSort),R=$G(^RES("DC","PI","MEMO","D",MemRef,Taal))
 .Quit:R=""
 .Xecute:$E(R,1,2)="$$" "Set R="_R
 .Set Attr=$P(^RES("DC","PI","MEMO","D",MemRef),"`",7)
 .Set Memo("M",1)=R
 .Do GETWRAP^vhBIGEDIT("Memo(""M"")",78,.MemoWrap,"G","~","")
 .If Count Set Count=Count+1,Memo(Count)=""
 .For I=1:1 Quit:'$D(MemoWrap(I))  Set Count=Count+1,Memo(Count)=Attr_"`"_$P(MemoWrap(I),"`",5)
 .Kill Memo("M"),MemoWrap
 For I=1:1 Quit:'$D(Memo(I))  Do
 .Set Attr=$P(Memo(I),"`"),Tekst=$P(Memo(I),"`",2)
 .Do BLOCK(Tekst_"`3``"_Attr_"T")
 Quit
 ;
MEMOPROXY(Document,Taal,Cache)   ; Cache als .local doorgeven --> wordt opgevuld met teksten
 New R,X,Memo,MemRef,MemSort,Count,MemTxt,ToonGeenBtwOmschrijving
 Set ToonGeenBtwOmschrijving = 1
 Do MEMOFill ; Copy
 Do MEMOArray
 Quit
MEMOFillCopy
 If '$G(%DebugVar) Do MEMOFill  Quit
 ; Else   ; Test Routine
 Set MemRef=""
 For  Set MemRef=$O(^RES("DC","PI","MEMO","D",MemRef)) Quit:MemRef=""  Do
 .Set R=^RES("DC","PI","MEMO","D",MemRef)
 .Quit:(";"_$P(R,"`",4)_";")'[(";"_Document_";")           ; Deze tekst mag niet voor dit document
 .If $L($P(R,"`",3)) Xecute "Set X="_$P(R,"`",3) Quit:'X   ; Deze tekst mag niet onder bepaalde voorwaarde
 .;If $P(R,"`",5) Quit:$P($H,",")<$P(R,"`",5)               ; Begintijdstip is nog niet bereikt voor deze tekst
 .;If $P(R,"`",6) Quit:$P($H,",")>$P(R,"`",6)               ; Eindtijdstip is reeds verstreken voor deze tekst
 .Set Memo("S",$P(R,"`"))=MemRef
 Quit
 Quit
MEMOArray 
 ; Alternatieve methode opbouw van teksten (voor Proxy-objecten)
 Set MemSort="",Count=0
 For  Set MemSort=$O(Memo("S",MemSort)) Quit:MemSort=""  Do
 .Set MemRef=Memo("S",MemSort)
 .Set MemTxt=$G(^RES("DC","PI","MEMO","D",MemRef,Taal))
 .Quit:(MemTxt="")
 .Xecute:$E(MemTxt,1,2)="$$" "Set MemTxt="_MemTxt
 .Set Cache("MEMO",$INCREMENT(Count))=MemTxt ;$TR(MemTxt,"~"," ")
 .Set Cache("MEMO",Count,"R")=MemRef
 Quit
 ;
 
VHPB(PCount,Blank,Aantal) 
 Set:$G(Aantal)="" Aantal=18
 If '$D(DataRef) New DataRef Set DataRef="C"
 For Blank=1:1:Aantal Do CACHE("")
 Quit
 ;
VHPD(PCount,Blank,VH) 
 New R,Iban
 For Blank=1:1:Blank Do
 .Quit:Blank>11
 .Set R=VH(Blank),Iban=0
 .If R["IBAN BE" Set $E(R,$L(R)-13)=P("B",1)_$E(R,$L(R)-13),R=R_P("B",0),Iban=1
 .If R["IBAN NL" Set $E(R,$L(R)-9)=P("B",1)_$E(R,$L(R)-9),R=R_P("B",0),Iban=1
 .If $G(%Fax),$G(%FaxNr) Do PASTE(PCount,Blank,R,2,1+$L(R)-(10*Iban),"") Quit
 .Do PASTE(PCount,Blank,R,2,2+$L(R)-5,$S(Blank>3:"C",1:""))
 .Quit:Blank<3
 .Do PASTE(PCount,Blank,$C(13)_$J("",$L(R)-2+$G(V)),2+$L(R)+3,2+$L(R)+3,"")
 Quit
 ;