DDGLIBP ;SFISC/MKO - PRINT FROM WITHIN SCREEN TOOLS ;13APR2016
;;22.2;VA FileMan;**3,5**;Jan 05, 2016;Build 28
;;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.
;;GFT;**169,1055**
;
PT(DDGLROOT,DDGLHDR) ;Prompt for device and print
N POP,DDGLBAR,DDGLFLAG,DDGLHELP,DDGLI,DDGLPHDR,DDGLREF,DDGLWRAP,DX,DY,DIR0,DDS
N %,%A,%B,%B1,%B2,%B3,%BA,%C,%E,%G,%H,%I,%J,%K,%M,%N
N %P,%S,%T,%W,%X,%Y
N %A0,%D1,%D2,%DT,%J1,%W0
;
S DDGLFLAG=""
;
;Set terminal characterstics for scroll mode
X DDGLZOSF("EON"),DDGLZOSF("TRMOFF")
S X=$G(IOM,80) X $G(^%ZOSF("RM"),$G(DDGLZOSF("RM")))
W $P(DDGLVID,DDGLDEL,9)
;
W:$G(DDGLHDR)]"" "Document: "_DDGLHDR,!
;
;Prompt whether to print a header
S DDGLHELP(1)=" Answer 'Y' to print a document title, date/time, and page number"
S DDGLHELP=" at the top of each page."
S DDGLPHDR=$$YNREAD("Print a header on each page","N",.DDGLHELP)
K DDGLHELP
I DDGLPHDR=-1 D FINISH("Report canceled.") Q
S:DDGLPHDR DDGLFLAG=DDGLFLAG_"H"
;
;Prompt whether to wrap text
S DDGLHELP(1)=" Answer 'Y' to wrap the text at word boundaries to fit within the margins"
S DDGLHELP(2)=" of the device."
S DDGLHELP=" Answer 'N' to print the text as-is (no-wrap)."
S DDGLWRAP=$$YNREAD("Wrap text","N",.DDGLHELP)
K DDGLHELP
I DDGLWRAP=-1 D FINISH("Report canceled.") Q
;
;Prompt whether to interpret word processing (|) windows"
S DDGLHELP(1)=" Answer 'Y' to have text enclosed within vertical bars (|) interpreted as"
S DDGLHELP(2)=" word processing windows."
S DDGLHELP=" Answer 'N' to have vertical bars printed as-is."
S DDGLBAR=$$YNREAD("Interpret word processing windows (|)","N",.DDGLHELP)
K DDGLHELP
I DDGLBAR=-1 D FINISH("Report canceled.") Q
;
;Set flag for wrap and wp windows
S DDGLFLAG=DDGLFLAG_$S(DDGLWRAP&'DDGLBAR:"|",'DDGLWRAP&DDGLBAR:"N",'DDGLWRAP&'DDGLBAR:"X",1:"")
;
DEVICE ;Device prompt
N IOF,IOSL
S IOF="#",IOSL=IOBM-IOTM+1 ;In case help frames are invoked
S %ZIS=$S($D(^%ZTSK):"Q",1:""),%ZIS("B")=""
S %ZIS("S")="I $TR($P(^(0),U),""browse"",""BROWSE"")'[""BROWSE"""
D ^%ZIS K %ZIS
;
I POP D FINISH("Report canceled!") Q
;
;Get the closed root of the array containing the text, resolve values like $J
S DDGLREF=$NA(@$$CREF^DILF($G(DDGLROOT)))
;
;If CRT selected, reset scrolling region to entire screen
I $E(IOST,1,2)="C-" D
. I $D(IOSTBM)#2 N IOTM,IOBM S IOTM=0,IOBM=$G(IOSL,24) W @IOSTBM
. W @IOF
;
;Queue report
I $D(IO("Q")),$D(^%ZTSK) D Q
. N I,ZTRTN,ZTDESC,ZTSAVE,ZTSK,DDGLMSG
. S ZTRTN="PRINT^DDGLIBP"
. S ZTDESC=DDGLHDR
. F I="DDGLREF","DDGLHDR","DDGLFLAG" S ZTSAVE(I)=""
. I DDGLREF]"" S ZTSAVE($$OREF^DILF(DDGLREF))=""
. D ^%ZTLOAD
. I $D(ZTSK)#2 D
.. W !,"Report queued!",!,"Task number: "_ZTSK,!
.. D EOPREAD
. E S DDGLMSG="Report canceled!"
. S IOP="HOME" D ^%ZIS
. D FINISH($G(DDGLMSG))
;
NONQUEUE ;Non-queued report
D PRINT
I $E(IOST,1,2)="C-" W @IOF W:$D(IOSTBM)#2 @IOSTBM ; Reset bottom margin
N %ZISPCX X $G(^%ZIS("C")) ;DON'T DO THE BROWSER'S POST-CLOSE EXECUTE
D FINISH("Done.")
Q
;
PRINT ;Print the document in DDGLREF, Header text in DDGLHDR
N DDGLDT,DDGLI,DDGLPAGE,DDGLZN
I $G(DDGLREF)="" D PRINTQ Q
I '$D(@DDGLREF) D PRINTQ Q
;
S DDGLZN=$D(@DDGLREF@($O(@DDGLREF@(0)),0))#2
S DDGLFLAG=$G(DDGLFLAG)
;
;Format the text, if DDGLFLAG doesn't contain X
I DDGLFLAG'["X" D
. D FORMAT(DDGLREF,DDGLZN,DDGLFLAG)
. S DDGLZN=1
. S DDGLREF=$NA(^UTILITY($J,"W",1))
;
;Write the report from the original location or from ^UTILITY
U IO
I DDGLFLAG["H" D
. ;Get current date/time and write first header
. N %,%H,X,Y
. S %H=$H D YX^%DTC
. S DDGLDT=$E(Y,1,18)
. D HDR
;
;Print each line
S DDGLI=0 F S DDGLI=$O(@DDGLREF@(DDGLI)) Q:'DDGLI D
. I DDGLFLAG["H",$Y+6>IOSL W @IOF D HDR
. W !,$S(DDGLZN:$G(@DDGLREF@(DDGLI,0)),1:$G(@DDGLREF@(DDGLI)))
;
K:$G(DDGLFLAG)'["N" ^UTILITY($J,"W")
D PRINTQ
Q
;
PRINTQ ;Delete the queued task and quit
S:$D(ZTQUEUED) ZTREQ="@"
Q
;
HDR ;Print the header DDGLHDR; increment DDGLPAGE
N DDGLCOL,DDGLPSTR
S DDGLPAGE=$G(DDGLPAGE)+1
S DDGLPSTR=DDGLDT_" Page: "_DDGLPAGE
S DDGLCOL=IOM-$L(DDGLPSTR)-1
W DDGLHDR
W:$X+2'<DDGLCOL !
W ?DDGLCOL,DDGLPSTR
W !,$TR($J("",IOM-1)," ","-")
Q
;
YNREAD(DDGLPROM,DDGLDEF,DDGLHELP) ;Issue a Yes/No Read
N DIR,DTOUT,DUOUT,DIRUT,DIROUT,X,Y
S DIR(0)="Y"
S DIR("B")=$S("Nn0"[$E($G(DDGLDEF)):"NO",1:"YES")
M:$D(DDGLHELP)]"" DIR("?")=DDGLHELP
S:$G(DDGLPROM)]"" DIR("A")=DDGLPROM
D ^DIR
Q $S($D(DIRUT):-1,1:Y)
;
EOPREAD ; Issue an End-of-Page Read
N DIR,DTOUT,DUOUT,DIRUT,DIROUT,X,Y
S DIR(0)="E" D ^DIR
Q
;
FORMAT(DDGLREF,DDGLZN,DDGLFLAG) ;Use ^DIWP to format the text
N DIWL,DIWR,DIWF,X
K ^UTILITY($J,"W")
S DIWL=1,DIWR=IOM-1,DIWF=$E("N",DDGLFLAG["N")_$E("|",DDGLFLAG["|")_$E("X",DDGLFLAG["X")
S DDGLI=0 F S DDGLI=$O(@DDGLREF@(DDGLI)) Q:'DDGLI D
. S X=$S($G(DDGLZN):@DDGLREF@(DDGLI,0),1:$G(@DDGLREF@(DDGLI)))
. D ^DIWP
Q
;
FINISH(DDGLMSG) ;Print message and reset terminal characteristics
I $G(DDGLMSG)]"" W !,DDGLMSG H 1
;
;Reset terminal characteristics for screen handling
X DDGLZOSF("EOFF"),DDGLZOSF("TRMON")
S X=0 X $G(^%ZOSF("RM"),$G(DDGLZOSF("RM")))
W $P(DDGLVID,DDGLDEL,8)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDDGLIBP 5514 printed Oct 16, 2024@18:43:11 Page 2
DDGLIBP ;SFISC/MKO - PRINT FROM WITHIN SCREEN TOOLS ;13APR2016
+1 ;;22.2;VA FileMan;**3,5**;Jan 05, 2016;Build 28
+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 ;;GFT;**169,1055**
+7 ;
PT(DDGLROOT,DDGLHDR) ;Prompt for device and print
+1 NEW POP,DDGLBAR,DDGLFLAG,DDGLHELP,DDGLI,DDGLPHDR,DDGLREF,DDGLWRAP,DX,DY,DIR0,DDS
+2 NEW %,%A,%B,%B1,%B2,%B3,%BA,%C,%E,%G,%H,%I,%J,%K,%M,%N
+3 NEW %P,%S,%T,%W,%X,%Y
+4 NEW %A0,%D1,%D2,%DT,%J1,%W0
+5 ;
+6 SET DDGLFLAG=""
+7 ;
+8 ;Set terminal characterstics for scroll mode
+9 XECUTE DDGLZOSF("EON")
XECUTE DDGLZOSF("TRMOFF")
+10 SET X=$GET(IOM,80)
XECUTE $GET(^%ZOSF("RM"),$GET(DDGLZOSF("RM")))
+11 WRITE $PIECE(DDGLVID,DDGLDEL,9)
+12 ;
+13 if $GET(DDGLHDR)]""
WRITE "Document: "_DDGLHDR,!
+14 ;
+15 ;Prompt whether to print a header
+16 SET DDGLHELP(1)=" Answer 'Y' to print a document title, date/time, and page number"
+17 SET DDGLHELP=" at the top of each page."
+18 SET DDGLPHDR=$$YNREAD("Print a header on each page","N",.DDGLHELP)
+19 KILL DDGLHELP
+20 IF DDGLPHDR=-1
DO FINISH("Report canceled.")
QUIT
+21 if DDGLPHDR
SET DDGLFLAG=DDGLFLAG_"H"
+22 ;
+23 ;Prompt whether to wrap text
+24 SET DDGLHELP(1)=" Answer 'Y' to wrap the text at word boundaries to fit within the margins"
+25 SET DDGLHELP(2)=" of the device."
+26 SET DDGLHELP=" Answer 'N' to print the text as-is (no-wrap)."
+27 SET DDGLWRAP=$$YNREAD("Wrap text","N",.DDGLHELP)
+28 KILL DDGLHELP
+29 IF DDGLWRAP=-1
DO FINISH("Report canceled.")
QUIT
+30 ;
+31 ;Prompt whether to interpret word processing (|) windows"
+32 SET DDGLHELP(1)=" Answer 'Y' to have text enclosed within vertical bars (|) interpreted as"
+33 SET DDGLHELP(2)=" word processing windows."
+34 SET DDGLHELP=" Answer 'N' to have vertical bars printed as-is."
+35 SET DDGLBAR=$$YNREAD("Interpret word processing windows (|)","N",.DDGLHELP)
+36 KILL DDGLHELP
+37 IF DDGLBAR=-1
DO FINISH("Report canceled.")
QUIT
+38 ;
+39 ;Set flag for wrap and wp windows
+40 SET DDGLFLAG=DDGLFLAG_$SELECT(DDGLWRAP&'DDGLBAR:"|",'DDGLWRAP&DDGLBAR:"N",'DDGLWRAP&'DDGLBAR:"X",1:"")
+41 ;
DEVICE ;Device prompt
+1 NEW IOF,IOSL
+2 ;In case help frames are invoked
SET IOF="#"
SET IOSL=IOBM-IOTM+1
+3 SET %ZIS=$SELECT($DATA(^%ZTSK):"Q",1:"")
SET %ZIS("B")=""
+4 SET %ZIS("S")="I $TR($P(^(0),U),""browse"",""BROWSE"")'[""BROWSE"""
+5 DO ^%ZIS
KILL %ZIS
+6 ;
+7 IF POP
DO FINISH("Report canceled!")
QUIT
+8 ;
+9 ;Get the closed root of the array containing the text, resolve values like $J
+10 SET DDGLREF=$NAME(@$$CREF^DILF($GET(DDGLROOT)))
+11 ;
+12 ;If CRT selected, reset scrolling region to entire screen
+13 IF $EXTRACT(IOST,1,2)="C-"
Begin DoDot:1
+14 IF $DATA(IOSTBM)#2
NEW IOTM,IOBM
SET IOTM=0
SET IOBM=$GET(IOSL,24)
WRITE @IOSTBM
+15 WRITE @IOF
End DoDot:1
+16 ;
+17 ;Queue report
+18 IF $DATA(IO("Q"))
IF $DATA(^%ZTSK)
Begin DoDot:1
+19 NEW I,ZTRTN,ZTDESC,ZTSAVE,ZTSK,DDGLMSG
+20 SET ZTRTN="PRINT^DDGLIBP"
+21 SET ZTDESC=DDGLHDR
+22 FOR I="DDGLREF","DDGLHDR","DDGLFLAG"
SET ZTSAVE(I)=""
+23 IF DDGLREF]""
SET ZTSAVE($$OREF^DILF(DDGLREF))=""
+24 DO ^%ZTLOAD
+25 IF $DATA(ZTSK)#2
Begin DoDot:2
+26 WRITE !,"Report queued!",!,"Task number: "_ZTSK,!
+27 DO EOPREAD
End DoDot:2
+28 IF '$TEST
SET DDGLMSG="Report canceled!"
+29 SET IOP="HOME"
DO ^%ZIS
+30 DO FINISH($GET(DDGLMSG))
End DoDot:1
QUIT
+31 ;
NONQUEUE ;Non-queued report
+1 DO PRINT
+2 ; Reset bottom margin
IF $EXTRACT(IOST,1,2)="C-"
WRITE @IOF
if $DATA(IOSTBM)#2
WRITE @IOSTBM
+3 ;DON'T DO THE BROWSER'S POST-CLOSE EXECUTE
NEW %ZISPCX
XECUTE $GET(^%ZIS("C"))
+4 DO FINISH("Done.")
+5 QUIT
+6 ;
PRINT ;Print the document in DDGLREF, Header text in DDGLHDR
+1 NEW DDGLDT,DDGLI,DDGLPAGE,DDGLZN
+2 IF $GET(DDGLREF)=""
DO PRINTQ
QUIT
+3 IF '$DATA(@DDGLREF)
DO PRINTQ
QUIT
+4 ;
+5 SET DDGLZN=$DATA(@DDGLREF@($ORDER(@DDGLREF@(0)),0))#2
+6 SET DDGLFLAG=$GET(DDGLFLAG)
+7 ;
+8 ;Format the text, if DDGLFLAG doesn't contain X
+9 IF DDGLFLAG'["X"
Begin DoDot:1
+10 DO FORMAT(DDGLREF,DDGLZN,DDGLFLAG)
+11 SET DDGLZN=1
+12 SET DDGLREF=$NAME(^UTILITY($JOB,"W",1))
End DoDot:1
+13 ;
+14 ;Write the report from the original location or from ^UTILITY
+15 USE IO
+16 IF DDGLFLAG["H"
Begin DoDot:1
+17 ;Get current date/time and write first header
+18 NEW %,%H,X,Y
+19 SET %H=$HOROLOG
DO YX^%DTC
+20 SET DDGLDT=$EXTRACT(Y,1,18)
+21 DO HDR
End DoDot:1
+22 ;
+23 ;Print each line
+24 SET DDGLI=0
FOR
SET DDGLI=$ORDER(@DDGLREF@(DDGLI))
if 'DDGLI
QUIT
Begin DoDot:1
+25 IF DDGLFLAG["H"
IF $Y+6>IOSL
WRITE @IOF
DO HDR
+26 WRITE !,$SELECT(DDGLZN:$GET(@DDGLREF@(DDGLI,0)),1:$GET(@DDGLREF@(DDGLI)))
End DoDot:1
+27 ;
+28 if $GET(DDGLFLAG)'["N"
KILL ^UTILITY($JOB,"W")
+29 DO PRINTQ
+30 QUIT
+31 ;
PRINTQ ;Delete the queued task and quit
+1 if $DATA(ZTQUEUED)
SET ZTREQ="@"
+2 QUIT
+3 ;
HDR ;Print the header DDGLHDR; increment DDGLPAGE
+1 NEW DDGLCOL,DDGLPSTR
+2 SET DDGLPAGE=$GET(DDGLPAGE)+1
+3 SET DDGLPSTR=DDGLDT_" Page: "_DDGLPAGE
+4 SET DDGLCOL=IOM-$LENGTH(DDGLPSTR)-1
+5 WRITE DDGLHDR
+6 if $X+2'<DDGLCOL
WRITE !
+7 WRITE ?DDGLCOL,DDGLPSTR
+8 WRITE !,$TRANSLATE($JUSTIFY("",IOM-1)," ","-")
+9 QUIT
+10 ;
YNREAD(DDGLPROM,DDGLDEF,DDGLHELP) ;Issue a Yes/No Read
+1 NEW DIR,DTOUT,DUOUT,DIRUT,DIROUT,X,Y
+2 SET DIR(0)="Y"
+3 SET DIR("B")=$SELECT("Nn0"[$EXTRACT($GET(DDGLDEF)):"NO",1:"YES")
+4 if $DATA(DDGLHELP)]""
MERGE DIR("?")=DDGLHELP
+5 if $GET(DDGLPROM)]""
SET DIR("A")=DDGLPROM
+6 DO ^DIR
+7 QUIT $SELECT($DATA(DIRUT):-1,1:Y)
+8 ;
EOPREAD ; Issue an End-of-Page Read
+1 NEW DIR,DTOUT,DUOUT,DIRUT,DIROUT,X,Y
+2 SET DIR(0)="E"
DO ^DIR
+3 QUIT
+4 ;
FORMAT(DDGLREF,DDGLZN,DDGLFLAG) ;Use ^DIWP to format the text
+1 NEW DIWL,DIWR,DIWF,X
+2 KILL ^UTILITY($JOB,"W")
+3 SET DIWL=1
SET DIWR=IOM-1
SET DIWF=$EXTRACT("N",DDGLFLAG["N")_$EXTRACT("|",DDGLFLAG["|")_$EXTRACT("X",DDGLFLAG["X")
+4 SET DDGLI=0
FOR
SET DDGLI=$ORDER(@DDGLREF@(DDGLI))
if 'DDGLI
QUIT
Begin DoDot:1
+5 SET X=$SELECT($GET(DDGLZN):@DDGLREF@(DDGLI,0),1:$GET(@DDGLREF@(DDGLI)))
+6 DO ^DIWP
End DoDot:1
+7 QUIT
+8 ;
FINISH(DDGLMSG) ;Print message and reset terminal characteristics
+1 IF $GET(DDGLMSG)]""
WRITE !,DDGLMSG
HANG 1
+2 ;
+3 ;Reset terminal characteristics for screen handling
+4 XECUTE DDGLZOSF("EOFF")
XECUTE DDGLZOSF("TRMON")
+5 SET X=0
XECUTE $GET(^%ZOSF("RM"),$GET(DDGLZOSF("RM")))
+6 WRITE $PIECE(DDGLVID,DDGLDEL,8)
+7 QUIT
