| 1 | LEXAB ; ISL/KER Look-up Exact Match "B" index ; 05/14/2003
|
|---|
| 2 | ;;2.0;LEXICON UTILITY;**25**;Sep 23, 1996
|
|---|
| 3 | ;
|
|---|
| 4 | ; External References
|
|---|
| 5 | ; DBIA 10104 $$UP^XLFSTR
|
|---|
| 6 | ;
|
|---|
| 7 | ; Exact match S X=$$EN^LEXAB("LEXSCH",LEXVDT)
|
|---|
| 8 | ;
|
|---|
| 9 | ; INPUT
|
|---|
| 10 | ; LEXSCH User input string to search for
|
|---|
| 11 | ; LEXVDT Date used to screen out inactive codes
|
|---|
| 12 | ;
|
|---|
| 13 | ; Notes:
|
|---|
| 14 | ;
|
|---|
| 15 | ; 1. If an exact match is found, it is placed at
|
|---|
| 16 | ; the top of the selection list at
|
|---|
| 17 | ; ^TMP("LEXFND",$J)
|
|---|
| 18 | ;
|
|---|
| 19 | ; 2. Returns
|
|---|
| 20 | ;
|
|---|
| 21 | ; 0 - Exact match not found
|
|---|
| 22 | ; 1 - Exact match found
|
|---|
| 23 | ;
|
|---|
| 24 | EN(LEXSCH,LEXVDT) ; Check "B" index for exact match
|
|---|
| 25 | Q:'$L(LEXSCH) 0
|
|---|
| 26 | N LEXLKGL,LEXEM,LEXEMC S LEXLKGL=$G(^TMP("LEXSCH",$J,"GBL",0)),LEXEMC=0
|
|---|
| 27 | Q:$G(LEXLKGL)'["757.01" 0
|
|---|
| 28 | N LEXSHOW S LEXSHOW=$G(^TMP("LEXSCH",$J,"DIS",0))
|
|---|
| 29 | N LEXO,LEXE,LEXOK,LEXDES,LEXDSP
|
|---|
| 30 | S (LEXE,LEXOK)=0,LEXO=$$SCH(LEXSCH)
|
|---|
| 31 | F S LEXO=$O(^LEX(757.01,"B",LEXO)) Q:LEXO=""!(LEXSCH'[LEXO) D
|
|---|
| 32 | . S (LEXE,LEXOK)=0
|
|---|
| 33 | . F S LEXE=$O(^LEX(757.01,"B",LEXO,LEXE)) Q:+LEXE=0 D
|
|---|
| 34 | . . Q:+($P($G(^LEX(757.01,LEXE,1)),"^",5))=1
|
|---|
| 35 | . . I $$UP^XLFSTR(LEXSCH)=$$UP^XLFSTR($G(^LEX(757.01,LEXE,0))) D
|
|---|
| 36 | . . . S LEXEMC=+($G(LEXEMC)),LEXEMC=LEXEMC+1,LEXEM=LEXE
|
|---|
| 37 | S:+($G(LEXEMC))=1 LEXOK=$G(LEXEM) S:+($G(LEXEMC))'=1 LEXOK=0
|
|---|
| 38 | ; Exact Match Found
|
|---|
| 39 | I +LEXOK>0 D
|
|---|
| 40 | . S LEXE=LEXOK
|
|---|
| 41 | . ; Filter
|
|---|
| 42 | . S LEXFILR=$$EN^LEXAFIL($G(LEXFIL),LEXE) Q:LEXFILR=0
|
|---|
| 43 | . ; Deactivated
|
|---|
| 44 | . Q:+($P($G(^LEX(757.01,LEXE,1)),"^",5))=1
|
|---|
| 45 | . S LEXDES=$$DES(LEXE)
|
|---|
| 46 | . S LEXDSP="" S:$L($G(LEXSHOW)) LEXDSP=$$DSP(LEXE,$G(LEXSHOW),$G(LEXVDT))
|
|---|
| 47 | . D ADDE^LEXAL(LEXE,LEXDES,LEXDSP)
|
|---|
| 48 | . S ^TMP("LEXSCH",$J,"EXM",0)=LEXE
|
|---|
| 49 | . S ^TMP("LEXSCH",$J,"EXM",1)=$G(^LEX(757.01,+LEXE,0))
|
|---|
| 50 | . I '$D(^LEX(757,"B",LEXE)) D
|
|---|
| 51 | . . N LEXME,LEXM S LEXM=+($G(^LEX(757.01,LEXE,1))) Q:LEXM=0
|
|---|
| 52 | . . S LEXME=+($G(^LEX(757,LEXM,0))) Q:LEXM=0 Q:LEXE=LEXME
|
|---|
| 53 | . . I +($G(^LEX(757.01,LEXME,1)))=LEXM D
|
|---|
| 54 | . . . S LEXDES=$$DES(LEXME),LEXDSP="" S:$L($G(LEXSHOW)) LEXDSP=$$DSP(LEXE,$G(LEXSHOW),$G(LEXVDT))
|
|---|
| 55 | . . . D ADDEM^LEXAL(LEXME,LEXDES,LEXDSP)
|
|---|
| 56 | . . . S ^TMP("LEXSCH",$J,"EXC",0)=LEXME
|
|---|
| 57 | . . . S ^TMP("LEXSCH",$J,"EXC",1)=$G(^LEX(757.01,+LEXME,0))
|
|---|
| 58 | Q:$D(^TMP("LEXFND",$J)) 1
|
|---|
| 59 | Q 0
|
|---|
| 60 | DES(LEXX) ; Get description flag
|
|---|
| 61 | N LEXDES,LEXE,LEXM S LEXDES="",LEXE=+LEXX
|
|---|
| 62 | S LEXM=$P($G(^LEX(757.01,+($G(LEXX)),1)),"^",1)
|
|---|
| 63 | S LEXM=+($G(^LEX(757,+($G(LEXM)),0)))
|
|---|
| 64 | S:$D(^LEX(757.01,LEXM,3)) LEXDES="*"
|
|---|
| 65 | S LEXX=$G(LEXDES) Q LEXX
|
|---|
| 66 | TERM(LEXX) ; Get expression
|
|---|
| 67 | Q $G(^LEX(757.01,LEXX,0))
|
|---|
| 68 | DSP(LEXX,LEXDSP,LEXVDT) ; Return displayable text
|
|---|
| 69 | N LEXMCE S LEXMCE=+($G(^LEX(757,+($G(^LEX(757.01,LEXX,1))),0)))
|
|---|
| 70 | I +LEXMCE>0,$D(^LEX(757.01,+LEXMCE,0)) S LEXX=$$SO^LEXASO(+LEXMCE,LEXDSP,1,$G(LEXVDT)) Q LEXX
|
|---|
| 71 | S LEXX=$$SO^LEXASO(LEXX,LEXDSP,1,$G(LEXVDT)) Q LEXX
|
|---|
| 72 | SCH(LEXX) ; Search for LEXX a $Orderable variable
|
|---|
| 73 | S LEXX=$$UP^XLFSTR($E(LEXX,1,63))
|
|---|
| 74 | S LEXX=$E(LEXX,1,($L(LEXX)-1))_$C($A($E(LEXX,$L(LEXX)))-1)_"~" Q LEXX
|
|---|
