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

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

initial load of FOIAVistA 6/30/08 version
File size: 5.1 KB
Line 
1DDW6 ;SFISC/MKO-JOIN ;10:41 AM 16 Jun 2000
2 ;;22.0;VA FileMan;**18**;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5REFMT ;Reformat
6 N DDWRFMT
7 I $D(DDWMARK),DDWRW+DDWA'>$P(DDWMARK,U,3) D UNMARK^DDW7
8 D POS(DDWRW,DDWLMAR,"R")
9 S DDWRFMT=0 F D JOIN Q:DDWRFMT
10 Q
11 ;
12JOIN ;Join
13 N DDWI,DDWSCR,DDWNSV,DDWLL,DDWTXT,DDWTXT0
14 I $D(DDWMARK),DDWRW+DDWA'>$P(DDWMARK,U,3) D UNMARK^DDW7
15 ;
16 ;Get current line
17 S (DDWTXT(1),DDWNSV)=DDWN
18 ;
19 ;Get next line
20 I DDWRW=DDWMR S:DDWSTB DDWTXT(2)=^TMP("DDW1",$J,DDWSTB)
21 E S:DDWA+DDWRW<DDWCNT DDWTXT(2)=DDWL(DDWRW+1)
22 ;
23 I $G(DDWTXT(2))?." " D Q:$G(DDWRFMT)
24 . I $L(DDWN)>DDWRMAR S:$D(DDWTXT(2))#2 DDWLL=DDWTXT(2)
25 . E I $D(DDWRFMT) S DDWRFMT=1
26 ;
27 ;Adjust
28 S DDWTXT0=$O(DDWTXT(""),-1)
29 D ADJMAR(.DDWTXT,"","I")
30 S:$D(DDWLL) DDWTXT=DDWTXT+1,DDWTXT(DDWTXT)=DDWLL
31 S (DDWN,DDWL(DDWRW))=DDWTXT(1)
32 ;
33 ;Delete next line
34 I DDWTXT0>1,DDWTXT=1 D
35 . I DDWRW=DDWMR S DDWSTB=DDWSTB-1,DDWCNT=DDWCNT-1,$E(DDWBF,1,3)=111
36 . E D POS(DDWRW+1,DDWC,"RN"),XLINE^DDW5(1),POS(DDWRW-1,DDWC,"RN")
37 ;
38 ;DDWSCR: curr scr = final scr
39 I DDWTXT=1,'$D(DDWRFMT) S DDWSCR=$L(DDWTXT(1))+1-DDWOFS
40 E S DDWSCR=DDWLMAR-DDWOFS
41 S DDWSCR=DDWSCR'<1&(DDWSCR'>IOM)
42 ;
43 I DDWSCR,DDWNSV'=DDWN D
44 . I DDWNSV]"",$P(DDWNSV,DDWN)="" D
45 .. D CUP(DDWRW,$$MAX($L(DDWN)+1-DDWOFS,1))
46 .. W $P(DDGLCLR,DDGLDEL)
47 . E I DDWN]"",$P(DDWN,DDWNSV)="" D
48 .. D CUP(DDWRW,$$MAX($L(DDWNSV)+1-DDWOFS,1))
49 .. W $E(DDWN,$$MAX($L(DDWNSV),DDWOFS)+1,IOM+DDWOFS)
50 . E D
51 .. D CUP(DDWRW,DDWOFS+1)
52 .. W $P(DDGLCLR,DDGLDEL)_$E(DDWN,DDWOFS+1,IOM+DDWOFS)
53 ;
54 I DDWTXT=1 D
55 . I '$D(DDWRFMT) D
56 .. D POS(DDWRW,"E","RN")
57 . E D POS(DDWRW,DDWLMAR,"RN")
58 E D JOIN2
59 Q
60 ;
61JOIN2 ;Join produced >1 lines
62 D POS(DDWRW,DDWLMAR,"R")
63 ;
64 I DDWTXT0=2 D
65 . I DDWRW<DDWMR D
66 .. S DDWL(DDWRW+1)=DDWTXT(2)
67 .. S DDWRW=DDWRW+1
68 .. I DDWSCR D
69 ... D CUP(DDWRW,1)
70 ... W $P(DDGLCLR,DDGLDEL)_$E(DDWL(DDWRW),1+DDWOFS,IOM+DDWOFS)
71 . E D
72 .. S ^TMP("DDW1",$J,DDWSTB)=DDWTXT(2)
73 .. D MVFWD^DDW3(1)
74 ;
75 F DDWI=DDWTXT0+1:1:DDWTXT D
76 . D ILINE^DDW5
77 . S (DDWN,DDWL(DDWRW))=DDWTXT(DDWI)
78 . D CUP(DDWRW,1)
79 . W $P(DDGLCLR,DDGLDEL)_$E(DDWN,1+DDWOFS,IOM+DDWOFS)
80 ;
81 D POS(DDWRW-($D(DDWLL)#2),DDWLMAR,"RN")
82 Q
83 ;
84ADJMAR(DDWT,DDWW,DDWFLG) ;Adjust length of text in DDWT array
85 ; DDWT = Text array
86 ; DDWW = Width
87 ;DDWFLG = I:First line $L=DDWRMAR, subsequent $L=DDWRMAR-DDWLMAR+1
88 ;
89 N DDWJ
90 S DDWJ=1
91 I $G(DDWFLG)["I" S DDWW=DDWRMAR
92 E I '$D(DDWW) S DDWW=DDWRMAR-DDWLMAR+1
93 ;
94 F Q:'$D(DDWT(DDWJ)) D AMLOOP
95 S DDWT=$O(DDWT(""),-1)
96 I DDWLMAR>1 F DDWJ=$G(DDWFLG)["I"+1:1:DDWT D
97 . S DDWT(DDWJ)=$J("",DDWLMAR-1)_DDWT(DDWJ)
98 Q
99 ;
100AMLOOP ;Process DDWT(DDWJ)
101 I $E(DDWT(DDWJ),1,DDWW)=$J("",DDWW) S DDWT(DDWJ)=$$LD(DDWT(DDWJ))
102 ;
103 E I $L(DDWT(DDWJ))>DDWW F D Q:$L(DDWT(DDWJ))'>DDWW
104 . N DDWK,DDWFST,DDWLST
105 . F DDWK=$O(DDWT(""),-1)+1:-1:DDWJ+2 S DDWT(DDWK)=DDWT(DDWK-1)
106 . D SLICE(DDWT(DDWJ),DDWW,.DDWFST,.DDWLST)
107 . S DDWT(DDWJ)=DDWFST,DDWT(DDWJ+1)=DDWLST
108 . D AMINCJ
109 ;
110 E I $L(DDWT(DDWJ))=DDWW!'$D(DDWT(DDWJ+1)) D
111 . I DDWRAP,$D(DDWT(DDWJ+1)) S DDWT(DDWJ+1)=$$LD(DDWT(DDWJ+1))
112 . D AMINCJ
113 ;
114 E I 'DDWRAP D
115 . N DDWK S DDWK=DDWW-$L(DDWT(DDWJ))
116 . S DDWT(DDWJ)=DDWT(DDWJ)_$E(DDWT(DDWJ+1),1,DDWK)
117 . S DDWT(DDWJ+1)=$E(DDWT(DDWJ+1),DDWK+1,999)
118 . D:DDWT(DDWJ+1)="" AMSHIFT(.DDWT,DDWJ+1)
119 ;
120 E D
121 . N DDWD,DDWI,DDWNXT,DDWSP,DDWX1,DDWX2
122 . S DDWD=0 F D Q:DDWD
123 .. S DDWX1=DDWT(DDWJ),(DDWX2,DDWT(DDWJ+1))=$$LD(DDWT(DDWJ+1))
124 .. I DDWX2="" S DDWD=1 Q
125 .. S DDWNXT=$P(DDWX2," "),DDWI=$L(DDWNXT)
126 .. I $E(DDWX2,DDWI+2)=" ",$E(DDWX2,DDWI+3,999)'?." " D
127 ... F DDWI=DDWI+2:1 Q:$E(DDWX2,DDWI+1)'=" "
128 .. S DDWSP=DDWX1'?.E1" "
129 .. I $L(DDWX1)+DDWSP+$L($E(DDWX2,1,DDWI))>DDWW S DDWD=1 Q
130 .. S DDWT(DDWJ)=DDWX1_$E(" ",DDWSP)_$E(DDWX2,1,DDWI)
131 .. S DDWT(DDWJ+1)=$$LD($E(DDWX2,DDWI+1,999))
132 . ;
133 . I DDWT(DDWJ+1)="" D
134 .. D AMSHIFT(.DDWT,DDWJ+1)
135 . E D AMINCJ
136 Q
137 ;
138AMSHIFT(DDWT,DDWJ) ;Delete DDWT(DDWJ) and shift up
139 N DDWI
140 F DDWI=DDWJ:1:$O(DDWT(""),-1)-1 S DDWT(DDWI)=DDWT(DDWI+1)
141 K DDWT($O(DDWT(""),-1))
142 Q
143 ;
144AMINCJ ;Incr DDWJ
145 I DDWJ=1,$G(DDWFLG)["I" S DDWW=DDWRMAR-DDWLMAR+1
146 S DDWJ=DDWJ+1
147 Q
148 ;
149SLICE(DDWN,DDWW,DDWFST,DDWRST) ;
150 ;Out: DDWFST=first part of text, $L<=DDWRMAR
151 ; DDWRST=remaining part (lead blanks removed)
152 N DDWI,DDWP,DDWX
153 S:'$G(DDWW) DDWW=DDWRMAR
154 I 'DDWRAP S DDWFST=$E(DDWN,1,DDWW),DDWLST=$E(DDWN,DDWW+1,999) Q
155 ;
156 ;Set DDWI to column # at which to break
157 S DDWX=$E(DDWN,1,DDWW),DDWI=DDWW
158 I DDWX'[" "
159 E I DDWX?." "
160 E I $E(DDWX,DDWW)=" ",$E(DDWN,DDWW+1)'=" "
161 E D
162 . F DDWP=$L(DDWX," "):-1:0 Q:$P(DDWX," ",DDWP)]""
163 . Q:DDWP=1
164 . S DDWI=$L($P(DDWX," ",1,DDWP-1))+1
165 . S:DDWI'>$S(DDWW=DDWRMAR:DDWLMAR,1:1) DDWI=DDWW
166 ;
167 S DDWFST=$E(DDWN,1,DDWI),DDWRST=$$LD($E(DDWN,DDWI+1,999))
168 Q
169 ;
170TR(X) Q:$G(X)="" X
171 N I
172 F I=$L(X):-1:0 Q:$E(X,I)'=" "
173 Q $E(X,1,I)
174 ;
175LD(X) Q:$G(X)="" X
176 N I
177 F I=1:1:$L(X)+1 Q:$E(X,I)'=" "
178 Q $E(X,I,999)
179 ;
180CUP(Y,X) ;
181 S DY=IOTM+Y-2,DX=X-1 X IOXY
182 Q
183 ;
184POS(R,C,F) ;Pos cursor
185 N DDWX
186 S:$G(C)="E" C=$L($G(DDWL(R)))+1
187 S:$G(F)["N" DDWN=$G(DDWL(R))
188 S:$G(F)["R" DDWRW=R,DDWC=C
189 ;
190 S DDWX=C-DDWOFS
191 I DDWX>IOM!(DDWX<1) D SHIFT^DDW3(C,.DDWOFS)
192 S DY=IOTM+R-2,DX=C-DDWOFS-1 X IOXY
193 Q
194 ;
195SCR(C) ;Screen number
196 Q C-$P(DDWOFS,U,2)-1\$P(DDWOFS,U,3)+1
197 ;
198MIN(X,Y) ;
199 Q $S(X<Y:X,1:Y)
200MAX(X,Y) ;
201 Q $S(X>Y:X,1:Y)
Note: See TracBrowser for help on using the repository browser.