CIAUEDT ;MSC/IND/DKM - Screen-oriented line editor;14-Aug-2006 09:35;DKM
;;1.2;CIA UTILITIES;;Mar 20, 2007
;;Copyright 2000-2006, Medsphere Systems Corporation
;=================================================================
; Inputs:
; CIADATA = Data to edit
; CIALEN = Maximum length of data
; CIAX = Starting column position
; CIAY = Starting row position
; CIAVALD = List of valid inputs (optional)
; CIADISV = DISV node to save under (optional)
; CIATERM = Valid input terminators (default=<CR>)
; CIAABRT = Valid input abort characters (default=none)
; CIARM = Right margin setting (default=IOM or 80)
; CIAQUIT = Exit code (returned)
; CIAOPT = Input options
; C = Mark <CR> with ~
; E = Echo off
; H = Horizontal scroll
; I = No timeout
; L = Lowercase only
; O = Overwrite mode
; Q = Quiet mode
; R = Reverse video
; T = Auto-terminate
; U = Uppercase only
; V = Up/down cursor keys terminate input
; X = Suppress auto-erase
; Outputs:
; Return value = Edited data
;=================================================================
ENTRY(CIADATA,CIALEN,CIAX,CIAY,CIAVALD,CIAOPT,CIADISV,CIATERM,CIAABRT,CIARM,CIAQUIT) ;
N CIAZ,CIAZ1,CIAZ2,CIASAVE,CIAINS,CIAAE,CIABUF,CIATAB,CIAPOS,CIAEON,CIALEFT,CIABEL,CIAMAX,CIARVON,CIARVOFF,CIAC,CIAW
S CIAVALD=$G(CIAVALD),CIAOPT=$$UP^XLFSTR($G(CIAOPT)),CIABEL=$S(CIAOPT'["Q":$C(7),1:""),CIADISV=$G(CIADISV)
S:$G(CIATERM)="" CIATERM=$C(13) ; Valid line terminators
S CIAABRT=$G(CIAABRT) ; Valid input abort keys
S CIARVON=$C(27,91,55,109),CIARVOFF=$C(27,91,109) ; Reverse video control
S CIAINS=CIAOPT'["O" ; Default mode = insert
S CIAAE=CIAOPT'["X" ; Auto-erase option
S CIAEON=CIAOPT'["E" ; No echo option
I CIAOPT["I"!'$D(DTIME) N DTIME S DTIME=99999999 ; Suppress timeout option
S CIABUF=""
S CIARM=$G(CIARM,$G(IOM,80)) ; Display width
S CIATAB=$C(9) ; Tab character
S CIAX=$G(CIAX,$X),CIAY=$G(CIAY,$Y),CIAW=CIARM-CIAX
S:CIAW'>0 CIAW=1
S:'$G(CIALEN) CIALEN=CIAW ; Default field width
S CIAMAX=$S(CIAOPT["H":250,1:CIALEN) ; Maximum data length
S (CIASAVE,CIADATA)=$E($G(CIADATA),1,CIAMAX) ; Truncate data if too long
I $$NEWERR^%ZTER N $ET S $ET=""
S @$$TRAP^CIAUOS("ERROR^CIAUEDT")
D RM^CIAUOS(0)
X ^%ZOSF("EOFF")
F Q:CIADATA'[CIATAB S CIAZ=$P(CIADATA,CIATAB),CIADATA=CIAZ_$J("",8-($L(CIAZ)#8))_$P(CIADATA,CIATAB,2,999)
RESTART D RESET
AGAIN F CIAQUIT=0:0 Q:CIAQUIT D NXT S CIAAE=0
X ^%ZOSF("EON")
W $$XY^CIAU(CIAX,CIAY),$S(CIAOPT["R":CIARVOFF,1:"")
I CIADISV'="" Q:"^^"[CIADATA CIADATA S:CIADATA=" " CIADATA=$G(^DISV(DUZ,CIADISV))
S:CIADISV'="" ^DISV(DUZ,CIADISV)=CIADATA
Q CIADATA ; Return to calling routine
NXT D POSCUR() ; Position cursor
R *CIAC:DTIME ; Next character typed
I CIAC=27 D ESC Q:'CIAC
I CIAC<1!(CIAABRT[$C(CIAC)) S CIADATA=U,CIAQUIT=1 Q
I CIATERM[$C(CIAC) D TERM Q
I CIAC<28 D:CIAC'=27 @("CTL"_$C(CIAC+64)) Q
I CIAC=127!(CIAC=240) D CTLH Q
I CIAC>64,CIAC<91,CIAOPT["L" S CIAC=CIAC+32
E I CIAC>96,CIAC<123,CIAOPT["U" S CIAC=CIAC-32
I $L(CIAVALD),CIAVALD'[$C(CIAC) D RAISE^CIAUOS()
D:CIAAE CTLK,POSCUR() ; Erase buffer if auto erase on
D INSW($C(CIAC))
S CIAQUIT=CIAPOS=CIALEN&(CIAOPT["T")
Q
CTLA S CIAINS='CIAINS ; Toggle insert mode
Q
CTLB D MOVETO(0) ; Move cursor to beginning
Q
CTLX S CIADATA=CIASAVE ; Restore buffer to original
G RESET
CTLE D MOVETO($L(CIADATA)) ; Move cursor to end
Q
CTLI D INSW($J("",8-(CIAPOS#8))) ; Insert expanded tab
Q
CTLJ F CIAZ=CIAPOS:-1:1 Q:$A(CIADATA,CIAZ)'=32 ; Find previous nonspace
F CIAZ=CIAZ:-1:1 Q:$A(CIADATA,CIAZ)=32 ; Find previous space
S CIABUF=$E(CIADATA,CIAZ,CIAPOS) ; Save deleted portion
S CIADATA=$E(CIADATA,1,CIAZ-1)_$E(CIADATA,CIAPOS+1,CIALEN) ; Remove word
D MOVETO(CIAZ-1)
Q
CTLK S CIABUF=CIADATA ; Save buffer
S CIADATA="" ; Erase buffer
D RESET
Q
CTLL S CIABUF=$E(CIADATA,CIAPOS+1,CIALEN) ; Save deleted portion
S CIADATA=$E(CIADATA,1,CIAPOS) ; Truncate at current position
D DSPLY(CIAPOS)
Q
CTLM D POSCUR(CIAPOS),INSW("~"):CIAOPT["C",MOVETO(CIAPOS-$X+CIAX+CIAW)
Q
CTLR D INSW(CIABUF) ; Insert at current position
Q
CTLT D CTLL
Q
CTLU S CIABUF=$E(CIADATA,1,CIAPOS) ; Save deleted portion
S CIADATA=$E(CIADATA,CIAPOS+1,CIALEN) ; Remove to left of cursor
D RESET
Q
CTLH I 'CIAPOS W CIABEL Q
D LEFT
CTLD S CIADATA=$E(CIADATA,1,CIAPOS)_$E(CIADATA,CIAPOS+2,CIAMAX) ; Delete character to left
D DSPLY(CIAPOS,1)
Q
TERM S CIAQUIT=2
Q
ESC R *CIAZ:1
R:CIAZ>0 *CIAZ:1
S CIAC=0
G UP:CIAZ=65,DOWN:CIAZ=66,RIGHT:CIAZ=67,LEFT:CIAZ=68 ;Execute code
S CIAC=27
Q
DSPLY(CIAP1,CIAP2) ;
Q:'CIAEON ; Refresh buffer display starting at position CIAP1
N CIAZ,CIAZ1
S CIAP1=+$G(CIAP1,CIALEFT),CIAZ=$E(CIADATA,CIAP1+1,CIALEFT+CIALEN),CIAP2=$S($D(CIAP2):CIAP2+$L(CIAZ),1:CIALEN-CIAP1+CIALEFT)
S:CIAP2>CIALEN CIAP2=CIALEN
S CIAZ=CIAZ_$J("",CIAP2-$L(CIAZ))
F D Q:CIAZ=""
.D POSCUR(CIAP1)
.S CIAZ1=CIARM-$X
.S:CIAZ1<1 CIAZ1=1
.W $E(CIAZ,1,CIAZ1)
.S CIAZ=$E(CIAZ,CIAZ1+1,999),CIAP1=CIAP1+CIAZ1
Q
INSW(CIATXT) ;
S:CIAPOS>$L(CIADATA) CIADATA=CIADATA_$J("",CIAPOS-$L(CIADATA)) ; Pad if past end of buffer
S CIADATA=$E($E(CIADATA,1,CIAPOS)_CIATXT_$E(CIADATA,CIAPOS+2-CIAINS,CIAMAX),1,CIAMAX)
D DSPLY(CIAPOS,0),MOVETO(CIAPOS+$L(CIATXT))
Q
POSCUR(CIAP) ;
N CIAZX,CIAZY
S CIAP=+$G(CIAP,CIAPOS),CIAZX=CIAP-CIALEFT,CIAZY=CIAZX\CIAW+CIAY,CIAZX=CIAZX#CIAW+CIAX
W $$XY^CIAU(CIAZX,CIAZY)
Q
MOVETO(CIAP) ;
I CIAP>CIAMAX!(CIAP<0) W CIABEL Q
S CIAPOS=CIAP,CIAP=CIALEFT
S:CIAPOS<CIALEFT CIALEFT=CIAPOS-CIAW-1
S:CIALEFT+CIALEN<CIAPOS CIALEFT=CIAPOS-CIAW+1
S:CIALEFT'<CIAMAX CIALEFT=CIAMAX-CIAW
S:CIALEFT<0 CIALEFT=0
D DSPLY():CIALEFT'=CIAP,POSCUR()
Q
UP I CIAOPT["V" S CIAQUIT=3
E D MOVETO(CIAPOS-CIAW)
Q
DOWN I CIAOPT["V" S CIAQUIT=4
E D MOVETO(CIAPOS+CIAW)
Q
RIGHT D MOVETO(CIAPOS+1)
Q
LEFT D MOVETO(CIAPOS-1)
Q
RESET W $S(CIAOPT["R":CIARVON,1:CIARVOFF)
S (CIAPOS,CIALEFT)=0 ; Current edit offset
D DSPLY() ; Refresh display
Q
ERROR W CIABEL ; Sound bell
S @$$TRAP^CIAUOS("ERROR^CIAUEDT")
G AGAIN
CIAUEDT ;MSC/IND/DKM - Screen-oriented line editor;14-Aug-2006 09:35;DKM
+1 ;;1.2;CIA UTILITIES;;Mar 20, 2007
+2 ;;Copyright 2000-2006, Medsphere Systems Corporation
+3 ;=================================================================
+4 ; Inputs:
+5 ; CIADATA = Data to edit
+6 ; CIALEN = Maximum length of data
+7 ; CIAX = Starting column position
+8 ; CIAY = Starting row position
+9 ; CIAVALD = List of valid inputs (optional)
+10 ; CIADISV = DISV node to save under (optional)
+11 ; CIATERM = Valid input terminators (default=<CR>)
+12 ; CIAABRT = Valid input abort characters (default=none)
+13 ; CIARM = Right margin setting (default=IOM or 80)
+14 ; CIAQUIT = Exit code (returned)
+15 ; CIAOPT = Input options
+16 ; C = Mark <CR> with ~
+17 ; E = Echo off
+18 ; H = Horizontal scroll
+19 ; I = No timeout
+20 ; L = Lowercase only
+21 ; O = Overwrite mode
+22 ; Q = Quiet mode
+23 ; R = Reverse video
+24 ; T = Auto-terminate
+25 ; U = Uppercase only
+26 ; V = Up/down cursor keys terminate input
+27 ; X = Suppress auto-erase
+28 ; Outputs:
+29 ; Return value = Edited data
+30 ;=================================================================
ENTRY(CIADATA,CIALEN,CIAX,CIAY,CIAVALD,CIAOPT,CIADISV,CIATERM,CIAABRT,CIARM,CIAQUIT) ;
+1 NEW CIAZ,CIAZ1,CIAZ2,CIASAVE,CIAINS,CIAAE,CIABUF,CIATAB,CIAPOS,CIAEON,CIALEFT,CIABEL,CIAMAX,CIARVON,CIARVOFF,CIAC,CIAW
+2 SET CIAVALD=$GET(CIAVALD)
SET CIAOPT=$$UP^XLFSTR($GET(CIAOPT))
SET CIABEL=$SELECT(CIAOPT'["Q":$CHAR(7),1:"")
SET CIADISV=$GET(CIADISV)
+3 ; Valid line terminators
IF $GET(CIATERM)=""
SET CIATERM=$CHAR(13)
+4 ; Valid input abort keys
SET CIAABRT=$GET(CIAABRT)
+5 ; Reverse video control
SET CIARVON=$CHAR(27,91,55,109)
SET CIARVOFF=$CHAR(27,91,109)
+6 ; Default mode = insert
SET CIAINS=CIAOPT'["O"
+7 ; Auto-erase option
SET CIAAE=CIAOPT'["X"
+8 ; No echo option
SET CIAEON=CIAOPT'["E"
+9 ; Suppress timeout option
IF CIAOPT["I"!'$DATA(DTIME)
NEW DTIME
SET DTIME=99999999
+10 SET CIABUF=""
+11 ; Display width
SET CIARM=$GET(CIARM,$GET(IOM,80))
+12 ; Tab character
SET CIATAB=$CHAR(9)
+13 SET CIAX=$GET(CIAX,$X)
SET CIAY=$GET(CIAY,$Y)
SET CIAW=CIARM-CIAX
+14 IF CIAW'>0
SET CIAW=1
+15 ; Default field width
IF '$GET(CIALEN)
SET CIALEN=CIAW
+16 ; Maximum data length
SET CIAMAX=$SELECT(CIAOPT["H":250,1:CIALEN)
+17 ; Truncate data if too long
SET (CIASAVE,CIADATA)=$EXTRACT($GET(CIADATA),1,CIAMAX)
+18 IF $$NEWERR^%ZTER
NEW $ETRAP
SET $ETRAP=""
+19 SET @$$TRAP^CIAUOS("ERROR^CIAUEDT")
+20 DO RM^CIAUOS(0)
+21 XECUTE ^%ZOSF("EOFF")
+22 FOR
IF CIADATA'[CIATAB
QUIT
SET CIAZ=$PIECE(CIADATA,CIATAB)
SET CIADATA=CIAZ_$JUSTIFY("",8-($LENGTH(CIAZ)#8))_$PIECE(CIADATA,CIATAB,2,999)
RESTART DO RESET
AGAIN FOR CIAQUIT=0:0
IF CIAQUIT
QUIT
DO NXT
SET CIAAE=0
+1 XECUTE ^%ZOSF("EON")
+2 WRITE $$XY^CIAU(CIAX,CIAY),$SELECT(CIAOPT["R":CIARVOFF,1:"")
+3 IF CIADISV'=""
IF "^^"[CIADATA
QUIT CIADATA
IF CIADATA=" "
SET CIADATA=$GET(^DISV(DUZ,CIADISV))
+4 IF CIADISV'=""
SET ^DISV(DUZ,CIADISV)=CIADATA
+5 ; Return to calling routine
QUIT CIADATA
NXT ; Position cursor
DO POSCUR()
+1 ; Next character typed
READ *CIAC:DTIME
+2 IF CIAC=27
DO ESC
IF 'CIAC
QUIT
+3 IF CIAC<1!(CIAABRT[$CHAR(CIAC))
SET CIADATA=U
SET CIAQUIT=1
QUIT
+4 IF CIATERM[$CHAR(CIAC)
DO TERM
QUIT
+5 IF CIAC<28
IF CIAC'=27
DO @("CTL"_$CHAR(CIAC+64))
QUIT
+6 IF CIAC=127!(CIAC=240)
DO CTLH
QUIT
+7 IF CIAC>64
IF CIAC<91
IF CIAOPT["L"
SET CIAC=CIAC+32
+8 IF '$TEST
IF CIAC>96
IF CIAC<123
IF CIAOPT["U"
SET CIAC=CIAC-32
+9 IF $LENGTH(CIAVALD)
IF CIAVALD'[$CHAR(CIAC)
DO RAISE^CIAUOS()
+10 ; Erase buffer if auto erase on
IF CIAAE
DO CTLK
DO POSCUR()
+11 DO INSW($CHAR(CIAC))
+12 SET CIAQUIT=CIAPOS=CIALEN&(CIAOPT["T")
+13 QUIT
CTLA ; Toggle insert mode
SET CIAINS='CIAINS
+1 QUIT
CTLB ; Move cursor to beginning
DO MOVETO(0)
+1 QUIT
CTLX ; Restore buffer to original
SET CIADATA=CIASAVE
+1 GOTO RESET
CTLE ; Move cursor to end
DO MOVETO($LENGTH(CIADATA))
+1 QUIT
CTLI ; Insert expanded tab
DO INSW($JUSTIFY("",8-(CIAPOS#8)))
+1 QUIT
CTLJ ; Find previous nonspace
FOR CIAZ=CIAPOS:-1:1
IF $ASCII(CIADATA,CIAZ)'=32
QUIT
+1 ; Find previous space
FOR CIAZ=CIAZ:-1:1
IF $ASCII(CIADATA,CIAZ)=32
QUIT
+2 ; Save deleted portion
SET CIABUF=$EXTRACT(CIADATA,CIAZ,CIAPOS)
+3 ; Remove word
SET CIADATA=$EXTRACT(CIADATA,1,CIAZ-1)_$EXTRACT(CIADATA,CIAPOS+1,CIALEN)
+4 DO MOVETO(CIAZ-1)
+5 QUIT
CTLK ; Save buffer
SET CIABUF=CIADATA
+1 ; Erase buffer
SET CIADATA=""
+2 DO RESET
+3 QUIT
CTLL ; Save deleted portion
SET CIABUF=$EXTRACT(CIADATA,CIAPOS+1,CIALEN)
+1 ; Truncate at current position
SET CIADATA=$EXTRACT(CIADATA,1,CIAPOS)
+2 DO DSPLY(CIAPOS)
+3 QUIT
CTLM DO POSCUR(CIAPOS)
IF CIAOPT["C"
DO INSW("~")
DO MOVETO(CIAPOS-$X+CIAX+CIAW)
+1 QUIT
CTLR ; Insert at current position
DO INSW(CIABUF)
+1 QUIT
CTLT DO CTLL
+1 QUIT
CTLU ; Save deleted portion
SET CIABUF=$EXTRACT(CIADATA,1,CIAPOS)
+1 ; Remove to left of cursor
SET CIADATA=$EXTRACT(CIADATA,CIAPOS+1,CIALEN)
+2 DO RESET
+3 QUIT
CTLH IF 'CIAPOS
WRITE CIABEL
QUIT
+1 DO LEFT
CTLD ; Delete character to left
SET CIADATA=$EXTRACT(CIADATA,1,CIAPOS)_$EXTRACT(CIADATA,CIAPOS+2,CIAMAX)
+1 DO DSPLY(CIAPOS,1)
+2 QUIT
TERM SET CIAQUIT=2
+1 QUIT
ESC READ *CIAZ:1
+1 IF CIAZ>0
READ *CIAZ:1
+2 SET CIAC=0
+3 ;Execute code
IF CIAZ=65
GOTO UP
IF CIAZ=66
GOTO DOWN
IF CIAZ=67
GOTO RIGHT
IF CIAZ=68
GOTO LEFT
+4 SET CIAC=27
+5 QUIT
DSPLY(CIAP1,CIAP2) ;
+1 ; Refresh buffer display starting at position CIAP1
IF 'CIAEON
QUIT
+2 NEW CIAZ,CIAZ1
+3 SET CIAP1=+$GET(CIAP1,CIALEFT)
SET CIAZ=$EXTRACT(CIADATA,CIAP1+1,CIALEFT+CIALEN)
SET CIAP2=$SELECT($DATA(CIAP2):CIAP2+$LENGTH(CIAZ),1:CIALEN-CIAP1+CIALEFT)
+4 IF CIAP2>CIALEN
SET CIAP2=CIALEN
+5 SET CIAZ=CIAZ_$JUSTIFY("",CIAP2-$LENGTH(CIAZ))
+6 FOR
Begin DoDot:1
+7 DO POSCUR(CIAP1)
+8 SET CIAZ1=CIARM-$X
+9 IF CIAZ1<1
SET CIAZ1=1
+10 WRITE $EXTRACT(CIAZ,1,CIAZ1)
+11 SET CIAZ=$EXTRACT(CIAZ,CIAZ1+1,999)
SET CIAP1=CIAP1+CIAZ1
End DoDot:1
IF CIAZ=""
QUIT
+12 QUIT
INSW(CIATXT) ;
+1 ; Pad if past end of buffer
IF CIAPOS>$LENGTH(CIADATA)
SET CIADATA=CIADATA_$JUSTIFY("",CIAPOS-$LENGTH(CIADATA))
+2 SET CIADATA=$EXTRACT($EXTRACT(CIADATA,1,CIAPOS)_CIATXT_$EXTRACT(CIADATA,CIAPOS+2-CIAINS,CIAMAX),1,CIAMAX)
+3 DO DSPLY(CIAPOS,0)
DO MOVETO(CIAPOS+$LENGTH(CIATXT))
+4 QUIT
POSCUR(CIAP) ;
+1 NEW CIAZX,CIAZY
+2 SET CIAP=+$GET(CIAP,CIAPOS)
SET CIAZX=CIAP-CIALEFT
SET CIAZY=CIAZX\CIAW+CIAY
SET CIAZX=CIAZX#CIAW+CIAX
+3 WRITE $$XY^CIAU(CIAZX,CIAZY)
+4 QUIT
MOVETO(CIAP) ;
+1 IF CIAP>CIAMAX!(CIAP<0)
WRITE CIABEL
QUIT
+2 SET CIAPOS=CIAP
SET CIAP=CIALEFT
+3 IF CIAPOS<CIALEFT
SET CIALEFT=CIAPOS-CIAW-1
+4 IF CIALEFT+CIALEN<CIAPOS
SET CIALEFT=CIAPOS-CIAW+1
+5 IF CIALEFT'<CIAMAX
SET CIALEFT=CIAMAX-CIAW
+6 IF CIALEFT<0
SET CIALEFT=0
+7 IF CIALEFT'=CIAP
DO DSPLY()
DO POSCUR()
+8 QUIT
UP IF CIAOPT["V"
SET CIAQUIT=3
+1 IF '$TEST
DO MOVETO(CIAPOS-CIAW)
+2 QUIT
DOWN IF CIAOPT["V"
SET CIAQUIT=4
+1 IF '$TEST
DO MOVETO(CIAPOS+CIAW)
+2 QUIT
RIGHT DO MOVETO(CIAPOS+1)
+1 QUIT
LEFT DO MOVETO(CIAPOS-1)
+1 QUIT
RESET WRITE $SELECT(CIAOPT["R":CIARVON,1:CIARVOFF)
+1 ; Current edit offset
SET (CIAPOS,CIALEFT)=0
+2 ; Refresh display
DO DSPLY()
+3 QUIT
ERROR ; Sound bell
WRITE CIABEL
+1 SET @$$TRAP^CIAUOS("ERROR^CIAUEDT")
+2 GOTO AGAIN
