source: FOIAVistA/trunk/r/VA_FILEMAN-ARJT-DI-DD-DM-DT-%DT-%RCR/DIR03.m@ 1446

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

initial load of FOIAVistA 6/30/08 version

File size: 3.9 KB
Line 
1DIR03 ;SFISC/MKO-MULTILINE FIELD EDITOR ;12:36 PM 15 Feb 1995
2 ;;22.0;VA FileMan;;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 F D E X IOXY Q:DIR0DN!$G(DIR0QT)
5 Q
6 ;
7E I $G(DIR0("REP"))&DIR0C>1!(DIR0C>$L(DIR0A)),$S(DIR0LN<DIR0NL:DIR0F,1:DIR0FL)>DX,'$D(DIR0KD) D
8 . D PREAD^DIR01($S(DIR0LN<DIR0NL:DIR0F,1:DIR0FL)-DX,.DIR0ST,.DIR0CH)
9 . Q:'$L(DIR0ST)
10 . I '$G(DIR0("REP")) S DIR0A=DIR0A_DIR0ST
11 . E S $E(DIR0A,DIR0C,DIR0C+$L(DIR0ST)-1)=DIR0ST
12 . S DX=DX+$L(DIR0ST),DIR0C=DIR0C+$L(DIR0ST)
13 E D READ^DIR01(.DIR0CH)
14 Q:DIR0CH=""
15 ;
16 I "?^"[DIR0CH,DIR0C=1,'DIR0QU D Q
17 . D DEOF X IOXY
18 . S DIR0A="",DIR0QU=1 D REP
19 D @$S($L(DIR0CH)>1:DIR0CH,$G(DIR0("REP")):"REP",1:"INS")
20 I DIR0QU,"?^"'[$E(DIR0A)!'$L(DIR0A) S DIR0QU=0,DIR0A="" D CLR
21 Q
22 ;
23REP I DIR0C>DIR0M W $C(7) Q
24 S DIR0CHG=1
25 S DIR0A=$E(DIR0A,1,DIR0C-1)_DIR0CH_$E(DIR0A,DIR0C+1,999)
26 S DIR0C=DIR0C+1
27 W DIR0CH
28 I DX<DIR0F S DX=DX+1 Q
29 S DIR0LN=DIR0LN+1,DY=DY+1,DX=DIR0S Q
30 Q
31 ;
32INS I $L(DIR0A)'<DIR0M W $C(7) Q
33 S DIR0CHG=1
34 S DIR0A=$E(DIR0A,1,DIR0C-1)_DIR0CH_$E(DIR0A,DIR0C,999)
35 W $E(DIR0A,DIR0C,DIR0C+DIR0F-DX)
36 D
37 . N DIR0LN,DY,DX
38 . S DX=DIR0S
39 . F DIR0LN=DIR0C-1\DIR0L+2:1:$L(DIR0A)\DIR0L+1 D
40 .. S DY=DIR0R+DIR0LN-1 X IOXY
41 .. W $E(DIR0A,DIR0LN-1*DIR0L+1,DIR0LN*DIR0L)
42 S DIR0C=DIR0C+1
43 I DX<DIR0F S DX=DX+1 Q
44 S DIR0LN=DIR0LN+1,DY=DY+1,DX=DIR0S
45 Q
46 ;
47RIGHT Q:DIR0C>$L(DIR0A)
48 S DIR0C=DIR0C+1
49 I DX<DIR0F!(DIR0LN=DIR0NL) S DX=DX+1 Q
50 S DIR0LN=DIR0LN+1,DY=DY+1,DX=DIR0S
51 Q
52 ;
53LEFT Q:DIR0C'>1
54 S DIR0C=DIR0C-1
55 I DX>DIR0S S DX=DX-1 Q
56 S DIR0LN=DIR0LN-1,DY=DY-1,DX=DIR0F
57 Q
58 ;
59JRT Q:DIR0C>$L(DIR0A)
60 Q:DX=DIR0F
61 S DIR0C=DIR0LN*DIR0L S:DIR0C>$L(DIR0A) DIR0C=$L(DIR0A)+1
62 S DX=DIR0C#DIR0L-1+DIR0S S:DX<DIR0S DX=DIR0F
63 Q
64 ;
65JLT Q:DIR0C'>1
66 Q:DX=DIR0S
67 S DIR0C=DIR0C-DX+DIR0S,DX=DIR0S
68 Q
69 ;
70UP Q:DIR0LN=1
71 S DIR0C=DIR0C-DIR0L,DIR0LN=DIR0LN-1,DY=DY-1
72 Q
73 ;
74DOWN Q:DIR0LN=DIR0NL
75 Q:$L(DIR0A)\DIR0L<DIR0LN
76 S DIR0C=DIR0C+DIR0L,DIR0LN=DIR0LN+1,DY=DY+1
77 S:DIR0C>($L(DIR0A)+1) DIR0C=$L(DIR0A)+1,DX=DIR0C#DIR0L+DIR0S-1
78 Q
79 ;
80FDE ;
81NP Q:DIR0C>$L(DIR0A)
82 S DIR0C=$L(DIR0A)+1,DIR0LN=DIR0C-1\DIR0L+1,DX=DIR0C-1#DIR0L+DIR0S
83 S:DIR0LN>DIR0NL DIR0LN=DIR0NL,DX=DIR0S+DIR0NC
84 S DY=DIR0R+DIR0LN-1
85 Q
86 ;
87FDB ;
88PP Q:DIR0C'>1
89 S DIR0LN=1,DY=DIR0R,DX=DIR0S,DIR0C=1
90 Q
91 ;
92BS Q:DIR0C'>1
93 S DIR0CHG=1
94 S DX=DX-1,DIR0C=DIR0C-1
95 S DIR0A=$E(DIR0A,1,DIR0C-1)_$E(DIR0A,DIR0C+1,999)_" "
96 I DX<DIR0S S DIR0LN=DIR0LN-1,DY=DY-1,DX=DIR0F
97 X IOXY W $E(DIR0A,DIR0C,DIR0C+DIR0F-DX)
98 D
99 . N DIR0LN,DY,DX
100 . S DX=DIR0S
101 . F DIR0LN=DIR0C-1\DIR0L+2:1:$L(DIR0A)\DIR0L+1 D
102 .. S DY=DIR0R+DIR0LN-1 X IOXY
103 .. W $E(DIR0A,DIR0LN-1*DIR0L+1,DIR0LN*DIR0L)
104 S DIR0A=$E(DIR0A,1,$L(DIR0A)-1)
105 Q
106 ;
107DEL Q:DIR0C>$L(DIR0A)
108 S DIR0CHG=1
109 S DIR0A=$E(DIR0A,1,DIR0C-1)_$E(DIR0A,DIR0C+1,999)_" "
110 W $E(DIR0A,DIR0C,DIR0C+DIR0F-DX)
111 D
112 . N DIR0LN,DY,DX
113 . S DX=DIR0S
114 . F DIR0LN=DIR0C-1\DIR0L+2:1:$L(DIR0A)\DIR0L+1 D
115 .. S DY=DIR0R+DIR0LN-1 X IOXY
116 .. W $E(DIR0A,DIR0LN-1*DIR0L+1,DIR0LN*DIR0L)
117 S DIR0A=$E(DIR0A,1,$L(DIR0A)-1)
118 Q
119 ;
120CLR N %X
121 S DIR0CHG=1
122 S %X=DIR0A
123 I DIR0A]"",DIR0A'=DIR0D S DIR0SV=DIR0A
124 S DIR0A=$S(DIR0A=DIR0D:DIR0SV,DIR0A="":DIR0D,1:"")
125 S %X=DIR0A_$J("",$L(%X)-$L(DIR0A))
126 S DX=DIR0S
127 F DIR0LN=1:1:$L(%X)\DIR0L+1 D
128 . S DY=DIR0R+DIR0LN-1 X IOXY
129 . W $E(%X,DIR0LN-1*DIR0L+1,DIR0LN*DIR0L)
130 S (DIR0C,DIR0LN)=1,DY=DIR0R
131 Q
132 ;
133DEOF N %X
134 Q:DIR0C>$L(DIR0A)
135 S DIR0CHG=1
136 S %X=DIR0A,DIR0A=$E(DIR0A,1,DIR0C-1),%X=DIR0A_$J("",$L(%X)-$L(DIR0A))
137 W $E(%X,DIR0C,DIR0C+DIR0F-DX)
138 D
139 . N DIR0LN,DY,DX
140 . S DX=DIR0S
141 . F DIR0LN=DIR0C-1\DIR0L+2:1:$L(%X)\DIR0L+1 D
142 .. S DY=DIR0R+DIR0LN-1 X IOXY
143 .. W $E(%X,DIR0LN-1*DIR0L+1,DIR0LN*DIR0L)
144 Q
145 ;
146RPM N DX,DY
147 I $D(DDS) S DX=IOM-8,DY=IOSL-1 X IOXY
148 I $G(DIR0("REP")) W "Insert " K DIR0("REP")
149 E W "Replace" S DIR0("REP")=1
150 Q
151 ;
152KPM I $G(DDGLKPNM) K DDGLKPNM W $P(DDGLED,DDGLDEL,9)
153 E S DDGLKPNM=1 W $P(DDGLED,DDGLDEL,10)
154 Q
155 ;
156WRT G WRT2^DIR0W
157WLT ;
158FDL G WLT2^DIR0W
159DLW G DLW2^DIR0W
160 ;
161HLP ;
162NB ;
163SEL ;
164SV ;
165RF ;
166NOP W $C(7)
167 Q
168TO I $D(DIR0TO)#2 D @DIR0TO Q
169 S DTOUT=1
170ZM ;
171QT ;
172EX ;
173CL ;
174TAB ;
175CR S DIR0DN=1
176 Q
Note: See TracBrowser for help on using the repository browser.