| [613] | 1 | RGUTLK2 ;CAIRO/DKM - Continuation of RGUTLKP;04-Sep-1998 11:26;DKM
|
|---|
| 2 | ;;2.1;RUN TIME LIBRARY;;Mar 22, 1999
|
|---|
| 3 | LKP(%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
|
|---|
| 8 | NXTREF 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
|
|---|
| 16 | NR2 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
|
|---|
| 24 | NR3 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)
|
|---|
| 26 | NR4 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 ""
|
|---|
| 46 | NR5 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
|
|---|
| 66 | SLCT(%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
|
|---|
| 72 | DISV(%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
|
|---|
| 81 | APP(%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
|
|---|
| 90 | MTL 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
|
|---|
| 98 | ADD(%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
|
|---|
| 108 | VALD(%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@(%)
|
|---|
| 115 | V2 .Q
|
|---|
| 116 | Q %1
|
|---|
| 117 | V3 Q 0
|
|---|
| 118 | ; Show the specified selection
|
|---|
| 119 | SHOW(%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
|
|---|
| 135 | FMT(%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
|
|---|
| 143 | SID(%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
|
|---|
| 149 | PARTIAL(%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(%),".,;:?/!-"," ")
|
|---|
| 153 | P1 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
|
|---|
| 159 | HELP(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
|
|---|
| 165 | HELP1 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
|
|---|
| 183 | HELP2 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
|
|---|
| 192 | PAUSE N %
|
|---|
| 193 | R !,"Press any key for more...",*%:DTIME
|
|---|
| 194 | W $$XY(0,%RGY+2),%RGEOS
|
|---|
| 195 | Q
|
|---|
| 196 | XY(X,Y) Q $S(%RGRS:"",1:$$XY^RGUT(X,Y))
|
|---|
