- 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 Mar 13, 2025@21:46:21 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
