DVBAUTL4 ;ALB/JLU;UTILITY ROUTINE;9/9/94
;;2.7;AMIE;**28**;Apr 10, 1995
;
WR(TEXT) ;
;this is the main entry point for the AMIE writer
;the following is a desciption of how to set up the text string to use
;this call.
;The first uparrow piece contians the description of what to execute
;on this line. The second peice contians the actual line of text.
;The descriptions are defined below
;1st = contains a 1 or zero 1 for beep zero no beep
;2nd = contains the number of spaces before and/or after the text 1:1
;3rd = contains the number of tabs before and/or after the text 1:2
;4th = contains the number of lines before and/or after the text 1:4
;5th = contains the number of form feeds before and/or after the
; text 1:3
;TEXT = contains the array that holds the text to be displayed
; the array is to look like ARRAY(X,0) local or global
; The X must start at one and be in consecutive order.
;The data in each array element will look like. "0,1:1,1:2,1:4,1:3^text"
;
F LP=1:1 S TEXTM=$G(@TEXT@(LP,0)) Q:TEXTM="" DO
.D SETTEXT
.D SETVAR
.I TEXT2="",SPACE="",TAB="",LINE="",FORM="",BEEP="" Q
.I $G(IO)'="" U IO
.I TEXT2="" D SHORT
.I TEXT2]"" D BODY
.Q
D EXIT
Q
;
EXIT K TEXTM,TEXT1,TEXT2,SPACE,TAB,BEEP,LINE,FORM,LP
Q
;
SHORT ;no text available may want to just use curser control
I FORM]"" D FORM(FORM,"B")
I LINE]"" D LINE(LINE,"B")
I TAB]"" D TAB(TAB,"B")
I SPACE]"" D SPACE(SPACE,"B")
I BEEP]"",BEEP>0 D BEEP
Q
;
BODY ;text is available will look at all
I BEEP]"",BEEP>0 D BEEP
I FORM]"" D FORM(FORM,"B")
I LINE]"" D LINE(LINE,"B")
I TAB]"" D TAB(TAB,"B")
I SPACE]"" D SPACE(SPACE,"B")
D TEXT(TEXT2)
I SPACE]"" D SPACE(SPACE,"A")
I TAB]"" D TAB(TAB,"A")
I LINE]"" D LINE(LINE,"A")
I FORM]"" D FORM(FORM,"A")
Q
;
FORM(A,B) ;issues the form feeds
;
N VAR,LP
S VAR=$$SET(A,B)
Q:VAR=""
F LP=1:1:VAR W @$S('$D(IOF):"#",IOF="":"#",1:IOF)
Q
;
LINE(A,B) ;issues the line feeds
;
N VAR,LP
S VAR=$$SET(A,B)
Q:VAR=""
F LP=1:1:VAR W !
Q
;
TAB(A,B) ;issues the tabs
;
N VAR,LP
S VAR=$$SET(A,B)
Q:VAR=""!(VAR=0)
S DX=0,DY=$S(IOST["C-":$S($Y>IOSL:IOSL,1:$Y),1:0)
X ^%ZOSF("XY")
K DX,DY
W ?VAR
Q
;
SPACE(A,B) ;issues the spaces
;
N VAR,LP
S VAR=$$SET(A,B)
Q:VAR=""
F LP=1:1:VAR W " "
Q
;
TEXT(A) ;writes the text
;
W A
Q
;
SET(A,B) ;general set statement
;
Q $S(B="B":+A,1:$P(A,":",2))
;
BEEP ;does a beep
W *7
Q
;
SETTEXT ;sets up the two parts of each string
S TEXT1=$P(TEXTM,"^",1)
S TEXT2=$F(TEXTM,"^")
S TEXT2=$E(TEXTM,TEXT2,999)
Q
;
SETVAR ;sets up the necessary variables for each attribute
S BEEP=$P(TEXT1,",",1)
S SPACE=$P(TEXT1,",",2)
S TAB=$P(TEXT1,",",3)
S LINE=$P(TEXT1,",",4)
S FORM=$P(TEXT1,",",5)
Q
;
CLEAR ;clears the screen
S VAR(1,0)="0,0,0,3,1^"
D WR^DVBAUTL4("VAR")
K VAR
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBAUTL4 2942 printed Sep 23, 2025@19:18:18 Page 2
DVBAUTL4 ;ALB/JLU;UTILITY ROUTINE;9/9/94
+1 ;;2.7;AMIE;**28**;Apr 10, 1995
+2 ;
WR(TEXT) ;
+1 ;this is the main entry point for the AMIE writer
+2 ;the following is a desciption of how to set up the text string to use
+3 ;this call.
+4 ;The first uparrow piece contians the description of what to execute
+5 ;on this line. The second peice contians the actual line of text.
+6 ;The descriptions are defined below
+7 ;1st = contains a 1 or zero 1 for beep zero no beep
+8 ;2nd = contains the number of spaces before and/or after the text 1:1
+9 ;3rd = contains the number of tabs before and/or after the text 1:2
+10 ;4th = contains the number of lines before and/or after the text 1:4
+11 ;5th = contains the number of form feeds before and/or after the
+12 ; text 1:3
+13 ;TEXT = contains the array that holds the text to be displayed
+14 ; the array is to look like ARRAY(X,0) local or global
+15 ; The X must start at one and be in consecutive order.
+16 ;The data in each array element will look like. "0,1:1,1:2,1:4,1:3^text"
+17 ;
+18 FOR LP=1:1
SET TEXTM=$GET(@TEXT@(LP,0))
if TEXTM=""
QUIT
Begin DoDot:1
+19 DO SETTEXT
+20 DO SETVAR
+21 IF TEXT2=""
IF SPACE=""
IF TAB=""
IF LINE=""
IF FORM=""
IF BEEP=""
QUIT
+22 IF $GET(IO)'=""
USE IO
+23 IF TEXT2=""
DO SHORT
+24 IF TEXT2]""
DO BODY
+25 QUIT
End DoDot:1
+26 DO EXIT
+27 QUIT
+28 ;
EXIT KILL TEXTM,TEXT1,TEXT2,SPACE,TAB,BEEP,LINE,FORM,LP
+1 QUIT
+2 ;
SHORT ;no text available may want to just use curser control
+1 IF FORM]""
DO FORM(FORM,"B")
+2 IF LINE]""
DO LINE(LINE,"B")
+3 IF TAB]""
DO TAB(TAB,"B")
+4 IF SPACE]""
DO SPACE(SPACE,"B")
+5 IF BEEP]""
IF BEEP>0
DO BEEP
+6 QUIT
+7 ;
BODY ;text is available will look at all
+1 IF BEEP]""
IF BEEP>0
DO BEEP
+2 IF FORM]""
DO FORM(FORM,"B")
+3 IF LINE]""
DO LINE(LINE,"B")
+4 IF TAB]""
DO TAB(TAB,"B")
+5 IF SPACE]""
DO SPACE(SPACE,"B")
+6 DO TEXT(TEXT2)
+7 IF SPACE]""
DO SPACE(SPACE,"A")
+8 IF TAB]""
DO TAB(TAB,"A")
+9 IF LINE]""
DO LINE(LINE,"A")
+10 IF FORM]""
DO FORM(FORM,"A")
+11 QUIT
+12 ;
FORM(A,B) ;issues the form feeds
+1 ;
+2 NEW VAR,LP
+3 SET VAR=$$SET(A,B)
+4 if VAR=""
QUIT
+5 FOR LP=1:1:VAR
WRITE @$SELECT('$DATA(IOF):"#",IOF="":"#",1:IOF)
+6 QUIT
+7 ;
LINE(A,B) ;issues the line feeds
+1 ;
+2 NEW VAR,LP
+3 SET VAR=$$SET(A,B)
+4 if VAR=""
QUIT
+5 FOR LP=1:1:VAR
WRITE !
+6 QUIT
+7 ;
TAB(A,B) ;issues the tabs
+1 ;
+2 NEW VAR,LP
+3 SET VAR=$$SET(A,B)
+4 if VAR=""!(VAR=0)
QUIT
+5 SET DX=0
SET DY=$SELECT(IOST["C-":$SELECT($Y>IOSL:IOSL,1:$Y),1:0)
+6 XECUTE ^%ZOSF("XY")
+7 KILL DX,DY
+8 WRITE ?VAR
+9 QUIT
+10 ;
SPACE(A,B) ;issues the spaces
+1 ;
+2 NEW VAR,LP
+3 SET VAR=$$SET(A,B)
+4 if VAR=""
QUIT
+5 FOR LP=1:1:VAR
WRITE " "
+6 QUIT
+7 ;
TEXT(A) ;writes the text
+1 ;
+2 WRITE A
+3 QUIT
+4 ;
SET(A,B) ;general set statement
+1 ;
+2 QUIT $SELECT(B="B":+A,1:$PIECE(A,":",2))
+3 ;
BEEP ;does a beep
+1 WRITE *7
+2 QUIT
+3 ;
SETTEXT ;sets up the two parts of each string
+1 SET TEXT1=$PIECE(TEXTM,"^",1)
+2 SET TEXT2=$FIND(TEXTM,"^")
+3 SET TEXT2=$EXTRACT(TEXTM,TEXT2,999)
+4 QUIT
+5 ;
SETVAR ;sets up the necessary variables for each attribute
+1 SET BEEP=$PIECE(TEXT1,",",1)
+2 SET SPACE=$PIECE(TEXT1,",",2)
+3 SET TAB=$PIECE(TEXT1,",",3)
+4 SET LINE=$PIECE(TEXT1,",",4)
+5 SET FORM=$PIECE(TEXT1,",",5)
+6 QUIT
+7 ;
CLEAR ;clears the screen
+1 SET VAR(1,0)="0,0,0,3,1^"
+2 DO WR^DVBAUTL4("VAR")
+3 KILL VAR
+4 QUIT
