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

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

initial load of WorldVistAEHR
File size: 4.2 KB
RevLine 
[613]1DDW8 ;SFISC/MKO-COPY, CUT, PASTE ;2:15 PM 5 Jul 1996
2 ;;22.0;VA FileMan;;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5CUT() ;Cut selected text
6 N DDWADJ,DDWC1,DDWC2,DDWCSV,DDWISIN,DDWNDEL,DDWR1,DDWR2,DDWRSV
7 I '$D(DDWMARK) D ERR("No text selected.") Q
8 ;
9 S DDWED=1
10 S DDWISIN=$$ISINSEL()
11 D PMARK(DDWMARK,.DDWR1,.DDWC1,.DDWR2,.DDWC2)
12 D COPYBUF
13 ;
14 S DDWRSV=DDWRW,DDWCSV=DDWC
15 I DDWR2>DDWA,DDWR2-DDWA<DDWRW S DDWADJ=1
16 E I DDWR1-DDWA'>DDWMR,DDWR1-DDWA>DDWRW S DDWADJ=0
17 ;
18 D DELBLK^DDW9(.DDWNDEL)
19 D:$D(DDWADJ) POS(DDWRSV-(DDWADJ*DDWNDEL),DDWCSV,"RN")
20 D:'DDWISIN PASTE()
21 Q
22 ;
23COPY() ;Copy selected text
24 N DDWC1,DDWC2,DDWISIN,DDWR1,DDWR2
25 I '$D(DDWMARK) D ERR("No text selected.") Q
26 ;
27 S DDWISIN=$$ISINSEL()
28 D PMARK(DDWMARK,.DDWR1,.DDWC1,.DDWR2,.DDWC2)
29 D COPYBUF
30 D UNMARK^DDW7
31 D:'DDWISIN PASTE()
32 Q
33 ;
34COPYBUF ;Copy selected text to buffer
35 N DDWND,DDWI,DDWX,DDWX1,DDWX2
36 K ^TMP("DDWB",$J)
37 S DDWND=0
38 ;
39 D:DDWR2-DDWR1>50 MSG^DDW("Copying text to buffer ...")
40 ;
41 F DDWI=DDWR1:1:$$MIN(DDWA,DDWR2) D
42 . S DDWND=DDWND+1
43 . S DDWX=^TMP("DDW",$J,DDWI)
44 . S DDWX=$E(DDWX,$S(DDWI=DDWR1:DDWC1,1:1),$S(DDWI=DDWR2:DDWC2,1:999))
45 . S ^TMP("DDWB",$J,DDWND)=DDWX
46 ;
47 F DDWI=$$MAX(DDWR1-DDWA,1):1:$$MIN(DDWR2-DDWA,DDWMR) D
48 . S DDWX=$E(DDWL(DDWI),$S(DDWI+DDWA=DDWR1:DDWC1,1:1),$S(DDWI+DDWA=DDWR2:DDWC2,1:999))
49 . S DDWND=DDWND+1
50 . S ^TMP("DDWB",$J,DDWND)=DDWX
51 ;
52 S DDWX1=$$RTOSTB(DDWR1),DDWX2=$$RTOSTB(DDWR2)
53 F DDWI=$$MIN(DDWSTB,DDWX1):-1:DDWX2 D
54 . S DDWND=DDWND+1
55 . S DDWX=^TMP("DDW1",$J,DDWI)
56 . S DDWX=$E(DDWX,$S(DDWI=DDWX1:DDWC1,1:1),$S(DDWI=DDWX2:DDWC2,1:999))
57 . S ^TMP("DDWB",$J,DDWND)=DDWX
58 ;
59 D:DDWR2-DDWR1>50 MSG^DDW()
60 Q
61 ;
62PASTE() ;Paste text
63 I $D(DDWMARK) D ERR("You curently have text selected.") Q
64 I '$D(^TMP("DDWB",$J)) D ERR("The buffer contains no text.") Q
65 ;
66 S DDWED=1
67 N DDWBSIZ,DDWFC,DDWI,DDWLST,DDWNSV,DDWTXT,DDWX
68 S DDWBSIZ=$O(^TMP("DDWB",$J,""),-1)
69 ;
70 S DDWTXT=1
71 S:$L(DDWN)+1<DDWC DDWN=DDWN_$J("",DDWC-$L(DDWN)-1)
72 S (DDWNSV,DDWX)=$E(DDWN,1,DDWC-1)
73 S DDWTXT(1)=DDWX
74 I $L(DDWX)+$L(^TMP("DDWB",$J,1))<256!(DDWX="") S DDWTXT(1)=DDWTXT(1)_^(1)
75 E S DDWTXT=DDWTXT+1,DDWTXT(DDWTXT)=^TMP("DDWB",$J,1)
76 ;
77 S DDWLST=$E(DDWN,DDWC,999)
78 I DDWRAP,DDWLST?1." " S DDWLST=""
79 I DDWLST]"",DDWBSIZ=1 S DDWTXT=DDWTXT+1,DDWTXT(DDWTXT)=DDWLST,DDWLST=""
80 ;
81 D:DDWTXT ADJMAR^DDW6(.DDWTXT,"","I")
82 S (DDWN,DDWL(DDWRW))=DDWTXT(1)
83 ;
84 I DDWBSIZ=1,DDWTXT=1 S DDWFC=$L(DDWNSV)+$L(^TMP("DDWB",$J,1))+1
85 E I DDWBSIZ=1,DDWTXT=2,DDWLST="" S DDWFC=$L(DDWTXT(2))+1
86 E S DDWFC=1
87 ;
88 I $$SCR(DDWFC)=$P(DDWOFS,U,4) D
89 . D POS(DDWRW,$$MIN($L(DDWNSV),$L(DDWN))+1)
90 . W $P(DDGLCLR,DDGLDEL)_$E(DDWN,$L(DDWNSV)+1,IOM+DDWOFS)
91 ;
92 D POS(DDWRW,DDWFC,"R")
93 ;
94 F DDWI=2:1:DDWTXT D
95 . D ILINE^DDW5
96 . S (DDWN,DDWL(DDWRW))=DDWTXT(DDWI)
97 . D CUP(DDWRW,1)
98 . W $E(DDWN,1+DDWOFS,IOM+DDWOFS)
99 ;
100 F DDWI=2:1:DDWBSIZ D
101 . D ILINE^DDW5
102 . S (DDWN,DDWL(DDWRW))=^TMP("DDWB",$J,DDWI)
103 . D CUP(DDWRW,1)
104 . W $E(DDWN,1+DDWOFS,IOM+DDWOFS)
105 ;
106 I DDWLST]"" D
107 . D ILINE^DDW5
108 . S (DDWN,DDWL(DDWRW))=DDWLST
109 . D CUP(DDWRW,1)
110 . W $E(DDWN,1+DDWOFS,IOM+DDWOFS)
111 ;
112 D POS(DDWRW,DDWFC,"RN")
113 Q
114 ;
115CUP(Y,X) ;
116 S DY=IOTM+Y-2,DX=X-1 X IOXY
117 Q
118 ;
119POS(R,C,F) ;Pos cursor based on char pos C
120 N DDWX
121 S:$G(C)="E" C=$L($G(DDWL(R)))+1
122 S:$G(F)["N" DDWN=$G(DDWL(R))
123 S:$G(F)["R" DDWRW=R,DDWC=C
124 ;
125 S DDWX=C-DDWOFS
126 I DDWX>IOM!(DDWX<1) D SHIFT^DDW3(C,.DDWOFS)
127 S DY=IOTM+R-2,DX=C-DDWOFS-1 X IOXY
128 Q
129 ;
130ISINSEL() ;Is the cursor within the selected text
131 N DDWI,DDWY
132 S DDWI=DDWRW+DDWA,DDWY=0
133 I DDWI<$P(DDWMARK,U)
134 E I DDWI>$P(DDWMARK,U,3)
135 E I DDWI=$P(DDWMARK,U),DDWC<$P(DDWMARK,U,2)
136 E I DDWI=$P(DDWMARK,U,3),DDWC-1>$P(DDWMARK,U,4)
137 E S DDWY=1
138 Q DDWY
139 ;
140PMARK(M,R1,C1,R2,C2) ;Parse M (DDWMARK)
141 S R1=$P(M,U),C1=$P(M,U,2)
142 S R2=$P(M,U,3),C2=$P(M,U,4)
143 Q
144 ;
145ERR(DDWX) ;
146 D MSG^DDW($C(7)_DDWX) H 2 D MSG^DDW()
147 D CUP(DDWRW,DDWC-DDWOFS)
148 F R *DDWX:0 E Q
149 Q
150 ;
151TR(X) ;Strip trailing blanks
152 Q:$G(X)="" X
153 N I
154 F I=$L(X):-1:0 Q:$E(X,I)'=" "
155 Q $E(X,1,I)
156 ;
157LD(X) ;Strip leading blanks
158 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 ;
163RTOSTB(R) ;Return node in STB given line #
164 Q DDWSTB+DDWA+DDWMR+1-R
165 ;
166SCR(C) ;Return screen number
167 Q C-$P(DDWOFS,U,2)-1\$P(DDWOFS,U,3)+1
168 ;
169MIN(X,Y) ;
170 Q $S(X<Y:X,1:Y)
171 ;
172MAX(X,Y) ;
173 Q $S(X>Y:X,1:Y)
Note: See TracBrowser for help on using the repository browser.