Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DDGLIBP

DDGLIBP.m

Go to the documentation of this file. 
  1. DDGLIBP ;SFISC/MKO-PRINT FROM WITHIN SCREEN TOOLS ;10:27 AM  14 Feb 2013
  1.  ;;22.0;VA FileMan;**169**;Mar 30, 1999;Build 28
  1.  ;Per VHA Directive 2004-038, this routine should not be modified.
  1.  ;
  1. PT(DDGLROOT,DDGLHDR) ;Prompt for device and print
  1.  N POP,DDGLBAR,DDGLFLAG,DDGLHELP,DDGLI,DDGLPHDR,DDGLREF,DDGLWRAP,DX,DY,DIR0,DDS
  1.  N %,%A,%B,%B1,%B2,%B3,%BA,%C,%E,%G,%H,%I,%J,%K,%M,%N
  1.  N %P,%S,%T,%W,%X,%Y
  1.  N %A0,%D1,%D2,%DT,%J1,%W0
  1.  ;
  1.  S DDGLFLAG=""
  1.  ;
  1.  ;Set terminal characterstics for scroll mode
  1.  X DDGLZOSF("EON"),DDGLZOSF("TRMOFF")
  1.  S X=$G(IOM,80) X ^%ZOSF("RM")
  1.  W $P(DDGLVID,DDGLDEL,9)
  1.  ;
  1.  W:$G(DDGLHDR)]"" "Document: "_DDGLHDR,!
  1.  ;
  1.  ;Prompt whether to print a header
  1.  S DDGLHELP(1)="  Answer 'Y' to print a document title, date/time, and page number"
  1.  S DDGLHELP="  at the top of each page."
  1.  S DDGLPHDR=$$YNREAD("Print a header on each page","N",.DDGLHELP)
  1.  K DDGLHELP
  1.  I DDGLPHDR=-1 D FINISH("Report canceled.") Q
  1.  S:DDGLPHDR DDGLFLAG=DDGLFLAG_"H"
  1.  ;
  1.  ;Prompt whether to wrap text
  1.  S DDGLHELP(1)="  Answer 'Y' to wrap the text at word boundaries to fit within the margins"
  1.  S DDGLHELP(2)="             of the device."
  1.  S DDGLHELP="  Answer 'N' to print the text as-is (no-wrap)."
  1.  S DDGLWRAP=$$YNREAD("Wrap text","N",.DDGLHELP)
  1.  K DDGLHELP
  1.  I DDGLWRAP=-1 D FINISH("Report canceled.") Q
  1.  ;
  1.  ;Prompt whether to interpret word processing (|) windows"
  1.  S DDGLHELP(1)="  Answer 'Y' to have text enclosed within vertical bars (|) interpreted as"
  1.  S DDGLHELP(2)="             word processing windows."
  1.  S DDGLHELP="  Answer 'N' to have vertical bars printed as-is."
  1.  S DDGLBAR=$$YNREAD("Interpret word processing windows (|)","N",.DDGLHELP)
  1.  K DDGLHELP
  1.  I DDGLBAR=-1 D FINISH("Report canceled.") Q
  1.  ;
  1.  ;Set flag for wrap and wp windows
  1.  S DDGLFLAG=DDGLFLAG_$S(DDGLWRAP&'DDGLBAR:"|",'DDGLWRAP&DDGLBAR:"N",'DDGLWRAP&'DDGLBAR:"X",1:"")
  1.  ;
  1. DEVICE ;Device prompt
  1.  N IOF,IOSL
  1.  S IOF="#",IOSL=IOBM-IOTM+1 ;In case help frames are invoked
  1.  S %ZIS=$S($D(^%ZTSK):"Q",1:""),%ZIS("B")=""
  1.  S %ZIS("S")="I $TR($P(^(0),U),""browse"",""BROWSE"")'[""BROWSE"""
  1.  D ^%ZIS K %ZIS
  1.  ;
  1.  I POP D FINISH("Report canceled!") Q
  1.  ;
  1.  ;Get the closed root of the array containing the text, resolve values like $J
  1.  S DDGLREF=$NA(@$$CREF^DILF($G(DDGLROOT)))
  1.  ;
  1.  ;If CRT selected, reset scrolling region to entire screen
  1.  I $E(IOST,1,2)="C-" D
  1.  . I $D(IOSTBM)#2 N IOTM,IOBM S IOTM=0,IOBM=$G(IOSL,24) W @IOSTBM
  1.  . W @IOF
  1.  ;
  1.  ;Queue report
  1.  I $D(IO("Q")),$D(^%ZTSK) D  Q
  1.  . N I,ZTRTN,ZTDESC,ZTSAVE,ZTSK,DDGLMSG
  1.  . S ZTRTN="PRINT^DDGLIBP"
  1.  . S ZTDESC=DDGLHDR
  1.  . F I="DDGLREF","DDGLHDR","DDGLFLAG" S ZTSAVE(I)=""
  1.  . I DDGLREF]"" S ZTSAVE($$OREF^DILF(DDGLREF))=""
  1.  . D ^%ZTLOAD
  1.  . I $D(ZTSK)#2 D
  1.  .. W !,"Report queued!",!,"Task number: "_ZTSK,!
  1.  .. D EOPREAD
  1.  . E  S DDGLMSG="Report canceled!"
  1.  . S IOP="HOME" D ^%ZIS
  1.  . D FINISH($G(DDGLMSG))
  1.  ;
  1.  ;Non-queued report
  1.  D PRINT
  1.  I $E(IOST,1,2)="C-" W @IOF W:$D(IOSTBM)#2 @IOSTBM
  1.  X $G(^%ZIS("C"))
  1.  D FINISH("Done.")
  1.  Q
  1.  ;
  1. PRINT ;Print the document in DDGLREF, Header text in DDGLHDR
  1.  N DDGLDT,DDGLI,DDGLPAGE,DDGLZN
  1.  I $G(DDGLREF)="" D PRINTQ Q
  1.  I '$D(@DDGLREF) D PRINTQ Q
  1.  ;
  1.  S DDGLZN=$D(@DDGLREF@($O(@DDGLREF@(0)),0))#2
  1.  S DDGLFLAG=$G(DDGLFLAG)
  1.  ;
  1.  ;Format the text, if DDGLFLAG doesn't contain X
  1.  I DDGLFLAG'["X" D
  1.  . D FORMAT(DDGLREF,DDGLZN,DDGLFLAG)
  1.  . S DDGLZN=1
  1.  . S DDGLREF=$NA(^UTILITY($J,"W",1))
  1.  ;
  1.  ;Write the report from the original location or from ^UTILITY
  1.  U IO
  1.  I DDGLFLAG["H" D
  1.  . ;Get current date/time and write first header
  1.  . N %,%H,X,Y
  1.  . S %H=$H D YX^%DTC
  1.  . S DDGLDT=$E(Y,1,18)
  1.  . D HDR
  1.  ;
  1.  ;Print each line
  1.  S DDGLI=0 F  S DDGLI=$O(@DDGLREF@(DDGLI)) Q:'DDGLI  D
  1.  . I DDGLFLAG["H",$Y+6>IOSL W @IOF D HDR
  1.  . W !,$S(DDGLZN:$G(@DDGLREF@(DDGLI,0)),1:$G(@DDGLREF@(DDGLI)))
  1.  ;
  1.  K:$G(DDGLFLAG)'["N" ^UTILITY($J,"W")
  1.  D PRINTQ
  1.  Q
  1.  ;
  1. PRINTQ ;Delete the queued task and quit
  1.  S:$D(ZTQUEUED) ZTREQ="@"
  1.  Q
  1.  ;
  1. HDR ;Print the header DDGLHDR; increment DDGLPAGE
  1.  N DDGLCOL,DDGLPSTR
  1.  S DDGLPAGE=$G(DDGLPAGE)+1
  1.  S DDGLPSTR=DDGLDT_"    Page: "_DDGLPAGE
  1.  S DDGLCOL=IOM-$L(DDGLPSTR)-1
  1.  W DDGLHDR
  1.  W:$X+2'<DDGLCOL !
  1.  W ?DDGLCOL,DDGLPSTR
  1.  W !,$TR($J("",IOM-1)," ","-")
  1.  Q
  1.  ;
  1. YNREAD(DDGLPROM,DDGLDEF,DDGLHELP) ;Issue a Yes/No Read
  1.  N DIR,DTOUT,DUOUT,DIRUT,DIROUT,X,Y
  1.  S DIR(0)="Y"
  1.  S DIR("B")=$S("Nn0"[$E($G(DDGLDEF)):"NO",1:"YES")
  1.  M:$D(DDGLHELP)]"" DIR("?")=DDGLHELP
  1.  S:$G(DDGLPROM)]"" DIR("A")=DDGLPROM
  1.  D ^DIR
  1.  Q $S($D(DIRUT):-1,1:Y)
  1.  ;
  1. EOPREAD ; Issue an End-of-Page Read
  1.  N DIR,DTOUT,DUOUT,DIRUT,DIROUT,X,Y
  1.  S DIR(0)="E" D ^DIR
  1.  Q
  1.  ;
  1. FORMAT(DDGLREF,DDGLZN,DDGLFLAG) ;Use ^DIWP to format the text
  1.  N DIWL,DIWR,DIWF,X
  1.  K ^UTILITY($J,"W")
  1.  S DIWL=1,DIWR=IOM-1,DIWF=$E("N",DDGLFLAG["N")_$E("|",DDGLFLAG["|")_$E("X",DDGLFLAG["X")
  1.  S DDGLI=0 F  S DDGLI=$O(@DDGLREF@(DDGLI)) Q:'DDGLI  D
  1.  . S X=$S($G(DDGLZN):@DDGLREF@(DDGLI,0),1:$G(@DDGLREF@(DDGLI)))
  1.  . D ^DIWP
  1.  Q
  1.  ;
  1. FINISH(DDGLMSG) ;Print message and reset terminal characteristics
  1.  I $G(DDGLMSG)]"" W !,DDGLMSG H 1
  1.  ;
  1.  ;Reset terminal characteristics for screen handling
  1.  X DDGLZOSF("EOFF"),DDGLZOSF("TRMON")
  1.  S X=0 X ^%ZOSF("RM")
  1.  W $P(DDGLVID,DDGLDEL,8)
  1.  Q