vhScherm3 ;Tonen en verwerking van in ^SD gedefinieerde schermen [ 11/08/2003  2:41 PM ]
 ;
PRINT(sScrn,sHead,sTit,sRect,sNoBreak) 
 New sFR,sScrnHfd,sScrnPos,sScrnW,sDelim,sXP,sYP,sModT,sFld,sInp,sPromptL,sScrnDef
 Set sModT="P"
 Do INIT
 X:'$G(sFldEd) $G(^SD("D",sScrn,"N"))_" Do IE,PAINT"
 Set D=sDelim
 Quit
 ;
 ; Initialisatie van een scherm
INIT 
 If '$D(^SD("D",sScrn)) Write "Scherm ",sScrn," bestaat niet" h 2 Quit
 Merge sScrnDef=^SD("D",sScrn,"F")
 Set sScrnHfd=^SD("D",sScrn)
 Set:'$G(sScrnPos) sScrnPos=$P(sScrnHfd,"`",1)
 Set sScrnW=$P(sScrnHfd,"`",4) Set:'sScrnW sScrnW=80
 Set sDelim=D Set:$L($P(sScrnHfd,"`",5)) D=$C($P(sScrnHfd,"`",5))
 Set sPromptL=$P(sScrnHfd,"`",6) Set:'sPromptL sPromptL=15
 Set sHead=$G(sHead) Set:sHead="" sHead=$P(sScrnHfd,"`",3) Set:sHead="" sHead="T" ;1=NOtitel, T=Titel tussen lijn, H=Hoofding scherm
 Set sScrnPos=sScrnPos-sHead
 Set:sTit="H" Print("LIJN")=9999
 Set sRect=$G(sRect)
 Quit
 ;
 ; Initialisatie execute
IE 
 X:$D(^SD("D",sScrn,"I")) ^("I")
 Quit
 ;
 ;Afdrukken van een scherm
PAINT 
 New sFld,sFR,I,sSort
 For sFld=1:1 Quit:'$D(sScrnDef(sFld))  Do SORTFLD
 Do LCOUNT(sScrnPos+$O(sSort(""),-1)+(sRect*2),sTit)
 Do HEADER($P(sScrnHfd,"`",2),sHead)
 Do WRITE
 Quit
 ;
SORTFLD 
 Set sFR=sScrnDef(sFld)
 Do SORTRM(sFld,sFR)
 Do:$P(sFR,"`",8)'="B" SORTVAL(sFld,sFR)
 Do:$P(sFR,"`",8)="B" SORTBIG(sFld,sFR)
 Quit
 ;
 ; Sort prompt
