source: FOIAVistA/tag/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/RGUTLKP.m@ 1424

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

initial load of FOIAVistA 6/30/08 version

File size: 5.8 KB
Line 
1RGUTLKP ;CAIRO/DKM - File lookup utility;04-Sep-1998 11:26;DKM
2 ;;2.1;RUN TIME LIBRARY;;Mar 22, 1999
3 ;=================================================================
4 ; Inputs:
5 ; %RGDIC = Global root or file #
6 ; %RGOPT = Options
7 ; A allow automatic selection of exact match
8 ; B sound bell with selection prompt
9 ; C use roll & scroll mode
10 ; D index is in date/time format
11 ; E use line editor
12 ; F forget the entry (i.e., ^DISV not updated)
13 ; G start with prior entry
14 ; H HTML-formatted output
15 ; I show only lookup identifiers
16 ; J show only secondary identifiers
17 ; K null entry at select prompt exits
18 ; L like X, but allows lookup at select prompt
19 ; M allow multiple selection
20 ; O show entry only once
21 ; P partial lookup
22 ; Q silent lookup
23 ; R reverse search through indices
24 ; S start selection list at last selection
25 ; T forget trapped inputs
26 ; U force uppercase translation
27 ; V extended DISV recall (prompt-specific)
28 ; W use multi-term lookup algorithm
29 ; X do not prompt for input
30 ; Y right justify secondary identifiers
31 ; Z perform special formatting of output
32 ; 1 automatic selection if one match only
33 ; 2-9 # of columns for selection display (default=1)
34 ; * force all indices to be searched
35 ; ^ allow search to be aborted
36 ; %RGPRMPT = Prompt (optional)
37 ; %RGXRFS = Cross-references to examine (all "B"'s by default)
38 ; %RGDATA = Data to lookup (optional)
39 ; %RGSCN = Screening criteria (optional)
40 ; %RGMUL = Local variable or global reference to
41 ; store multiple hits
42 ; %RGX = Column position for prompt (optional)
43 ; %RGY = Row position for prompt (optional)
44 ; %RGSID = Piece # of secondary identifier (optional)
45 ; or executable M code to display same
46 ; %RGTRP = Special inputs to trap (optional)
47 ; %RGHLP = Entry point to invoke help
48 ; Outputs:
49 ; Return value = index of selected entry or:
50 ; -1 for forced exit by ^
51 ; -2 for forced exit by ^^
52 ; 0 for null entry
53 ;=================================================================
54ENTRY(%RGDIC,%RGOPT,%RGPRMPT,%RGXRFS,%RGDATA,%RGSCN,%RGMUL,%RGX,%RGY,%RGSID,%RGTRP,%RGHLP) ;
55 N %,%1,%N,%S,%Z,%RGPID,%RGXRF,%RGSCT,%RGKEY,%RGKEY1,%RGDISV,%RGSLCT,%RGXRALL,%RGXRN,%RGSMAX,%RGTRUNC,%RGD,%RGD1,%RGD2,%RGBEL,%RGNUM,%RGDIR,%RGSLT,%RGCOL,%RGLAST,%RGSAME,%RGEOS,%RGEOL,%RGHTML,%RGRS,%RGQUIET
56 I $$NEWERR^%ZTER N $ET S $ET=""
57 S (%RGOPT,%RGOPT(0))=$$UP^XLFSTR($G(%RGOPT)),%RGPID="%RGLKP"_$J,%RGBEL=$S(%RGOPT["B":$C(7),1:""),%RGDIR=$S(%RGOPT["R":-1,1:1),%RGSLT=1,%RGCOL=1,%RGEOS=$C(27,91,74),%RGEOL=$C(27,91,75),%RGHTML=0,%RGLAST=0,%RGRS=%RGOPT["C",%RGQUIET=%RGOPT["Q"
58 S:%RGRS (%RGEOL,%RGEOS)=""
59 S:%RGQUIET %RGOPT=%RGOPT_"XHM"
60 S:%RGOPT["H" (%RGBEL,%RGEOL,%RGEOS)="",%RGOPT=%RGOPT_"X",%RGHTML=1
61 S:%RGOPT["L" %RGOPT=%RGOPT_"X"
62 S U="^",DUZ=$G(DUZ,0),IO=$G(IO,$I),IOM=$G(IOM,80),%RGMUL=$G(%RGMUL),%RGHLP=$G(%RGHLP),%RGTRP=$G(%RGTRP),%RGSCN=$G(%RGSCN),%RGSAME=%RGOPT["M"&(%RGMUL'="")
63 F %=2:1:9 S:%RGOPT[% %RGCOL=%
64 S:%RGOPT'["M" %RGMUL=""
65 K:%RGMUL'="" @%RGMUL
66 S:%RGDIC=+%RGDIC %RGDIC=$$ROOT^DILFD(%RGDIC)
67 S:$E(%RGDIC,$L(%RGDIC))="(" %RGDIC=$E(%RGDIC,1,$L(%RGDIC)-1)
68 S:$E(%RGDIC,$L(%RGDIC))="," %RGDIC=$E(%RGDIC,1,$L(%RGDIC)-1)
69 I %RGDIC["(",$E(%RGDIC,$L(%RGDIC))'=")" S %RGDIC=%RGDIC_")"
70 S %RGPRMPT=$G(%RGPRMPT,$S(%RGOPT["X":"",1:"Enter identifier: "))
71 S %RGDISV=$S(%RGDIC[")":$TR(%RGDIC,")",","),1:%RGDIC_"(")_$S(%RGOPT["V":";"_%RGPRMPT,1:"")
72 S %RGSID=$G(%RGSID),%RGXRFS=$G(%RGXRFS),%RGDATA=$G(%RGDATA)
73 S:%RGSID=+%RGSID %RGSID=$S(%RGSID<0:%RGSID,1:"$P(%Z,U,"_%RGSID_")")
74 S %RGX=$G(%RGX,0),%RGY=$G(%RGY,3),DTIME=$G(DTIME,999999999)
75 W:'%RGHTML $$XY(%RGX,%RGY),%RGEOS,!
76 I %RGOPT["G",$G(^DISV(DUZ,%RGDISV))'="" D
77 .S %RGDATA=^(%RGDISV)
78 .S:+%RGDATA=%RGDATA %RGDATA=$P($G(@%RGDIC@(%RGDATA,0)),U)
79 I %RGXRFS="" D
80 .S (%,%RGXRFS)="B"
81 .F S %=$O(@%RGDIC@(%)) Q:$E(%)'="B" S %RGXRFS=%RGXRFS_U_%
82 F %=1:1:$L(%RGXRFS,U) S %1=$P(%RGXRFS,U,%) S:%1'="" %RGXRFS($P(%1,":"))=$P(%1,":",2),$P(%RGXRFS,U,%)=$P(%1,":")
83 S (%RGD1,%RGD2)=""
84 D RM(0)
85 S %RGIEN=$$INPUT
86 W:'%RGHTML $$XY(%RGX+$L(%RGPRMPT),%RGY),$$TRUNC^RGUT(%RGD2,IOM-$X),%RGEOS
87 D RM(IOM)
88 K ^TMP(%RGPID)
89 Q %RGIEN
90INPUT() ;
91INP K ^TMP(%RGPID)
92 D READ
93 S:%RGOPT["U" %RGD=$$UP^XLFSTR(%RGD)
94 S @$$TRAP^RGUTOS("ERROR^RGUTLKP")
95 I %RGD="",%RGTRP'="" S %RGD=$G(@%RGTRP@(" "))
96 Q:"^^"[%RGD -$L(%RGD)
97 I "?"[%RGD D HELP1^RGUTLK2 G INP
98 I %RGD=" " D SAME G:%RGD="" INP2
99 I %RGTRP'="",$D(@%RGTRP@(%RGD)) D Q %RGD
100 .S %RGSAME=1
101 .D:%RGOPT'["T" DISV^RGUTLK2(%RGD)
102 .S %RGD2=$G(@%RGTRP@(%RGD))
103 .S:%RGD2="" %RGD2=%RGD
104 S:%RGD="??" %RGD=""
105 I $E(%RGD,$L(%RGD))="*" S %RGXRALL=1,%RGD=$E(%RGD,1,$L(%RGD)-1)
106 E S %RGXRALL=%RGOPT["*"
107 S %RGIEN=$$LKP^RGUTLK2(%RGD)
108INP2 G INP:%RGIEN=""!$L(%RGD1)
109 Q %RGIEN
110READ S %RGD=""
111 F Q:%RGD'=""!(%RGD1="") S %RGD=$P(%RGD1,";"),%RGD1=$P(%RGD1,";",2,999)
112 Q:$L(%RGD)
113 S %RGD=%RGDATA,%RGDATA=""
114 W:'%RGHTML $$XY(0,%RGY+2),%RGEOS,$$XY(%RGX,%RGY),%RGPRMPT_%RGEOL
115 I %RGOPT["X" S:%RGOPT["E" %RGOPT=$TR(%RGOPT,"X"),%RGDATA=%RGD Q
116 I %RGOPT["E" D
117 .N %,%1
118 .S:%RGD?1"`"1.N %RGD=+$E(%RGD,2,99),%RGD=$$FMT^RGUTLK2(%RGD,$P($G(@%RGDIC@(%RGD,0)),U))
119 .S %1=0,%=%RGX+$L(%RGPRMPT),%=$$ENTRY^RGUTEDT(%RGD,IOM-%-1,%,%RGY,"","RHV",,,,,.%1)
120 .S:%1=3 %=U
121 .S:%="?" %RGDATA=%RGD
122 .S %RGD=%
123 E I '$L(%RGD) R %RGD:DTIME S:'$T %RGD=U
124 I %RGOPT["M",%RGD[";" S %RGD1=%RGD G READ
125 Q
126SAME S %RGSAME=0,%RGIEN="",%RGD="",%RGSCT=0
127 I %RGMUL'="" D
128 .S %=""
129 .F S %=$O(^DISV(DUZ,%RGDISV,%)) Q:%="" D SM1
130 E S %=$G(^DISV(DUZ,%RGDISV)) D:%'="" SM1
131 S:%RGHTML %RGIEN=%RGSCT
132 Q
133SM1 I %RGTRP'="",$D(@%RGTRP@(%)) S %RGIEN=%,%RGD=%
134 E I $$VALD^RGUTLK2(%) S %RGIEN=%
135 I D DISV^RGUTLK2(%RGIEN) S %RGSCT=%RGSCT+1
136 Q
137XY(X,Y) Q $S(%RGRS:"",1:$$XY^RGUT(X,Y))
138RM(X) X ^%ZOSF("RM")
139 Q
140ERROR W:'%RGHTML $$XY(0,%RGY+1),*7,%RGEOL,$$EC^%ZOSV
141 S (%RGDATA,%RGD1,%RGD2)=""
142 G INP
Note: See TracBrowser for help on using the repository browser.