DDBRP ;SFISC/DCL-BROWSER PRINT UTILITY ;30NOV2012
;;22.2;VA FileMan;;Jan 05, 2016;Build 42
;;Per VA Directive 6402, this routine should not be modified.
;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
;;Licensed under the terms of the Apache License, Version 2.0.
;
;
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($$EZBLD^DIALOG(7076.4),$J("",IOM+1),IOM) ;**'PRINT BROWSER HELP'
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 ^DD("OS",DISYS,"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
;
DEVICE ;
; Save $R, otherwise, it becomes ^%ZTSK in standalone-FM. Fails in DIALOG which saves ^(0)
; ^(0) doesn't exist, and it fails on both GT.M and Cache.
N DINAKED S DINAKED=$NA(^(0))
S %ZIS=$S($D(^%ZTSK):"Q",1:""),%ZIS("B")=""
S %ZIS("S")="I $$UP^DILIBF($P(^(0),U))'[""BROWSE"",$E($$GET1^DIQ(3.5,Y,""SUBTYPE""))=""P""" ;**
S IOF="#",IOSL=DDBSRL
D ^%ZIS
K %ZIS
;
; Restore $R for DIALOG call.
D:DINAKED]""
.I DINAKED["(" Q:$O(@(DINAKED)) Q
.I $D(@(DINAKED))
;
I POP D
.W !!,$$EZBLD^DIALOG(1901) ;**REPORT CANCELLED
.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
.;
.; Restore $R again
.D:DINAKED]""
..I DINAKED["(" Q:$O(@(DINAKED)) Q
..I $D(@(DINAKED))
.;
.; Done with DINAKED
.K DINAKED
.;
QUEUED .I $D(ZTSK)#2 W !,$$EZBLD^DIALOG(8161,ZTSK),! ;**
.E W !,$$EZBLD^DIALOG(1901),! ;**REPORT CANCELLED
.K ZTSK
.S IOP="HOME" D ^%ZIS
;
E I $E(IOST,1,2)="C-" D
.W !,$C(7)_$$EZBLD^DIALOG(7076.3),! ;**NOT ON CRT
.H 2
;
;Non-queued report
E D
.W !,"..." ;**
.U IO
.D PRINTHLP
.X $G(^%ZIS("C"))
;
;Reset for Screen Mode
S X=0 X ^DD("OS",DISYS,"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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDDBRP 3005 printed Apr 09, 2024@21:46:20 Page 2
DDBRP ;SFISC/DCL-BROWSER PRINT UTILITY ;30NOV2012
+1 ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
+4 ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
+5 ;;Licensed under the terms of the Apache License, Version 2.0.
+6 ;
+7 ;
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 ;**'PRINT BROWSER HELP'
SET DX=0
SET DY=$PIECE(DDBSY,";")
SET X=$$CTXT^DDBR($$EZBLD^DIALOG(7076.4),$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 ^DD("OS",DISYS,"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 ;
DEVICE ;
+1 ; Save $R, otherwise, it becomes ^%ZTSK in standalone-FM. Fails in DIALOG which saves ^(0)
+2 ; ^(0) doesn't exist, and it fails on both GT.M and Cache.
+3 NEW DINAKED
SET DINAKED=$NAME(^(0))
+4 SET %ZIS=$SELECT($DATA(^%ZTSK):"Q",1:"")
SET %ZIS("B")=""
+5 ;**
SET %ZIS("S")="I $$UP^DILIBF($P(^(0),U))'[""BROWSE"",$E($$GET1^DIQ(3.5,Y,""SUBTYPE""))=""P"""
+6 SET IOF="#"
SET IOSL=DDBSRL
+7 DO ^%ZIS
+8 KILL %ZIS
+9 ;
+10 ; Restore $R for DIALOG call.
+11 if DINAKED]""
Begin DoDot:1
+12 IF DINAKED["("
if $ORDER(@(DINAKED))
QUIT
QUIT
+13 IF $DATA(@(DINAKED))
End DoDot:1
+14 ;
+15 IF POP
Begin DoDot:1
+16 ;**REPORT CANCELLED
WRITE !!,$$EZBLD^DIALOG(1901)
+17 HANG 2
End DoDot:1
+18 ;
+19 ;Queue report
+20 ;
+21 IF '$TEST
IF $DATA(IO("Q"))
IF $DATA(^%ZTSK)
Begin DoDot:1
+22 SET ZTRTN="PRINTHLP^DDBRP"
+23 SET ZTDESC="Browser help printout."
+24 NEW I
FOR I="DDGLHN1","DDGLHN2"
SET ZTSAVE(I)=""
+25 DO ^%ZTLOAD
+26 ;
+27 ; Restore $R again
+28 if DINAKED]""
Begin DoDot:2
+29 IF DINAKED["("
if $ORDER(@(DINAKED))
QUIT
QUIT
+30 IF $DATA(@(DINAKED))
End DoDot:2
+31 ;
+32 ; Done with DINAKED
+33 KILL DINAKED
+34 ;
QUEUED ;**
IF $DATA(ZTSK)#2
WRITE !,$$EZBLD^DIALOG(8161,ZTSK),!
+1 ;**REPORT CANCELLED
IF '$TEST
WRITE !,$$EZBLD^DIALOG(1901),!
+2 KILL ZTSK
+3 SET IOP="HOME"
DO ^%ZIS
End DoDot:1
+4 ;
+5 IF '$TEST
IF $EXTRACT(IOST,1,2)="C-"
Begin DoDot:1
+6 ;**NOT ON CRT
WRITE !,$CHAR(7)_$$EZBLD^DIALOG(7076.3),!
+7 HANG 2
End DoDot:1
+8 ;
+9 ;Non-queued report
+10 IF '$TEST
Begin DoDot:1
+11 ;**
WRITE !,"..."
+12 USE IO
+13 DO PRINTHLP
+14 XECUTE $GET(^%ZIS("C"))
End DoDot:1
+15 ;
+16 ;Reset for Screen Mode
+17 SET X=0
XECUTE ^DD("OS",DISYS,"RM")
+18 WRITE $PIECE(DDGLVID,DDGLDEL,8)
+19 ;
+20 ;Repaint help screen
+21 DO RPS^DDBRGE
+22 QUIT
+23 ;
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
