| [613] | 1 | LEXASC ; ISL/KER Look-up by Shortcuts ; 05/14/2003
|
|---|
| 2 | ;;2.0;LEXICON UTILITY;**25**;Sep 23, 1996;Build 1
|
|---|
| 3 | ;
|
|---|
| 4 | ; ^TMP("LEXFND",$J) Entries found
|
|---|
| 5 | ; ^TMP("LEXHIT",$J) Entries returned
|
|---|
| 6 | ;
|
|---|
| 7 | ; LEXSCH User input string to search for
|
|---|
| 8 | ; LEXVDT Date is used to screen out inactive codes
|
|---|
| 9 | ;
|
|---|
| 10 | ; LEXC Pointer to Shortcut Context in file 757.41
|
|---|
| 11 | ; LEXS Pointer to Shortcut in file 757.4
|
|---|
| 12 | ; LEXE Pointer to expression in 757.01
|
|---|
| 13 | ; LEXM Pointer to Major Concept in 757.01
|
|---|
| 14 | ;
|
|---|
| 15 | ; LEXDSP Source Display string
|
|---|
| 16 | ; LEXDES Flag - has (*) or doesn't have () a description
|
|---|
| 17 | ; LEXSHOW Display string from Application/User defaults
|
|---|
| 18 | ; LEXX Returned variable from functions
|
|---|
| 19 | ;
|
|---|
| 20 | EN(LEXSCH,LEXC,LEXVDT) ; Check Shortcuts file 757.4 for LEXSCH
|
|---|
| 21 | S LEXC=+($G(LEXC))
|
|---|
| 22 | Q:'$L(LEXSCH)!(LEXC=0) 0
|
|---|
| 23 | Q:'$D(^LEX(757.41,LEXC)) 0
|
|---|
| 24 | Q:$L(LEXSCH)<2!($L(LEXSCH)>63) 0
|
|---|
| 25 | Q:'$D(^LEX(757.4,"ARA",LEXSCH,LEXC)) 0
|
|---|
| 26 | N LEXS S LEXS=0
|
|---|
| 27 | F S LEXS=$O(^LEX(757.4,"ARA",LEXSCH,LEXC,LEXS)) Q:+LEXS=0 D
|
|---|
| 28 | . N LEXE,LEXDES,LEXDSP
|
|---|
| 29 | . S LEXE=+($G(^LEX(757.4,LEXS,0))) Q:LEXE'>0
|
|---|
| 30 | . ; Filter
|
|---|
| 31 | . S LEXFILR=$$EN^LEXAFIL($G(LEXFIL),LEXE) Q:LEXFILR=0
|
|---|
| 32 | . ; Deactivated Term
|
|---|
| 33 | . Q:+($P($G(^LEX(757.01,LEXE,1)),"^",5))=1
|
|---|
| 34 | . Q:+($$SUB(LEXE))=0
|
|---|
| 35 | . S LEXDES=$$DES(LEXE)
|
|---|
| 36 | . S LEXDSP="",LEXSHOW=$G(^TMP("LEXSCH",$J,"DIS",0)) S:$L($G(LEXSHOW)) LEXDSP=$$DSP(LEXE,$G(LEXSHOW),$G(LEXVDT))
|
|---|
| 37 | . D ADDL^LEXAL(LEXE,LEXDES,LEXDSP)
|
|---|
| 38 | I $D(^TMP("LEXFND",$J)) D BEG^LEXAL
|
|---|
| 39 | I '$D(^TMP("LEXFND",$J)) D
|
|---|
| 40 | . K LEX,^TMP("LEXFND",$J),^TMP("LEXHIT",$J) S LEX=0
|
|---|
| 41 | . S:+($G(^TMP("LEXSCH",$J,"UNR",0)))>0&($L($G(^TMP("LEXSCH",$J,"NAR",0)))) LEX("NAR")=$G(^TMP("LEXSCH",$J,"NAR",0))
|
|---|
| 42 | Q:$D(^TMP("LEXHIT",$J)) 1
|
|---|
| 43 | Q 0
|
|---|
| 44 | DES(LEXX) ; Get description flag
|
|---|
| 45 | N LEXDES,LEXE,LEXM S LEXDES="",LEXE=+LEXX
|
|---|
| 46 | S LEXM=$P($G(^LEX(757.01,+($G(LEXX)),1)),"^",1)
|
|---|
| 47 | S LEXM=+($G(^LEX(757,+($G(LEXM)),0)))
|
|---|
| 48 | S:$D(^LEX(757.01,LEXM,3)) LEXDES="*"
|
|---|
| 49 | S LEXX=$G(LEXDES) Q LEXX
|
|---|
| 50 | TERM(LEXX) ; Get expression
|
|---|
| 51 | Q $G(^LEX(757.01,LEXX,0))
|
|---|
| 52 | DSP(LEXX,LEXDSP,LEXVDT) ; Return displayable text
|
|---|
| 53 | S LEXX=$$SO^LEXASO(LEXX,LEXDSP,1,$G(LEXVDT)) Q LEXX
|
|---|
| 54 | SUB(LEXX) ;
|
|---|
| 55 | Q:$G(^TMP("LEXSCH",$J,"GBL",0))'="^LEX(757.21," 1
|
|---|
| 56 | Q:'$L($G(^TMP("LEXSCH",$J,"IDX",0))) 1
|
|---|
| 57 | N LEXIDX,LEXSS,LEXSN S LEXIDX=$G(^TMP("LEXSCH",$J,"IDX",0))
|
|---|
| 58 | S LEXSS=$E(LEXIDX,2,$L(LEXIDX))
|
|---|
| 59 | S LEXSN=$O(^LEXT(757.2,"AA",LEXSS,0))
|
|---|
| 60 | Q:+($G(LEXSN))=0 1
|
|---|
| 61 | N LEXOK,LEXR S (LEXR,LEXOK)=0
|
|---|
| 62 | F S LEXR=$O(^LEX(757.21,"B",LEXX,LEXR)) Q:+LEXR=0 D
|
|---|
| 63 | . I $P($G(^LEX(757.21,LEXR,0)),"^",2)=LEXSN S LEXOK=1
|
|---|
| 64 | S LEXX=LEXOK Q LEXX
|
|---|
