OUTPUT2 ;Output: verwerken van de lijst [ 10/30/2001  3:24 PM ]
 Q
 ;
T1 ;Blz:
 ;
 ; Free space
FSp  ;Q:$P($ZOS(9,$E(%FN,1)),"^",2)>5
 S QUIT=1
 Q
 
 ; Write scherm
WSCHERM D INITPAR
 New DL,sLD,R,Input
 S sLD(1)="^OUTPUT("_$J
 S sLD(2)="1;C;L;"_Print("KOL")
 S sLD(3)=2
 S sLD(4)=23
 S sLD(5)=Print("KOL")
 S sLD(6)="1"
 S sLD(10)="\FMORE^OUTPUT2"
 s sLD(8)="Output op het scherm (- op te stoppen)"
 S DL(1)="sLD"
 Kill ^OUTPUT($J)
 S DLfn=@("^"_Q_"BA(99,1)"),DLad=^(2),DLwp=^(3)
 S Print("BLZ")=0,(Print("LIJN"),FP)=Print("LEN") W @F32
 Set sLD(9)=$$FMORE(0,24,"")
 Goto WPRINT1:'sLD(9)
 Do WL^PROC
 For  Do  Quit:R="-"!(R=",")!(R=".")
 .Do SL^PROC
 .If R="COM" Do MENU Set R=$G(Input)
 .Set:R="S" R="-"
 .Quit:R="-"!(R=",")!(R=".")
 .Set Input=R
 .If Input="PRINT" New F32,DevNm,DevOms,Print,PapTyp,PrintTyp Do P^OUTPUT
 .Do EXEC^vhMenu("OUTPUT",.Input)
WSCHERM1 S FP=66 W @F32
 Kill ^OUTPUT($J)
 Q
FMORE(sMax,sLen,sRef) 
 New sLCnt
 Set sLCnt=sMax
 Quit:sQNext="" sMax
 If 'sMax Do FHOOFD
 Do WLIST
 I $E(sQNext,1,$L(sQStart))'=sQStart Do
 .I $$CALLBACK("E") 
 .Do WFOOT
 .S sQNext=""
 Quit sLCnt
 ; Write transfert
WTRANS New FVAN,FNAAR
 Do VANNAAR^vhTERMINA($G(OutputType,"PC"))
 S $E(Print("PRINTER"))="T"
 D INITPAR
 D TRANSDEV,WLIST
 Q
 
 ; Write device
WDEV New FVAN,FNAAR
 Do VANNAAR^vhTERMINA("MC")
 S $E(Print("PRINTER"))="D"
 S $ZT="ER^OUTPUT2"
 
 D INITPAR
 D TRANSDEV,WLIST
 Q
 
 ; Write MAC's printer
WMAC D INITPAR,FHOOFD
 S DLfn=@("^"_Q_"BA(99,1)"),DLad=^(2),DLwp=^(3)
 S Print("BLZ")=0,(Print("LIJN"),FP)=Print("LEN") W @F32
 S $X=0,$Y=0
 D WLIST
 Goto WMAC1:'Print("BLZ")
 I $$CALLBACK("E") 
 Do WFOOT
WMAC1 S FP=66 W @F32 Q
 
 ; Write printer
WPRINT D INITPAR,FHOOFD
 S DLfn=@("^"_Q_"BA(99,1)"),DLad=^(2),DLwp=^(3)
 S Print("BLZ")=0,(Print("LIJN"),FP)=Print("LEN") W @F32
 D WLIST
 Goto WPRINT1:'Print("BLZ")
 I $$CALLBACK("E") 
 Do WFOOT
WPRINT1 S FP=66 W @F32
 Q
 
 ; Write kermit
WKERMIT Q
 
 ; **** Opbouw van de blocks ****
 
 ; Write titel
WTITEL S Print("BLZ")=Print("BLZ")+1,Print("LIJN")=0
 I $$CALLBACK("T") D WBEGIN:Print("BLZ")=1,WHOOFD Q
 S Print("LIJN")=Print("LIJN")+Print("TITEL")
 D FTITEL(ListDef(5),$P(sTitel,D),$P(sTitel,D,2),$P(sTitel,D,3))
 D WBEGIN:Print("BLZ")=1,WHOOFD
 Q
 
 ; Write Begin
WBEGIN I $$CALLBACK("B")
 Q
 
 ; Write End    
WEND I $$CALLBACK("E")
 Q
 
 ; Write hoofding
