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

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

initial load of WorldVistAEHR
File size: 4.7 KB
RevLine 
[613]1DDGLBXA1 ;SFISC/MKO-SINGLE SELECTION LIST BOX ;11:33 AM 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 ;
5 N DDGLQT,Y
6 D CUP(DDGLLINE,1)
7 ;
8 S DDGLQT=0
9 F S Y=$$READ D Q:DDGLQT
10 . I Y'[U,$T(@Y)="" W $C(7) Q
11 . D @Y
12 . D:$G(DDGLKEY("KMAP","KD"))]"" @DDGLKEY("KMAP","KD")
13 ;
14 S:$P(DDGLQT,U,2,999)]"" DDGLOUT("C")=$P(DDGLQT,U,2,999)
15 Q
16 ;
17UP ;Move up
18 I DDGLLINE>1 D
19 . D CUP(DDGLLINE,1)
20 . W $E(DDGLSEL,1,DDGLNC)
21 . S DDGLLINE=DDGLLINE-1
22 . S DDGLSEL=DDGLITEM(DDGLLINE)
23 . ;
24 . D CUP(DDGLLINE,1)
25 . W $P(DDGLVID,DDGLDEL,6)_$E(DDGLSEL,1,DDGLNC)_$P(DDGLVID,DDGLDEL,10)
26 ;
27 E D
28 . N DDGLE
29 . D SHIFTDN(1,.DDGLE) Q:$G(DDGLE)
30 . S DDGLSEL=DDGLITEM(1)
31 . D DISP(DDGLSEL)
32 Q
33 ;
34DN ;Move down
35 I DDGLLINE<DDGLNL D
36 . Q:DDGLITEM(DDGLLINE+1)=""
37 . D CUP(DDGLLINE,1)
38 . W $E(DDGLSEL,1,DDGLNC)
39 . S DDGLLINE=DDGLLINE+1
40 . S DDGLSEL=DDGLITEM(DDGLLINE)
41 . ;
42 . D CUP(DDGLLINE,1)
43 . W $P(DDGLVID,DDGLDEL,6)_$E(DDGLSEL,1,DDGLNC)_$P(DDGLVID,DDGLDEL,10)
44 ;
45 E D
46 . N DDGLE
47 . D SHIFTUP(1,.DDGLE) Q:$G(DDGLE)
48 . S DDGLSEL=DDGLITEM(DDGLNL)
49 . D DISP(DDGLSEL)
50 Q
51 ;
52PUP ;Page up in list
53 I DDGLLINE>1 D
54 . D CUP(DDGLLINE,1)
55 . W $E(DDGLSEL,1,DDGLNC)
56 . S DDGLLINE=1,DDGLSEL=DDGLITEM(1)
57 . D CUP(1,1)
58 . W $P(DDGLVID,DDGLDEL,6)_$E(DDGLSEL,1,DDGLNC)_$P(DDGLVID,DDGLDEL,10)
59 ;
60 E D
61 . N DDGLE
62 . D SHIFTDN(DDGLNL,.DDGLE) Q:$G(DDGLE)
63 . S DDGLSEL=DDGLITEM(1)
64 . D DISP(DDGLSEL)
65 Q
66 ;
67PDN ;Page down in list
68 I DDGLLINE<DDGLNL D
69 . D CUP(DDGLLINE,1)
70 . W $E(DDGLSEL,1,DDGLNC)
71 . F DDGLLINE=DDGLNL:-1:1 Q:DDGLITEM(DDGLLINE)]""
72 . S DDGLSEL=DDGLITEM(DDGLLINE)
73 . D CUP(DDGLLINE,1)
74 . W $P(DDGLVID,DDGLDEL,6)_$E(DDGLSEL,1,DDGLNC)_$P(DDGLVID,DDGLDEL,10)
75 ;
76 E D
77 . N DDGLE
78 . D SHIFTUP(DDGLNL,.DDGLE) Q:$G(DDGLE)
79 . S DDGLSEL=DDGLITEM(DDGLNL)
80 . D DISP(DDGLSEL)
81 Q
82 ;
83TOP ;Move to top of list
84 N DDGLFRST,DDGLI,DDGLT
85 ;
86 ;Check whether first item in list is the first displayed
87 S DDGLFRST=$O(@DDGLGLO@(""))
88 I DDGLFRST=DDGLITEM(1) D:DDGLLINE>1 PUP Q
89 ;
90 ;Fill DDGLITEM array
91 S DDGLT=DDGLFRST
92 F DDGLI=1:1:DDGLNL D
93 . S DDGLITEM(DDGLI)=DDGLT
94 . S:DDGLT]"" DDGLT=$O(@DDGLGLO@(DDGLT))
95 ;
96 S DDGLLINE=1,DDGLSEL=DDGLITEM(1)
97 D DISP(DDGLSEL)
98 Q
99 ;
100BOT ;Move to bottom of list
101 N DDGLAST,DDGLI,DDGLT,DDGLIND
102 ;
103 ;Set DDGLIND = index of last non-null DDGLITEM
104 F DDGLIND=DDGLNL:-1:1 Q:DDGLITEM(DDGLIND)]""
105 ;
106 S DDGLAST=$O(@DDGLGLO@(""),-1)
107 I DDGLAST=DDGLITEM(DDGLIND) D:DDGLLINE<DDGLIND PDN Q
108 ;
109 ;Fill DDGLITEM array
110 S DDGLT=DDGLAST
111 F DDGLI=DDGLNL:-1:1 D
112 . S DDGLITEM(DDGLI)=DDGLT
113 . S DDGLT=$O(@DDGLGLO@(DDGLT),-1)
114 ;
115 S DDGLLINE=DDGLNL,DDGLSEL=DDGLITEM(DDGLNL)
116 D DISP(DDGLSEL)
117 Q
118 ;
119SEL ;Select item
120 K DDGLOUT
121 S DDGLOUT=$O(@DDGLGLO@(DDGLSEL,"")),DDGLOUT(0)=DDGLSEL
122 S DDGLOUT("C")="SEL"
123 S DDGLQT=1
124 Q
125 ;
126QT ;Quit
127 K DDGLOUT
128 S DDGLOUT=-1,DDGLOUT(0)="",DDGLOUT("C")="QT"
129 S DDGLQT=1
130 Q
131 ;
132TO ;Timeout
133 D:$G(DDGLKEY("KMAP","TO"))]"" @DDGLKEY("KMAP","TO")
134 K DDGLOUT
135 S DDGLOUT=-1,DDGLOUT(0)="",DDGLOUT("C")="TO"
136 S DDGLQT=1
137 Q
138 ;
139READ() ;Read next key and return mnemonic
140 N S,Y
141 F R *Y:DTIME D C Q:Y'=-1
142 Q Y
143 ;
144C I Y<0 S Y="TO" Q
145 S S=""
146C1 S S=S_$C(Y)
147 I DDGLKEY("KMAP","IN")'[(U_S) D I Y=-1 W $C(7) D FLUSH Q
148 . I $C(Y)'?1L S Y=-1 Q
149 . S S=$E(S,1,$L(S)-1)_$C(Y-32) S:DDGLKEY("KMAP","IN")'[(U_S_U) Y=-1
150 ;
151 I DDGLKEY("KMAP","IN")[(U_S_U),S'=$C(27) S Y=$P(DDGLKEY("KMAP","OUT"),";",$L($P(DDGLKEY("KMAP","IN"),U_S_U),U)) Q
152 R *Y:5 G:Y'=-1 C1
153 W $C(7)
154 Q
155 ;
156SHIFTDN(DDGLN,DDGLE) ;Shift DDGLITEM array down DDGLN times
157 ;Out: DDGLE = 1, if no more items above
158 ;
159 N DDGLI,DDGLT,DDGLA
160 S DDGLE=0
161 S DDGLT=DDGLITEM(1) I DDGLT="" S DDGLE=1 Q
162 ;
163 F DDGLI=-1:-1:-DDGLN S DDGLT=$O(@DDGLGLO@(DDGLT),-1) Q:DDGLT="" D
164 . S DDGLA(DDGLI)=DDGLT
165 S:DDGLT="" DDGLI=DDGLI+1
166 I DDGLI=0 S DDGLE=1 Q
167 S DDGLN=-DDGLI
168 ;
169 F DDGLI=DDGLNL:-1:DDGLN+1 S DDGLITEM(DDGLI)=DDGLITEM(DDGLI-DDGLN)
170 F DDGLI=DDGLN:-1:1 S DDGLITEM(DDGLI)=DDGLA(DDGLI-DDGLN-1)
171 Q
172 ;
173SHIFTUP(DDGLN,DDGLE) ;Shift DDGLITEM array down DDGLN times
174 ;Out: DDGLE = 1, if no more items above
175 ;
176 N DDGLI,DDGLT,DDGLA
177 S DDGLE=0
178 S DDGLT=DDGLITEM(DDGLNL) I DDGLT="" S DDGLE=1 Q
179 ;
180 F DDGLI=1:1:DDGLN S DDGLT=$O(@DDGLGLO@(DDGLT)) Q:DDGLT="" D
181 . S DDGLA(DDGLI)=DDGLT
182 S:DDGLT="" DDGLI=DDGLI-1
183 I DDGLI=0 S DDGLE=1 Q
184 S DDGLN=DDGLI
185 ;
186 F DDGLI=1:1:DDGLNL-DDGLN S DDGLITEM(DDGLI)=DDGLITEM(DDGLI+DDGLN)
187 F DDGLI=DDGLNL-DDGLN+1:1:DDGLNL S DDGLITEM(DDGLI)=DDGLA(DDGLI-DDGLNL+DDGLN)
188 Q
189 ;
190DISP(DDGLSEL) ;Display the list
191 ;In: DDGLSEL = text of selected item
192 ;
193 N DDGLI,DDGLT
194 F DDGLI=1:1:DDGLNL D
195 . D CUP(DDGLI,1)
196 . S DDGLT=$E(DDGLITEM(DDGLI),1,DDGLNC)
197 . S DDGLT=$S(DDGLT=DDGLSEL:$P(DDGLVID,DDGLDEL,6)_DDGLT_$P(DDGLVID,DDGLDEL,10),1:DDGLT)_$J("",DDGLNC-$L(DDGLT))
198 . W DDGLT
199 Q
200 ;
201FLUSH ;Flush read buffer
202 N DDGLX
203 F R *DDGLX:0 E Q
204 Q
205 ;
206CUP(Y,X) ;Position cursor relative to list coords
207 S DY=DDGLROW+Y,DX=DDGLCOL+X+1 X IOXY
208 Q
Note: See TracBrowser for help on using the repository browser.