VT520 ;VT520 control functions [ 11/07/2001  3:20 PM ]
 ;
 New
 Do INIT^vhTERMINA
 Write @F11,@F1
 Do SELECT()
 Quit
 ;
SELECT(Routines) 
 Set Routines=$G(Routines)
 If $L(Routines) Do
 .For I=$L(Routines,";"):-1:1 Do
 ..Set R=$T(@$P(Routines,";",I))
 ..If R="" Set $P(Routines,";",I,I+1)=$P(Routines,";",I+1)
 .Set:$E(Routines,$L(Routines))=";" $E(Routines,$L(Routines))="" 
 If Routines="" Do
 .For I=2:1 Set R=$T(+I) Quit:R=""  Do
 ..Quit:$E(R)=" "  Quit:$E(R,1,6)="SELECT"
 ..Set Routines=Routines_";"_$P(R,"(")
 .Set $E(Routines)=""
 For I=2:1 Set R=$T(+I) Quit:R=""  Do
 .Quit:(";"_Routines_";")'[(";"_$P(R,"(")_";")
 .For Next=1:1 Quit:$P(Routines,";",Next)=$P(R,"(")
 .Set Routines(Next)=R,R=$T(+I-1),Routines(Next)=$P(R,";",2)_D_Routines(Next)
 Set Next=$O(Routines(""),-1)
 Set DL(1)="LijstDef",LijstDef(1)="Routines",LijstDef(2)="1;C;L;40;; | \2;C;L;35"
 Set LijstDef(3)=24-Next+1 Set:LijstDef(3)<3 LijstDef(3)=3 Set:LijstDef(3)<20 LijstDef(3)=20
 Set LijstDef(6)=1,LijstDef(8)=" Functie                                 | Routine"
 Do WL^PROC
 For  Do SL^PROC Quit:R="-"  If R="ENTER" Set R=LijstDef(6) Quit
 If R'="-" Do
 .Set R=Routines(R),Routine=$P(R,D,2),RoutName=$P(Routine,"("),Params=$P($P(Routine,"(",2),")")
 .Write @F11,@F1,$P(R,D),!,$P(R,D,2)
 .For I=1:1:$L(Params,",") Do
 ..If I=2 Do
 ...Xecute "ZL VT520 Set R=$T(@RoutName+1)"
 ...Quit:$E(R,1,2)'=" ;"
 ...Write ! 
 ...Xecute "ZL VT520 For J=1:1 Set R=$T(@RoutName+J) Quit:$E(R,1,2)'="" ;""  Write !,$P(R,"";"",2)"
 ...Write ! 
 ..Write !,$P(Params,",",I)," ? "
 ..Read @$P(Params,",",I)
 ..If I=1,@$P(Params,",")="" Write $I
 .Xecute "Do "_Routine
 Quit
 ;
 ; Cursor next line
CNL(Dev,Lines) 
 Set:'$G(Dev) Dev=$I
 Set Lines=$G(Lines)
 ZU Dev Write *27,"[",Lines,"E"
 Quit
 ;
 ; Cursor previus line
CPL(Dev,Lines) 
 Set:'$G(Dev) Dev=$I
 Set Lines=$G(Lines)
 ZU Dev Write *27,"[",Lines,"F"
 Quit
 ;
 ; Cursor backward
CUB(Dev,Columns) 
 Set:'$G(Dev) Dev=$I
 Set Columns=$G(Columns)
 ZU Dev Write *27,"[",Columns,"D"
 Quit
 ;
 ; Cursor down
CUD(Dev,Lines) 
 Set:'$G(Dev) Dev=$I
 Set Lines=$G(Lines)
 ZU Dev Write *27,"[",Lines,"B"
 Quit
 ;
 ; Cursor forward
CUF(Dev,Columns) 
 Set:'$G(Dev) Dev=$I
 Set Columns=$G(Columns)
 ZU Dev Write *27,"[",Columns,"C"
 Quit
 ;
 ; Cursor position
CUP(Dev,Line,Column) 
 Set:'$G(Dev) Dev=$I
 Set Line=$G(Line),Column=$G(Column)
 ZU Dev Write *27,"[",Line,";",Column,"H"
 Quit
 ;
 ; Cursor up