WHOOFD I $$CALLBACK("H") Q
 S Print("LIJN")=Print("LIJN")+Print("HEAD")
 D FHSEP("-")
 D FHOOFD2
 D FHSEP("-")
 Q
 
 ; Write Footer
WFOOT I '$D(Print("NOTFIRST")) Set Print("NOTFIRST")=1 Q
 I $$CALLBACK("F") w # Q
 S Print("LIJN")=Print("LIJN")+Print("FOOT")
 D FHSEP("-")
 W #
 Q
 
 ; Write list
WLIST N FL
WLIST0 If $E(Print("PRINTER"))="S" Quit:sLCnt>(sLen+sMax)
 S sQNext=$Q(@sQNext)
 Q:$E(sQNext,1,$L(sQStart))'=sQStart
 K FL(3)
 I $L(sCBExec) X "S sCBVal="_$S($E(sCBExec,1,5)="Class":"##",1:"$$")_sCBExec_"(sQNext)"
WLIST1 I $D(sCBVal) D  I sCBFunc="SK"!(sCBFmt="SK") G WLIST1:$L(sCBVal),WLIST0
 .S sCBFunc=$P($P(sCBVal,D),U),sCBFmt=$P($P(sCBVal,D),U,2),sCBVal=$P(sCBVal,D,2,99)
 .I "\BL\BR\BD\PB\"[(D_sCBFmt_D) S sCBFunc=sCBFmt
 I $D(sCBFunc),$D(Print("BLZ")),$D(Print("LIJN")) D  I "\BL\BR\BD\PB\"[(D_sCBFunc_D) G WLIST1:$L(sCBVal),WLIST0
 .I sCBFunc="PB" S Print("LIJN")=999 Q
 .I sCBFunc="BR"!(sCBFunc="BL")!(sCBFunc="BD") D
 ..I 'Print("LIJN") Q
 ..S Print("LIJN")=Print("LIJN")+1
 ..I Print("LIJN")>(Print("MAXLIJN")-Print("FOOT")+1) Q
 ..I sCBFunc="BD" D FHSEP("=")
 ..I sCBFunc="BR" D FHSEP("-")
 ..I sCBFunc="BL" D FHSEP(" ")
 I $D(vhDEV),$D(%FN) D FSp Q:$D(QUIT)
