DVBAUDDEV1 ;ALB/CP - UTL Device related subroutines #1 ; 10/10/18 2:05pm
;;2.7;AMIE;**256**;;Build 19
; Per VHA Directive 6402 this DVBROUTINE should not be modified
; ^%ZIS ; IA #10086
; HOME^%ZIS ; IA #10086
; ^%ZISC ; IA #10089
; ^%ZTLOAD ; IA #10063
Q
;
CLOSE ; Close the DEVICE, but NEW the appropriate variables first
;
N @($$%ZISC^DVBAUDNEW1())
W ! D ^%ZISC
;
Q ; Close
;
DEVICE(DVBROUTINE,DVBDEFAULT,DVBCOL,DVBQUE,DVBDESC) ; Get device -- see numbered list below:
;
N @($$%ZIS^DVBAUDNEW1())
N @($$%ZTLOAD^DVBAUDNEW1())
; ZEXCEPT: DVBQUIT,U,XQY0,ZTDESC,ZTRTN,ZTSAVE
;
S DVBQUIT=0 ; DVBDEFAULT output state variable to successful
S DVBDEFAULT=$G(DVBDEFAULT)
S DVBCOL=$G(DVBCOL)
S DVBDESC=$G(DVBDESC,$P($G(XQY0),U,1)) ; Defaults to OPTION NAME
S ZTRTN="START^"_DVBROUTINE
S ZTDESC=DVBDESC
S ZTSAVE("AMIE*")=""
S ZTSAVE("ST*")="" ; **1** Added for Symbol Table Validation
S ZTSAVE("^TMP(""AMIE"",$J,")=""
S ZTSAVE("^UTILITY($J,")=""
I $G(DVBQUE)="Q" D TASK(DVBROUTINE,DVBDEFAULT,DVBCOL,DVBQUE)
I $G(DVBQUE)'="Q" D TASK(DVBROUTINE,DVBDEFAULT,DVBCOL)
;
Q ; DEVICE
;
IOM80(DVBROUTINE) ; Set IOM to 80 columns & screen to 10 CPI using
;
N @($$%ZIS^DVBAUDNEW1())
N DVBPIOM
; ZEXCEPT: IOP,IOSL,IOST
;
S DVBPIOM=$G(^TMP("AMIE",$J,"DVBPIOM",DVBROUTINE)) Q:DVBPIOM'=80
;
I $E(IOST,1,2)="C-" D ;
. S IOP="HOME;80;"_IOSL D ^%ZIS ; Set to home device with IOM of 132
. W $C(27),"[?3l" ; Change FONT to 10 CPI for 80 char. right margin
;
Q ; IOM80
;
IOM132(DVBROUTINE) ; Set IOM to 132 columns & screen to 16 CPI
;
N @($$%ZIS^DVBAUDNEW1())
N DVBPIOM
; ZEXCEPT: IOP,IOSL,IOST
;
D IOMSAVE(DVBROUTINE)
S DVBPIOM=$G(^TMP("AMIE",$J,"DVBPIOM",DVBROUTINE))
;
Q:DVBPIOM'=80
I $E(IOST,1,2)="C-" D ;
. S IOP="HOME;132;"_IOSL D ^%ZIS ; Set to home device with IOM of 132
. W $C(27),"[?3h" ; Change FONT to 16 CPI for 132 char. right margin
Q ; IOM132
;
IOMRESET(DVBROUTINE) ; Reset IOM (typically at closing of Device)
;
N DVBPIOM
;
S DVBPIOM=$G(^TMP("AMIE",$J,"DVBPIOM",DVBROUTINE)) ; Retrieve saved IOM
;
; Reset IOM variable and CPI according to previously saved value.
I DVBPIOM=80 D IOM80(DVBROUTINE) ;... Set IOM=80 & CPI=80
I DVBPIOM=132 D IOM132(DVBROUTINE) ;. Set IOM=132 & CPI=16
;
Q ; IOMRESET
;
IOMSAVE(DVBROUTINE) ; When IOM=80, save IOM for later reset at close
;
Q:IOM'=80
S ^TMP("AMIE",$J,"DVBPIOM",DVBROUTINE)=IOM ; Used by IOMRESET^DVBAUDDEV1
;
Q ; IOMSAVE
;
MSGCOL(DVBCOL) ; Display recommended column width or device type
;
W !,"<"_DVBCOL_"> ",$S(DVBCOL:"Column ",1:""),"device recommended"
;
Q ; MSGCOL
;
TASK(DVBROUTINE,DVBDEFAULT,DVBCOL,DVBQUE) ;Prompt for device and optionally queue the task
;
N %L,%ZIS,%ZTSK,IOHG,IOP,IOPAR,IOUPAR,POP,ZTSK
; ZEXCEPT: IO,DVBQUIT
W !
S %ZIS="MQ" ; M=Right Margin ; Q=Queuing Allowed
S %ZIS("B")=$G(DVBDEFAULT) ; Display DVBDEFAULT device if defined
;
;-> Display appropriate message(s) based upon input variables
;
I $G(DVBQUE)="Q" S IOP="Q"
I $G(DVBQUE)'="Q" D IOMSAVE(DVBROUTINE)
I $G(DVBCOL)]"" D MSGCOL(DVBCOL) I $G(DVBQUE)="Q" W !
;
;-> Prompt for device
;
S DVBQUIT=0 ; DVBDEFAULT output state variable to successful
D ^%ZIS I POP S DVBQUIT=1 Q
Q:'$D(IO("Q")) ;-> Queuing not allowed
;
D ^%ZTLOAD,HOME^%ZIS K IO("Q")
;
I $G(ZTSK)'>0 W !!,"Request cancelled.."
;
I $G(ZTSK)>0 W !!,"This task has been queued...Task #",ZTSK,!
;
D CONTINUE^DVBAUDPRT1(2,"R") ; 2 line feeds, Press <ENTER> to continue
S DVBQUIT=1 ;-> Indicates job is queued, or error found
;
Q ; TASK
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBAUDDEV1 3698 printed Sep 17, 2026@20:27:14 Page 2
DVBAUDDEV1 ;ALB/CP - UTL Device related subroutines #1 ; 10/10/18 2:05pm
+1 ;;2.7;AMIE;**256**;;Build 19
+2 ; Per VHA Directive 6402 this DVBROUTINE should not be modified
+3 ; ^%ZIS ; IA #10086
+4 ; HOME^%ZIS ; IA #10086
+5 ; ^%ZISC ; IA #10089
+6 ; ^%ZTLOAD ; IA #10063
+7 QUIT
+8 ;
CLOSE ; Close the DEVICE, but NEW the appropriate variables first
+1 ;
+2 NEW @($$%ZISC^DVBAUDNEW1())
+3 WRITE !
DO ^%ZISC
+4 ;
+5 ; Close
QUIT
+6 ;
DEVICE(DVBROUTINE,DVBDEFAULT,DVBCOL,DVBQUE,DVBDESC) ; Get device -- see numbered list below:
+1 ;
+2 NEW @($$%ZIS^DVBAUDNEW1())
+3 NEW @($$%ZTLOAD^DVBAUDNEW1())
+4 ; ZEXCEPT: DVBQUIT,U,XQY0,ZTDESC,ZTRTN,ZTSAVE
+5 ;
+6 ; DVBDEFAULT output state variable to successful
SET DVBQUIT=0
+7 SET DVBDEFAULT=$GET(DVBDEFAULT)
+8 SET DVBCOL=$GET(DVBCOL)
+9 ; Defaults to OPTION NAME
SET DVBDESC=$GET(DVBDESC,$PIECE($GET(XQY0),U,1))
+10 SET ZTRTN="START^"_DVBROUTINE
+11 SET ZTDESC=DVBDESC
+12 SET ZTSAVE("AMIE*")=""
+13 ; **1** Added for Symbol Table Validation
SET ZTSAVE("ST*")=""
+14 SET ZTSAVE("^TMP(""AMIE"",$J,")=""
+15 SET ZTSAVE("^UTILITY($J,")=""
+16 IF $GET(DVBQUE)="Q"
DO TASK(DVBROUTINE,DVBDEFAULT,DVBCOL,DVBQUE)
+17 IF $GET(DVBQUE)'="Q"
DO TASK(DVBROUTINE,DVBDEFAULT,DVBCOL)
+18 ;
+19 ; DEVICE
QUIT
+20 ;
IOM80(DVBROUTINE) ; Set IOM to 80 columns & screen to 10 CPI using
+1 ;
+2 NEW @($$%ZIS^DVBAUDNEW1())
+3 NEW DVBPIOM
+4 ; ZEXCEPT: IOP,IOSL,IOST
+5 ;
+6 SET DVBPIOM=$GET(^TMP("AMIE",$JOB,"DVBPIOM",DVBROUTINE))
if DVBPIOM'=80
QUIT
+7 ;
+8 ;
IF $EXTRACT(IOST,1,2)="C-"
Begin DoDot:1
+9 ; Set to home device with IOM of 132
SET IOP="HOME;80;"_IOSL
DO ^%ZIS
+10 ; Change FONT to 10 CPI for 80 char. right margin
WRITE $CHAR(27),"[?3l"
End DoDot:1
+11 ;
+12 ; IOM80
QUIT
+13 ;
IOM132(DVBROUTINE) ; Set IOM to 132 columns & screen to 16 CPI
+1 ;
+2 NEW @($$%ZIS^DVBAUDNEW1())
+3 NEW DVBPIOM
+4 ; ZEXCEPT: IOP,IOSL,IOST
+5 ;
+6 DO IOMSAVE(DVBROUTINE)
+7 SET DVBPIOM=$GET(^TMP("AMIE",$JOB,"DVBPIOM",DVBROUTINE))
+8 ;
+9 if DVBPIOM'=80
QUIT
+10 ;
IF $EXTRACT(IOST,1,2)="C-"
Begin DoDot:1
+11 ; Set to home device with IOM of 132
SET IOP="HOME;132;"_IOSL
DO ^%ZIS
+12 ; Change FONT to 16 CPI for 132 char. right margin
WRITE $CHAR(27),"[?3h"
End DoDot:1
+13 ; IOM132
QUIT
+14 ;
IOMRESET(DVBROUTINE) ; Reset IOM (typically at closing of Device)
+1 ;
+2 NEW DVBPIOM
+3 ;
+4 ; Retrieve saved IOM
SET DVBPIOM=$GET(^TMP("AMIE",$JOB,"DVBPIOM",DVBROUTINE))
+5 ;
+6 ; Reset IOM variable and CPI according to previously saved value.
+7 ;... Set IOM=80 & CPI=80
IF DVBPIOM=80
DO IOM80(DVBROUTINE)
+8 ;. Set IOM=132 & CPI=16
IF DVBPIOM=132
DO IOM132(DVBROUTINE)
+9 ;
+10 ; IOMRESET
QUIT
+11 ;
IOMSAVE(DVBROUTINE) ; When IOM=80, save IOM for later reset at close
+1 ;
+2 if IOM'=80
QUIT
+3 ; Used by IOMRESET^DVBAUDDEV1
SET ^TMP("AMIE",$JOB,"DVBPIOM",DVBROUTINE)=IOM
+4 ;
+5 ; IOMSAVE
QUIT
+6 ;
MSGCOL(DVBCOL) ; Display recommended column width or device type
+1 ;
+2 WRITE !,"<"_DVBCOL_"> ",$SELECT(DVBCOL:"Column ",1:""),"device recommended"
+3 ;
+4 ; MSGCOL
QUIT
+5 ;
TASK(DVBROUTINE,DVBDEFAULT,DVBCOL,DVBQUE) ;Prompt for device and optionally queue the task
+1 ;
+2 NEW %L,%ZIS,%ZTSK,IOHG,IOP,IOPAR,IOUPAR,POP,ZTSK
+3 ; ZEXCEPT: IO,DVBQUIT
+4 WRITE !
+5 ; M=Right Margin ; Q=Queuing Allowed
SET %ZIS="MQ"
+6 ; Display DVBDEFAULT device if defined
SET %ZIS("B")=$GET(DVBDEFAULT)
+7 ;
+8 ;-> Display appropriate message(s) based upon input variables
+9 ;
+10 IF $GET(DVBQUE)="Q"
SET IOP="Q"
+11 IF $GET(DVBQUE)'="Q"
DO IOMSAVE(DVBROUTINE)
+12 IF $GET(DVBCOL)]""
DO MSGCOL(DVBCOL)
IF $GET(DVBQUE)="Q"
WRITE !
+13 ;
+14 ;-> Prompt for device
+15 ;
+16 ; DVBDEFAULT output state variable to successful
SET DVBQUIT=0
+17 DO ^%ZIS
IF POP
SET DVBQUIT=1
QUIT
+18 ;-> Queuing not allowed
if '$DATA(IO("Q"))
QUIT
+19 ;
+20 DO ^%ZTLOAD
DO HOME^%ZIS
KILL IO("Q")
+21 ;
+22 IF $GET(ZTSK)'>0
WRITE !!,"Request cancelled.."
+23 ;
+24 IF $GET(ZTSK)>0
WRITE !!,"This task has been queued...Task #",ZTSK,!
+25 ;
+26 ; 2 line feeds, Press <ENTER> to continue
DO CONTINUE^DVBAUDPRT1(2,"R")
+27 ;-> Indicates job is queued, or error found
SET DVBQUIT=1
+28 ;
+29 ; TASK
QUIT