CUU(Dev,Lines) 
 Set:'$G(Dev) Dev=$I
 Set Lines=$G(Lines)
 ZU Dev Write *27,"[",Lines,"A"
 Quit
 ;
 ; Delete character
DCH(Dev,Chars) 
 Set:'$G(Dev) Dev=$I
 Set Chars=$G(Chars)
 ZU Dev Write *27,"[",Chars,"P"
 Quit
 ;
 ; Set - reset auto answerback mode
DECAAM(Dev,Set) 
 ;Set = 1 no auto answerback
 ;    = 0 auto answerback
 Set:'$G(Dev) Dev=$I
 Set Set=$G(Set),Set=$S(Set:"l",1:"h")
 ZU Dev Write *27,"[?100",Set
 Quit
 ;
 ; Screen alignment pattern
DECALN(Dev) 
 Set:'$G(Dev) Dev=$I
 ZU Dev Write *27,"#8"
 Quit
 ;
 ; Set - reset autorepeat mode
DECARM(Dev,Set) 
 ;Set = 1 no autorepeat
 ;    = 0 autorepeat
 Set:'$G(Dev) Dev=$I
 Set Set=$G(Set),Set=$S(Set:"l",1:"h")
 ZU Dev Write *27,"[?8",Set
 Quit
 ;
 ; Set - reset auto resise mode
DECARSM(Dev,Set) 
 ;Set = 1 no auto resise
 ;    = 0 auto resise
 Set:'$G(Dev) Dev=$I
 Set Set=$G(Set),Set=$S(Set:"l",1:"h")
 ZU Dev Write *27,"[?98",Set
 Quit
 ;
 ; Set - reset autowrap mode
DECAWM(Dev,Set) 
 ;Set = 1 no autowrap
 ;    = 0 autowrap
 Set:'$G(Dev) Dev=$I
 Set Set=$G(Set),Set=$S(Set:"l",1:"h")
 ZU Dev Write *27,"[?7",Set
 Quit
 ;
 ; Caps lock mode
DECCAPSL(Dev,Set) 
 ;Set = 1 locked
 ;    = 0 not locked
 Set:'$G(Dev) Dev=$I
 Set Set=$G(Set),Set=$S(Set:"h",1:"l")
 ZU Dev Write *27,"[?109",Set
 Quit
 ;
 ;
 ; Change attributes in rectangular area
DECCARA(Dev,Attrib,Top,Left,Bottom,Right) 
 ;Attrib = 0 off
 ;       = 1 bold
 ;       = 4 underline
 ;       = 5 blink
 ;       = 7 negative image
 ;       = 22 no bold
 ;       = 24 no underline
 ;       = 25 no blink
 ;       = 27 positive image
 Set:'$G(Dev) Dev=$I
 Set Top=$G(Top) Set:'Top Top=1
 Set Left=$G(Left) Set:'Left Left=1
 Set Bottom=$G(Bottom) Set:'Bottom Bottom=24
 Set Right=$G(Right) Set:'Right Right=80
 ZU Dev Write *27,"[",Top,";",Left,";",Bottom,";",Right,";",Attrib,"$r"
 Quit
 ;
 ; Set - reset cursor keys mode
DECCKM(Dev,Set) 
 ;Set = 1 application keys
 ;    = 0 cursor keys
 Set:'$G(Dev) Dev=$I
 Set Set=$G(Set),Set=$S(Set:"h",1:"l")
 ZU Dev Write *27,"[?1",Set
 Quit
 ;
 ; Memory checksum report
DECCKSR(Dev) 
 Set:'$G(Dev) Dev=$I
 ZU Dev Write *27,"[?63;n"
 Read R:1
 Quit
 ;
 ; Set - reset 132 columns per page
DECCOLM(Dev,Set) 
 ;Set = 1 132
 ;    = 0 80
 Set:'$G(Dev) Dev=$I
 Set Set=$G(Set),Set=$S(Set:"h",1:"l")
 ZU Dev Write *27,"[?3",Set
 Quit
 ;
 ; Set - reset CRT save mode
DECCRTSM(Dev,Set) 
 ;Set = 1 save mode on
 ;    = 0 save mode off
 Set:'$G(Dev) Dev=$I
 Set Set=$G(Set),Set=$S(Set:"h",1:"l")
 ZU Dev Write *27,"[?97",Set
 Quit
 ;
 ; Delete column