WLIST2 I $D(Print("BLZ")),$D(Print("LIJN")) S Print("LIJN")=Print("LIJN")+1 I Print("LIJN")>(Print("MAXLIJN")-Print("FOOT")) D WFOOT,WTITEL G WLIST2
 I "DT"[$E(Print("PRINTER")),$L(sHoofd) D FHOOFD2 S sHoofd=""
 S R=$S($D(FL(3))#10:FL(3),1:@sQNext) D FLIJN G WLIST0:'$D(sCBVal),WLIST0:sCBVal="",WLIST1
 
 ; **** Formateren en schrijven ****
 
 ; Format en write line
FLIJN S FL(1)=$S('$D(sCBFmt):sFmt,sCBFmt="":sFmt,$D(sFmt(sCBFmt)):sFmt(sCBFmt),$D(^LD("L",sCBFmt)):^LD("L",sCBFmt),1:sFmt)
 S DLv=+$P(sQNext,",",$L(sQNext,","))
 I $E(Print("PRINTER"))="T"!($E(Print("PRINTER"))="D") S R=$TR(R,FVAN,FNAAR)
 S FL(2)=0,FL(3)=R,FL(5)=$G(ListDef(12)) W sSpace D PRINTLN
 D PRINTLF
 Q
 
 ; Formateren en afdrukken van een lijn
PRINTLN If $E(Print("PRINTER"))="S" Set FL(2)="" Do FL^PROC Set sLCnt=sLCnt+1,^OUTPUT($J,sLCnt)=R Quit
 Do FL^PROC 
 Quit
 ; Afdrukken lijnfeed
PRINTLF Quit:$E(Print("PRINTER"))="S" 
 W Print("LF")
 Quit
 ; Afdrukken van een lijn
PRINTR(R1,R2,R3) If $E(Print("PRINTER"))="S" Set sLCnt=sLCnt+1,^OUTPUT($J,sLCnt)=$G(R1)_$G(R2)_$G(R3) Quit
 W $G(R1),$G(R2),$G(R3)
 Quit
 ; Format en write horizontale separator
FHSEP(SepChar) 
 N sTemp
 S sTemp=sHoofd S:sHoofd?1.2N sTemp=sHoofd(1)
 S R=$P(sTemp,"`")
 I R'[D D  D PRINTR(sSpace,R),PRINTLF Q
 .F sI=1:1 Q:$E(R,sI)=""  I $P(sTemp,"`",3)'[$E(R,sI)!'$L($E(R,sI)) S $E(R,sI)=SepChar
 F sI=1:1 S K=$P(R,D,sI) Q:K=""  D
 .S sX=$P($P($P(sTemp,"`"),D,sI-1),U,6),sX=$P(sX,$TR(sX," ",""),2),$P(K,U,4)=$P(K,U,4)+$L(sX)
 .Set sX=$P(K,U,6),sX=$P(sX,$TR(sX," ",""),1),$P(K,U,4)=$P(K,U,4)+$L(sX)
 .Set sX="",$P(sX,SepChar,$P(K,U,4))=SepChar
 .Set $P(K,U,1)=""""_sX_"""",$P(K,U,6)=$TR($P(K,U,6)," ","")
 .Set $P(K,U,2)="C",$P(K,U,7)="",$P(R,D,sI)=K
 K FL S FL(1)=R,FL(2)=0 W sSpace D PRINTLN,PRINTLF
 Q
 
 ; Format en write hoofding
FHOOFD2 New HI,HRef
 If sHoofd?1.2N For HI=1:1:sHoofd Set HRef="sHoofd(HI)" Do FHOOFD2b
 Else  If sHoofd'?1.2N Set HRef="sHoofd" Do FHOOFD2b
 Q
FHOOFD2b S R=$P(@HRef,"`")
 I R[D K FL S FL(1)=R,FL(2)=0 w sSpace D PRINTLN,PRINTLF S R=""
 I $L(R) D PRINTR(sSpace,R),PRINTLF
 Q
 ; Format hoofding
FHOOFD New HI,HRef
 If sHoofd?1.2N For HI=1:1:sHoofd Set HRef="sHoofd(HI)" Do FHOOFDb
 Else  If sHoofd'?1.2N Set HRef="sHoofd" Do FHOOFDb
 Q
FHOOFDb S R=$P(@HRef,"`")
 I R[D K FL S FL(1)=R D PRINTLN S $P(@HRef,"`")=R
 I $P(@HRef,"`",3)="" S $P(@HRef,"`",3)="|"
 Q
 
 ; Format titel
FTITEL(Breedte,Titel1,Titel2,Titel3) 
 New Space,LT1,LT2,LT3,LM,RM,L1,L2,L3,R1,R2,R3,DubbelW,NameSpace
 New Formatter 
 set Formatter = ##class(APPS.common.Print.Output.IoCContainer).Instance().Resolve("Formatter")
 If Print("PAPIER")="L" Do  ; Met logo
 .Set L1="Blz:"_$J(Print("BLZ"),4)
 .Set L2=Formatter.FormatHorolog(Print("$H"),"DD-MM-JJ")
 .Set L3=Formatter.FormatHorolog(Print("$H"),"hh:nn")
 .Set LM=$L(L2)
 .Set (R1,R2,R3)=""
 .Set RM=Print("KOLLOGO")
 Else  Do  ; Zonder logo
 . If $D(ListDef("HALUX")) Do
 . . Set NameSpace=$TR($ZU(5),1,2)
 . . Set L1=@("^|NameSpace|"_Q_"BA(99,1)")
 . . Set L2=$$REPLACE^vhRtn1(@("^|NameSpace|"_Q_"BA(99,2)")," - ","-")
 . . Set L3=$$REPLACE^vhRtn1(@("^|NameSpace|"_Q_"BA(99,3)"),"   "," ")
 . Else  Do
 . . Set L1=@("^"_Q_"BA(99,1)")
 . . Set L2=@("^"_Q_"BA(99,2)")
 . . Set L3=@("^"_Q_"BA(99,3)")
 .Set LM=$L(L2)
 .Set R1="Blz:"_$J(Print("BLZ"),4)
 .Set R2=Formatter.FormatHorolog(Print("$H"),"DD-MM-JJ")
 .Set R3=Formatter.FormatHorolog(Print("$H"),"hh:nn")
 .Set RM=$L(R2)
 Set Space=Print("LMARG")
 Set LT1=$L(Titel1)
 If Breedte-LM-RM-LT1-LT1>2,$E(Print("PRINTER"))="P" S LT1=LT1*2,DubbelW=1
 Else  If $E(Print("PRINTER"))'="S" Set Titel1=$E(Titel1,1,Breedte-LM-RM-2),LT1=$L(Titel1),DubbelW=0
 Else  Set Titel1=$E(Titel1,1,Breedte-LM-RM-2),LT1=$L(Titel1),DubbelW=0
 Set Titel2=$E($G(Titel2),1,Breedte-LM-RM-2)
 Set Titel3=$E($G(Titel3),1,Breedte-LM-RM-2)
 Set LT2=$L(Titel2),LT3=$L(Titel3)
 If Titel3="" Set Titel3=Titel2,Titel2=Titel1,Titel1="",LT3=LT2,LT2=LT1,LT1=0
 ; Write titel
 ; Li - Titeli - Ri
 D:$E(Print("PRINTER"))'="M" PRINTLF
 If DubbelW Do
 .Write ?Space,L1,?Breedte-LM-RM-LT1\2+Space+LM,@F82,Titel1,@F83,Print("CR"),?Breedte+Space-$L(R1),R1 D PRINTLF
 .Write ?Space,L2,?Breedte-LM-RM-LT2\2+Space+LM,@$S('LT1:F82,1:""""""),Titel2,@$S('LT1:F83,1:""""""),Print("CR"),?Breedte+Space-$L(R2),R2 D PRINTLF
 .Write ?Space,L3,?Breedte-LM-RM-LT3\2+Space+LM,Titel3,Print("CR"),?Breedte+Space-$L(R3),R3 D PRINTLF
 .Do PRINTLF
 Else  If $E(Print("PRINTER"))'="S" Do
 .Write $J("",Space),L1,$J("",Breedte+LM-RM-LT1\2-$L(L1)),@FMTB,Titel1,@FMTb,$J("",Breedte-(Breedte+LM-RM-LT1\2-$L(L1))-$L(L1)-LT1-$L(R1)),R1 D PRINTLF
 .Write $J("",Space),L2,$J("",Breedte+LM-RM-LT2\2-$L(L2)),@$S('LT1:FMTB,1:""""""),Titel2,@$S('LT1:FMTb,1:""""""),$J("",Breedte-(Breedte+LM-RM-LT2\2-$L(L2))-$L(L2)-LT2-$L(R2)),R2 D PRINTLF
 .Write $J("",Space),L3,$J("",Breedte+LM-RM-LT3\2-$L(L3)),Titel3,$J("",Breedte-(Breedte+LM-RM-LT3\2-$L(L3))-$L(L3)-LT3-$L(R3)),R3 D PRINTLF
 .Do PRINTLF
 Else  Do  ; op terminal
 .Set sLCnt=sLCnt+1,^OUTPUT($J,sLCnt)=L1_$J("",Breedte+LM-RM-LT1\2-$L(L1))_Titel1_$J("",Breedte-(Breedte+LM-RM-LT1\2-$L(L1))-$L(L1)-LT1-$L(R1))_R1 
 .Set sLCnt=sLCnt+1,^OUTPUT($J,sLCnt)=L2_$J("",Breedte+LM-RM-LT2\2-$L(L2))_Titel2_$J("",Breedte-(Breedte+LM-RM-LT2\2-$L(L2))-$L(L2)-LT2-$L(R2))_R2
 .Set sLCnt=sLCnt+1,^OUTPUT($J,sLCnt)=L3_$J("",Breedte+LM-RM-LT3\2-$L(L3))_Titel3_$J("",Breedte-(Breedte+LM-RM-LT3\2-$L(L3))-$L(L3)-LT3-$L(R3))_R3
 Q
 
 ; Lijst parameters
INITPAR S sQNext=ListDef(1) F sI=$L(sQNext):-1 Q:" ,)"'[$E(sQNext,sI)  ; instellen van de referenties
 S sQNext=$E(sQNext,1,sI),ListDef(1)=sQNext I sQNext["(",sQNext'[")" S sQNext=sQNext_")"
 I $P(sQNext,"(")["^" S sQStart=$D(@sQNext),sQStart=$E($zr,1,$L($zr)-1)
 E  S sQStart=$E(sQNext,1,$L(sQNext)+$S($E(sQNext,$L(sQNext))=")":-1,1:0))
 M sFmt=ListDef(2)
 
 S sHoofd=$G(ListDef(8))
 
 If $D(ListDef(8))>1 For sHoofd=1:1:$O(ListDef(8,""),-1) Set sHoofd(sHoofd)=ListDef(8,sHoofd)
 
 S sBreed=$G(ListDef(5)) Set:'sBreed sBreed=Print("KOL")-Print("LMARG")
 S sCBExec=$P($G(ListDef(10)),D,1)
 S:$E($$LOCASE^vhRtn1(sCBExec),1,5)="class" sCBExec="Class"_$E(sCBExec,6,999)
 S sTitel=$G(ListDef(11))
 S sSpace=$J("",Print("LMARG"))
 Q
 
 ; Init titel en format (tabs, lengte ...)
TRANSDEV  New sH
 S sH=$P(sHoofd,"`")
 S sHoofd=""
 If $G(ListDef(13))?1A.E,$D(^LD("D",ListDef(13))) Set sH=ListDef(13) Do
 .For sI=1:1:$O(^LD("D",sH,"F",""),-1) Do
 ..Set sHoofd=sHoofd_""""_$P(^LD("D",sH,"F",sI),"`",12)_""";C;L;;;"_$C(9)_"\"
 .Set sHoofd=$E(sHoofd,1,$L(sHoofd)-2)
 Else  I sHoofd[D For sI=1:1:$L(ListDef(8),D) D
 .S sHoofd=sHoofd_$P($P(sH,D,sI),U,1,2)_U_U_U
 .S sHoofd=sHoofd_$P($P(sH,D,sI),U,5)_U
 .I sI'=$L(sH,D) S sHoofd=sHoofd_$C(9)
 .S sHoofd=sHoofd_U_$P($P(sH,D,sI),U,7,99)
 .S sHoofd=sHoofd_D
 Else  Set sHoofd=$TR(sH,"|",$C(9))
 Set sFmt=$$TRANSFMT(sFmt)      
 Set sI=""
 For  Set sI=$O(sFmt(sI)) Quit:sI=""  Set sFmt(sI)=$$TRANSFMT(sFmt(sI))
 Q
 
TRANSFMT(sOld) 
 New sFmt,sI
 Set sFmt=""
 F sI=1:1:$L(sOld,D) D
 .S sFmt=sFmt_$P($P(sOld,D,sI),U,1,2)_U_U_U
 .S sFmt=sFmt_$P($P(sOld,D,sI),U,5)_U
 .I sI'=$L(sOld,D) S sFmt=sFmt_$C(9)
 .S sFmt=sFmt_U_U_$P($P(sOld,D,sI),U,8,99)
 .S sFmt=sFmt_D
 Quit sFmt
 
 S sFmt="" F sI=1:1:$L(ListDef(2),D) D
 .S sFmt=sFmt_$P($P(ListDef(2),D,sI),U,1,2)_U_U_U
 .S sFmt=sFmt_$P($P(ListDef(2),D,sI),U,5)_U
 .I sI'=$L(ListDef(2),D) S sFmt=sFmt_$C(9)
 .S sFmt=sFmt_U_U_$P($P(ListDef(2),D,sI),U,8,99)
 .S sFmt=sFmt_D
 Q
 
 ; Write callback
 ; Gebruikt bij BEGIN,END,TITEL,HOOFD blocks
CALLBACK(C) N sCBVal,sCBFunc,sCBFmt,FL
 I $L(sCBExec) X "S sCBVal="_$S($E(sCBExec,1,5)="Class":"##",1:"$$")_sCBExec_"(C)"
 Q:'$D(sCBVal) 0 Q:'$L(sCBVal) 0
CALLB1 S sCBFunc=$P($P(sCBVal,D),U),sCBFmt=$P($P(sCBVal,D),U,2),sCBVal=$P(sCBVal,D,2,99)
 I "\BL\BR\PB\"[(D_sCBFmt_D) S sCBFunc=sCBFmt
 I sCBFunc="SK"!(sCBFmt="SK") G CALLB1:$L(sCBVal) Q 1
 I $D(sCBFunc),$D(Print("BLZ")),$D(Print("LIJN")) D  I "\BL\BR\PB\"[(D_sCBFunc_D) G CALLB1:$L(sCBVal) Q 1
 .I sCBFunc="PB" S Print("LIJN")=999 Q
 .I sCBFunc="BR"!(sCBFunc="BL") D
 ..S Print("LIJN")=Print("LIJN")+1
 ..I Print("LIJN")>(Print("MAXLIJN")-Print("FOOT")+1) Q
 ..I sCBFunc="BR" D FHSEP("-")
 ..I sCBFunc="BL" D FHSEP(" ")
 S Print("LIJN")=Print("LIJN")+1
 S R=$S($D(FL(3))#10:FL(3),1:@sQNext) D @$S(sCBFmt=""&(sCBFunc="")&(C="H"):"FHOOFD2",1:"FLIJN") I $D(sCBVal),$L(sCBVal) G CALLB1
 Q 1
        
MENU 
 Do CALL^vhMenu("OUTPUT")
 Quit
 ;
 ; Error processing
ER C vhDEV  S QUIT=0 Q
 Q
 ;