DDBRP ;SFISC/DCL-BROWSER PRINT UTILITY ;NOV 04, 1996@13:54
;;22.0;VA FileMan;;Mar 30, 1999
;Per VHA Directive 10-93-142, this routine should not be modified.
PRTHELP ; Print Help
;
N DDGLI,DDGLHN1,DDGLHN2
S (DDGLHN1,DDGLHN2)=$S(DDBRHTF:9202,1:9201)
;
BRM ;Clear scroll region, title bar and
N DX,DY,X
S DX=0,DY=$P(DDBSY,";"),X=$$CTXT^DDBR("PRINT BROWSER HELP",$J("",IOM+1),IOM)
X IOXY
W $P(DDGLVID,DDGLDEL,6) ;rvon
W $P(DDGLVID,DDGLDEL,4) ;uon
W X
W $P(DDGLVID,DDGLDEL,10) ;rvoff
F DY=$P(DDBSY,";",2):1:$P(DDBSY,";",4) X IOXY W $P(DDGLCLR,DDGLDEL)
W $P(DDGLVID,DDGLDEL,6) ;rvon
W $P(DDGLVID,DDGLDEL,4) ;uon
W X
W $P(DDGLVID,DDGLDEL,10) ;rvoff
W @IOSTBM
S DY=$P(DDBSY,";",2)
X IOXY
;
;Reset for Roll/Scroll mode
S X=$G(IOM,80) X ^%ZOSF("RM")
W $P(DDGLVID,DDGLDEL,9)
;
N POP,XQH
N IOF,IOSL,DDBUC,DDBLC,DDBRZIS
N %,%A,%B,%B1,%B2,%B3,%BA,%C,%E,%G,%H,%I,%J,%K,%M,%N
N %P,%S,%T,%W,%X,%Y,%XX,%YY
N %A0,%D1,%D2,%DT,%J1,%W0
;
S DDBUC="ABCDEFGHIJKLMNOPQRSTUVWXYZ",DDBLC="abcdefghijklmnopqrstuvwxyz"
DEVICE ;
S %ZIS=$S($D(^%ZTSK):"Q",1:""),%ZIS("B")=""
S %ZIS("S")="I $TR($P(^(0),U),DDBLC,DDBUC)'[""BROWSE"",$E($$GET1^DIQ(3.5,Y,""SUBTYPE""))=""P"""
S IOF="#",IOSL=DDBSRL
D ^%ZIS
K %ZIS
;
I POP D
.W !!,"Report canceled!"
.H 2
;
;Queue report
E I $D(IO("Q")),$D(^%ZTSK) D
.S ZTRTN="PRINTHLP^DDBRP"
.S ZTDESC="Browser help printout."
.N I F I="DDGLHN1","DDGLHN2" S ZTSAVE(I)=""
.D ^%ZTLOAD
.I $D(ZTSK)#2 W !,"Report queued!",!,"Task number: "_ZTSK,!
.E W !,"Report canceled!",!
.K ZTSK
.S IOP="HOME" D ^%ZIS
;
E I $E(IOST,1,2)="C-" D G DEVICE
.W !,$C(7)_"You cannot print the Browser help on a CRT.",!
;
;Non-queued report
E D
.W !,"Printing ..."
.U IO
.D PRINTHLP
.X $G(^%ZIS("C"))
;
;Reset for Screen Mode
S X=0 X ^%ZOSF("RM")
W $P(DDGLVID,DDGLDEL,8)
;
;Repaint help screen
D RPS^DDBRGE
Q
;
PRINTHLP ;
;
N DDGLJ,DDGLL,DDGLP
F DDGLI=DDGLHN1:1:DDGLHN2 D
. I DDGLI'=DDGLHN1 D
.. I $Y+$O(^DI(.84,DDGLI,2," "),-1)+2'<IOSL W @IOF
.. E W !!
. S DDGLJ=0
. F S DDGLJ=$O(^DI(.84,DDGLI,2,DDGLJ)) Q:'DDGLJ D
.. S DDGLL=$G(^DI(.84,DDGLI,2,DDGLJ,0))
.. F Q:DDGLL'["\" D
... S DDGLP=$F(DDGLL,"\") Q:$E(DDGLL,DDGLP)="\"
... S $E(DDGLL,DDGLP-1,DDGLP)=""
.. W !,DDGLL
;
S:$D(ZTQUEUED) ZTREQ="@"
Q
DDBRP ;SFISC/DCL-BROWSER PRINT UTILITY ;NOV 04, 1996@13:54
+1 ;;22.0;VA FileMan;;Mar 30, 1999
+2 ;Per VHA Directive 10-93-142, this routine should not be modified.
PRTHELP ; Print Help
+1 ;
+2 NEW DDGLI,DDGLHN1,DDGLHN2
+3 SET (DDGLHN1,DDGLHN2)=$SELECT(DDBRHTF:9202,1:9201)
+4 ;
BRM ;Clear scroll region, title bar and
+1 NEW DX,DY,X
+2 SET DX=0
SET DY=$PIECE(DDBSY,";")
SET X=$$CTXT^DDBR("PRINT BROWSER HELP",$JUSTIFY("",IOM+1),IOM)
+3 XECUTE IOXY
+4 ;rvon
WRITE $PIECE(DDGLVID,DDGLDEL,6)
+5 ;uon
WRITE $PIECE(DDGLVID,DDGLDEL,4)
+6 WRITE X
+7 ;rvoff
WRITE $PIECE(DDGLVID,DDGLDEL,10)
+8 FOR DY=$PIECE(DDBSY,";",2):1:$PIECE(DDBSY,";",4)
XECUTE IOXY
WRITE $PIECE(DDGLCLR,DDGLDEL)
+9 ;rvon
WRITE $PIECE(DDGLVID,DDGLDEL,6)
+10 ;uon
WRITE $PIECE(DDGLVID,DDGLDEL,4)
+11 WRITE X
+12 ;rvoff
WRITE $PIECE(DDGLVID,DDGLDEL,10)
+13 WRITE @IOSTBM
+14 SET DY=$PIECE(DDBSY,";",2)
+15 XECUTE IOXY
+16 ;
+17 ;Reset for Roll/Scroll mode
+18 SET X=$GET(IOM,80)
XECUTE ^%ZOSF("RM")
+19 WRITE $PIECE(DDGLVID,DDGLDEL,9)
+20 ;
+21 NEW POP,XQH
+22 NEW IOF,IOSL,DDBUC,DDBLC,DDBRZIS
+23 NEW %,%A,%B,%B1,%B2,%B3,%BA,%C,%E,%G,%H,%I,%J,%K,%M,%N
+24 NEW %P,%S,%T,%W,%X,%Y,%XX,%YY
+25 NEW %A0,%D1,%D2,%DT,%J1,%W0
+26 ;
+27 SET DDBUC="ABCDEFGHIJKLMNOPQRSTUVWXYZ"
SET DDBLC="abcdefghijklmnopqrstuvwxyz"
DEVICE ;
+1 SET %ZIS=$SELECT($DATA(^%ZTSK):"Q",1:"")
SET %ZIS("B")=""
+2 SET %ZIS("S")="I $TR($P(^(0),U),DDBLC,DDBUC)'[""BROWSE"",$E($$GET1^DIQ(3.5,Y,""SUBTYPE""))=""P"""
+3 SET IOF="#"
SET IOSL=DDBSRL
+4 DO ^%ZIS
+5 KILL %ZIS
+6 ;
+7 IF POP
Begin DoDot:1
+8 WRITE !!,"Report canceled!"
+9 HANG 2
End DoDot:1
+10 ;
+11 ;Queue report
+12 IF '$TEST
IF $DATA(IO("Q"))
IF $DATA(^%ZTSK)
Begin DoDot:1
+13 SET ZTRTN="PRINTHLP^DDBRP"
+14 SET ZTDESC="Browser help printout."
+15 NEW I
FOR I="DDGLHN1","DDGLHN2"
SET ZTSAVE(I)=""
+16 DO ^%ZTLOAD
+17 IF $DATA(ZTSK)#2
WRITE !,"Report queued!",!,"Task number: "_ZTSK,!
+18 IF '$TEST
WRITE !,"Report canceled!",!
+19 KILL ZTSK
+20 SET IOP="HOME"
DO ^%ZIS
End DoDot:1
+21 ;
+22 IF '$TEST
IF $EXTRACT(IOST,1,2)="C-"
Begin DoDot:1
+23 WRITE !,$CHAR(7)_"You cannot print the Browser help on a CRT.",!
End DoDot:1
GOTO DEVICE
+24 ;
+25 ;Non-queued report
+26 IF '$TEST
Begin DoDot:1
+27 WRITE !,"Printing ..."
+28 USE IO
+29 DO PRINTHLP
+30 XECUTE $GET(^%ZIS("C"))
End DoDot:1
+31 ;
+32 ;Reset for Screen Mode
+33 SET X=0
XECUTE ^%ZOSF("RM")
+34 WRITE $PIECE(DDGLVID,DDGLDEL,8)
+35 ;
+36 ;Repaint help screen
+37 DO RPS^DDBRGE
+38 QUIT
+39 ;
PRINTHLP ;
+1 ;
+2 NEW DDGLJ,DDGLL,DDGLP
+3 FOR DDGLI=DDGLHN1:1:DDGLHN2
Begin DoDot:1
+4 IF DDGLI'=DDGLHN1
Begin DoDot:2
+5 IF $Y+$ORDER(^DI(.84,DDGLI,2," "),-1)+2'<IOSL
WRITE @IOF
+6 IF '$TEST
WRITE !!
End DoDot:2
+7 SET DDGLJ=0
+8 FOR
SET DDGLJ=$ORDER(^DI(.84,DDGLI,2,DDGLJ))
IF 'DDGLJ
QUIT
Begin DoDot:2
+9 SET DDGLL=$GET(^DI(.84,DDGLI,2,DDGLJ,0))
+10 FOR
IF DDGLL'["\"
QUIT
Begin DoDot:3
+11 SET DDGLP=$FIND(DDGLL,"\")
IF $EXTRACT(DDGLL,DDGLP)="\"
QUIT
+12 SET $EXTRACT(DDGLL,DDGLP-1,DDGLP)=""
End DoDot:3
+13 WRITE !,DDGLL
End DoDot:2
End DoDot:1
+14 ;
+15 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+16 QUIT
