Annotation of freem_fileman/DDGFEL.m, revision 1.1.1.1
1.1 snw 1: DDGFEL ;SFISC/MKO-SELECT OR EDIT ELEMENT ;02:53 PM 12 Oct 1994
2: ;;21.0;VA FileMan;;Dec 28, 1994
3: ;Per VHA Directive 10-93-142, this routine should not be modified.
4: ;
5: SELECT ;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: ;
19: EDIT ;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" W $C(7) S X=C
37: . S:X["^" X=C
38: . S C3=C2+$L(X)-1
39: . ;
40: . S @DDGFREF@("RC",DDGFWID,C1,C2,C3,B,F,"C")=""
41: . D WRITE^DDGLIBW(DDGFWID,X,C1-P1,C2-P2)
42: . I $L(X)<$L(C) D REPAINT^DDGLIBW(DDGFWID,(C1-P1)_U_(C3+1-P2)_U_1_U_($L(C)-$L(X)))
43: . S $P(@DDGFREF@("F",DDGFPG,B,F),U,1,4)=C1_U_C2_U_C3_U_X,$P(^(F),U,9)=1
44: ;
45: I T="D" D
46: . K C,C1,C2,C3
47: . S $P(@DDGFREF@("F",DDGFPG,B,F),U,5,8)=""
48: . K @DDGFREF@("RC",DDGFWID,D1,D2,D3,B,F)
49: . D COVER,^DDGFADL
50: . ;
51: . S $P(@DDGFREF@("F",DDGFPG,B,F),U,5,8)=D1_U_D2_U_D3_U_L,$P(^(F),U,9)=1
52: . S @DDGFREF@("RC",DDGFWID,D1,D2,D3,B,F,"D")=""
53: . D WRITE^DDGLIBW(DDGFWID,D,D1-P1,D2-P2)
54: ;
55: D RC(DY,DX)
56: Q
57: ;
58: GETELEM(DY,DX) ;Which element is the cursor on
59: ;Returns P,B,F,T,C,C1,C2,C3,D,D1,D2,D3,L,P1,P2
60: ;If on pop-up page border, return only B="P",F="P",T="PTOP" or "PBRC"
61: ;Set P=page,B=Block,F=DDO,T=type ("D" or "C")
62: ;If cursor is not on anything, $G(F)=""
63: ;
64: Q:'$D(@DDGFREF@("RC",DDGFWID,DY))
65: N X1,X2,F1
66: S X1="" K F
67: F S X1=$O(@DDGFREF@("RC",DDGFWID,DY,X1)) Q:X1=""!(DX<X1) D
68: . S X2=""
69: . F S X2=$O(@DDGFREF@("RC",DDGFWID,DY,X1,X2)) Q:X2="" D Q:$G(F)
70: .. Q:DX>X2
71: .. S B=$O(@DDGFREF@("RC",DDGFWID,DY,X1,X2,""))
72: .. S F=$O(@DDGFREF@("RC",DDGFWID,DY,X1,X2,B,""))
73: .. S T=$O(@DDGFREF@("RC",DDGFWID,DY,X1,X2,B,F,""))
74: Q:"P"[$G(F)
75: ;
76: S P1=$P(DDGFLIM,U),P2=$P(DDGFLIM,U,2)
77: S F1=$G(@DDGFREF@("F",DDGFPG,B,F))
78: ;
79: ;Get caption, data, and coordinates
80: S C1=$P(F1,U),C2=$P(F1,U,2),C3=$P(F1,U,3),C=$P(F1,U,4)
81: I $P(F1,U,8)]"" D
82: . S D1=$P(F1,U,5),D2=$P(F1,U,6),D3=$P(F1,U,7)
83: . S L=$P(F1,U,8),D=$TR($J("",L)," ","_")
84: Q
85: ;
86: COVER ;Look for covered (hidden) fields
87: ;Input:
88: ; T,C,C1,C2,P1,P2
89: ;H(DDO) - array of hidden fields
90: ;Erase the element we've selected from buffer
91: ;Redraw the element(s) that were covered
92: N H,O,X1,X2,Y
93: F Y="C1","D1" D
94: . I Y="C1",T'="C" Q
95: . I Y="D1",'$D(D) Q
96: . S X1=""
97: . F S X1=$O(@DDGFREF@("RC",DDGFWID,@Y,X1)) Q:X1="" D
98: .. S X2=""
99: .. F S X2=$O(@DDGFREF@("RC",DDGFWID,@Y,X1,X2)) Q:X2="" D
100: ... N B
101: ... S B=$O(@DDGFREF@("RC",DDGFWID,@Y,X1,X2,""))
102: ... S O=$O(@DDGFREF@("RC",DDGFWID,@Y,X1,X2,B,""))
103: ... I O]"",$D(H(O))[0 D
104: .... I T="C",$$OVERLAP(C2,C3,X1,X2) S H(O)=DDGFPG_U_B
105: .... E I $D(D),$$OVERLAP(D2,D3,X1,X2) S H(O)=DDGFPG_U_B
106: ;
107: ;Clear in buffer area occupied by element(s) selected
108: D:T="C" CLEAR(C,C1,C2,C3)
109: D:$D(D) CLEAR(D,D1,D2,D3)
110: ;
111: ;Write to buffer the overlapped field(s)
112: I $D(H) S H="" F S H=$O(H(H)) Q:H="" D
113: . S O=$G(@DDGFREF@("F",$P(H(H),U),$P(H(H),U,2),H)) Q:O=""
114: . D WRITE^DDGLIBW(DDGFWID,$P(O,U,4),$P(O,U)-P1,$P(O,U,2)-P2,"",1)
115: . 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)
116: Q
117: ;
118: OVERLAP(A1,A2,B1,B2) ;Does line with X-coords A1,A2 overlap B1,B2
119: N T
120: I A1<B1 S T=A1,A1=B1,B1=T,T=A2,A2=B2,B2=T
121: Q A1'<B1&(A1'>B2)!(A2'<B1&(A2'>B2))
122: ;
123: RC(DDGFY,DDGFX) ;Update status line, reset DX and DY, move cursor
124: N S
125: I DDGFR D
126: . S DY=IOSL-6,DX=IOM-9,S="R"_(DDGFY+1)_",C"_(DDGFX+1)
127: . X IOXY W S_$J("",7-$L(S))
128: S DY=DDGFY,DX=DDGFX X IOXY
129: Q
130: ;
131: CLEAR(C,C1,C2,C3) ;Clear in buffer area occupied by element(s) selected
132: ;If on the page border, redraw the lines
133: N L
134: S L=$J("",$L(C)-$S(C3>$P(DDGFLIM,U,4):C3-$P(DDGFLIM,U,4),1:0))
135: D WRITE^DDGLIBW(DDGFWID,L,C1-$P(DDGFLIM,U),C2-$P(DDGFLIM,U,2),"",1)
136: ;
137: I $P(@DDGFREF@("F",DDGFPG),U,3) D
138: . I C1=$P(DDGFLIM,U)!(C1=$P(DDGFLIM,U,3)) D
139: .. S L=$TR(L," ",$P(DDGLGRA,DDGLDEL,3))
140: .. S:C2=$P(DDGFLIM,U,2) $E(L)=$P(DDGLGRA,DDGLDEL,$S(C1=$P(DDGFLIM,U):5,1:7))
141: .. S:C3'<$P(DDGFLIM,U,4) $E(L,$L(L))=$P(DDGLGRA,DDGLDEL,$S(C1=$P(DDGFLIM,U):6,1:8))
142: .. D WRITE^DDGLIBW(DDGFWID,L,C1-$P(DDGFLIM,U),C2-$P(DDGFLIM,U,2),"G",1)
143: . E I C2=$P(DDGFLIM,U,2) D
144: .. D WRITE^DDGLIBW(DDGFWID,$P(DDGLGRA,DDGLDEL,4),C1-$P(DDGFLIM,U),C2-$P(DDGFLIM,U,2),"G",1)
145: . E I C3'<$P(DDGFLIM,U,4) D
146: .. D WRITE^DDGLIBW(DDGFWID,$P(DDGLGRA,DDGLDEL,4),C1-$P(DDGFLIM,U),$P(DDGFLIM,U,4)-$P(DDGFLIM,U,2),"G",1)
147: Q
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to DDGFEL.m CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Coherent Logic Development] / freem_fileman