DVBAUDPRT1 ;ALB/CP - UTL Printing subroutines & extrinsics #1 ; 10/31/18 2:00pm
;;2.7;AMIE;**256**;;Build 19
; Per VHA Directive 6402 this routine should not be modified
; ^%DT ; IA #10003
; GETS^DIQ ; IA # 2056
; ^%ZOSF("RM" ; IA #10096
; $$FMDIFF^XLFDT ; IA #10103
; $$NOW^XLFDT ; IA #10103
;
Q
;
CENTER(DVBTEXT,DVBLF,DVBRM,DVBRVIDEO) ;
;
N DVBCNTLF ; Count of line feeds
; ZEXCEPT: IOM
;
Q:$G(DVBTEXT)=""
S DVBLF=$G(DVBLF,1)
S DVBRM=$G(DVBRM,IOM)
S DVBRVIDEO=$G(DVBRVIDEO,0)
I DVBLF>0 F DVBCNTLF=1:1:DVBLF W !
W ?(DVBRM-$L(DVBTEXT))\2
D:DVBRVIDEO REVVIDEO("ON")
W DVBTEXT
D:DVBRVIDEO REVVIDEO("OFF")
;
Q ; CENTER
;
CONTINUE(DVBLF,DVBTYPE) ; Variations of Press <ENTER> to continue.
;
N DVBCNT,DVBREAD,DVBDTIME
; ZEXCEPT: DTIME,IOST,DVBQUIT
;
Q:$E($G(IOST),1,2)'="C-"
S DVBLF=$G(DVBLF,2) ; Default to two line feeds
S DVBDTIME=$S($G(DTIME)>0:DTIME,1:300)
S:$G(DVBTYPE)="" DVBTYPE="R"
;
F DVBCNT=1:1:+$G(DVBLF) W !
;
I DVBTYPE="R" D Q
. W "Press <ENTER> to continue: "
. R DVBREAD:DVBDTIME
;
I DVBTYPE="Q" D Q
. S DVBQUIT=0 ; Initialize output status flag to successful
. W "Press <ENTER> to continue, '^' to quit: "
. R DVBREAD:DVBDTIME
. S:'$T DVBREAD="^" I DVBREAD["^" SET DVBQUIT=1 ; User entered '^', quit
Q:DVBQUIT
;
Q ; CONTINUE
;
INITPRT ; Initialize printed report variables
; Count, Page Number, and Quit Flag
S (DVBCNT,DVBPG,DVBQUIT)=0
;
S DVBDT=$$DATE^DVBAUDDT1($$NOW^XLFDT(),1,0,1) ; mm/dd/yy hh:mm
S $P(DVBLINED,"-",IOM+1)="" ;.............. Line of dashes
S $P(DVBLINEE,"=",IOM+1)="" ;.............. Line of equal signs
S $P(DVBLINEP,".",IOM+1)="" ;.............. Line of periods
S $P(DVBLINEU,"_",IOM+1)="" ;.............. Line of underscores
S DVBFLAG1=1 ;............................. 1st_time_flag
;
Q ; INITPRT
;
LINEWRAP(DVBVALUE) ; Turn line wrapping off or on ; Used for data extraction
;
N X
; ZEXCEPT: IOM
;
S X=$S(DVBVALUE="ON":IOM,1:0) ; 0=Turns wrapping off
X ^%ZOSF("RM") ; Turn wrapping off or reset right margin/turn wrap on
;
Q ; LINEWRAP
;
NODATA(DVBLF) ; Use for printouts when no data is in ^TMP global
;
S DVBLF=$G(DVBLF,2)
D CENTER("No data was found for the requested input criteria.",DVBLF)
D CONTINUE(2,"R")
;
Q ; NODATA
;
PAGEBRK(DVBRTN,DVBPG,DVBCHKSL,DVBNEWPG) ; Generic page break logic
;
S DVBNEWPG=$G(DVBNEWPG,0) ;.... Default, does NOT force a page break
S DVBCHKSL=$G(DVBCHKSL,1) ;.... Default, check for page break
I DVBCHKSL,$Y'>(IOSL-5) Q ;.. If it's not time for a page break, quit
;
I DVBPG D CONTINUE(2,"Q") Q:DVBQUIT ;. Quit on user '^'
I DVBPG!DVBNEWPG!($E(IOST)="C") W @IOF ;Issue form feed
S DVBPG=DVBPG+1 ;...................... Increment page number
;
D @("PRINTHD^"_DVBRTN) ;.............. Prt rpt header from calling rtn
;
Q ; PAGEBRK
;
PRTVARS() ; Extrinsic function news standard variables used in printed reports
;
QUIT "DVBCNT,DVBDT,DVBFLAG1,DVBLINED,DVBLINEE,DVBLINEP,DVBLINEU,DVBPG,DVBQUIT" ;Extrinsic PRTVARS
;
PROCTIME(DVBTIMEBEG,DVBTIMEEND) ; Display the amount of processing time for the rpt
;
N %,DVBDAYS,DVBDIFF,DVBHRS,DVBMINS,DVBSECS
N @($$%DT^DVBAUDNEW1())
; ZEXCEPT: %DT,X,Y
;
S DVBTIMEEND=$G(DVBTIMEEND,$$NOW^XLFDT())
;
S %DT="ST"
S X=DVBTIMEBEG
K Y D ^%DT I Y=-1!($P(DVBTIMEBEG,".")'?7N) Q
S X=DVBTIMEEND
K Y D ^%DT I Y=-1!($P(DVBTIMEEND,".")'?7N) Q
;
S DVBDIFF=$$FMDIFF^XLFDT(DVBTIMEEND,DVBTIMEBEG,3) ; Returns: DD HH:MM:SS
;
;
S DVBDAYS=$P(DVBDIFF," ")
S DVBHRS=$P($P(DVBDIFF," ",2),":")
S DVBMINS=$P($P(DVBDIFF," ",2),":",2)
S DVBSECS=$P($P(DVBDIFF," ",2),":",3)
S:DVBSECS="" DVBSECS=1
W !!," PROCESSING TIME:"
W:DVBDAYS " DAYS: ",DVBDAYS
W:DVBHRS " HOURS: ",DVBHRS
W:DVBMINS " MINS: ",DVBMINS
W:DVBSECS " SECS: ",DVBSECS
;
W " (",$$DATE^DVBAUDDT1($$NOW^XLFDT(),1),")" ; Display end time
;
Q ; PROCTIME
;
REVVIDEO(DVBVALUE) ; Turn REVERSE VIDEO on or off depending upon ENVALUE
;
N DIERR,DVBIENS,DVBQUIT,DVBTT,DVBRVDOFF,DVBRVDON
; ZEXCEPT: IOST
;
S DVBIENS=+$G(IOST(0))_"," Q:$P(DVBIENS,",")'>0
D GETS^DIQ(3.2,DVBIENS,"14;15","E","DVBTT")
D DIERR^DVBAUDDILG1(60,5,"DVBERROR","REVVIDEO^"_$T(+0)) Q:DVBQUIT
S DVBRVDON=DVBTT(3.2,DVBIENS,14,"E")
S DVBRVDOFF=DVBTT(3.2,DVBIENS,15,"E")
;
I DVBVALUE="ON",DVBRVDON]"" W @(DVBRVDON) Q
I DVBVALUE="OFF",DVBRVDOFF]"" W @(DVBRVDOFF) Q
;
Q ; REVVIDEO
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBAUDPRT1 4515 printed Sep 17, 2026@20:27:27 Page 2
DVBAUDPRT1 ;ALB/CP - UTL Printing subroutines & extrinsics #1 ; 10/31/18 2:00pm
+1 ;;2.7;AMIE;**256**;;Build 19
+2 ; Per VHA Directive 6402 this routine should not be modified
+3 ; ^%DT ; IA #10003
+4 ; GETS^DIQ ; IA # 2056
+5 ; ^%ZOSF("RM" ; IA #10096
+6 ; $$FMDIFF^XLFDT ; IA #10103
+7 ; $$NOW^XLFDT ; IA #10103
+8 ;
+9 QUIT
+10 ;
CENTER(DVBTEXT,DVBLF,DVBRM,DVBRVIDEO) ;
+1 ;
+2 ; Count of line feeds
NEW DVBCNTLF
+3 ; ZEXCEPT: IOM
+4 ;
+5 if $GET(DVBTEXT)=""
QUIT
+6 SET DVBLF=$GET(DVBLF,1)
+7 SET DVBRM=$GET(DVBRM,IOM)
+8 SET DVBRVIDEO=$GET(DVBRVIDEO,0)
+9 IF DVBLF>0
FOR DVBCNTLF=1:1:DVBLF
WRITE !
+10 WRITE ?(DVBRM-$LENGTH(DVBTEXT))\2
+11 if DVBRVIDEO
DO REVVIDEO("ON")
+12 WRITE DVBTEXT
+13 if DVBRVIDEO
DO REVVIDEO("OFF")
+14 ;
+15 ; CENTER
QUIT
+16 ;
CONTINUE(DVBLF,DVBTYPE) ; Variations of Press <ENTER> to continue.
+1 ;
+2 NEW DVBCNT,DVBREAD,DVBDTIME
+3 ; ZEXCEPT: DTIME,IOST,DVBQUIT
+4 ;
+5 if $EXTRACT($GET(IOST),1,2)'="C-"
QUIT
+6 ; Default to two line feeds
SET DVBLF=$GET(DVBLF,2)
+7 SET DVBDTIME=$SELECT($GET(DTIME)>0:DTIME,1:300)
+8 if $GET(DVBTYPE)=""
SET DVBTYPE="R"
+9 ;
+10 FOR DVBCNT=1:1:+$GET(DVBLF)
WRITE !
+11 ;
+12 IF DVBTYPE="R"
Begin DoDot:1
+13 WRITE "Press <ENTER> to continue: "
+14 READ DVBREAD:DVBDTIME
End DoDot:1
QUIT
+15 ;
+16 IF DVBTYPE="Q"
Begin DoDot:1
+17 ; Initialize output status flag to successful
SET DVBQUIT=0
+18 WRITE "Press <ENTER> to continue, '^' to quit: "
+19 READ DVBREAD:DVBDTIME
+20 ; User entered '^', quit
if '$TEST
SET DVBREAD="^"
IF DVBREAD["^"
SET DVBQUIT=1
End DoDot:1
QUIT
+21 if DVBQUIT
QUIT
+22 ;
+23 ; CONTINUE
QUIT
+24 ;
INITPRT ; Initialize printed report variables
+1 ; Count, Page Number, and Quit Flag
+2 SET (DVBCNT,DVBPG,DVBQUIT)=0
+3 ;
+4 ; mm/dd/yy hh:mm
SET DVBDT=$$DATE^DVBAUDDT1($$NOW^XLFDT(),1,0,1)
+5 ;.............. Line of dashes
SET $PIECE(DVBLINED,"-",IOM+1)=""
+6 ;.............. Line of equal signs
SET $PIECE(DVBLINEE,"=",IOM+1)=""
+7 ;.............. Line of periods
SET $PIECE(DVBLINEP,".",IOM+1)=""
+8 ;.............. Line of underscores
SET $PIECE(DVBLINEU,"_",IOM+1)=""
+9 ;............................. 1st_time_flag
SET DVBFLAG1=1
+10 ;
+11 ; INITPRT
QUIT
+12 ;
LINEWRAP(DVBVALUE) ; Turn line wrapping off or on ; Used for data extraction
+1 ;
+2 NEW X
+3 ; ZEXCEPT: IOM
+4 ;
+5 ; 0=Turns wrapping off
SET X=$SELECT(DVBVALUE="ON":IOM,1:0)
+6 ; Turn wrapping off or reset right margin/turn wrap on
XECUTE ^%ZOSF("RM")
+7 ;
+8 ; LINEWRAP
QUIT
+9 ;
NODATA(DVBLF) ; Use for printouts when no data is in ^TMP global
+1 ;
+2 SET DVBLF=$GET(DVBLF,2)
+3 DO CENTER("No data was found for the requested input criteria.",DVBLF)
+4 DO CONTINUE(2,"R")
+5 ;
+6 ; NODATA
QUIT
+7 ;
PAGEBRK(DVBRTN,DVBPG,DVBCHKSL,DVBNEWPG) ; Generic page break logic
+1 ;
+2 ;.... Default, does NOT force a page break
SET DVBNEWPG=$GET(DVBNEWPG,0)
+3 ;.... Default, check for page break
SET DVBCHKSL=$GET(DVBCHKSL,1)
+4 ;.. If it's not time for a page break, quit
IF DVBCHKSL
IF $Y'>(IOSL-5)
QUIT
+5 ;
+6 ;. Quit on user '^'
IF DVBPG
DO CONTINUE(2,"Q")
if DVBQUIT
QUIT
+7 ;Issue form feed
IF DVBPG!DVBNEWPG!($EXTRACT(IOST)="C")
WRITE @IOF
+8 ;...................... Increment page number
SET DVBPG=DVBPG+1
+9 ;
+10 ;.............. Prt rpt header from calling rtn
DO @("PRINTHD^"_DVBRTN)
+11 ;
+12 ; PAGEBRK
QUIT
+13 ;
PRTVARS() ; Extrinsic function news standard variables used in printed reports
+1 ;
+2 ;Extrinsic PRTVARS
QUIT "DVBCNT,DVBDT,DVBFLAG1,DVBLINED,DVBLINEE,DVBLINEP,DVBLINEU,DVBPG,DVBQUIT"
+3 ;
PROCTIME(DVBTIMEBEG,DVBTIMEEND) ; Display the amount of processing time for the rpt
+1 ;
+2 NEW %,DVBDAYS,DVBDIFF,DVBHRS,DVBMINS,DVBSECS
+3 NEW @($$%DT^DVBAUDNEW1())
+4 ; ZEXCEPT: %DT,X,Y
+5 ;
+6 SET DVBTIMEEND=$GET(DVBTIMEEND,$$NOW^XLFDT())
+7 ;
+8 SET %DT="ST"
+9 SET X=DVBTIMEBEG
+10 KILL Y
DO ^%DT
IF Y=-1!($PIECE(DVBTIMEBEG,".")'?7N)
QUIT
+11 SET X=DVBTIMEEND
+12 KILL Y
DO ^%DT
IF Y=-1!($PIECE(DVBTIMEEND,".")'?7N)
QUIT
+13 ;
+14 ; Returns: DD HH:MM:SS
SET DVBDIFF=$$FMDIFF^XLFDT(DVBTIMEEND,DVBTIMEBEG,3)
+15 ;
+16 ;
+17 SET DVBDAYS=$PIECE(DVBDIFF," ")
+18 SET DVBHRS=$PIECE($PIECE(DVBDIFF," ",2),":")
+19 SET DVBMINS=$PIECE($PIECE(DVBDIFF," ",2),":",2)
+20 SET DVBSECS=$PIECE($PIECE(DVBDIFF," ",2),":",3)
+21 if DVBSECS=""
SET DVBSECS=1
+22 WRITE !!," PROCESSING TIME:"
+23 if DVBDAYS
WRITE " DAYS: ",DVBDAYS
+24 if DVBHRS
WRITE " HOURS: ",DVBHRS
+25 if DVBMINS
WRITE " MINS: ",DVBMINS
+26 if DVBSECS
WRITE " SECS: ",DVBSECS
+27 ;
+28 ; Display end time
WRITE " (",$$DATE^DVBAUDDT1($$NOW^XLFDT(),1),")"
+29 ;
+30 ; PROCTIME
QUIT
+31 ;
REVVIDEO(DVBVALUE) ; Turn REVERSE VIDEO on or off depending upon ENVALUE
+1 ;
+2 NEW DIERR,DVBIENS,DVBQUIT,DVBTT,DVBRVDOFF,DVBRVDON
+3 ; ZEXCEPT: IOST
+4 ;
+5 SET DVBIENS=+$GET(IOST(0))_","
if $PIECE(DVBIENS,",")'>0
QUIT
+6 DO GETS^DIQ(3.2,DVBIENS,"14;15","E","DVBTT")
+7 DO DIERR^DVBAUDDILG1(60,5,"DVBERROR","REVVIDEO^"_$TEXT(+0))
if DVBQUIT
QUIT
+8 SET DVBRVDON=DVBTT(3.2,DVBIENS,14,"E")
+9 SET DVBRVDOFF=DVBTT(3.2,DVBIENS,15,"E")
+10 ;
+11 IF DVBVALUE="ON"
IF DVBRVDON]""
WRITE @(DVBRVDON)
QUIT
+12 IF DVBVALUE="OFF"
IF DVBRVDOFF]""
WRITE @(DVBRVDOFF)
QUIT
+13 ;
+14 ; REVVIDEO
QUIT
