source: WorldVistAEHR/trunk/r/VA_FILEMAN-ARJT-DI-DD-DM-DT-%DT-%RCR/DDGFEL.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.8 KB
Line 
1DDGFEL ;SFISC/MKO-SELECT OR EDIT ELEMENT ;07:25 AM 7 Aug 1995
2 ;;22.0;VA FileMan;;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5SELECT ;Select an element
6 N B,F,T,C,C1,C2,C3,D,D1,D2,D3,L,P1,P2
7 D GETELEM(DY,DX) Q:$G(F)=""
8 ;
9 I F="P" G ^DDGFAPC
10 ;
11 ;Clear and/or kill portions of DDGFREF
12 S:T="D" $P(@DDGFREF@("F",DDGFPG,B,F),U,5,8)=""
13 K:T="C" @DDGFREF@("RC",DDGFWID,C1,C2,C3,B,F,"C"),@DDGFREF@("F",DDGFPG,B,F)
14 K:$D(D) @DDGFREF@("RC",DDGFWID,D1,D2,D3,B,F,"D")
15 ;
16 D COVER
17 G ^DDGF2
18 ;
19EDIT ;Edit a caption or data length
20 N B,F,T,C,C1,C2,C3,D,D1,D2,D3,L,P1,P2,X,Y
21 D GETELEM(DY,DX) Q:"P"[$G(F)
22 ;
23 S DDGFCHG=1
24 I T="C" D
25 . K D,D1,D2,D3,L
26 . S $P(@DDGFREF@("F",DDGFPG,B,F),U,1,4)="^^^"
27 . K @DDGFREF@("RC",DDGFWID,C1,C2,C3,B,F,"C")
28 . D COVER
29 . D
30 .. N DX,DY
31 .. S DY=IOSL-6,DX=IOM-9 X IOXY W "EDIT "
32 . ;
33 . N DDGFCOD,DDGFX
34 . D EN^DIR0(C1,C2,$L(C),1,C,"","","","KWT",.DDGFX,.DDGFCOD)
35 . S X=DDGFX
36 . I $P(DDGFCOD,U)="TO"!(X="!M") W $C(7) S X=C
37 . E I X["^" S X=C
38 . E X $P(^DD(.4044,1,0),U,5,999) I '$D(X) W $C(7) S X=C
39 . S C3=C2+$L(X)-1
40 . ;
41 . S @DDGFREF@("RC",DDGFWID,C1,C2,C3,B,F,"C")=""
42 . D WRITE^DDGLIBW(DDGFWID,X,C1-P1,C2-P2)
43 . I $L(X)<$L(C) D REPAINT^DDGLIBW(DDGFWID,(C1-P1)_U_(C3+1-P2)_U_1_U_($L(C)-$L(X)))
44 . S $P(@DDGFREF@("F",DDGFPG,B,F),U,1,4)=C1_U_C2_U_C3_U_X,$P(^(F),U,9)=1
45 ;
46 I T="D" D
47 . K C,C1,C2,C3
48 . S $P(@DDGFREF@("F",DDGFPG,B,F),U,5,8)=""
49 . K @DDGFREF@("RC",DDGFWID,D1,D2,D3,B,F)
50 . D COVER,^DDGFADL
51 . ;
52 . S $P(@DDGFREF@("F",DDGFPG,B,F),U,5,8)=D1_U_D2_U_D3_U_L,$P(^(F),U,9)=1
53 . S @DDGFREF@("RC",DDGFWID,D1,D2,D3,B,F,"D")=""
54 . D WRITE^DDGLIBW(DDGFWID,D,D1-P1,D2-P2)
55 ;
56 D RC(DY,DX)
57 Q
58 ;
59GETELEM(DY,DX) ;Which element is the cursor on
60 ;Returns P,B,F,T,C,C1,C2,C3,D,D1,D2,D3,L,P1,P2
61 ;If on pop-up page border, return only B="P",F="P",T="PTOP" or "PBRC"
62 ;Set P=page,B=Block,F=DDO,T=type ("D" or "C")
63 ;If cursor is not on anything, $G(F)=""
64 ;
65 Q:'$D(@DDGFREF@("RC",DDGFWID,DY))
66 N X1,X2,F1
67 S X1="" K F
68 F S X1=$O(@DDGFREF@("RC",DDGFWID,DY,X1)) Q:X1=""!(DX<X1) D
69 . S X2=""
70 . F S X2=$O(@DDGFREF@("RC",DDGFWID,DY,X1,X2)) Q:X2="" D Q:$G(F)
71 .. Q:DX>X2
72 .. S B=$O(@DDGFREF@("RC",DDGFWID,DY,X1,X2,""))
73 .. S F=$O(@DDGFREF@("RC",DDGFWID,DY,X1,X2,B,""))
74 .. S T=$O(@DDGFREF@("RC",DDGFWID,DY,X1,X2,B,F,""))
75 Q:"P"[$G(F)
76 ;
77 S P1=$P(DDGFLIM,U),P2=$P(DDGFLIM,U,2)
78 S F1=$G(@DDGFREF@("F",DDGFPG,B,F))
79 ;
80 ;Get caption, data, and coordinates
81 S C1=$P(F1,U),C2=$P(F1,U,2),C3=$P(F1,U,3),C=$P(F1,U,4)
82 I $P(F1,U,8)]"" D
83 . S D1=$P(F1,U,5),D2=$P(F1,U,6),D3=$P(F1,U,7)
84 . S L=$P(F1,U,8),D=$TR($J("",L)," ","_")
85 Q
86 ;
87COVER ;Look for covered (hidden) fields
88 ;Input:
89 ; T,C,C1,C2,P1,P2
90 ;H(DDO) - array of hidden fields
91 ;Erase the element we've selected from buffer
92 ;Redraw the element(s) that were covered
93 N H,O,X1,X2,Y
94 F Y="C1","D1" D
95 . I Y="C1",T'="C" Q
96 . I Y="D1",'$D(D) Q
97 . S X1=""
98 . F S X1=$O(@DDGFREF@("RC",DDGFWID,@Y,X1)) Q:X1="" D
99 .. S X2=""
100 .. F S X2=$O(@DDGFREF@("RC",DDGFWID,@Y,X1,X2)) Q:X2="" D
101 ... N B
102 ... S B=$O(@DDGFREF@("RC",DDGFWID,@Y,X1,X2,""))
103 ... S O=$O(@DDGFREF@("RC",DDGFWID,@Y,X1,X2,B,""))
104 ... I O]"",$D(H(O))[0 D
105 .... I T="C",$$OVERLAP(C2,C3,X1,X2) S H(O)=DDGFPG_U_B
106 .... E I $D(D),$$OVERLAP(D2,D3,X1,X2) S H(O)=DDGFPG_U_B
107 ;
108 ;Clear in buffer area occupied by element(s) selected
109 D:T="C" CLEAR(C,C1,C2,C3)
110 D:$D(D) CLEAR(D,D1,D2,D3)
111 ;
112 ;Write to buffer the overlapped field(s)
113 I $D(H) S H="" F S H=$O(H(H)) Q:H="" D
114 . S O=$G(@DDGFREF@("F",$P(H(H),U),$P(H(H),U,2),H)) Q:O=""
115 . D WRITE^DDGLIBW(DDGFWID,$P(O,U,4),$P(O,U)-P1,$P(O,U,2)-P2,"",1)
116 . I $P(O,U,8)>0 D WRITE^DDGLIBW(DDGFWID,$TR($J("",$P(O,U,8))," ","_"),$P(O,U,5)-P1,$P(O,U,6)-P2,"",1)
117 Q
118 ;
119OVERLAP(A1,A2,B1,B2) ;Does line with X-coords A1,A2 overlap B1,B2
120 N T
121 I A1<B1 S T=A1,A1=B1,B1=T,T=A2,A2=B2,B2=T
122 Q A1'<B1&(A1'>B2)!(A2'<B1&(A2'>B2))
123 ;
124RC(DDGFY,DDGFX) ;Update status line, reset DX and DY, move cursor
125 N S
126 I DDGFR D
127 . S DY=IOSL-6,DX=IOM-9,S="R"_(DDGFY+1)_",C"_(DDGFX+1)
128 . X IOXY W S_$J("",7-$L(S))
129 S DY=DDGFY,DX=DDGFX X IOXY
130 Q
131 ;
132CLEAR(C,C1,C2,C3) ;Clear in buffer area occupied by element(s) selected
133 ;If on the page border, redraw the lines
134 N L
135 S L=$J("",$L(C)-$S(C3>$P(DDGFLIM,U,4):C3-$P(DDGFLIM,U,4),1:0))
136 D WRITE^DDGLIBW(DDGFWID,L,C1-$P(DDGFLIM,U),C2-$P(DDGFLIM,U,2),"",1)
137 ;
138 I $P(@DDGFREF@("F",DDGFPG),U,3) D
139 . I C1=$P(DDGFLIM,U)!(C1=$P(DDGFLIM,U,3)) D
140 .. S L=$TR(L," ",$P(DDGLGRA,DDGLDEL,3))
141 .. S:C2=$P(DDGFLIM,U,2) $E(L)=$P(DDGLGRA,DDGLDEL,$S(C1=$P(DDGFLIM,U):5,1:7))
142 .. S:C3'<$P(DDGFLIM,U,4) $E(L,$L(L))=$P(DDGLGRA,DDGLDEL,$S(C1=$P(DDGFLIM,U):6,1:8))
143 .. D WRITE^DDGLIBW(DDGFWID,L,C1-$P(DDGFLIM,U),C2-$P(DDGFLIM,U,2),"G",1)
144 . E I C2=$P(DDGFLIM,U,2) D
145 .. D WRITE^DDGLIBW(DDGFWID,$P(DDGLGRA,DDGLDEL,4),C1-$P(DDGFLIM,U),C2-$P(DDGFLIM,U,2),"G",1)
146 . E I C3'<$P(DDGFLIM,U,4) D
147 .. D WRITE^DDGLIBW(DDGFWID,$P(DDGLGRA,DDGLDEL,4),C1-$P(DDGFLIM,U),$P(DDGFLIM,U,4)-$P(DDGFLIM,U,2),"G",1)
148 Q
Note: See TracBrowser for help on using the repository browser.