- 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 Jan 18, 2025@02:43:33 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