![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to DIR01.m CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Coherent Logic Development] / freem_fileman|
Return to DIR01.m CVS log | Up to [Coherent Logic Development] / freem_fileman |
1.1 snw 1: DIR01 ;SFISC/MKO-FIELD EDITOR ;02:39 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: I DIR0A]"" D F X IOXY Q:DIR0QT
5: F D E X IOXY Q:DIR0QT
6: Q
7: ;
8: F D READ(.DIR0CH)
9: I "?^"'[DIR0CH=$L(DIR0CH) S DIR0A="" D REP,DEOF Q
10: D:DIR0CH]"" E1
11: Q
12: ;
13: E I $G(DIR0("REP"))&DIR0C>1!(DIR0C>$L(DIR0A)),DIR0F>DX,DIR0M>$L(DIR0A),'$D(DIR0KD) D
14: . D PREAD($$MIN(DIR0F-DX,DIR0M-DIR0C+1),.DIR0ST,.DIR0CH)
15: . Q:DIR0ST=""
16: . S DIR0CHG=1
17: . I '$G(DIR0("REP")) S DIR0A=DIR0A_DIR0ST
18: . E S $E(DIR0A,DIR0C,DIR0C+$L(DIR0ST)-1)=DIR0ST
19: . S DX=DX+$L(DIR0ST),DIR0C=DIR0C+$L(DIR0ST)
20: E D READ(.DIR0CH)
21: Q:DIR0CH=""
22: ;
23: E1 I "?^"[DIR0CH,DIR0C=1,'DIR0QU S DIR0A="",DIR0QU=1 D REP,DEOF Q
24: D @$S($L(DIR0CH)>1:DIR0CH,$G(DIR0("REP")):"REP",1:"INS")
25: I DIR0QU,"?^"'[$E(DIR0A)!'$L(DIR0A) S DIR0QU=0,DIR0A="" D CLR
26: Q
27: ;
28: REP I DIR0C>DIR0M W $C(7) Q
29: S DIR0CHG=1
30: S $E(DIR0A,DIR0C)=DIR0CH,DIR0C=DIR0C+1
31: I DIR0F>DX S DX=DX+1 W DIR0CH Q
32: N DIX
33: S DIX=DIR0C-(DIR0L\2)
34: S:$L(DIR0A)-DIX+1<DIR0L DIX=$L(DIR0A)-DIR0L+1
35: S DX=DIR0S X IOXY
36: W $E(DIR0A,DIX,DIX+DIR0L-1) S DX=DIR0S+DIR0C-DIX
37: Q
38: ;
39: INS I $L(DIR0A)'<DIR0M W $C(7) Q
40: S DIR0CHG=1
41: S DIR0A=$E(DIR0A,1,DIR0C-1)_DIR0CH_$E(DIR0A,DIR0C,999),DIR0C=DIR0C+1
42: I DIR0F>DX S DX=DX+1 W $E(DIR0A,DIR0C-1,DIR0C+DIR0F-DX-1) Q
43: S DX=DIR0S X IOXY W $E(DIR0A,DIR0C-DIR0L,DIR0C-1) S DX=DIR0F
44: Q
45: ;
46: RIGHT Q:DIR0C>$L(DIR0A)
47: I DX<DIR0F S DX=DX+1,DIR0C=DIR0C+1 Q
48: S DIR0C=DIR0C+1,DX=DIR0S X IOXY
49: W $E(DIR0A,DIR0C-DIR0L,DIR0C-1)
50: S DX=DIR0F
51: Q
52: ;
53: LEFT Q:DIR0C'>1
54: I DX>DIR0S S DX=DX-1,DIR0C=DIR0C-1 Q
55: S DIR0C=DIR0C-1 W $E(DIR0A,DIR0C,DIR0C+DIR0L-1)
56: Q
57: ;
58: JRT Q:DIR0C>$L(DIR0A)
59: I DIR0F=DX D Q
60: . S DIR0C=DIR0C+DIR0L S:DIR0C+1>$L(DIR0A) DIR0C=$L(DIR0A)+1
61: . S DX=DIR0S X IOXY W $E(DIR0A,DIR0C-DIR0L,DIR0C-1)
62: . S DX=DIR0F
63: N DIX
64: S DIX=$L(DIR0A)-DIR0C+1
65: I DIR0F-DX>DIX S DX=DX+DIX,DIR0C=DIR0C+DIX Q
66: S DIR0C=DIR0C+DIR0F-DX,DX=DIR0F
67: Q
68: ;
69: JLT Q:DIR0C'>1
70: I DX=DIR0S D Q
71: . S DIR0C=DIR0C-DIR0L S:DIR0C<1 DIR0C=1
72: . W $E(DIR0A,DIR0C,DIR0C+DIR0L-1)
73: S DIR0C=DIR0C-DX+DIR0S,DX=DIR0S
74: Q
75: ;
76: FDE Q:DIR0C>$L(DIR0A)
77: I DX+$L(DIR0A)-DIR0C-DIR0L<DIR0S D Q
78: . S DX=DX+$L(DIR0A)-DIR0C+1,DIR0C=$L(DIR0A)+1
79: S DIR0C=$L(DIR0A)+1,DX=DIR0S X IOXY
80: W $E(DIR0A,DIR0C-DIR0L,DIR0C)
81: S DX=DIR0F
82: Q
83: ;
84: FDB Q:DIR0C'>1
85: I DX-DIR0C+1<DIR0S S DX=DIR0S X IOXY W $E(DIR0A,1,DIR0L)
86: S DX=DIR0S,DIR0C=1
87: Q
88: ;
89: BS Q:DIR0C'>1
90: S DIR0CHG=1
91: S DIR0C=DIR0C-1,DIR0A=$E(DIR0A,1,DIR0C-1)_$E(DIR0A,DIR0C+1,999)
92: I DX>DIR0S D Q
93: . S DX=DX-1 X IOXY
94: . W $E(DIR0A_$E(DIR0SP),DIR0C,DIR0C+DIR0F-DX-1)
95: N DIX
96: S DIX=DIR0C-(DIR0L\2)
97: S:$L(DIR0A)-DIX+1<DIR0L DIX=$L(DIR0A)-DIR0L+1
98: S:DIX<1 DIX=1
99: W $E(DIR0A,DIX,DIX+DIR0L-1) S DX=DIR0S+DIR0C-DIX
100: Q
101: ;
102: DEL Q:DIR0C>$L(DIR0A)!(DIR0F'>DX)
103: S DIR0CHG=1
104: S DIR0A=$E(DIR0A,1,DIR0C-1)_$E(DIR0A,DIR0C+1,999)
105: W $E(DIR0A_$E(DIR0SP),DIR0C,DIR0C+DIR0F-DX-1)
106: Q
107: ;
108: CLR S DIR0CHG=1
109: S DIR0C=1,DX=DIR0S X IOXY
110: I DIR0A]"",DIR0A'=DIR0D S DIR0SV=DIR0A
111: S DIR0A=$S(DIR0A=DIR0D:DIR0SV,DIR0A="":DIR0D,1:"")
112: W $E(DIR0A,1,DIR0L)_$E(DIR0SP,$L(DIR0A)+1,999)
113: Q
114: ;
115: DEOF S DIR0CHG=1
116: W $E(DIR0SP,DX-DIR0S+1,999)
117: S DIR0A=$E(DIR0A,1,DIR0C-1)
118: Q
119: ;
120: RPM N DX,DY
121: I $D(DDS) S DX=IOM-8,DY=IOSL-1 X IOXY
122: I $G(DIR0("REP")) W:$D(DDS) "Insert " K DIR0("REP")
123: E W:$D(DDS) "Replace" S DIR0("REP")=1
124: Q
125: ;
126: KPM I $G(DDGLKPNM) K DDGLKPNM W $P(DDGLED,DDGLDEL,9)
127: E S DDGLKPNM=1 W $P(DDGLED,DDGLDEL,10)
128: Q
129: ;
130: WRT G WRT^DIR0W
131: WLT G WLT^DIR0W
132: DLW G DLW^DIR0W
133: HLP G ^DIR0H
134: ZM G SM^DIR02
135: ;
136: TO S DTOUT=1,DIR0A=DIR0D
137: UP ;
138: DOWN ;
139: TAB ;
140: FDL ;
141: CR ;
142: NB ;
143: NP ;
144: PP ;
145: SEL ;
146: EX ;
147: QT ;
148: CL ;
149: SV ;
150: RF ;
151: S DIR0QT=1
152: Q
153: NOP W $C(7)
154: Q
155: ;
156: READ(Y) ;Out: Y=char or mnemonic
157: F D Q:Y'=-1
158: . R *Y:DTIME
159: . I Y>31,Y<127 S Y=$C(Y) Q
160: . I Y<0 S Y="TO" Q
161: . D MNE(.Y)
162: I Y'="TO",$D(DIR0KD) D @DIR0KD
163: Q
164: ;
165: PREAD(DIR0LEN,DIR0ST,Y) ;
166: ; Y = Mnem, Null if DIR0LEN chars read or invalid
167: X DDGLZOSF("EON")
168: R DIR0ST#DIR0LEN:DTIME E S Y="TO" Q
169: X DDGLZOSF("EOFF"),DDGLZOSF("TRMRD")
170: I $C(Y)?1C,Y D
171: . D MNE(.Y) S:Y=-1 Y=""
172: E S Y=""
173: Q
174: ;
175: MNE(Y) ;Out: Y=mnemonic, or -1 if invalid
176: N S,F
177: S S="",F=0
178: F D MNELOOP Q:F
179: Q
180: ;
181: MNELOOP ;
182: S S=S_$C(Y)
183: I DIR0(DIR0P_"IN")'[(U_S) D I Y=-1 D FLUSH Q
184: . I $C(Y)'?1L S Y=-1 Q
185: . S S=$E(S,1,$L(S)-1)_$C(Y-32)
186: . S:DIR0(DIR0P_"IN")'[(U_S_U) Y=-1
187: ;
188: I DIR0(DIR0P_"IN")[(U_S_U),S'=$C(27) D
189: . S Y=$P(DIR0(DIR0P_"OUT"),";",$L($P(DIR0(DIR0P_"IN"),U_S_U),U)),F=1
190: E R *Y:5 D:Y=-1 FLUSH
191: Q
192: ;
193: FLUSH N X
194: S F=1 W $C(7) F R *X:0 E Q
195: Q
196: ;
197: MIN(X,Y) ;
198: Q $S(X<Y:X,1:Y)