DECDC(Dev,Number) 
 Set:'$G(Dev) Dev=$I
 Set:'$G(Number) Number=1
 ZU Dev Write *27,"[",Number,"'~"
 Quit
 ;
 ; Double-width, double-height line
DECDHL(Dev,Text) 
 Set:'$G(Dev) Dev=$I
 ZU Dev Write !,*27,"#3",Text,!,*27,"#4",Text
 Quit
 ;
 ; Double-width, single-height line
DECDWL(Dev,Text) 
 Set:'$G(Dev) Dev=$I
 ZU Dev Write !,*27,"#6",Text
 Quit
 ;
 ; Erase rectangular area
DECERA(Dev,Top,Left,Bottom,Right) 
 Set:'$G(Dev) Dev=$I
 Set Top=$G(Top) Set:'Top Top=1
 Set Left=$G(Left) Set:'Left Left=1
 Set Bottom=$G(Bottom) Set:'Bottom Bottom=24
 Set Right=$G(Right) Set:'Right Right=80
 ZU Dev Write *27,"[",Top,";",Left,";",Bottom,";",Right,"$z"
 Quit
 ;
 ; Fill rectangular area
DECFRA(Dev,Char,Top,Left,Bottom,Right) 
 Set:'$G(Dev) Dev=$I
 Set Char=$A($G(Char," "))
 Set Top=$G(Top) Set:'Top Top=1
 Set Left=$G(Left) Set:'Left Left=1
 Set Bottom=$G(Bottom) Set:'Bottom Bottom=24
 Set Right=$G(Right) Set:'Right Right=80
 ZU Dev Write *27,"[",Char,";",Top,";",Left,";",Bottom,";",Right,"$x"
 Quit
 ;
 ; Delete column
DECIC(Dev,Number) 
 Set:'$G(Dev) Dev=$I
 Set:'$G(Number) Number=1
 ZU Dev Write *27,"[",Number,"'}"
 Quit
 ;
 ; Dataprocessing or typewriter keys
DECKBUM(Dev,Keys) 
 ;Keys = 1 dataprocessing keys
 ;     = 0 typewriter keys
 Set:'$G(Dev) Dev=$I
 Set Keys=$G(Keys),Keys=$S(Keys:"h",1:"l")
 ZU Dev Write *27,"[?68",Keys
 Quit
 ;
 ; Set - reset keyboard LED's host indicator mode
DECKLHIM(Dev,Set) 
 ;Set = 1 set
 ;    = 0 reset
 Set:'$G(Dev) Dev=$I
 Set Set=$G(Set),Set=$S(Set:"h",1:"l")
 ZU Dev Write *27,"[?110",Set
 Quit
 ;
 ; Load answerback message
DECLANS(Dev,Text) 
 Set:'$G(Dev) Dev=$I
 ZU Dev Write *27,"P1v",Text,*27,"\"
 Quit
 ;
 ; Load banner message
DECLBAN(Dev,Text) 
 Set:'$G(Dev) Dev=$I
 ZU Dev Write *27,"P2r",Text,*27,"\"
 Quit
 ;
 ; Load LEDs
DECLL(Dev,Led) 
 ;Led = 0 all off
 ;    = 1 Num Lock on
 ;    = 2 Caps Lock on
 ;    = 3 Scroll Lock on
 ;    = 21 Num Lock off
 ;    = 22 Caps Lock off
 ;    = 23 Scroll Lock off
 Set:'$G(Dev) Dev=$I Set Led=$G(Led)
 Do DECKLHIM(Dev,1)
 ZU Dev Write *27,"[",Led,"q"
 Quit
 ;
 ; Load time of day
DECLTOD(Dev) 
 New R
 Set:'$G(Dev) Dev=$I
 Set R=$$EXTTIME^vhDTyp($H)
 ZU Dev Write *27,"[",$P(R,":"),";",$P(R,":",2),",p"
 Quit
 ;
 ; Set - reset no clearing on column change
DECNCSM(Dev,Set) 
 ;Set = 0 clearing
 ;    = 1 no clearing
 Set:'$G(Dev) Dev=$I
 Set Set=$G(Set),Set=$S(Set:"h",1:"l")
 ZU Dev Write *27,"[?95",Set
 Quit
 ;
 ; Set - reset numlock mode
