XTLKDICL ; IHS/ACC,ALB/JLU,SFISC/JC ;10/11/94 14:42
;;7.3;TOOLKIT;;Apr 25, 1995
;Bypass special lookup if XTLKUT exists or DIC(0)["I"
I $D(XTLKUT) S:DIC(0)'["I" DIC(0)=DIC(0)_"I" G:$G(DIPGM(0))=2 RTN^DIC D ^DIC Q
S:'$D(X) X=""
I X?1"?".E S X="~"_X
G:DIPGM(0)=2 EN2
EN1 ; FIRST ENTRY FROM DIC
K HITLIMIT
G:DIC(0)["A" ASK^DIC
EN2 ; SECOND ENTRY FROM DIC OR FALL-THROUGH IF NO 'ASK' INDICATED
I X="?BAD"!(X["^") S Y=-1 Q
;Precede entry with "`" to 'force' lookup by IEN
I X?1"`"1N.N!(U[X)!(X?1N.N)!(X?.N1".".N) D:'$D(D0(2)) DO^DIC1 G RTN^DIC
;Precede entry with "~" to 'force' lookup by ALL X-REF'S
I X?1"~".E S X=$E(X,2,99) D:'$D(D0(2)) DO^DIC1 G RTN^DIC
;Setting up var, from old xtlkkwld routine
TS D DO^DIC1 I $D(DO(2)),'$D(^XT(8984.4,+DO(2),0)) W $C(7),!!,"'",$P(DO,U),"' is not in the 'Local Lookup Files' file. Unable to use lookup." S Y=-1 Q
S XTLKX=X K XTLKKSCH S XTLKKSCH("GBL")=DIC,XTLKKSCH("INDEX")=$P(^XT(8984.4,+DO(2),0),U,3)
S XTLKKSCH("DSPLY")=$S('$D(^XT(8984.4,+DO(2),1)):"DGEN^XTLKKWLD",$L(^(1))=0:"DGEN^XTLKKWLD",1:^(1))
I $D(DIC(0)),DIC(0)["A" W !
S X=XTLKX,XTLKX="" F XTLKPC=1:1 S XTLKC=$E(X,XTLKPC) Q:XTLKC="" S:XTLKC?1L XTLKC=$C($A(XTLKC)-32) S XTLKX=XTLKX_XTLKC
K XTLKC
D ^XTLKKWL
Q:$D(DIROUT)!($D(DTOUT))
I +Y=-1 S X="~"_X W !,"Attempting FILEMAN lookup..." G EN2
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXTLKDICL 1340 printed Nov 22, 2024@17:51:14 Page 2
XTLKDICL ; IHS/ACC,ALB/JLU,SFISC/JC ;10/11/94 14:42
+1 ;;7.3;TOOLKIT;;Apr 25, 1995
+2 ;Bypass special lookup if XTLKUT exists or DIC(0)["I"
+3 IF $DATA(XTLKUT)
if DIC(0)'["I"
SET DIC(0)=DIC(0)_"I"
if $GET(DIPGM(0))=2
GOTO RTN^DIC
DO ^DIC
QUIT
+4 if '$DATA(X)
SET X=""
+5 IF X?1"?".E
SET X="~"_X
+6 if DIPGM(0)=2
GOTO EN2
EN1 ; FIRST ENTRY FROM DIC
+1 KILL HITLIMIT
+2 if DIC(0)["A"
GOTO ASK^DIC
EN2 ; SECOND ENTRY FROM DIC OR FALL-THROUGH IF NO 'ASK' INDICATED
+1 IF X="?BAD"!(X["^")
SET Y=-1
QUIT
+2 ;Precede entry with "`" to 'force' lookup by IEN
+3 IF X?1"`"1N.N!(U[X)!(X?1N.N)!(X?.N1".".N)
if '$DATA(D0(2))
DO DO^DIC1
GOTO RTN^DIC
+4 ;Precede entry with "~" to 'force' lookup by ALL X-REF'S
+5 IF X?1"~".E
SET X=$EXTRACT(X,2,99)
if '$DATA(D0(2))
DO DO^DIC1
GOTO RTN^DIC
+6 ;Setting up var, from old xtlkkwld routine
TS DO DO^DIC1
IF $DATA(DO(2))
IF '$DATA(^XT(8984.4,+DO(2),0))
WRITE $CHAR(7),!!,"'",$PIECE(DO,U),"' is not in the 'Local Lookup Files' file. Unable to use lookup."
SET Y=-1
QUIT
+1 SET XTLKX=X
KILL XTLKKSCH
SET XTLKKSCH("GBL")=DIC
SET XTLKKSCH("INDEX")=$PIECE(^XT(8984.4,+DO(2),0),U,3)
+2 SET XTLKKSCH("DSPLY")=$SELECT('$DATA(^XT(8984.4,+DO(2),1)):"DGEN^XTLKKWLD",$LENGTH(^(1))=0:"DGEN^XTLKKWLD",1:^(1))
+3 IF $DATA(DIC(0))
IF DIC(0)["A"
WRITE !
+4 SET X=XTLKX
SET XTLKX=""
FOR XTLKPC=1:1
SET XTLKC=$EXTRACT(X,XTLKPC)
if XTLKC=""
QUIT
if XTLKC?1L
SET XTLKC=$CHAR($ASCII(XTLKC)-32)
SET XTLKX=XTLKX_XTLKC
+5 KILL XTLKC
+6 DO ^XTLKKWL
+7 if $DATA(DIROUT)!($DATA(DTOUT))
QUIT
+8 IF +Y=-1
SET X="~"_X
WRITE !,"Attempting FILEMAN lookup..."
GOTO EN2
+9 QUIT
