| 1 | RGUTLKP ;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 | ;=================================================================
|
|---|
| 54 | ENTRY(%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
|
|---|
| 90 | INPUT() ;
|
|---|
| 91 | INP 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)
|
|---|
| 108 | INP2 G INP:%RGIEN=""!$L(%RGD1)
|
|---|
| 109 | Q %RGIEN
|
|---|
| 110 | READ 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
|
|---|
| 126 | SAME 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
|
|---|
| 133 | SM1 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
|
|---|
| 137 | XY(X,Y) Q $S(%RGRS:"",1:$$XY^RGUT(X,Y))
|
|---|
| 138 | RM(X) X ^%ZOSF("RM")
|
|---|
| 139 | Q
|
|---|
| 140 | ERROR W:'%RGHTML $$XY(0,%RGY+1),*7,%RGEOL,$$EC^%ZOSV
|
|---|
| 141 | S (%RGDATA,%RGD1,%RGD2)=""
|
|---|
| 142 | G INP
|
|---|
