source: FOIAVistA/tag/r/TOOLKIT-AWCM-XD-XIN-XPAR-XQAB-XT-XUC-XUR-ZIN-ZTED/XTLKKWL.m@ 1424

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

initial load of FOIAVistA 6/30/08 version

File size: 1.3 KB
Line 
1XTLKKWL ; IHS/OHPRD/ACC,ALB/JLU,SFISC/JC - LOOKUP DRIVER PROGRAM FOR "AND"ING INVERTED SEARCH ;07/22/93 15:46
2 ;;7.3;TOOLKIT;;Apr 25, 1995
3 ; ASSUMES XTLKKSCH("TYPE"),("GBL"),("INDEX") AND XTLKX
4 S XTLKXSAV=XTLKX
5 K Y
6 S XTLKGBL=XTLKKSCH("GBL"),XTLKL=XTLKX
7 S XTLKASK=$S('$D(DIC(0)):1,DIC(0)["E":1,1:0)
8 I $G(XTLKSAY)="" S XTLKSAY=1
9INIT I XTLKGBL'["^",XTLKGBL'?1N.N,XTLKGBL'?1N.N1"."1N.N S XTLKGBL=$O(^DIC("B",XTLKGBL,""))
10 S:XTLKGBL'["^" XTLKGBL=^DIC(XTLKGBL,0,"GL")
11 S XTLKREF=XTLKGBL_""""_XTLKKSCH("INDEX")_""",XTLKWD)"
12 S XTLKREF1=XTLKGBL
13 S XTLKREF2=$E(XTLKREF,1,$L(XTLKREF)-1)_","""")"
14 S XTLKREF3=XTLKGBL_"^TMP(""XTLKHITS"",$J,XTLKH),0)"
15 S XTLKREF4=$E(XTLKREF,1,$L(XTLKREF)-1)_",XTLKD)"
16 ; NOTE: CHKSHRT HAS BEEN CHANGED TO USE "AB" BECAUSE THE
17 ; B INDEX NO LONGER EXISTS FOR ICD FILES -- NEEDS TO
18 ; BE IMPROVED TO PRESERVE GENERALITY OF LOOKUP!!!
19CHKSHRT G:'$D(^XT(8984.2,"AC",$P(XTLKREF1,U,2),XTLKL)) NOTSHRT S XTLKI=$O(^(XTLKL,"")),XTLKL=$P($P(^XT(8984.2,XTLKI,0),U,2),";") S Y=$S(XTLKREF1'[$P($P(^XT(8984.2,XTLKI,0),U,2),";",2):-1,$D(@(XTLKREF1_"XTLKL,0)")):XTLKL,1:-1)
20 G:Y<1 NOTSHRT
21 I $D(@(XTLKREF1_"Y,0)")) X:$D(DIC("S")) DIC("S") E S Y=-1
22 G:Y<1 NOTSHRT
23 K ^TMP("XTLKHITS",$J) S ^TMP("XTLKHITS",$J)=1,^TMP("XTLKHITS",$J,1)=Y G VERIFY
24NOTSHRT ;
25 G NOTSHRT^XTLKKWL1
26VERIFY ;
27 G VERIFY^XTLKKWL1
Note: See TracBrowser for help on using the repository browser.