DECNUMLK(Dev,Set) 
 ;Set = 1 locked
 ;    = 0 not locked
 Set:'$G(Dev) Dev=$I
 Set Set=$G(Set),Set=$S(Set:"h",1:"l")
 ZU Dev Write *27,"[?108",Set
 Quit
 ;
 ; Set - reset overscan mode
DECOSCNM(Dev,Set) 
 ;Set = 1 overscan
 ;    = 0 no overscan
 Set:'$G(Dev) Dev=$I
 Set Set=$G(Set),Set=$S(Set:"h",1:"l")
 ZU Dev Write *27,"[?106",Set
 Quit
 ;
 ; Restore cursor
DECRC(Dev) 
 Set:'$G(Dev) Dev=$I
 ZU Dev Write *27,8
 Quit
 ;
 ; Set - reset cursor right to left mode
DECRLM(Dev,Set) 
 ;Set = 1 right to left
 ;    = 0 left to right
 Set:'$G(Dev) Dev=$I
 Set Set=$G(Set),Set=$S(Set:"h",1:"l")
 ZU Dev Write *27,"[?34",Set
 Quit
 ;
 ; Report terminal unit ID
DECRPTUI(Dev,Text) 
 Write *7
 Quit
 Set:'$G(Dev) Dev=$I
 ZU Dev Write *27,"P!|",Text,*27,"\"
 Quit
 ;
 ; Request terminal state report
DECRQTSR(Dev,Report) 
 ;Report = 0 ignored, no report send
 ;       = 1 terminal state report
 Set:'$G(Dev) Dev=$I
 Set Report=$G(Report)
 ZU Dev Write *27,"[",Report,"$u"
 Read R:1
 Quit
 ;
 ; Save cursor
DECSC(Dev) 
 Set:'$G(Dev) Dev=$I
 ZU Dev Write *27,7
 Quit
 ;
 ; Set - reset scrolling mode
DECSCLM(Dev,Set) 
 ;Set = 1 smooth scroll
 ;    = 0 Jump scroll
 Set:'$G(Dev) Dev=$I
 Set Set=$G(Set),Set=$S(Set:"h",1:"l")
 ZU Dev Write *27,"[?4",Set
 Quit
 ;
 ; Set - reset reverse video
DECSCNM(Dev,Set) 
 ;Set = 1 reverse video
 ;    = 0 normal display
 Set:'$G(Dev) Dev=$I
 Set Set=$G(Set),Set=$S(Set:"h",1:"l")
 ZU Dev Write *27,"[?5",Set
 Quit
 ;
 ; Set cursor style
DECSCUSR(Dev,Style) 
 ;Style = 0 or 1 blink block
 ;      = 2 steady block
 ;      = 3 blink underline
 ;      = 4 steady underline
 Set:'$G(Dev) Dev=$I Set Style=$G(Style)
 ZU Dev Write *27,"[",Style," q"
 Quit
 ;
 ; Set key click volume
DECSKCV(Dev,Volume) 
 ;Volume = 0, 5, 6, 7 or 8 high
 ;       = 1 off
 ;       = 2, 3 or 4 low
 Set:'$G(Dev) Dev=$I
 Set Volume=$G(Volume)
 ZU Dev Write *27,"[",Volume," r"
 Quit
 ;
 ; Set marging bell volume
DECSMBV(Dev,Volume) 
 ;Volume = 0, 1 or none off
 ;       = 2, 3 or 4 low
 ;       = 5, 6, 7 or 8 high
 Set:'$G(Dev) Dev=$I
 Set Volume=$G(Volume)
 ZU Dev Write *27,"[",Volume," u"
 Quit
 ;
 ; Select status display (line) type
DECSSDT(Dev,Type) 
 ;Type = 0 no status line
 ;     = 1 indicator status line
 ;     = 2 host writable status line
 Set:'$G(Dev) Dev=$I
 Set Type=$G(Type)
 ZU Dev Write *27,"[",Type,"$~"
 Quit
 ;
 ; Select set-up language
DECSSL(Dev,Language) 
 ;Language = 0, 1 or none english
 ;         = 2 french
 ;         = 3 german
 ;         = 4 spanish
 Set:'$G(Dev) Dev=$I
 Set Language=$G(Language)
 ZU Dev Write *27,"[",Language,"p"
 Quit
 ;
 ; Set warning bell volume