SORTRM(sFld,sFR) 
 Set:'$L(sFR) sFR=sScrnDef(sFld)
 Quit:$P(sFR,"`",4)["H"
 S sXP=$P(sFR,"`",1) S:'sXP sXP=$P(sFR,"`",5)
 S sYP=$P(sFR,"`",2) S:'sYP sYP=$P(sFR,"`",6)-sPromptL
 If $P(sFR,"`",12)'["P" Do
 .If $L($P(sFR,"`",3)),"$"""[$E($P(sFR,"`",3)) X "S $P(sFR,""`"",3)="_$P(sFR,"`",3)
 .Do SORT(sXP,sYP,$P(sFR,"`",3),$P(sFR,"`",4))
 If $P(sFR,"`",12)[":" Do SORT($P(sFR,"`",5),$P(sFR,"`",6)-2,":","")
 Quit
 ;
 ; Sort value
SORTVAL(sFld,sFR) 
 New sFmt,sData
 If '$D(sFR) Set sFR=sScrnDef(sFld)
 Quit:$P(sFR,"`",4)["H"
 Set sFmt=$P(sFR,"`",7,11)
 Set:$P(sFmt,"`",4)>60 $P(sFmt,"`",4)=""
 Set $P(sFmt,"`",8)=$G(sScrnDef(sFld,"F")),sData=$$FKOL^vhRtn2(sFmt)
 If $P(sFmt,"`",4) Set sData(1)=sData
 Else  Do WRAP^vhRtn1("","sData","",.sData)
 Set sData=$O(sData(""),-1)
 For sData=1:1:sData Do SORT($P(sFR,"`",5)+sData-1,$P(sFR,"`",6),sData(sData),$TR($P(sFR,"`",12),":",""))
 Quit
 ;
SORTBIG(sFld,sFR) 
 New sFmt,sData,sDef,sLen
 If '$D(sFR) Set sFR=sScrnDef(sFld)
 Quit:$P(sFR,"`",4)["H"
 Set sDef=$G(sScrnDef(sFld,"F"))
 Set sParam=$P(sDef,"`",6)
 Set sLen=Print("KOL")-Print("LMARG")-$P(sFR,"`",6)+1
 Do:'$L(sParam) GETWRAP^vhBIGEDIT($P(sDef,"`",3),sLen,.sData,$P(sDef,"`",1),$P(sDef,"`",2),$P(sDef,"`",5))
 Do:$L(sParam) GETWRAP^vhBIGEDIT($P(sDef,"`",3),sLen,.sData,$P(sDef,"`",1),$P(sDef,"`",2),$P(sDef,"`",5),.@sParam)
 Set sData=$O(sData(""),-1)
 For sData=1:1:sData Do SORT($P(sFR,"`",5)+sData-1,$P(sFR,"`",6)+$P(sData(sData),"`",4),$P(sData(sData),"`",5),$TR($P(sFR,"`",12),":",""))
 Quit
 ;
SORT(X,Y,Val,Attrib) 
 For  Quit:$E(Val,$L(Val))'=" "  Set Val=$E(Val,1,$L(Val)-1)
 Set sSort(sScrnPos+X,Y)=Val_"`"_Attrib
 Quit
 ;
WRITE 
 New sLine,sPLine,sKolom,sRec,sVal,sAttrib,sWrap
 Set (sLine,sPLine)=""
 If sRect Do OUTPUT($$LINE^vhRtn1("F",(sScrnW+4),"1;"_(sScrnW+4)),Print("LMARG"),1)
 For  Set sLine=$O(sSort(sLine)) Quit:sLine=""  Do
 .For sPLine=sPLine+1:1:sLine-sScrnPos Do
 ..Do OUTPUT("",0,1) Quit:'sRect  Quit:sPLine'<(sLine-sScrnPos)
 ..Do OUTPUT($$LINE^vhRtn1("B",1,"1;1"),Print("LMARG"),0)
 ..Do OUTPUT($$LINE^vhRtn1("B",1,"1;1"),Print("LMARG")+sScrnW+3,0)
 .If '$G(%Fax),'$G(%FaxNr) Write $C(13)
 .If sRect Do OUTPUT($$LINE^vhRtn1("B",1,"1;1"),Print("LMARG"),0)
 .Set sKolom=""
 .For  Set sKolom=$O(sSort(sLine,sKolom)) Quit:sKolom=""  Do
 ..Set sRec=sSort(sLine,sKolom),sVal=$P(sRec,"`"),sAttrib=$P(sRec,"`",2),sRec=$P(sRec,"`")
 ..Do OUTPUT("",sKolom+Print("LMARG")+(sRect*2),0)
 ..Do:sAttrib["B" OUTPUT("@FMTB",0,0) Do:sAttrib["U" OUTPUT("@FMTU",0,0)
 ..Do WTXT(sRec)
 ..If sAttrib["B"!(sAttrib["U") Do
 ...Do:sAttrib["B" OUTPUT("@FMTb",0,0) Do:sAttrib["U" OUTPUT("@FMTu",0,0)
 ...If '$G(%Fax),'$G(%FaxNr) Write $C(13)
 .If sRect Do OUTPUT($$LINE^vhRtn1("B",1,"1;1"),Print("LMARG")+sScrnW+3,0)
 If sRect Do OUTPUT($$LINE^vhRtn1("L",(sScrnW+4),"1;"_(sScrnW+4)),Print("LMARG"),1)
 Quit
 ;
HEADER(Header,sHead) 
 For I=1:1:sScrnPos Do OUTPUT("",0,1)
 Quit:sHead
 X:$L(Header) "S Header="_Header
 Write $J("",Print("LMARG"))
 If sHead="I" Do
 .If $L(Header) Do
 ..Write @FMTB,$J("",sScrnW-$L(Header)\2-1)
 ..Write " "_Header_" "
 ..Write $J("",sScrnW-(sScrnW-$L(Header)\2)-1-$L(Header)),@FMTb
 .Else  Write @FMTB,$J("",sScrnW),@FMTb
 If sHead="T" Do
 .If $L(Header) Do
 ..Write $TR($J("",sScrnW-$L(Header)\2-1)," ",$c(196))
 ..Write " "_Header_" "
 ..Write $TR($J("",sScrnW-(sScrnW-$L(Header)\2)-1-$L(Header))," ",$c(196))
 .Else  Write $TR($J("",sScrnW)," ",$c(196))
 If sHead="H" Do
 .Write @FMTB," ",$P(Header,D,1)," - ",QN," ",@FMTb
 .If $P(Header,D,2)=""
 .Else  Write $J("",sScrnW-$L($P(Header,D,1))-$L($P(Header,D,2))-7-$L(QN)),@FMTB," ",$P(Header,D,2)," ",@FMTb
 Quit
 ;
PINIT(PapList,LijstBr,PrintTyp) 
 Do INIT^vhPRINTER(PapList,$G(LijstBr),$G(PrintTyp)) Quit:'$D(Print)
 Set Print("BLZ")=0,(Print("LIJN"),FP)=Print("LEN") W @F32
 Quit
 ;
LCOUNT(Lines,sTit) 
 Set Lines=$G(Lines) Set:'Lines Lines=1
 If $D(Print("BLZ")),$D(Print("LIJN")) Do
LCOUNT1 .Set Print("LIJN")=Print("LIJN")+Lines
 .If Print("LIJN")>(Print("MAXLIJN")-Print("FOOT")) Do
 ..If Print("BLZ") Write #
 ..Set Print("BLZ")=Print("BLZ")+1,Print("LIJN")=Print("TITEL")+Lines
 ..Quit:sTit
 ..If $G(%Fax),$G(%FaxNr) Do
 ...If Print("BLZ")=1 Do LOGO^vhFAX(%FaxNr,"LOGO_TOP") Quit
 ...Do NEWPAGE^vhFAX("%FaxNr"),LOGO^vhFAX(%FaxNr,"LOGO_ORD")
 ..Else  Do FTITEL^OUTPUT2(Print("KOL"),$G(Print("TITEL",1)),$G(Print("TITEL",2)),$G(Print("TITEL",3)))
 Quit
 ;
OUTPUT(R,Space,NewLine) 
 Set Space=$G(Space,$G(Print("LMARG"),0)),NewLine=$G(NewLine,1)
 If '$G(%Fax),'$G(%FaxNr) Do
 .Write:NewLine ! Write:Space ?Space
 .If $E(R,1,2)="@F",$D(@$E(R,2,9)) Do
 ..If $L(@$E(R,2,9)) Write @@$E(R,2,9)
 ..Else  Write ""
 .Else  Write R
 Else  If $G(%Fax),$G(%FaxNr) Do
 .If $E(R,1,2)="@F",$D(@$E(R,2,9)) Do
 ..If $L(@$E(R,2,9)) Xecute "Set R="_$E(R,2,9),"Set R="_R
 ..Else  Set R=""
 .Do STORE^vhFAX(%FaxNr,R,Space,.001*NewLine)
 Quit
 ;
WTXT(sLijn) 
 For  Quit:sLijn=""  Do
 .Do OUTPUT($P(sLijn,"ª"),0,0)
 .Set $P(sLijn,"ª")=""
 .If $E(sLijn)="ª",$L($E(sLijn,2)),"BIKUbiku"[$E(sLijn,2) Do
 ..Do OUTPUT("@FMT"_$E(sLijn,2),0,0)
 .Else  Do OUTPUT($E(sLijn,1,2),0,0)
 .Set $E(sLijn,1,2)=""
 Quit
 ;