source: FOIAVistA/trunk/r/VA_FILEMAN-ARJT-DI-DD-DM-DT-%DT-%RCR/DDGLBXA.m@ 1607

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

initial load of FOIAVistA 6/30/08 version
File size: 6.5 KB
Line 
1DDGLBXA ;SFISC/MKO-A LIST BOX ;1:58 PM 26 Apr 1996
2 ;;22.0;VA FileMan;;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5LIST(DDGLGLO,DDGLOUT,DDGLROW,DDGLCOL,DDGLHT,DDGLWD,DDGLSEL,DDGLFLG,DDGLMAP) ;
6 ;Input:
7 ; DDGLGLO = closed reference of local or global that contains
8 ; the list of entries
9 ; @DDGLGLO("B",entry,index)=""
10 ; DDGLROW = $Y of top left corner
11 ; DDGLCOL = $X of top left corner
12 ; DDGLHT = height of box
13 ; DDGLWD = width of box
14 ; DDGLSEL = text of selected item
15 ; DDGLFLG = flags
16 ; DDGLMAP = array to customize key sequences
17 ;
18 ;Output:
19 ; DDGLOUT = index of selected entry (if any)
20 ; DDGLOUT(0) = selected entry
21 ; DDGLOUT("C") = code indicates what terminated the read
22 ;
23 ;Other variables:
24 N DDGLCID ; window (control) id
25 N DDGLNL ; number of lines in list
26 N DDGLNC ; number of columns in list
27 N DDGLLINE ; current line number
28 N DDGLITEM ; item array
29 ; DDGLITEM(1..DDGLNL) = text of item displayed
30 ;
31 Q:$G(DDGLGLO)=""
32 D INIT
33 X DDGLZOSF("EOFF")
34 W $P(DDGLVID,DDGLDEL,11)
35 ;
36 D ^DDGLBXA1
37 ;
38 W $P(DDGLVID,DDGLDEL,12)
39 X DDGLZOSF("EON")
40 D DESTROY(DDGLCID,$G(DDGLFLG))
41 Q
42 ;
43CREATE(DDGLGLO,DDGLCID,DDGLROW,DDGLCOL,DDGLHT,DDGLWD,DDGLSEL,DDGLMAP) ;
44 ;Create a list box window
45 ;Out:
46 ; .DDGLCID array = properties of list box
47 ; .DDGLCID(id,"SV") = cid^$Y^$X^NL^NC^LINE
48 ; .DDGLCID(id,"ITEM",1..nl) = text of item n in display
49 ; .DDGLCID(id,"GL") = DDGLGLO
50 ; .DDGLCID(id,"KMAP","IN")
51 ; .DDGLCID(id,"KMAP","OUT")
52 ; .DDGLCID(id,"KMAP","KD")
53 ; .DDGLCID(id,"KMAP","TO")
54 ;
55 Q:$G(DDGLGLO)=""
56 N DDGLNL,DDGLNC,DDGLLINE,DDGLLAST,DDGLITEM
57 D INIT
58 D SETCID
59 Q
60 ;
61DESTROY(DDGLCID,DDGLFLG) ;Destroy the window and cleanup
62 D DESTROY^DDGLIBW(DDGLCID)
63 K DDGLCID(DDGLCID)
64 D KILL^DDGLIB0($G(DDGLFLG))
65 Q
66 ;
67READ(DDGLCID,DDGLOUT) ;
68 N DDGLGLO,DDGLROW,DDGLCOL,DDGLNL,DDGLNC,DDGLLINE,DDGLSEL,DDGLITEM
69 N DX,DY
70 ;
71 D SETPARM
72 X DDGLZOSF("EOFF")
73 W $P(DDGLVID,DDGLDEL,11)
74 ;
75 D ^DDGLBXA1
76 ;
77 D SETCID
78 W $P(DDGLVID,DDGLDEL,12)
79 X DDGLZOSF("EON")
80 Q
81 ;
82UPDATE(DDGLCID,DDGLVAL) ;
83 N DDGLGLO,DDGLROW,DDGLCOL,DDGLNL,DDGLNC,DDGLLINE,DDGLSEL,DDGLITEM
84 N DDGLI,DDGLT,DX,DY
85 ;
86 D SETPARM
87 ;
88 ;Get closest match incl. or foll. DDGLVAL
89 S DDGLSEL=$G(DDGLVAL)
90 I $G(DDGLSEL)="" S DDGLSEL=$O(@DDGLGLO@(""))
91 E I '$D(@DDGLGLO@(DDGLSEL)) S DDGLSEL=$O(@DDGLGLO@(DDGLSEL))
92 Q:DDGLSEL=""
93 ;
94 ;Check whether DDGLVAL is already on the screen
95 I DDGLITEM(1)']]DDGLSEL,DDGLSEL']]DDGLITEM(DDGLNL) D
96 . D CUP(DDGLLINE,1)
97 . W $E(DDGLITEM(DDGLLINE),1,DDGLNC)
98 . F DDGLLINE=1:1:DDGLNL Q:DDGLITEM(DDGLLINE)=DDGLSEL
99 . D CUP(DDGLLINE,1)
100 . W $P(DDGLVID,DDGLDEL,6)_$E(DDGLSEL,1,DDGLNC)_$P(DDGLVID,DDGLDEL,10)
101 ;
102 ;If not, adjust the array
103 E D
104 . S DDGLT=DDGLSEL
105 . F DDGLI=1:1:DDGLNL D
106 .. S DDGLITEM(DDGLI)=DDGLT
107 .. S:DDGLT]"" DDGLT=$O(@DDGLGLO@(DDGLT))
108 . D DISP(DDGLSEL)
109 ;
110 D SETCID
111 Q
112 ;
113SETCID ;Set DDGLCID array
114 K DDGLCID(DDGLCID)
115 S DDGLCID(DDGLCID,"SV")=DDGLCID_U_DDGLROW_U_DDGLCOL_U_DDGLNL_U_DDGLNC_U_DDGLLINE
116 M DDGLCID(DDGLCID,"ITEM")=DDGLITEM
117 S DDGLCID(DDGLCID,"GL")=DDGLGLO
118 M DDGLCID(DDGLCID,"KMAP")=DDGLKEY("KMAP")
119 Q
120 ;
121SETPARM ;Set parameters from DDGLCID array
122 N DDGLI
123 S DDGLGLO=DDGLCID(DDGLCID,"GL")
124 ;
125 K DDGLKEY("KMAP")
126 M DDGLKEY("KMAP")=DDGLCID(DDGLCID,"KMAP")
127 M DDGLITEM=DDGLCID(DDGLCID,"ITEM")
128 ;
129 S DDGLI=DDGLCID(DDGLCID,"SV")
130 S DDGLROW=$P(DDGLI,U,2)
131 S DDGLCOL=$P(DDGLI,U,3)
132 S DDGLNL=$P(DDGLI,U,4)
133 S DDGLNC=$P(DDGLI,U,5)
134 S DDGLLINE=$P(DDGLI,U,6)
135 S DDGLSEL=DDGLITEM(DDGLLINE)
136 K DDGLCID(DDGLCID)
137 Q
138 ;
139INIT ;Create list box (window) and setup variables
140 ;In: DDGLROW,DDGLCOL,DDGLHT,DDGLWD,DDGLSEL,DDGLGLO,DDGLMAP
141 ;Returns: DDGLROW,DDGLCOL,DDGLHT,DDGLWD,DDGLIND
142 ; DDGLCID,DDGLNL,DDGLNC,DDGLLINE,DDGLITEM,DDGLKEY("KMAP")
143 ;
144 N DDGLAREA,DDGLI,DDGLT
145 D INIT^DDGLIB0()
146 ;
147 ;Check and default DDGLROW,DDGLCOL,DDGLHT,DDGLWD,DDGLIND
148 I $G(DDGLROW,-1)<0 S DDGLROW=5
149 E I DDGLROW+3>IOSL S DDGLROW=IOSL-3
150 I $G(DDGLCOL,-1)<0 S DDGLCOL=5
151 E I DDGLCOL+5>IOM S DDGLCOL=IOM-5
152 ;
153 S DDGLHT=$S($D(DDGLHT)[0:7,DDGLHT<3:3,1:DDGLHT)
154 S:DDGLROW+DDGLHT+1>IOSL DDGLHT=IOSL-DDGLROW
155 ;
156 S DDGLWD=$S($D(DDGLWD)[0:14,DDGLWD<5:5,1:DDGLWD)
157 S:DDGLCOL+DDGLWD+1>IOM DDGLWD=IOM-DDGLCOL
158 ;
159 I $G(DDGLSEL)="" S DDGLSEL=$O(@DDGLGLO@(""))
160 E I '$D(@DDGLGLO@(DDGLSEL)) S DDGLSEL=$O(@DDGLGLO@(DDGLSEL))
161 ;
162 ;Initialize variables
163 F DDGLI=1:1 Q:'$$EXIST^DDGLIBW("LBOX"_DDGLI)
164 S DDGLCID="LBOX"_DDGLI
165 S DDGLAREA=DDGLROW_U_DDGLCOL_U_DDGLHT_U_DDGLWD
166 S DDGLNL=DDGLHT-2
167 S DDGLNC=DDGLWD-4
168 S DDGLLINE=1
169 ;
170 ;Fill DDGLITEM array
171 S DDGLT=DDGLSEL
172 F DDGLI=1:1:DDGLNL D
173 . S DDGLITEM(DDGLI)=DDGLT
174 . S:DDGLT]"" DDGLT=$O(@DDGLGLO@(DDGLT))
175 ;
176 ;Get key sequences, create window, display list
177 D GETKEY
178 D CREATE^DDGLIBW(DDGLCID,DDGLAREA,1)
179 D DISP(DDGLSEL)
180 Q
181 ;
182DISP(DDGLSEL) ;Display the list
183 ;In: DDGLSEL = text of selected item
184 ;
185 N DDGLI,DDGLT
186 F DDGLI=1:1:DDGLNL D
187 . D CUP(DDGLI,1)
188 . S DDGLT=$E(DDGLITEM(DDGLI),1,DDGLNC)
189 . S DDGLT=$S(DDGLT=DDGLSEL:$P(DDGLVID,DDGLDEL,6)_DDGLT_$P(DDGLVID,DDGLDEL,10),1:DDGLT)_$J("",DDGLNC-$L(DDGLT))
190 . W DDGLT
191 Q
192 ;
193CUP(Y,X) ;Position cursor relative to list coordinates
194 S DY=DDGLROW+Y,DX=DDGLCOL+X+1 X IOXY
195 Q
196 ;
197GETKEY ;Get key sequences and defaults
198 N AU,AD,AR,AL,F1,F2,F3,F4
199 N FIND,SELECT,INSERT,REMOVE,PREVSC,NEXTSC
200 N I,K,N,T
201 S AU=$P(DDGLKEY,U,2)
202 S AD=$P(DDGLKEY,U,3)
203 S AR=$P(DDGLKEY,U,4)
204 S AL=$P(DDGLKEY,U,5)
205 S F1=$P(DDGLKEY,U,6)
206 S FIND=$P(DDGLKEY,U,10)
207 S SELECT=$P(DDGLKEY,U,11)
208 S PREVSC=$P(DDGLKEY,U,14)
209 S NEXTSC=$P(DDGLKEY,U,15)
210 ;
211 S DDGLKEY("KMAP","IN")="",DDGLKEY("KMAP","OUT")=""
212 ;
213 I $D(DDGLMAP)>9 S I=0 F S I=$O(DDGLMAP(I)) Q:'I D
214 . I $P(DDGLMAP(I),";",2)="KEYDOWN" S DDGLKEY("KMAP","KD")=$P(DDGLMAP(I),";") Q
215 . I $P(DDGLMAP(I),";",2)="TIMEOUT" S DDGLKEY("KMAP","TO")=$P(DDGLMAP(I),";") Q
216 . ;
217 . S @("K="_$P(DDGLMAP(I),";",2))
218 . I DDGLKEY("KMAP","IN")'[(U_K),K]"" D
219 .. S DDGLKEY("KMAP","IN")=DDGLKEY("KMAP","IN")_U_K
220 .. S DDGLKEY("KMAP","OUT")=DDGLKEY("KMAP","OUT")_$P(DDGLMAP(I),";")_";"
221 ;
222 F I=1:1 S T=$P($T(MAP+I),";;",2,999) Q:T="" D
223 . S @("K="_$P(T,";",2))
224 . I DDGLKEY("KMAP","IN")'[(U_K),K]"" D
225 .. S DDGLKEY("KMAP","IN")=DDGLKEY("KMAP","IN")_U_K
226 .. S DDGLKEY("KMAP","OUT")=DDGLKEY("KMAP","OUT")_$P(T,";")_";"
227 S DDGLKEY("KMAP","IN")=DDGLKEY("KMAP","IN")_U
228 S DDGLKEY("KMAP","OUT")=$E(DDGLKEY("KMAP","OUT"),1,$L(DDGLKEY("KMAP","OUT"))-1)
229 Q
230 ;
231MAP ;Keys for main screen
232 ;;UP;AU
233 ;;UP;AL
234 ;;DN;AD
235 ;;DN;AR
236 ;;PUP;F1_AU
237 ;;PUP;PREVSC
238 ;;PDN;F1_AD
239 ;;PDN;NEXTSC
240 ;;TOP;F1_"T"
241 ;;TOP;F1_F1_AU
242 ;;TOP;FIND
243 ;;BOT;F1_"B"
244 ;;BOT;F1_F1_AD
245 ;;BOT;SELECT
246 ;;SEL;$C(13)
247 ;;SEL;F1_"E"
248 ;;QT;$C(27)_$C(27)
249 ;;QT;F1_"Q"
250 ;;QT;F1_"C"
251 ;;
Note: See TracBrowser for help on using the repository browser.