source: FOIAVistA/trunk/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/RGUTEDT.m@ 1394

Last change on this file since 1394 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 7.2 KB
Line 
1RGUTEDT ;CAIRO/DKM - Screen-oriented line editor;04-Sep-1998 11:26;DKM
2 ;;2.1;RUN TIME LIBRARY;;Mar 22, 1999
3 ;=================================================================
4 ; Inputs:
5 ; RGDATA = Data to edit
6 ; RGLEN = Maximum length of data
7 ; RGX = Starting column position
8 ; RGY = Starting row position
9 ; RGVALD = List of valid inputs (optional)
10 ; RGDISV = DISV node to save under (optional)
11 ; RGTERM = Valid input terminators (default=<CR>)
12 ; RGABRT = Valid input abort characters (default=none)
13 ; RGRM = Right margin setting (default=IOM or 80)
14 ; RGQUIT = Exit code (returned)
15 ; RGOPT = 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 ;=================================================================
31ENTRY(RGDATA,RGLEN,RGX,RGY,RGVALD,RGOPT,RGDISV,RGTERM,RGABRT,RGRM,RGQUIT) ;
32 N RGZ,RGZ1,RGZ2,RGSAVE,RGINS,RGAE,RGBUF,RGTAB,RGPOS,RGEON,RGLEFT,RGBEL,RGMAX,RGRVON,RGRVOFF,RGC,RGW
33 S RGVALD=$G(RGVALD),RGOPT=$$UP^XLFSTR($G(RGOPT)),RGBEL=$S(RGOPT'["Q":$C(7),1:""),RGDISV=$G(RGDISV)
34 S:$G(RGTERM)="" RGTERM=$C(13) ; Valid line terminators
35 S RGABRT=$G(RGABRT) ; Valid input abort keys
36 S RGRVON=$C(27,91,55,109),RGRVOFF=$C(27,91,109) ; Reverse video control
37 S RGINS=RGOPT'["O" ; Default mode = insert
38 S RGAE=RGOPT'["X" ; Auto-erase option
39 S RGEON=RGOPT'["E" ; No echo option
40 I RGOPT["I"!'$D(DTIME) N DTIME S DTIME=9999999999 ; Suppress timeout option
41 S RGBUF=""
42 S RGRM=$G(RGRM,$G(IOM,80)) ; Display width
43 S RGTAB=$C(9) ; Tab character
44 S RGX=$G(RGX,$X),RGY=$G(RGY,$Y),RGW=RGRM-RGX
45 S:RGW'>0 RGW=1
46 S:'$G(RGLEN) RGLEN=RGW ; Default field width
47 S RGMAX=$S(RGOPT["H":250,1:RGLEN) ; Maximum data length
48 S (RGSAVE,RGDATA)=$E($G(RGDATA),1,RGMAX) ; Truncate data if too long
49 I $$NEWERR^%ZTER N $ET S $ET=""
50 S @$$TRAP^RGZOSF("ERROR^RGUTEDT")
51 D RM^RGZOSF(0)
52 X ^%ZOSF("EOFF")
53 F Q:RGDATA'[RGTAB S RGZ=$P(RGDATA,RGTAB),RGDATA=RGZ_$J("",8-($L(RGZ)#8))_$P(RGDATA,RGTAB,2,999)
54RESTART D RESET
55AGAIN F RGQUIT=0:0 Q:RGQUIT D NXT S RGAE=0
56 X ^%ZOSF("EON")
57 W $$XY^RGUT(RGX,RGY),$S(RGOPT["R":RGRVOFF,1:"")
58 I RGDISV'="" Q:"^^"[RGDATA RGDATA S:RGDATA=" " RGDATA=$G(^DISV(DUZ,RGDISV))
59 S:RGDISV'="" ^DISV(DUZ,RGDISV)=RGDATA
60 Q RGDATA ; Return to calling routine
61NXT D POSCUR() ; Position cursor
62 R *RGC:DTIME ; Next character typed
63 I RGC=27 D ESC Q:'RGC
64 I RGC<1!(RGABRT[$C(RGC)) S RGDATA=U,RGQUIT=1 Q
65 I RGTERM[$C(RGC) D TERM Q
66 I RGC<28 D:RGC'=27 @("CTL"_$C(RGC+64)) Q
67 I RGC=127!(RGC=240) D CTLH Q
68 I RGC>64,RGC<91,RGOPT["L" S RGC=RGC+32
69 E I RGC>96,RGC<123,RGOPT["U" S RGC=RGC-32
70 I $L(RGVALD),RGVALD'[$C(RGC) D RAISE^RGZOSF()
71 D:RGAE CTLK,POSCUR() ; Erase buffer if auto erase on
72 D INSW($C(RGC))
73 S RGQUIT=RGPOS=RGLEN&(RGOPT["T")
74 Q
75CTLA S RGINS='RGINS ; Toggle insert mode
76 Q
77CTLB D MOVETO(0) ; Move cursor to beginning
78 Q
79CTLX S RGDATA=RGSAVE ; Restore buffer to original
80 G RESET
81CTLE D MOVETO($L(RGDATA)) ; Move cursor to end
82 Q
83CTLI D INSW($J("",8-(RGPOS#8))) ; Insert expanded tab
84 Q
85CTLJ F RGZ=RGPOS:-1:1 Q:$A(RGDATA,RGZ)'=32 ; Find previous nonspace
86 F RGZ=RGZ:-1:1 Q:$A(RGDATA,RGZ)=32 ; Find previous space
87 S RGBUF=$E(RGDATA,RGZ,RGPOS) ; Save deleted portion
88 S RGDATA=$E(RGDATA,1,RGZ-1)_$E(RGDATA,RGPOS+1,RGLEN) ; Remove word
89 D MOVETO(RGZ-1)
90 Q
91CTLK S RGBUF=RGDATA ; Save buffer
92 S RGDATA="" ; Erase buffer
93 D RESET
94 Q
95CTLL S RGBUF=$E(RGDATA,RGPOS+1,RGLEN) ; Save deleted portion
96 S RGDATA=$E(RGDATA,1,RGPOS) ; Truncate at current position
97 D DSPLY(RGPOS)
98 Q
99CTLM D POSCUR(RGPOS),INSW("~"):RGOPT["C",MOVETO(RGPOS-$X+RGX+RGW)
100 Q
101CTLR D INSW(RGBUF) ; Insert at current position
102 Q
103CTLT D CTLL
104 Q
105CTLU S RGBUF=$E(RGDATA,1,RGPOS) ; Save deleted portion
106 S RGDATA=$E(RGDATA,RGPOS+1,RGLEN) ; Remove to left of cursor
107 D RESET
108 Q
109CTLH I 'RGPOS W RGBEL Q
110 D LEFT
111CTLD S RGDATA=$E(RGDATA,1,RGPOS)_$E(RGDATA,RGPOS+2,RGMAX) ; Delete character to left
112 D DSPLY(RGPOS,1)
113 Q
114TERM S RGQUIT=2
115 Q
116ESC R *RGZ:1
117 R:RGZ>0 *RGZ:1
118 S RGC=0
119 G UP:RGZ=65,DOWN:RGZ=66,RIGHT:RGZ=67,LEFT:RGZ=68 ;Execute code
120 S RGC=27
121 Q
122DSPLY(RGP1,RGP2) ;
123 Q:'RGEON ; Refresh buffer display starting at position RGP1
124 N RGZ,RGZ1
125 S RGP1=+$G(RGP1,RGLEFT),RGZ=$E(RGDATA,RGP1+1,RGLEFT+RGLEN),RGP2=$S($D(RGP2):RGP2+$L(RGZ),1:RGLEN-RGP1+RGLEFT)
126 S:RGP2>RGLEN RGP2=RGLEN
127 S RGZ=RGZ_$J("",RGP2-$L(RGZ))
128 F D Q:RGZ=""
129 .D POSCUR(RGP1)
130 .S RGZ1=RGRM-$X
131 .S:RGZ1<1 RGZ1=1
132 .W $E(RGZ,1,RGZ1)
133 .S RGZ=$E(RGZ,RGZ1+1,999),RGP1=RGP1+RGZ1
134 Q
135INSW(RGTXT) ;
136 S:RGPOS>$L(RGDATA) RGDATA=RGDATA_$J("",RGPOS-$L(RGDATA)) ; Pad if past end of buffer
137 S RGDATA=$E($E(RGDATA,1,RGPOS)_RGTXT_$E(RGDATA,RGPOS+2-RGINS,RGMAX),1,RGMAX)
138 D DSPLY(RGPOS,0),MOVETO(RGPOS+$L(RGTXT))
139 Q
140POSCUR(RGP) ;
141 N RGZX,RGZY
142 S RGP=+$G(RGP,RGPOS),RGZX=RGP-RGLEFT,RGZY=RGZX\RGW+RGY,RGZX=RGZX#RGW+RGX
143 W $$XY^RGUT(RGZX,RGZY)
144 Q
145MOVETO(RGP) ;
146 I RGP>RGMAX!(RGP<0) W RGBEL Q
147 S RGPOS=RGP,RGP=RGLEFT
148 S:RGPOS<RGLEFT RGLEFT=RGPOS-RGW-1
149 S:RGLEFT+RGLEN<RGPOS RGLEFT=RGPOS-RGW+1
150 S:RGLEFT'<RGMAX RGLEFT=RGMAX-RGW
151 S:RGLEFT<0 RGLEFT=0
152 D DSPLY():RGLEFT'=RGP,POSCUR()
153 Q
154UP I RGOPT["V" S RGQUIT=3
155 E D MOVETO(RGPOS-RGW)
156 Q
157DOWN I RGOPT["V" S RGQUIT=4
158 E D MOVETO(RGPOS+RGW)
159 Q
160RIGHT D MOVETO(RGPOS+1)
161 Q
162LEFT D MOVETO(RGPOS-1)
163 Q
164RESET W $S(RGOPT["R":RGRVON,1:RGRVOFF)
165 S (RGPOS,RGLEFT)=0 ; Current edit offset
166 D DSPLY() ; Refresh display
167 Q
168ERROR W RGBEL ; Sound bell
169 S @$$TRAP^RGZOSF("ERROR^RGUTEDT")
170 G AGAIN
Note: See TracBrowser for help on using the repository browser.