OPROC2 ;PROCEDURES & FUNCTIES ;PROC; Beschrijving zie PROC2BES [ 08/07/2002  3:41 PM ]
 Q
 ;
T1 ;Blz:
 ;
 ; Free space
FSp Q:$P($ZOS(9,$E(%FN,1)),"^",2)>5
 S QUIT=1
 Q
 ;
 ; Write hoofding
WH I DLbz D:DLti[D WHl("-") W #
 S DLbz=DLbz+1,DLln=0
 W @DLt,DLfn,?DLll-8,$P($T(T1),U,2),$J(DLbz,4),@DLt
 W DLad I DLll>80 W ?DLll/2-$L(DLtp),@F82
 E  W ?DLll-$L(DLtp)/2
 W DLtp,@F83,$C(13),?DLll-8,DT,@DLt
 W DLwp,?DLll-7,TD,@DLt,@DLt,@DLt
 D:DLti[D WHl("-")
 D WTi
 D:DLti[D WHl("-")
 Q
 ;
 ; Write horz. lijn
WHl(DLch) 
 S R=DLti F DLi=1:1 S K=$P(R,D,DLi) Q:K=""  D
 .S DLx=$P($P(DLti,D,DLi-1),U,6),DLx=$P(DLx,$TR(DLx," ",""),2),$P(K,U,4)=$P(K,U,4)+$L(DLx)
 .Set DLx=$P(K,U,6),DLx=$P(DLx,$TR(DLx," ",""),1),$P(K,U,4)=$P(K,U,4)+$L(DLx)
 .Set DLx="",$P(DLx,DLch,$P(K,U,4))=DLch
 .Set $P(K,U,1)=""""_DLx_"""",$P(K,U,6)=$TR($P(K,U,6)," ","")
 .Set $P(K,U,2)="C",$P(K,U,7)="",$P(R,D,DLi)=K
 K FL S FL(1)=R,FL(2)=0 D FL^PROC W @DLt
 Q
 ;
 ; Write titel
WTi S R=DLti I R[D K FL S FL(1)=R,FL(2)=0 D FL^PROC W @DLt S R=""
 I $L(R) W R,@DLt
 Q
 ;
 ; Write line
WLn S FL(1)=DL(1)_"(2,DLFmt)"
 S FL(1)=$S('$D(DLFmt):DLfl,DLFmt="":DLfl,$D(@FL(1)):@FL(1),$D(^LD("L",DLFmt)):^LD("L",DLFmt),1:DLfl)
 S FL(2)=0,FL(3)=R D FL^PROC
 W @DLt
 Q
 ;
 ; Write list
WL S DLv=$Q(@DLv) Q:$E(DLv,1,$L(@(DL(1)_"(1)")))'=@(DL(1)_"(1)")
 I $L(DLc) D  G WL:DLcr="SK"
 .X "S DLcr=$$"_DLc_"(DLv,DLout"_$S($D(DLln):","_(DLln+1)_","_(DLal-16)_","_DLbz,1:"")_")"
 .S DLFmt=$P(DLcr,U),DLcr=$P(DLcr,U,2)
 I $D(DLcr),$D(DLbz),$D(DLln) D
 .I DLcr="PB" S DLln=999 Q
 .I DLcr="BR"!(DLcr="BL") D
 ..I 'DLln Q
 ..S DLln=DLln+1
 ..I DLln>(DLal-17) Q
 ..I DLcr="BR" D WHl("-")
 ..I DLcr="BL" D WHl(" ")
 I $D(vhDEV),$D(%FN) D FSp Q:$D(QUIT)
WL1 I $D(DLbz),$D(DLln) S DLln=DLln+1 I DLln>(DLal-16) D WH G WL1
 I "DT"[DLout,$L(DLti) D WTi S DLti=""
 S R=@DLv D WLn G WL
 ;
 ; Write transfert
WT D LPar
 S DLout="T",DLt="$C(13)"
 D TraDev,WL
 Q
 ;
 ; Write device
WD S $ZT="ER^PROC2"
 D LPar
 S DLout="D",DLt=$C(33)
 D TraDev,WL
 Q
 ;
 ; Write printer
WP D LPar
 S DLout="P",DLt=$C(33)
 S DLfn=^KBA(99,1),DLad=^(2),DLwp=^(3)
 S DLbz=0,(DLln,FP)=DLal W @F32
 D WL
 I DLbz,DLti[D D WHl("-")
 W #
 S FP=66 W @F32
 Q
 ;
 ; Write kermit
WK Q
 ;
 ; Lijst parameters
LPar S DLv=@(DL(1)_"(1)") F DLi=$L(DLv):-1 Q:" ,)"'[$E(DLv,DLi)  ; instellen van de referenties
 S DLv=$E(DLv,1,DLi),@(DL(1)_"(1)")=DLv I DLv["(",DLv'[")" S DLv=DLv_")"
 S DLfl=@(DL(1)_"(2)")
 S DLal=66 I $D(@(DL(1)_"(4)")),@(DL(1)_"(4)") S DLal=@(DL(1)_"(4)")
 S DLll=80 I $D(@(DL(1)_"(5)")),@(DL(1)_"(5)") S DLll=@(DL(1)_"(5)")
 S DLti="" I $D(@(DL(1)_"(8)")),$L(@(DL(1)_"(8)")) S DLti=@(DL(1)_"(8)")
 S DLc="" I $D(@(DL(1)_"(10)")),$L(@(DL(1)_"(10)")) S DLc=@(DL(1)_"(10)")
 S DLtp="" I $D(@(DL(1)_"(11)")),$L(@(DL(1)_"(11)")) S DLtp=@(DL(1)_"(11)")
 Q
 ;
 ; Init titel en format (tabs, lengte ...)
TraDev I DLti[D S DLti="" F DLi=1:1:$L(@(DL(1)_"(8)"),D) D
 .S DLti=DLti_$P($P(@(DL(1)_"(8)"),D,DLi),U,1,2)_U_U_U
 .S DLti=DLti_$P($P(@(DL(1)_"(8)"),D,DLi),U,5)_U
 .I DLi'=$L(@(DL(1)_"(8)"),D) S DLti=DLti_$C(9)
 .S DLti=DLti_D
 S DLfl="" F DLi=1:1:$L(@(DL(1)_"(2)"),D) D
 .S DLfl=DLfl_$P($P(@(DL(1)_"(2)"),D,DLi),U,1,2)_U_U_U
 .S DLfl=DLfl_$P($P(@(DL(1)_"(2)"),D,DLi),U,5)_U
 .I DLi'=$L(@(DL(1)_"(2)"),D) S DLfl=DLfl_$C(9)
 .S DLfl=DLfl_D
 Q
 ;
 ; Error processing
ER C vhDEV O vhDEV U vhDEV S K=$ZOS(2,%FN) C vhDEV S QUIT=0 Q
 Q
 ;
Z X ^cZ Q
ZZ ; 28.04.88 - 10 u 05