- XTLKKWL ; IHS/OHPRD/ACC,ALB/JLU,SFISC/JC - LOOKUP DRIVER PROGRAM FOR "AND"ING INVERTED SEARCH ;07/22/93 15:46
- ;;7.3;TOOLKIT;;Apr 25, 1995
- ; ASSUMES XTLKKSCH("TYPE"),("GBL"),("INDEX") AND XTLKX
- S XTLKXSAV=XTLKX
- K Y
- S XTLKGBL=XTLKKSCH("GBL"),XTLKL=XTLKX
- S XTLKASK=$S('$D(DIC(0)):1,DIC(0)["E":1,1:0)
- I $G(XTLKSAY)="" S XTLKSAY=1
- INIT I XTLKGBL'["^",XTLKGBL'?1N.N,XTLKGBL'?1N.N1"."1N.N S XTLKGBL=$O(^DIC("B",XTLKGBL,""))
- S:XTLKGBL'["^" XTLKGBL=^DIC(XTLKGBL,0,"GL")
- S XTLKREF=XTLKGBL_""""_XTLKKSCH("INDEX")_""",XTLKWD)"
- S XTLKREF1=XTLKGBL
- S XTLKREF2=$E(XTLKREF,1,$L(XTLKREF)-1)_","""")"
- S XTLKREF3=XTLKGBL_"^TMP(""XTLKHITS"",$J,XTLKH),0)"
- S XTLKREF4=$E(XTLKREF,1,$L(XTLKREF)-1)_",XTLKD)"
- ; NOTE: CHKSHRT HAS BEEN CHANGED TO USE "AB" BECAUSE THE
- ; B INDEX NO LONGER EXISTS FOR ICD FILES -- NEEDS TO
- ; BE IMPROVED TO PRESERVE GENERALITY OF LOOKUP!!!
- 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)
- G:Y<1 NOTSHRT
- I $D(@(XTLKREF1_"Y,0)")) X:$D(DIC("S")) DIC("S") E S Y=-1
- G:Y<1 NOTSHRT
- K ^TMP("XTLKHITS",$J) S ^TMP("XTLKHITS",$J)=1,^TMP("XTLKHITS",$J,1)=Y G VERIFY
- NOTSHRT ;
- G NOTSHRT^XTLKKWL1
- VERIFY ;
- G VERIFY^XTLKKWL1
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXTLKKWL 1353 printed Feb 19, 2025@00:07:49 Page 2
- XTLKKWL ; IHS/OHPRD/ACC,ALB/JLU,SFISC/JC - LOOKUP DRIVER PROGRAM FOR "AND"ING INVERTED SEARCH ;07/22/93 15:46
- +1 ;;7.3;TOOLKIT;;Apr 25, 1995
- +2 ; ASSUMES XTLKKSCH("TYPE"),("GBL"),("INDEX") AND XTLKX
- +3 SET XTLKXSAV=XTLKX
- +4 KILL Y
- +5 SET XTLKGBL=XTLKKSCH("GBL")
- SET XTLKL=XTLKX
- +6 SET XTLKASK=$SELECT('$DATA(DIC(0)):1,DIC(0)["E":1,1:0)
- +7 IF $GET(XTLKSAY)=""
- SET XTLKSAY=1
- INIT IF XTLKGBL'["^"
- IF XTLKGBL'?1N.N
- IF XTLKGBL'?1N.N1"."1N.N
- SET XTLKGBL=$ORDER(^DIC("B",XTLKGBL,""))
- +1 if XTLKGBL'["^"
- SET XTLKGBL=^DIC(XTLKGBL,0,"GL")
- +2 SET XTLKREF=XTLKGBL_""""_XTLKKSCH("INDEX")_""",XTLKWD)"
- +3 SET XTLKREF1=XTLKGBL
- +4 SET XTLKREF2=$EXTRACT(XTLKREF,1,$LENGTH(XTLKREF)-1)_","""")"
- +5 SET XTLKREF3=XTLKGBL_"^TMP(""XTLKHITS"",$J,XTLKH),0)"
- +6 SET XTLKREF4=$EXTRACT(XTLKREF,1,$LENGTH(XTLKREF)-1)_",XTLKD)"
- +7 ; NOTE: CHKSHRT HAS BEEN CHANGED TO USE "AB" BECAUSE THE
- +8 ; B INDEX NO LONGER EXISTS FOR ICD FILES -- NEEDS TO
- +9 ; BE IMPROVED TO PRESERVE GENERALITY OF LOOKUP!!!
- CHKSHRT if '$DATA(^XT(8984.2,"AC",$PIECE(XTLKREF1,U,2),XTLKL))
- GOTO NOTSHRT
- SET XTLKI=$ORDER(^(XTLKL,""))
- SET XTLKL=$PIECE($PIECE(^XT(8984.2,XTLKI,0),U,2),";")
- SET Y=$SELECT(XTLKREF1'[$PIECE($PIECE(^XT(8984.2,XTLKI,0),U,2),";",2):-1,$DATA(@(XTLKREF1_"XTLKL,0)")):XTLKL,1:-1)
- +1 if Y<1
- GOTO NOTSHRT
- +2 IF $DATA(@(XTLKREF1_"Y,0)"))
- if $DATA(DIC("S"))
- XECUTE DIC("S")
- IF '$TEST
- SET Y=-1
- +3 if Y<1
- GOTO NOTSHRT
- +4 KILL ^TMP("XTLKHITS",$JOB)
- SET ^TMP("XTLKHITS",$JOB)=1
- SET ^TMP("XTLKHITS",$JOB,1)=Y
- GOTO VERIFY
- NOTSHRT ;
- +1 GOTO NOTSHRT^XTLKKWL1
- VERIFY ;
- +1 GOTO VERIFY^XTLKKWL1