DECSWBV(Dev,Volume) 
 ;Volume = 0, 5, 6, 7 or 8 high
 ;       = 1 off
 ;       = 2, 3 or 4 low
 Set:'$G(Dev) Dev=$I
 Set Volume=$G(Volume)
 ZU Dev Write *27,"[",Volume," t",*7
 Quit
 ;
 ; Select terminal ID
DECTID(Dev,TermId) 
 ;TermId =  0 VT100
 ;       =  1 VT101
 ;       =  2 VT102
 ;       =  5 VT220
 ;       =  7 VT320
 ;       =  9 VT420
 ;       = 10 VT520
 Set:'$G(Dev) Dev=$I
 Set TermId=$G(TermId,10)
 ZU Dev Write *27,"[",TermId,",q"
 Quit
 ;
 ; Set terminal mode emulation
DECTME(Dev,Emulat) 
 ;Emulat =  0 or 1 VT500
 ;       =  2 VT100
 ;       =  3 VT52
 ;       =  4 VT420 PC term
 ;       =  5 Wyse 60/160
 ;       =  6 Wyse 60/160 PC term
 ;       =  7 Wyse 50+
 ;       =  8 Wyse 150/120
 ;       =  9 TVI950
 ;       = 10 TVI925
 ;       = 11 TVI 910+
 ;       = 12 ADDS A2
 ;       = 13 SCO console
 Set:'$G(Dev) Dev=$I
 Set Emulat=$G(Emulat)
 ZU Dev Write *27,"[",Emulat," ~"
 Quit
 ;
 ; Invoke confidence test
DECTST(Dev,Test) 
 ;Test =  0 All tests (1,2,3,6)
 ;     =  1 Power-up self test
 ;     =  2 RS232 port data loopback test
 ;     =  3 Printer port loopback test
 ;     =  4 Speed select and speed Indicator test
 ;     =  5 Reserved - no action
 ;     =  6 RS232 Port modem control line loopback test
 ;     =  7 EIA 423 port loopback test
 ;     =  8 Parallel port loopback test
 ;     =  9 Repeat (loop on) other tests in parameter string
 Set:'$G(Dev) Dev=$I
 Set Test=$G(Test)
 ZU Dev Write *27,"[4;",Test,"y"
 Quit
 ;
 ; Horizontal position absolute
HPA(Dev,Column) 
 Set:'$G(Dev) Dev=$I
 Set Column=$G(Column)
 ZU Dev Write *27,"[",Column,"`"
 Quit
 ;
 ; Horizontal position relative
HPR(Dev,Column) 
 Set:'$G(Dev) Dev=$I
 Set Column=$G(Column)
 ZU Dev Write *27,"[",Column,"a"
 Quit
 ;
 ; Horizontal and vertical position
HVP(Dev,Line,Column) 
 Set:'$G(Dev) Dev=$I
 Set Line=$G(Line),Column=$G(Column)
 ZU Dev Write *27,"[",Line,";",Column,"f"
 Quit
 ;
 ; Insert character
ICH(Dev,Chars) 
 Set:'$G(Dev) Dev=$I
 Set Chars=$G(Chars)
 ZU Dev Write *27,"[",Chars,"@"
 Quit
 ;
 ; Insert Line
IL(Dev,Lines) 
 Set:'$G(Dev) Dev=$I
 Set Lines=$G(Lines)
 ZU Dev Write *27,"[",Lines,"L"
 Quit
 ;
 ; Restore saved cursor position
SCORC(Dev) 
 Set:'$G(Dev) Dev=$I
 ZU Dev Write *27,"[u"
 Quit
 ;
 ; Save current cursor position
SCOSC(Dev) 
 Set:'$G(Dev) Dev=$I
 ZU Dev Write *27,"[s"
 Quit
 ;
 ; Vertical line position absolute
VPA(Dev,Line) 
 Set:'$G(Dev) Dev=$I
 Set Line=$G(Line)
 ZU Dev Write *27,"[",Line,"d"
 Quit
 ;
 ; Vertical position relative
VPR(Dev,Line) 
 Set:'$G(Dev) Dev=$I
 Set Line=$G(Line)
 ZU Dev Write *27,"[",Line,"e"
 Quit
 ;