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

RGUTLK2 ;CAIRO/DKM - Continuation of RGUTLKP;04-Sep-1998 11:26;DKM
 ;;2.1;RUN TIME LIBRARY;;Mar 22, 1999
LKP(%RGDX) ;
 N %RGD,%RGZ,%RGN
 S %RGXRN=0,%RGTRUNC=0,%RGIEN="",%RGSCT=0,%RGD=%RGDX
 W:'%RGHTML $$XY(%RGX+$L(%RGPRMPT),%RGY),$S(%RGOPT["X":"",1:%RGD),%RGEOS,!,"Searching"_$S(%RGOPT[U:" (press ^ to abort)",1:"")_"...",*13
 I $E(%RGD)="`" S %RGSLCT=%RGD G:'%RGHTML NR5 D SHOW($E(%RGD,2,999)) Q 1
NXTREF S %RGXRN=%RGXRN+1,%RGXRF=$P(%RGXRFS,U,%RGXRN),%RGD=%RGDX
 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 ""
 S %RGOPT(0)=%RGOPT_%RGXRFS(%RGXRF)
 I %RGOPT(0)["D",$L(%RGDX) D  G:%RGD<1 NXTREF
 .S %RGD=$$%DT^RGUT(%RGDX)
 I %RGOPT(0)["W" D MTL G NXTREF
 S %RGKEY=$S(%RGOPT(0)["P":$P(%RGD," "),1:%RGD)_$S(%RGDIR<0:$C(255),1:""),%RGNUM=$S(%RGKEY=+%RGKEY:%RGKEY,1:"")
 I %RGD'="",$D(@%RGDIC@(%RGXRF,%RGD)) S %=%RGSCT+1 D ADD(%RGD) I %RGSCT=%,%RGOPT(0)["A" D SLCT(%RGSCT) Q %RGIEN
NR2 I %RGOPT(0)[U R %#1:0 I %=U S %RGTRUNC=1 G NR3:%RGSCT Q ""
 S %RGKEY=$O(@%RGDIC@(%RGXRF,%RGKEY),%RGDIR)
 I (%RGNUM="")=(%RGKEY=+%RGKEY),%RGD'="" S %RGKEY=""
 I %RGKEY'="",%RGOPT(0)["P",%RGKEY'=%RGD S %=$$PARTIAL(%RGD,%RGKEY) D ADD(%RGKEY):%>0 G:%'<0 NR2:%RGSCT<100
 I %RGKEY'="",%RGOPT(0)'["P",$E(%RGKEY,1,$L(%RGD))=%RGD D ADD(%RGKEY) G:%RGSCT<100 NR2
 I %RGNUM'="" S %RGKEY=%RGNUM_$C($S(%RGDIR<0:255,1:1)),%RGNUM="" G NR2
 I %RGSCT'<100 W:'%RGHTML *7 S %RGXRALL=0,%RGTRUNC=1
 G:'%RGSCT!%RGXRALL NXTREF
NR3 I %RGSCT=1,%RGOPT(0)[1,'%RGTRUNC D SLCT(1) Q %RGIEN
 S %RGKEY=%RGSLT,%RGSLT=1,%RGSMAX=$S(%RGHTML:99999,1:17-%RGY)
NR4 W:'%RGHTML $$XY(0,%RGY+1),%RGEOS,!
 F %RGN=%RGKEY:1:%RGKEY+%RGSMAX-1 D  Q:%RGN=%RGSCT
 .F %RGZ=0:1:%RGCOL-1 D
 ..S %1=IOM/%RGCOL*%RGZ\1,%RGLAST=%RGZ*%RGSMAX+%RGN
 ..Q:%RGLAST>%RGSCT
 ..W:'%RGHTML $$XY(%1,$Y),%RGEOL,%RGLAST,?5
 ..D SHOW(^TMP(%RGPID,%RGLAST),%1+4)
 .W:'%RGQUIET !
 Q:%RGHTML $S(%RGTRUNC:-%RGSCT,1:%RGSCT)
 W:%RGLAST<%RGSCT !,%RGSCT-%RGLAST," more choice(s)..."
 W:%RGTRUNC "  (list was truncated)",!
 W %RGEOS_%RGBEL,!!
 R "Enter selection: ",%RGSLCT:DTIME
 S:'$T %RGSLCT=U
 W *13
 I %RGOPT["K",%RGSLCT="" Q -1
 I "Nn"[%RGSLCT S %RGKEY=$S(%RGLAST<%RGSCT:%RGLAST+1,1:1) G NR4
 I "Bb"[%RGSLCT S %RGKEY=$S(%RGKEY=1:%RGSCT-%RGSMAX+1,%RGKEY'>%RGSMAX:1,1:%RGKEY-%RGSMAX) S:%RGKEY<1 %RGKEY=1 G NR4
 I "?"[%RGSLCT D HELP2 G NR4
 I "^^"[%RGSLCT S %RGD2="",%RGD1=$S(%RGOPT(0)["X":%RGSLCT,%RGSLCT="^^":%RGSLCT,1:"") Q ""
NR5 F  D  Q:%RGSLCT=""
 .I %RGOPT(0)["M" S %RGD=$P(%RGSLCT,";"),%RGSLCT=$P(%RGSLCT,";",2,999)
 .E  S %RGD=%RGSLCT,%RGSLCT=""
 .Q:'$L(%RGD)
 .I %RGD?1.N D SLCT(%RGD) Q
 .I %RGOPT(0)["M",%RGD?1.N1"-".N D  Q
 ..N %1,%2
 ..S %1=+%RGD,%2=+$P(%RGD,"-",2)
 ..S:'%2 %2=%RGSCT
 ..S:%1>%2 %RGD=%1,%1=%2,%2=%RGD
 ..S:%2>%RGSCT %2=%RGSCT
 ..F %=%1:1:%2 D SLCT(%)
 .I %RGOPT["X",%RGOPT'["L" S (%RGSLCT,%RGD1,%RGIEN)="" Q
 .I $E(%RGD)="`" D  Q
 ..S %RGD=+$E(%RGD,2,999)
 ..I $$VALD(%RGD) D DISV(%RGD) S %RGIEN=%RGD
 .S %RGD1=%RGD1_";"_%RGD
 W $$XY(0,%RGY+1),%RGEOS,!
 Q %RGIEN
 ; Add list selection to output
SLCT(%RGSLCT) ;
 I %RGSLCT>0,%RGSLCT'>%RGSCT D
 .S %RGIEN=+^TMP(%RGPID,+%RGSLCT)
 .D DISV(%RGIEN)
 Q
 ; Add IEN to output
DISV(%RGIEN) ;
 Q:%RGIEN=""
 I %RGMUL'="",'$D(@%RGMUL@(%RGIEN)) S @%RGMUL@(%RGIEN)="" D:'%RGQUIET APP(%RGIEN)
 D:%RGMUL="" APP(%RGIEN)
 Q:%RGOPT(0)["F"
 K:%RGSAME ^DISV(DUZ,%RGDISV)
 S %RGSAME=0,^DISV(DUZ,%RGDISV)=%RGIEN,^(%RGDISV,%RGIEN)=""
 Q
 ; Append primary key to key list
APP(%RGIEN) ;
 N %RGKEY
 S %RGKEY=$S(%RGIEN=+%RGIEN:$P($G(@%RGDIC@(%RGIEN,0)),U),1:%RGIEN)
 S %RGKEY=$$FMT(%RGIEN,%RGKEY)
 Q:'$L(%RGKEY)!($L(%RGKEY)+$L(%RGD2)'<250)
 S %RGD2=%RGD2_$S($L(%RGD2):";",1:"")_%RGKEY
 I %RGOPT(0)'["J",%RGOPT(0)'["M" S %RGD2=%RGD2_"  "_$$SID(%RGIEN)
 Q
 ; Multi-term lookup
MTL N %
 S %=$S(%RGDIC[")":$TR(%RGDIC,")",","),1:%RGDIC_"(")_"%RGXRF)"
 S %=$$LKP^RGUTMTL(%,%RGD,"^TMP(""MTL"",%RGPID)",%RGOPT(0)[U)
 S:%<0 %RGTRUNC=1
 D:% ADD(%RGPID,"^TMP","MTL")
 K ^TMP("MTL",%RGPID)
 Q
 ; Add key to selection list
ADD(%RGKEY,%RGIDX,%RGSUB) ;
 N %S
 S:'$D(%RGIDX) %RGIDX=%RGDIC,%RGSUB=%RGXRF
 F %S=0:0 S %S=$O(@%RGIDX@(%RGSUB,%RGKEY,%S)) Q:'%S  D
 .I %RGOPT(0)["O",$D(^TMP(%RGPID,0,%S)) Q
 .I $$VALD(%S) D
 ..S %RGSCT=%RGSCT+1,^TMP(%RGPID,%RGSCT)=%S_U_$S(%RGOPT(0)["W":"",1:%RGKEY),^(0,%S)=""
 ..I %RGOPT(0)["S",$G(^DISV(DUZ,%RGDISV))=%S S %RGSLT=%RGSCT
 Q
 ; Check entry against screening criteria
VALD(%S) Q:'$D(@%RGDIC@(%S))!'%S 0
 Q:%RGSCN="" 1
 N %,%1
 S %1=1,@$$TRAP^RGUTOS("V3^RGUTLK2")
 F %=0:0 S %=$O(@%RGSCN@(%)) Q:'%  D  Q:%1
 .S %1=0,@$$TRAP^RGUTOS("V2^RGUTLK2")
 .X "S %1="_@%RGSCN@(%)
V2 .Q
 Q %1
V3 Q 0
 ; Show the specified selection
SHOW(%RGSLCT,%RGCOL1,%RGCOL2) ;
 N %S,%Z,%P,%I
 S %S=+%RGSLCT,%Z=$G(@%RGDIC@(%S,0)),%P=$$FMT(%S,$S(%RGOPT["I":$P(%RGSLCT,U,2),1:$P(%Z,U)))
 ;S %I=$$SID(%S,$P(%RGSLCT,U,2)),%I=$S(%I="":%P,1:%I)
 S %I=$$SID(%S,%P),%I=$S(%I="":%P,1:%I)
 I %RGHTML D  Q
 .I '%RGQUIET W $$MSG^RGUT(%RGPRMPT,"|"),!
 .E  D DISV(%S)
 S %RGCOL1=+$G(%RGCOL1,$X)
 I %RGOPT(0)["Y" S %RGCOL2=+$G(%RGCOL2,IOM\%RGCOL+%RGCOL1-8-$L(%I))
 E  S %RGCOL2=+$G(%RGCOL2,IOM\%RGCOL\$S(%RGOPT(0)["D":3,1:2)-3+%RGCOL1)
 W $$XY(%RGCOL1,$Y)
 I %RGOPT(0)'["J",%I'=%P W $$TRUNC^RGUT(%P,IOM\%RGCOL-6),?%RGCOL2," "_$$TRUNC^RGUT(%I,IOM-%RGCOL2-2)
 E  W $$TRUNC^RGUT(%I,IOM\%RGCOL-6)
 Q
 ; Return external form of result
FMT(%S,%RGKEY) ;
 Q:%RGKEY="" %RGKEY
 I %RGTRP'="",$D(@%RGTRP@(%RGKEY)) Q @%RGTRP@(%RGKEY)
 S:%RGOPT(0)["D" %RGKEY=$$ENTRY^RGUTDT(%RGKEY)
 I %RGOPT(0)["Z",%RGSCN'="",$G(@%RGSCN)'="" S @("%RGKEY="_@%RGSCN)
 S:%RGOPT["J" %RGKEY=$$SID(%S,%RGKEY)
 Q %RGKEY
 ; Return secondary identifier
SID(%S,%RGKEY) ;
 S %RGKEY=$G(%RGKEY)
 N %Z
 S %Z=$G(@%RGDIC@(%S,0)),@("%Z="_$S(%RGSID<0:$S(%RGKEY=$$UP^XLFSTR($P(%Z,U)):"""""",1:"%RGKEY"),%RGSID="":"%RGSID",1:%RGSID))
 Q %Z
 ; Partial key lookup
PARTIAL(%RGD,%RGKEY) ;
 N %,%1,%2
 S (%(1),%(2))=0,%1(1)=%RGD,%1(2)=%RGKEY
 F %=1,2 S %1(%)=$TR(%1(%),".,;:?/!-","        ")
P1 S (%2(1),%2(2))=""
 F %=1,2 D
 .F %(%)=%(%)+1:1:$L(%1(%)," ") S %2(%)=$P(%1(%)," ",%(%)) Q:%2(%)'=""
 Q:%2(1)="" 1
 Q:%2(1)'=$E(%2(2),1,$L(%2(1))) -(%(1)=1)
 G P1
HELP(X) ; Application-specific help
 N %
 S %=""
 F  S %=$O(X(%)) Q:%=""  D:$Y>20 PAUSE W $G(X(%)),!
 Q
 ; Generic help
HELP1 N %
 W !!
 D:%RGHLP'="" @%RGHLP
 W !,"Enter a blank line for default action.",!
 D:$Y>20 PAUSE
 W:%RGOPT'["W" "Enter ?? to see all possible selections.",!
 D:$Y>20 PAUSE
 W "Enter a space to retrieve previous selection.",!
 D:$Y>20 PAUSE
 W "Enter a valid identifier for lookup."
 W:(%RGOPT'["*")&(%RGXRFS[U) "  Append a * to include all indices."
 W !
 I %RGOPT["M" D
 .D:$Y>20 PAUSE
 .W "Separate multiple selections by semicolons."
 R !!,"Press any key to continue...",*%:DTIME
 Q
 ; Help at choice prompt
HELP2 N %
 W $$XY(0,16),%RGEOS,!
 W $S(%RGOPT(0)["K":"Enter N for next choices.",1:"Press RETURN for more choices.")
 W ?35,"Enter B for previous choices.",!
 W "Enter ^ to abort lookup.",?35,"Enter choice number to select.",!
 W "Any other entry = new lookup."
 W:%RGOPT(0)["M" ?35,"Separate multiple selections by semicolons."
 R !!,"Press any key to continue...",*%:DTIME
 Q
PAUSE N %
 R !,"Press any key for more...",*%:DTIME
 W $$XY(0,%RGY+2),%RGEOS
 Q
XY(X,Y) Q $S(%RGRS:"",1:$$XY^RGUT(X,Y))