Annotation of freem_fileman/DIR03.m, revision 1.1.1.1
1.1 snw 1: DIR03 ;SFISC/MKO-MULTILINE FIELD EDITOR ;03:37 PM 12 Oct 1994
2: ;;21.0;VA FileMan;;Dec 28, 1994
3: ;Per VHA Directive 10-93-142, this routine should not be modified.
4: F D E X IOXY Q:DIR0DN
5: Q
6: ;
7: E I $G(DIR0("REP"))&DIR0C>1!DIR0C>$L(DIR0A),$S(DIR0LN<DIR0NL:DIR0F,1:DIR0FL)>DX 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: ;
23: REP 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: ;
32: INS 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: ;
47: RIGHT 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: ;
53: LEFT 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: ;
59: JRT 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: ;
65: JLT Q:DIR0C'>1
66: Q:DX=DIR0S
67: S DIR0C=DIR0C-DX+DIR0S,DX=DIR0S
68: Q
69: ;
70: UP Q:DIR0LN=1
71: S DIR0C=DIR0C-DIR0L,DIR0LN=DIR0LN-1,DY=DY-1
72: Q
73: ;
74: DOWN 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: ;
80: FDE ;
81: NP 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: ;
87: FDB ;
88: PP Q:DIR0C'>1
89: S DIR0LN=1,DY=DIR0R,DX=DIR0S,DIR0C=1
90: Q
91: ;
92: BS 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: ;
107: DEL 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: ;
120: CLR 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: ;
133: DEOF 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: ;
146: RPM 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: ;
152: KPM I $G(DDGLKPNM) K DDGLKPNM W $P(DDGLED,DDGLDEL,9)
153: E S DDGLKPNM=1 W $P(DDGLED,DDGLDEL,10)
154: Q
155: ;
156: WRT G WRT2^DIR0W
157: WLT ;
158: FDL G WLT2^DIR0W
159: DLW G DLW2^DIR0W
160: ;
161: HLP ;
162: NB ;
163: SEL ;
164: SV ;
165: RF ;
166: NOP W $C(7)
167: Q
168: TO S DTOUT=1,DIR0A=DIR0D
169: ZM ;
170: QT ;
171: EX ;
172: CL ;
173: TAB ;
174: CR S DIR0DN=1
175: Q
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>