| 1 | XTLKKWL ; 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
|
|---|
| 9 | INIT 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!!!
|
|---|
| 19 | CHKSHRT 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
|
|---|
| 24 | NOTSHRT ;
|
|---|
| 25 | G NOTSHRT^XTLKKWL1
|
|---|
| 26 | VERIFY ;
|
|---|
| 27 | G VERIFY^XTLKKWL1
|
|---|
