source: FOIAVistA/trunk/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/RGUTLK2.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 7.0 KB
Line 
1RGUTLK2 ;CAIRO/DKM - Continuation of RGUTLKP;04-Sep-1998 11:26;DKM
2 ;;2.1;RUN TIME LIBRARY;;Mar 22, 1999
3LKP(%RGDX) ;
4 N %RGD,%RGZ,%RGN
5 S %RGXRN=0,%RGTRUNC=0,%RGIEN="",%RGSCT=0,%RGD=%RGDX
6 W:'%RGHTML $$XY(%RGX+$L(%RGPRMPT),%RGY),$S(%RGOPT["X":"",1:%RGD),%RGEOS,!,"Searching"_$S(%RGOPT[U:" (press ^ to abort)",1:"")_"...",*13
7 I $E(%RGD)="`" S %RGSLCT=%RGD G:'%RGHTML NR5 D SHOW($E(%RGD,2,999)) Q 1
8NXTREF S %RGXRN=%RGXRN+1,%RGXRF=$P(%RGXRFS,U,%RGXRN),%RGD=%RGDX
9 I %RGXRF="" G:%RGSCT NR3 W:'%RGHTML *7,*13,%RGEOL,"Not found"_$S(%RGD="":".",1:": ")_$S(%RGD'=+%RGD:%RGD,%RGOPT["D":$$ENTRY^RGUTDT(%RGD),1:%RGD) S %RGD1=$S(%RGOPT["X":U,1:"") Q ""
10 S %RGOPT(0)=%RGOPT_%RGXRFS(%RGXRF)
11 I %RGOPT(0)["D",$L(%RGDX) D G:%RGD<1 NXTREF
12 .S %RGD=$$%DT^RGUT(%RGDX)
13 I %RGOPT(0)["W" D MTL G NXTREF
14 S %RGKEY=$S(%RGOPT(0)["P":$P(%RGD," "),1:%RGD)_$S(%RGDIR<0:$C(255),1:""),%RGNUM=$S(%RGKEY=+%RGKEY:%RGKEY,1:"")
15 I %RGD'="",$D(@%RGDIC@(%RGXRF,%RGD)) S %=%RGSCT+1 D ADD(%RGD) I %RGSCT=%,%RGOPT(0)["A" D SLCT(%RGSCT) Q %RGIEN
16NR2 I %RGOPT(0)[U R %#1:0 I %=U S %RGTRUNC=1 G NR3:%RGSCT Q ""
17 S %RGKEY=$O(@%RGDIC@(%RGXRF,%RGKEY),%RGDIR)
18 I (%RGNUM="")=(%RGKEY=+%RGKEY),%RGD'="" S %RGKEY=""
19 I %RGKEY'="",%RGOPT(0)["P",%RGKEY'=%RGD S %=$$PARTIAL(%RGD,%RGKEY) D ADD(%RGKEY):%>0 G:%'<0 NR2:%RGSCT<100
20 I %RGKEY'="",%RGOPT(0)'["P",$E(%RGKEY,1,$L(%RGD))=%RGD D ADD(%RGKEY) G:%RGSCT<100 NR2
21 I %RGNUM'="" S %RGKEY=%RGNUM_$C($S(%RGDIR<0:255,1:1)),%RGNUM="" G NR2
22 I %RGSCT'<100 W:'%RGHTML *7 S %RGXRALL=0,%RGTRUNC=1
23 G:'%RGSCT!%RGXRALL NXTREF
24NR3 I %RGSCT=1,%RGOPT(0)[1,'%RGTRUNC D SLCT(1) Q %RGIEN
25 S %RGKEY=%RGSLT,%RGSLT=1,%RGSMAX=$S(%RGHTML:99999,1:17-%RGY)
26NR4 W:'%RGHTML $$XY(0,%RGY+1),%RGEOS,!
27 F %RGN=%RGKEY:1:%RGKEY+%RGSMAX-1 D Q:%RGN=%RGSCT
28 .F %RGZ=0:1:%RGCOL-1 D
29 ..S %1=IOM/%RGCOL*%RGZ\1,%RGLAST=%RGZ*%RGSMAX+%RGN
30 ..Q:%RGLAST>%RGSCT
31 ..W:'%RGHTML $$XY(%1,$Y),%RGEOL,%RGLAST,?5
32 ..D SHOW(^TMP(%RGPID,%RGLAST),%1+4)
33 .W:'%RGQUIET !
34 Q:%RGHTML $S(%RGTRUNC:-%RGSCT,1:%RGSCT)
35 W:%RGLAST<%RGSCT !,%RGSCT-%RGLAST," more choice(s)..."
36 W:%RGTRUNC " (list was truncated)",!
37 W %RGEOS_%RGBEL,!!
38 R "Enter selection: ",%RGSLCT:DTIME
39 S:'$T %RGSLCT=U
40 W *13
41 I %RGOPT["K",%RGSLCT="" Q -1
42 I "Nn"[%RGSLCT S %RGKEY=$S(%RGLAST<%RGSCT:%RGLAST+1,1:1) G NR4
43 I "Bb"[%RGSLCT S %RGKEY=$S(%RGKEY=1:%RGSCT-%RGSMAX+1,%RGKEY'>%RGSMAX:1,1:%RGKEY-%RGSMAX) S:%RGKEY<1 %RGKEY=1 G NR4
44 I "?"[%RGSLCT D HELP2 G NR4
45 I "^^"[%RGSLCT S %RGD2="",%RGD1=$S(%RGOPT(0)["X":%RGSLCT,%RGSLCT="^^":%RGSLCT,1:"") Q ""
46NR5 F D Q:%RGSLCT=""
47 .I %RGOPT(0)["M" S %RGD=$P(%RGSLCT,";"),%RGSLCT=$P(%RGSLCT,";",2,999)
48 .E S %RGD=%RGSLCT,%RGSLCT=""
49 .Q:'$L(%RGD)
50 .I %RGD?1.N D SLCT(%RGD) Q
51 .I %RGOPT(0)["M",%RGD?1.N1"-".N D Q
52 ..N %1,%2
53 ..S %1=+%RGD,%2=+$P(%RGD,"-",2)
54 ..S:'%2 %2=%RGSCT
55 ..S:%1>%2 %RGD=%1,%1=%2,%2=%RGD
56 ..S:%2>%RGSCT %2=%RGSCT
57 ..F %=%1:1:%2 D SLCT(%)
58 .I %RGOPT["X",%RGOPT'["L" S (%RGSLCT,%RGD1,%RGIEN)="" Q
59 .I $E(%RGD)="`" D Q
60 ..S %RGD=+$E(%RGD,2,999)
61 ..I $$VALD(%RGD) D DISV(%RGD) S %RGIEN=%RGD
62 .S %RGD1=%RGD1_";"_%RGD
63 W $$XY(0,%RGY+1),%RGEOS,!
64 Q %RGIEN
65 ; Add list selection to output
66SLCT(%RGSLCT) ;
67 I %RGSLCT>0,%RGSLCT'>%RGSCT D
68 .S %RGIEN=+^TMP(%RGPID,+%RGSLCT)
69 .D DISV(%RGIEN)
70 Q
71 ; Add IEN to output
72DISV(%RGIEN) ;
73 Q:%RGIEN=""
74 I %RGMUL'="",'$D(@%RGMUL@(%RGIEN)) S @%RGMUL@(%RGIEN)="" D:'%RGQUIET APP(%RGIEN)
75 D:%RGMUL="" APP(%RGIEN)
76 Q:%RGOPT(0)["F"
77 K:%RGSAME ^DISV(DUZ,%RGDISV)
78 S %RGSAME=0,^DISV(DUZ,%RGDISV)=%RGIEN,^(%RGDISV,%RGIEN)=""
79 Q
80 ; Append primary key to key list
81APP(%RGIEN) ;
82 N %RGKEY
83 S %RGKEY=$S(%RGIEN=+%RGIEN:$P($G(@%RGDIC@(%RGIEN,0)),U),1:%RGIEN)
84 S %RGKEY=$$FMT(%RGIEN,%RGKEY)
85 Q:'$L(%RGKEY)!($L(%RGKEY)+$L(%RGD2)'<250)
86 S %RGD2=%RGD2_$S($L(%RGD2):";",1:"")_%RGKEY
87 I %RGOPT(0)'["J",%RGOPT(0)'["M" S %RGD2=%RGD2_" "_$$SID(%RGIEN)
88 Q
89 ; Multi-term lookup
90MTL N %
91 S %=$S(%RGDIC[")":$TR(%RGDIC,")",","),1:%RGDIC_"(")_"%RGXRF)"
92 S %=$$LKP^RGUTMTL(%,%RGD,"^TMP(""MTL"",%RGPID)",%RGOPT(0)[U)
93 S:%<0 %RGTRUNC=1
94 D:% ADD(%RGPID,"^TMP","MTL")
95 K ^TMP("MTL",%RGPID)
96 Q
97 ; Add key to selection list
98ADD(%RGKEY,%RGIDX,%RGSUB) ;
99 N %S
100 S:'$D(%RGIDX) %RGIDX=%RGDIC,%RGSUB=%RGXRF
101 F %S=0:0 S %S=$O(@%RGIDX@(%RGSUB,%RGKEY,%S)) Q:'%S D
102 .I %RGOPT(0)["O",$D(^TMP(%RGPID,0,%S)) Q
103 .I $$VALD(%S) D
104 ..S %RGSCT=%RGSCT+1,^TMP(%RGPID,%RGSCT)=%S_U_$S(%RGOPT(0)["W":"",1:%RGKEY),^(0,%S)=""
105 ..I %RGOPT(0)["S",$G(^DISV(DUZ,%RGDISV))=%S S %RGSLT=%RGSCT
106 Q
107 ; Check entry against screening criteria
108VALD(%S) Q:'$D(@%RGDIC@(%S))!'%S 0
109 Q:%RGSCN="" 1
110 N %,%1
111 S %1=1,@$$TRAP^RGUTOS("V3^RGUTLK2")
112 F %=0:0 S %=$O(@%RGSCN@(%)) Q:'% D Q:%1
113 .S %1=0,@$$TRAP^RGUTOS("V2^RGUTLK2")
114 .X "S %1="_@%RGSCN@(%)
115V2 .Q
116 Q %1
117V3 Q 0
118 ; Show the specified selection
119SHOW(%RGSLCT,%RGCOL1,%RGCOL2) ;
120 N %S,%Z,%P,%I
121 S %S=+%RGSLCT,%Z=$G(@%RGDIC@(%S,0)),%P=$$FMT(%S,$S(%RGOPT["I":$P(%RGSLCT,U,2),1:$P(%Z,U)))
122 ;S %I=$$SID(%S,$P(%RGSLCT,U,2)),%I=$S(%I="":%P,1:%I)
123 S %I=$$SID(%S,%P),%I=$S(%I="":%P,1:%I)
124 I %RGHTML D Q
125 .I '%RGQUIET W $$MSG^RGUT(%RGPRMPT,"|"),!
126 .E D DISV(%S)
127 S %RGCOL1=+$G(%RGCOL1,$X)
128 I %RGOPT(0)["Y" S %RGCOL2=+$G(%RGCOL2,IOM\%RGCOL+%RGCOL1-8-$L(%I))
129 E S %RGCOL2=+$G(%RGCOL2,IOM\%RGCOL\$S(%RGOPT(0)["D":3,1:2)-3+%RGCOL1)
130 W $$XY(%RGCOL1,$Y)
131 I %RGOPT(0)'["J",%I'=%P W $$TRUNC^RGUT(%P,IOM\%RGCOL-6),?%RGCOL2," "_$$TRUNC^RGUT(%I,IOM-%RGCOL2-2)
132 E W $$TRUNC^RGUT(%I,IOM\%RGCOL-6)
133 Q
134 ; Return external form of result
135FMT(%S,%RGKEY) ;
136 Q:%RGKEY="" %RGKEY
137 I %RGTRP'="",$D(@%RGTRP@(%RGKEY)) Q @%RGTRP@(%RGKEY)
138 S:%RGOPT(0)["D" %RGKEY=$$ENTRY^RGUTDT(%RGKEY)
139 I %RGOPT(0)["Z",%RGSCN'="",$G(@%RGSCN)'="" S @("%RGKEY="_@%RGSCN)
140 S:%RGOPT["J" %RGKEY=$$SID(%S,%RGKEY)
141 Q %RGKEY
142 ; Return secondary identifier
143SID(%S,%RGKEY) ;
144 S %RGKEY=$G(%RGKEY)
145 N %Z
146 S %Z=$G(@%RGDIC@(%S,0)),@("%Z="_$S(%RGSID<0:$S(%RGKEY=$$UP^XLFSTR($P(%Z,U)):"""""",1:"%RGKEY"),%RGSID="":"%RGSID",1:%RGSID))
147 Q %Z
148 ; Partial key lookup
149PARTIAL(%RGD,%RGKEY) ;
150 N %,%1,%2
151 S (%(1),%(2))=0,%1(1)=%RGD,%1(2)=%RGKEY
152 F %=1,2 S %1(%)=$TR(%1(%),".,;:?/!-"," ")
153P1 S (%2(1),%2(2))=""
154 F %=1,2 D
155 .F %(%)=%(%)+1:1:$L(%1(%)," ") S %2(%)=$P(%1(%)," ",%(%)) Q:%2(%)'=""
156 Q:%2(1)="" 1
157 Q:%2(1)'=$E(%2(2),1,$L(%2(1))) -(%(1)=1)
158 G P1
159HELP(X) ; Application-specific help
160 N %
161 S %=""
162 F S %=$O(X(%)) Q:%="" D:$Y>20 PAUSE W $G(X(%)),!
163 Q
164 ; Generic help
165HELP1 N %
166 W !!
167 D:%RGHLP'="" @%RGHLP
168 W !,"Enter a blank line for default action.",!
169 D:$Y>20 PAUSE
170 W:%RGOPT'["W" "Enter ?? to see all possible selections.",!
171 D:$Y>20 PAUSE
172 W "Enter a space to retrieve previous selection.",!
173 D:$Y>20 PAUSE
174 W "Enter a valid identifier for lookup."
175 W:(%RGOPT'["*")&(%RGXRFS[U) " Append a * to include all indices."
176 W !
177 I %RGOPT["M" D
178 .D:$Y>20 PAUSE
179 .W "Separate multiple selections by semicolons."
180 R !!,"Press any key to continue...",*%:DTIME
181 Q
182 ; Help at choice prompt
183HELP2 N %
184 W $$XY(0,16),%RGEOS,!
185 W $S(%RGOPT(0)["K":"Enter N for next choices.",1:"Press RETURN for more choices.")
186 W ?35,"Enter B for previous choices.",!
187 W "Enter ^ to abort lookup.",?35,"Enter choice number to select.",!
188 W "Any other entry = new lookup."
189 W:%RGOPT(0)["M" ?35,"Separate multiple selections by semicolons."
190 R !!,"Press any key to continue...",*%:DTIME
191 Q
192PAUSE N %
193 R !,"Press any key for more...",*%:DTIME
194 W $$XY(0,%RGY+2),%RGEOS
195 Q
196XY(X,Y) Q $S(%RGRS:"",1:$$XY^RGUT(X,Y))
Note: See TracBrowser for help on using the repository browser.