source: WorldVistAEHR/trunk/r/VA_FILEMAN-ARJT-DI-DD-DM-DT-%DT-%RCR/DDW5.m@ 1806

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

initial load of WorldVistAEHR
File size: 4.7 KB
RevLine 
[613]1DDW5 ;SFISC/PD KELTZ-WRAP, BREAK, ILINE, XLINE ;01:23 PM 21 Dec 1994
2 ;;22.0;VA FileMan;;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5WRAP ;Wrap at word boundary
6 S:$E(DDWN,DDWC,999)?1." " (DDWN,DDWL(DDWRW))=$E(DDWN,1,DDWC-1)
7 I DDWC'>$L(DDWN) D WRAPI Q
8 I 'DDWRAP D POS(DDWRW,DDWRMAR+1,"R"),BREAK(1) Q
9 D WRAPW
10 Q
11 ;
12WRAPI ;Cursor in middle
13 I $E(DDWN,DDWLMAR,999)'[" "!'DDWRAP D BREAK(-1),POS(DDWRW-1,"E","RN") Q
14 N DDWCSV,DDWI,DDWLST,DDWRMSV
15 S DDWI=$F(DDWN," ",DDWC)
16 I DDWI,DDWI-2'>DDWRMAR D
17 . S DDWCSV=DDWC
18 . S (DDWN,DDWL(DDWRW))=$$TR(DDWN)
19 . D POS(DDWRW,DDWI,"R"),BREAK(-1),POS(DDWRW-1,DDWCSV,"RN")
20 . S (DDWN,DDWL(DDWRW))=$$TR(DDWN)
21 E I DDWC=2 D
22 . D POS(DDWRW,DDWRMAR+1,"R"),BREAK(-1),POS(DDWRW-1,2,"RN")
23 E D
24 . S DDWLST=$$TR($E(DDWN,DDWC,999))
25 . S (DDWL(DDWRW),DDWN)=$E(DDWN,1,DDWC-1)
26 . S DDWRMSV=DDWRMAR,DDWRMAR=$$MIN(DDWRMAR,DDWC-2)
27 . D WRAPW
28 . W $E(DDWLST,1,IOM+DDWOFS-DDWC)
29 . S DDWL(DDWRW)=DDWN_DDWLST,DDWRMAR=DDWRMSV
30 . D POS(DDWRW,DDWC,"RN")
31 Q
32 ;
33WRAPW ;Cursor at end
34 N DDWI,DDWS1,DDWS2,DDWTXT
35 S DDWTXT(1)=DDWN
36 D ADJMAR^DDW6(.DDWTXT,"","I")
37 ;
38 S DDWS1=$$SCR($L(DDWTXT(1))+1),DDWS2=$$SCR($L(DDWTXT(DDWTXT))+1)
39 I DDWS1=$P(DDWOFS,U,4),DDWS2=$P(DDWOFS,U,4),DDWTXT=2 D
40 . S (DDWN,DDWL(DDWRW))=DDWTXT(1)_DDWTXT(2)
41 . S DDWC=$L(DDWTXT(1))+1
42 . D POS(DDWRW,DDWC),BREAK(1)
43 ;
44 E D
45 . F DDWI=1:1:DDWTXT-1 D
46 .. S (DDWN,DDWL(DDWRW))=DDWTXT(DDWI)
47 .. D ILINE
48 .. S (DDWN,DDWL(DDWRW))=DDWTXT(DDWI+1)
49 .. I DDWS2=$P(DDWOFS,U,4) D
50 ... D CUP(DDWRW-1,1)
51 ... W $P(DDGLCLR,DDGLDEL)_$E(DDWTXT(DDWI),1+DDWOFS,IOM+DDWOFS)
52 ... D CUP(DDWRW,1) W $E(DDWN,1+DDWOFS,IOM+DDWOFS)
53 . D POS(DDWRW,"E","R")
54 Q
55 ;
56BREAK(DDWFLAG) ;Break line, make new line current
57 ;Final cursor position:
58 ; 0:lmar of new line (used by <RET>)
59 ; 1:end of new line (used by Wrap)
60 ;-1:doesn't matter (used by Wrap)
61 N DDWRST
62 I $D(DDWMARK),DDWRW+DDWA'>$P(DDWMARK,U,3) D UNMARK^DDW7
63 S DDWRST=$E(DDWN,DDWC,999)
64 I DDWLMAR>1,DDWRST'?@(DDWLMAR-1_""" "".E") D
65 . S DDWRST=$J("",DDWLMAR-1)_$$LD(DDWRST)
66 S (DDWN,DDWL(DDWRW))=$E(DDWN,1,DDWC-1)
67 W $P(DDGLCLR,DDGLDEL)
68 D ILINE
69 S (DDWN,DDWL(DDWRW))=DDWRST
70 ;
71 I $G(DDWFLAG)=1 D
72 . I $$SCR($L(DDWN)+1)=$P(DDWOFS,U,4) D
73 .. D CUP(DDWRW,1) W $E(DDWN,1+DDWOFS,IOM+DDWOFS)
74 . D POS(DDWRW,"E","R")
75 ;
76 E I '$G(DDWFLAG) D
77 . I $P(DDWOFS,U,4)=1 D CUP(DDWRW,1) W $E(DDWN,1,IOM)
78 . D POS(DDWRW,DDWLMAR,"R")
79 ;
80 E D CUP(DDWRW,1) W $E(DDWN,1+DDWOFS,IOM+DDWOFS)
81 Q
82 ;
83ILINE ;Insert line below current line, make that current
84 ;Column is unchanged
85 N DDWI,DDWX
86 I DDWRW<DDWMR D
87 . I DDWA+DDWMR'>DDWCNT D
88 .. S DDWSTB=DDWSTB+1,^TMP("DDW1",$J,DDWSTB)=DDWL(DDWMR)
89 . F DDWI=DDWMR:-1:DDWRW+2 S DDWL(DDWI)=DDWL(DDWI-1)
90 . S DDWL(DDWRW+1)=""
91 . D CUP(DDWRW+1,1)
92 . ;
93 . I $P(DDGLED,DDGLDEL,3)]"" D
94 .. I $P(DDGLED,DDGLDEL,2)="" D
95 ... D CUP(DDWMR,1) W $P(DDGLED,DDGLDEL,4) D CUP(DDWRW+1,1)
96 .. W $P(DDGLED,DDGLDEL,3)
97 . E D
98 .. S DDWX=IOTM
99 .. S IOTM=IOTM+DDWRW W @$P(DDGLED,DDGLDEL,2) S IOTM=DDWX
100 .. D CUP(DDWRW+1,1) W $P(DDGLED,DDGLDEL)
101 .. W @$P(DDGLED,DDGLDEL,2)
102 . D POS(DDWRW+1,DDWC,"RN")
103 ;
104 E D
105 . S DDWA=DDWA+1,^TMP("DDW",$J,DDWA)=DDWL(1)
106 . F DDWI=1:1:DDWMR-1 S DDWL(DDWI)=DDWL(DDWI+1)
107 . S DDWL(DDWMR)=""
108 . D SCRUP^DDW3(1)
109 S DDWCNT=DDWCNT+1
110 S $E(DDWBF,1,3)=111
111 Q
112 ;
113XLINE(DDWFLAG,DDWNP) ;Delete current line
114 ;DDWFLAG:
115 ; 1:leave cursor on deleted line (used by Join)
116 ; 0:move cursor up one line if deleted line is last line
117 ; (used by PF1-D and DELBLK)
118 ; DDWNP = 1:don't bother printing, used by DELBLK
119 N DDWI,DDWX
120 I $D(DDWMARK),DDWRW+DDWA'>$P(DDWMARK,U,3) D UNMARK^DDW7
121 F DDWI=DDWRW:1:DDWMR-1 S DDWL(DDWI)=DDWL(DDWI+1)
122 S DDWX="" S:DDWSTB DDWX=^TMP("DDW1",$J,DDWSTB),DDWSTB=DDWSTB-1
123 S DDWL(DDWMR)=DDWX
124 ;
125 D:'$G(DDWNP) XLINEP
126 ;
127 S DDWCNT=DDWCNT-1
128 I 'DDWCNT D
129 . S DDWCNT=1 D POS(1,DDWLMAR,"RN")
130 E I DDWA+DDWRW>DDWCNT,'$G(DDWFLAG) D
131 . D UP^DDWT1
132 E D POS(DDWRW,DDWC,"N")
133 S $E(DDWBF,1,3)=111
134 Q
135 ;
136XLINEP ;Redisplay screen
137 I $P(DDGLED,DDGLDEL,4)]"" D
138 . W $P(DDGLED,DDGLDEL,4)
139 . I $P(DDGLED,DDGLDEL,2)="" D CUP(DDWMR,1) W $P(DDGLED,DDGLDEL,3)
140 E I DDWRW<DDWMR D
141 . S DDWX=IOTM
142 . S IOTM=IOTM+DDWRW-1 W @$P(DDGLED,DDGLDEL,2) S IOTM=DDWX
143 . D CUP(DDWMR,1) W $C(10)
144 . W @$P(DDGLED,DDGLDEL,2)
145 E D
146 . D CUP(DDWMR,1) W $P(DDGLCLR,DDGLDEL)
147 ;
148 I DDWL(DDWMR)'?." " D
149 . D CUP(DDWMR,1)
150 . W $E(DDWL(DDWMR),1+DDWOFS,IOM+DDWOFS)
151 Q
152 ;
153TR(X) Q:$G(X)="" X
154 N I
155 F I=$L(X):-1:0 Q:$E(X,I)'=" "
156 Q $E(X,1,I)
157 ;
158LD(X) Q:$G(X)="" X
159 N I
160 F I=1:1:$L(X)+1 Q:$E(X,I)'=" "
161 Q $E(X,I,999)
162 ;
163CUP(Y,X) ;
164 S DY=IOTM+Y-2,DX=X-1 X IOXY
165 Q
166 ;
167POS(R,C,F) ;
168 N DDWX
169 S:$G(C)="E" C=$L($G(DDWL(R)))+1
170 S:$G(F)["N" DDWN=$G(DDWL(R))
171 S:$G(F)["R" DDWRW=R,DDWC=C
172 ;
173 S DDWX=C-DDWOFS
174 I DDWX>IOM!(DDWX<1) D SHIFT^DDW3(C,.DDWOFS)
175 S DY=IOTM+R-2,DX=C-DDWOFS-1 X IOXY
176 Q
177 ;
178SCR(C) ;
179 Q C-$P(DDWOFS,U,2)-1\$P(DDWOFS,U,3)+1
180 ;
181MIN(X,Y) ;
182 Q $S(X<Y:X,1:Y)
Note: See TracBrowser for help on using the repository browser.