source: WorldVistAEHR/trunk/r/TOOLKIT-AWCM-XD-XIN-XPAR-XQAB-XT-XUC-XUR-ZIN-ZTED/XTLKDICL.m@ 1365

Last change on this file since 1365 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.3 KB
RevLine 
[613]1XTLKDICL ; IHS/ACC,ALB/JLU,SFISC/JC ;10/11/94 14:42
2 ;;7.3;TOOLKIT;;Apr 25, 1995
3 ;Bypass special lookup if XTLKUT exists or DIC(0)["I"
4 I $D(XTLKUT) S:DIC(0)'["I" DIC(0)=DIC(0)_"I" G:$G(DIPGM(0))=2 RTN^DIC D ^DIC Q
5 S:'$D(X) X=""
6 I X?1"?".E S X="~"_X
7 G:DIPGM(0)=2 EN2
8EN1 ; FIRST ENTRY FROM DIC
9 K HITLIMIT
10 G:DIC(0)["A" ASK^DIC
11EN2 ; SECOND ENTRY FROM DIC OR FALL-THROUGH IF NO 'ASK' INDICATED
12 I X="?BAD"!(X["^") S Y=-1 Q
13 ;Precede entry with "`" to 'force' lookup by IEN
14 I X?1"`"1N.N!(U[X)!(X?1N.N)!(X?.N1".".N) D:'$D(D0(2)) DO^DIC1 G RTN^DIC
15 ;Precede entry with "~" to 'force' lookup by ALL X-REF'S
16 I X?1"~".E S X=$E(X,2,99) D:'$D(D0(2)) DO^DIC1 G RTN^DIC
17 ;Setting up var, from old xtlkkwld routine
18TS 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
19 S XTLKX=X K XTLKKSCH S XTLKKSCH("GBL")=DIC,XTLKKSCH("INDEX")=$P(^XT(8984.4,+DO(2),0),U,3)
20 S XTLKKSCH("DSPLY")=$S('$D(^XT(8984.4,+DO(2),1)):"DGEN^XTLKKWLD",$L(^(1))=0:"DGEN^XTLKKWLD",1:^(1))
21 I $D(DIC(0)),DIC(0)["A" W !
22 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
23 K XTLKC
24 D ^XTLKKWL
25 Q:$D(DIROUT)!($D(DTOUT))
26 I +Y=-1 S X="~"_X W !,"Attempting FILEMAN lookup..." G EN2
27 Q
Note: See TracBrowser for help on using the repository browser.