1: DDWT1 ;SFISC/PD KELTZ,MKO-READ AND PROCESS ;08:14 AM 30 Aug 1994
2: ;;21.0;VA FileMan;;Dec 28, 1994
3: ;Per VHA Directive 10-93-142, this routine should not be modified.
4: D LOAD^DDW1
5: F D GETIN Q:$D(DDWFIN)
6: Q
7: ;
8: GETIN ;Get input
9: I DDWC'>DDWRMAR,DDWC-DDWOFS<IOM,DDWC>$L(DDWN)!DDWREP,'$D(DDWMARK) D
10: . N DDWANS
11: . D PREAD($$MIN(DDWRMAR,IOM-1+DDWOFS)-DDWC+1,DDWTO,.DDWANS,.DDWQ)
12: . I DDWANS]"" D
13: .. S:DDWQ="TO" DDWQ=""
14: .. S $E(DDWN,DDWC,DDWC+$L(DDWANS)-1)=DDWANS,DDWL(DDWRW)=DDWN
15: .. S DDWC=DDWC+$L(DDWANS)
16: E D
17: . D READ(DDWTO,.DDWQ)
18: . D:$L(DDWQ)=1 DISPL
19: ;
20: I DDWQ'="TO" K DDWTC
21: E D
22: . S DDWTC=$G(DDWTC)+1
23: . S:DDWTC<(DTIME\DDWTO) DDWQ=""
24: . I DDWSTAT,DDWTC=1,$L(DDWQ)'>1 D STATUS
25: ;
26: I $L(DDWQ)>1 D @DDWQ I DDWSTAT D STATUS S DDWTC=1
27: Q
28: ;
29: DISPL ;Display char
30: I DDWC>245 W $C(7) Q
31: ;
32: I $D(DDWMARK),DDWRW+DDWA'>$P(DDWMARK,U,3) D UNMARK^DDW7
33: S:DDWC-1>$L(DDWN) DDWN=DDWN_$J("",DDWC-$L(DDWN)-1)
34: S (DDWN,DDWL(DDWRW))=$E(DDWN,1,DDWC-1)_DDWQ_$E(DDWN,DDWC+DDWREP,999)
35: S DDWC=DDWC+1
36: ;
37: I DDWREP W DDWQ
38: E D
39: . I $P(DDGLED,DDGLDEL,5)]"" W $P(DDGLED,DDGLDEL,5)_DDWQ
40: . E W DDWQ_$E(DDWN,DDWC,IOM+DDWOFS)
41: D POS(DDWRW,DDWC,"R")
42: D:$L(DDWN)>DDWRMAR WRAP^DDW5
43: Q
44: ;
45: RUB N DDWX
46: I $D(DDWMARK) D CHKDEL^DDW9(.DDWX) Q:DDWX
47: ;
48: I DDWC=1 D
49: . I DDWRW=1 D
50: .. I 'DDWA W $C(7)
51: .. E D MVBCK^DDW3(1),POS(1,"E","R")
52: . E D POS(DDWRW-1,"E","RN")
53: E D
54: . S DDWC=DDWC-1,$E(DDWN,DDWC)="",DDWL(DDWRW)=DDWN
55: . I DDWC-DDWOFS>0 D
56: .. D CUP(DDWRW,DDWC-DDWOFS)
57: .. I $P(DDGLED,DDGLDEL,6)]"" W $P(DDGLED,DDGLDEL,6)
58: .. E W $E(DDWN_" ",DDWC,IOM+DDWOFS) D CUP(DDWRW,DDWC-DDWOFS)
59: . E D POS(DDWRW,DDWC)
60: Q
61: ;
62: DEL N DDWX
63: I $D(DDWMARK) D CHKDEL^DDW9(.DDWX) Q:DDWX
64: ;
65: I DDWC>$L(DDWN) D Q
66: . I DDWN?." " D
67: .. D XLINE^DDW5()
68: . E D
69: .. N DDWY,DDWX
70: .. S DDWY=DDWRW+DDWA,DDWX=DDWC
71: .. D JOIN^DDW6
72: .. D POS(DDWY-DDWA,DDWX,"RN")
73: ;
74: S $E(DDWN,DDWC)="",DDWL(DDWRW)=DDWN,DDWX=$E(DDWN,IOM+DDWOFS)
75: I $P(DDGLED,DDGLDEL,6)]"" D
76: . W $P(DDGLED,DDGLDEL,6)
77: . I DDWX]" " D CUP(DDWRW,IOM) W DDWX D CUP(DDWRW,DDWC-DDWOFS)
78: E D
79: . W $E(DDWN_" ",DDWC,IOM+DDWOFS)
80: . D CUP(DDWRW,DDWC-DDWOFS)
81: Q
82: ;
83: STATUS N DDWX,DDWS
84: S DDWS="Scr "_(DDWA+DDWRW-1\DDWMR+1)_" of "_(DDWCNT-1\DDWMR+1)
85: S DDWX="Ln "_(DDWA+DDWRW)_" of "_DDWCNT
86: S $E(DDWS,IOM\2+1-($L(DDWX)\2),999)=DDWX
87: S DDWX="Col "_DDWC
88: S $E(DDWS,IOM-$L(DDWX),999)=DDWX
89: D CUP(DDWMR+2,1) W $P(DDGLCLR,DDGLDEL)_DDWS
90: D POS(DDWRW,DDWC)
91: Q
92: ;
93: UP I DDWRW>1 D
94: . D POS(DDWRW-1,DDWC,"RN")
95: E I DDWA D
96: . D MVBCK^DDW3(1)
97: E W $C(7)
98: I DDWC>246,$L(DDWN)<246 D POS(DDWRW,246,"R")
99: Q
100: DN I DDWA+DDWRW'<DDWCNT W $C(7) Q
101: I DDWRW<DDWMR D
102: . D POS(DDWRW+1,DDWC,"RN")
103: E I DDWSTB D
104: . D MVFWD^DDW3(1)
105: E W $C(7) Q
106: I DDWC>246,$L(DDWN)<246 D POS(DDWRW,246,"R")
107: Q
108: RT I DDWC>245,DDWC>$L(DDWN) W $C(7)
109: E D POS(DDWRW,DDWC+1,"R")
110: Q
111: LT I DDWC=1 D
112: . D UP,POS(DDWRW,"E","R")
113: E D POS(DDWRW,DDWC-1,"R")
114: Q
115: ;
116: SV G SV^DDW1
117: SW D SAVE^DDW1 S DDWFIN="",DIWESW=1 Q
118: EX D SAVE^DDW1 S DDWFIN="" Q
119: QT S DDWFIN="" Q
120: TO D SAVE^DDW1 S DTOUT=1,DDWFIN="" W $C(7) Q
121: HLP D HLP^DDWH,POS(DDWRW,DDWC) Q
122: ;
123: TST G TSET^DDW2
124: LST G LSET^DDW2
125: RST G RSET^DDW2
126: WRM G WRAPM^DDW2
127: RPM G REPLM^DDW2
128: ST G STAT^DDW2
129: ;
130: TOP G TOP^DDW3
131: BOT G BOT^DDW3
132: ;
133: PDN G PGDN^DDW4
134: PUP G PGUP^DDW4
135: TAB G TAB^DDW4
136: JLT G JLEFT^DDW4
137: JRT G JRIGHT^DDW4
138: LB G LBEG^DDW4
139: LE G LEND^DDW4
140: WRT G WORDR^DDW4
141: WLT G WORDL^DDW4
142: DLW G DELW^DDW4
143: DEOL G DEOL^DDW4
144: ;
145: BRK D BREAK^DDW5() Q
146: XLN D XLINE^DDW5() D:DDWC'=1 POS(DDWRW,1,"R") Q
147: ;
148: JN G JOIN^DDW6
149: RFT G REFMT^DDW6
150: ;
151: MRK G MARK^DDW7
152: UMK G UNMARK^DDW7
153: ;
154: CPY D COPY^DDW8() Q
155: CUT D CUT^DDW8() Q
156: PST D PASTE^DDW8() Q
157: ;
158: FND G FIND^DDWF
159: ;
160: NXT G NEXT^DDWF
161: GTO G GOTO^DDWG
162: CHG G CHG^DDWC
163: ;
164: READ(DDWTO,Y) ;Out: Y = Char or mnemonic
165: F D Q:Y'=-1
166: . R *Y:DDWTO
167: . I Y>31,Y<127 S Y=$C(Y) Q
168: . I Y<0 S Y="TO" Q
169: . D MNE(.Y)
170: Q
171: ;
172: PREAD(DDWLEN,DDWTO,DDWST,Y) ;
173: ;In: DDWLEN = # chars to read
174: ;Out: DDWST = String
175: ; Y = Mnemonic, Null if DDWLEN chars read or invalid
176: X DDGLZOSF("EON")
177: R DDWST#DDWLEN:DDWTO E S Y="TO" Q
178: X DDGLZOSF("EOFF"),DDGLZOSF("TRMRD")
179: I $C(Y)?1C,Y D
180: . D MNE(.Y) S:Y=-1 Y=""
181: E S Y=""
182: Q
183: ;
184: MNE(Y) ;Out: Y = Mnemonic, or -1 if invalid
185: N S,F
186: S S="",F=0
187: F D MNELOOP Q:F
188: Q
189: ;
190: MNELOOP ;Read more
191: S S=S_$C(Y)
192: I DDW("IN")'[(U_S) D I Y=-1 D FLUSH Q
193: . I $C(Y)'?1L S Y=-1 Q
194: . S S=$E(S,1,$L(S)-1)_$C(Y-32)
195: . S:DDW("IN")'[(U_S_U) Y=-1
196: ;
197: I DDW("IN")[(U_S_U),S'=$C(27) D Q
198: . S Y=$P(DDW("OUT"),U,$L($P(DDW("IN"),U_S_U),U)),F=1
199: ;
200: R *Y:5 D:Y=-1 FLUSH
201: Q
202: ;
203: FLUSH ;
204: N DDWX
205: S F=1 W $C(7) F R *DDWX:0 E Q
206: Q
207: ;
208: CUP(Y,X) ;
209: S DY=IOTM+Y-2,DX=X-1 X IOXY
210: Q
211: ;
212: POS(R,C,F) ;Pos cursor based on char pos C
213: N DDWX
214: S:$G(C)="E" C=$L($G(DDWL(R)))+1
215: S:$G(F)["N" DDWN=$G(DDWL(R))
216: S:$G(F)["R" DDWRW=R,DDWC=C
217: ;
218: S DDWX=C-DDWOFS
219: I DDWX>IOM!(DDWX<1) D SHIFT^DDW3(C,.DDWOFS)
220: S DY=IOTM+R-2,DX=C-DDWOFS-1 X IOXY
221: Q
222: ;
223: MIN(X,Y) ;
224: Q $S(X<Y:X,1:Y)
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to DDWT1.m CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Coherent Logic Development] / freem_fileman / USER