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

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

initial load of WorldVistAEHR
File size: 4.2 KB
Line 
1DDGF2 ;SFISC/MKO-ACTIONS FOR SELECTED FIELDS ;02:48 PM 12 Oct 1994
2 ;;22.0;VA FileMan;;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;Input:
5 ; B = internal block number
6 ; F = internal field order
7 ; T = type of element ("C" = caption, "D" = data)
8 ; C = caption
9 ; C1 = $Y of caption
10 ; C2 = $X of caption
11 ; D = data representation (underlines)
12 ; D1 = $Y of data
13 ; D2 = $X of data
14 ; L = length of data
15 ; P1 = page $Y
16 ; P2 = page $X
17 N DDGFE
18 S DDGFE=0,DDGFLSV=DDGFLIM
19 S DDGFLIM=$P(@DDGFREF@("F",DDGFPG,B),U,1,2)_U_$P(DDGFLIM,U,3,4)
20 ;
21 D PAINTS
22 S DDGFE=0 F S Y=$$READ W:$T(@Y)="" $C(7) D:$T(@Y)]"" @Y Q:DDGFE
23 D END
24 D:$G(DDGFSUBP) SUBPG1^DDGFPG
25 Q
26 ;
27END ;Redraw the field
28 S DDGFLIM=DDGFLSV K DDGFLSV
29 Q:$D(^DIST(.404,B,40,F,0))[0
30 ;
31 S C3=C2+$L(C)-1
32 I T="C",C]"" D
33 . D WRITE^DDGLIBW(DDGFWID,C,C1-P1,C2-P2)
34 . S @DDGFREF@("RC",DDGFWID,C1,C2,C3,B,F,"C")=""
35 ;
36 I $D(D) D
37 . S D3=D2+L-1
38 . D WRITE^DDGLIBW(DDGFWID,D,D1-P1,D2-P2)
39 . S @DDGFREF@("RC",DDGFWID,D1,D2,D3,B,F,"D")=""
40 ;
41 S @DDGFREF@("F",DDGFPG,B,F)=C1_U_C2_U_C3_U_C_U_$S($D(D):D1_U_D2_U_D3_U_L,1:"^^^")_U_1,DDGFCHG=1
42 X IOXY
43 Q
44 ;
45TO ;Time-out
46 W $C(7)
47 G DESELECT
48 ;
49DESELECT ;
50 S DDGFE=1
51 Q
52 ;
53LNU I T="C" Q:C1'>$P(DDGFLIM,U)
54 I $D(D),D1'>$P(DDGFLIM,U) Q
55 D REDRAW S:T="C" C1=C1-1
56 S:$D(D) D1=D1-1
57 S DY=DY-1
58 D PAINTS
59 Q
60LND I T="C" Q:C1'<$P(DDGFLIM,U,3)
61 I $D(D),D1'<$P(DDGFLIM,U,3) Q
62 D REDRAW
63 S:T="C" C1=C1+1
64 S:$D(D) D1=D1+1
65 S DY=DY+1
66 D PAINTS
67 Q
68CHR I T="C" Q:C2+$L(C)>$P(DDGFLIM,U,4)
69 I $D(D),D2+L>$P(DDGFLIM,U,4) Q
70 D REDRAW S:T="C" C2=C2+1
71 S:$D(D) D2=D2+1
72 S DX=DX+1
73 D PAINTS
74 Q
75CHL I T="C" Q:C2'>$P(DDGFLIM,U,2)
76 I $D(D),D2'>$P(DDGFLIM,U,2) Q
77 D REDRAW S:T="C" C2=C2-1
78 S:$D(D) D2=D2-1
79 S DX=DX-1
80 D PAINTS
81 Q
82TBR N X
83 I T="C" Q:C2+$L(C)>$P(DDGFLIM,U,4)
84 I $D(D),D2+L>$P(DDGFLIM,U,4) Q
85 D REDRAW
86 I T="C" D
87 . S X=$$MIN(5,$P(DDGFLIM,U,4)-(C2+$L(C)),$S($D(D):$P(DDGFLIM,U,4)-(D2+L)+1,1:""))
88 . S C2=C2+X
89 E S X=$$MIN(5,$P(DDGFLIM,U,4)-(D2+L)+1)
90 S:$D(D) D2=D2+X
91 S DX=DX+X
92 D PAINTS
93 Q
94TBL N X
95 I T="C" Q:C2'>$P(DDGFLIM,U,2)
96 I $D(D),D2'>$P(DDGFLIM,U,2) Q
97 D REDRAW
98 I T="C" D
99 . S X=$$MIN(5,C2-$P(DDGFLIM,U,2),$S($D(D):D2-$P(DDGFLIM,U,2),1:""))
100 . S C2=C2-X
101 E S X=$$MIN(5,D2-$P(DDGFLIM,U,2))
102 S:$D(D) D2=D2-X
103 S DX=DX-X
104 D PAINTS
105 Q
106SCT N Y
107 I T="C" Q:C1'>$P(DDGFLIM,U)
108 I $D(D),D1'>$P(DDGFLIM,U) Q
109 D REDRAW
110 I T="C" S Y=$S('$D(D):C1,C1<D1:C1,1:D1)-$P(DDGFLIM,U),C1=C1-Y
111 E S Y=D1-$P(DDGFLIM,U)
112 S:$D(D) D1=D1-Y
113 S DY=DY-Y
114 D PAINTS
115 Q
116SCB N Y
117 I T="C" Q:C1'<$P(DDGFLIM,U,3)
118 I $D(D),D1'<$P(DDGFLIM,U,3) Q
119 D REDRAW
120 I T="C" S Y=$P(DDGFLIM,U,3)-$S('$D(D):C1,C1>D1:C1,1:D1),C1=C1+Y
121 E S Y=$P(DDGFLIM,U,3)-D1
122 S:$D(D) D1=D1+Y
123 S DY=DY+Y
124 D PAINTS
125 Q
126SCR N X
127 I T="C" Q:C2+$L(C)>$P(DDGFLIM,U,4)
128 I $D(D),D2+L>$P(DDGFLIM,U,4) Q
129 D REDRAW
130 I T="C" D
131 . S X=$P(DDGFLIM,U,4)-$S('$D(D):C2+$L(C),C2+$L(C)>(D2+L):C2+$L(C),1:D2+L)+1
132 . S C2=C2+X
133 E S X=$P(DDGFLIM,U,4)-(D2+L)+1
134 S:$D(D) D2=D2+X
135 S DX=DX+X
136 D PAINTS
137 Q
138SCL N X
139 I T="C" Q:C2'>$P(DDGFLIM,U,2)
140 I $D(D),D2'>$P(DDGFLIM,U,2) Q
141 D REDRAW
142 I T="C" S X=$S('$D(D):C2,C2<D2:C2,1:D2)-$P(DDGFLIM,U,2),C2=C2-X
143 E S X=D2-$P(DDGFLIM,U,2)
144 S:$D(D) D2=D2-X
145 S DX=DX-X
146 D PAINTS
147 Q
148EDIT ;
149 G EDIT^DDGFFLD
150SUBPG ;
151 G SUBPG^DDGFPG
152 ;
153RC(DDGFY,DDGFX) ;Update status line, reset DX and DY, move cursor
154 N DDGFS
155 I DDGFR D
156 . S DY=IOSL-6,DX=IOM-9,DDGFS="R"_(DDGFY+1)_",C"_(DDGFX+1)
157 . X IOXY W DDGFS_$J("",7-$L(DDGFS))
158 S DY=DDGFY,DX=DDGFX X IOXY
159 Q
160 ;
161REDRAW ;
162 D:T="C" REPAINT^DDGLIBW(DDGFWID,(C1-P1)_U_(C2-P2)_U_1_U_$L(C))
163 D:$D(D) REPAINT^DDGLIBW(DDGFWID,(D1-P1)_U_(D2-P2)_U_1_U_L)
164 Q
165 ;
166PAINTS ;
167 N Y,X
168 S Y=DY,X=DX
169 I T="C" S DY=C1,DX=C2 X IOXY W $P(DDGLVID,DDGLDEL,6)_$E(C,1,$$MIN($L(C),$P(DDGFLIM,U,4)-C2+1))_$P(DDGLVID,DDGLDEL,10)
170 I $D(D) S DY=D1,DX=D2 X IOXY W $P(DDGLVID,DDGLDEL,6)_$E(D,1,$$MIN(L,$P(DDGFLIM,U,4)-D2+1))_$P(DDGLVID,DDGLDEL,10)
171 D RC(Y,X)
172 Q
173 ;
174MIN(X,Y,Z) ;Return the minimum of two or three numbers
175 N A
176 S A=$S(X<Y:X,1:Y)
177 Q:$G(Z)="" A
178 Q $S(A<Z:A,1:Z)
179 ;
180READ() N S,Y
181 F R *Y:DTIME D C Q:Y'=-1
182 Q Y
183 ;
184C I Y<0 S Y="TO" Q
185 S S=""
186C1 S S=S_$C(Y)
187 I DDGF("SIN")'[(U_S) D I Y=-1 W $C(7) Q
188 . I $C(Y)'?1L S Y=-1 Q
189 . S S=$E(S,1,$L(S)-1)_$C(Y-32) S:DDGF("SIN")'[(U_S_U) Y=-1
190 ;
191 I DDGF("SIN")[(U_S_U),S'=$C(27) S Y=$P(DDGF("SOUT"),U,$L($P(DDGF("SIN"),U_S_U),U)) Q
192 R *Y:5 G:Y'=-1 C1 W $C(7)
193 Q
Note: See TracBrowser for help on using the repository browser.