source: WorldVistAEHR/trunk/r/LEXICON_UTILITY-LEX-GMPT/LEXASC.m@ 1006

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

initial load of WorldVistAEHR

File size: 2.4 KB
Line 
1LEXASC ; 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 ;
20EN(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
44DES(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
50TERM(LEXX) ; Get expression
51 Q $G(^LEX(757.01,LEXX,0))
52DSP(LEXX,LEXDSP,LEXVDT) ; Return displayable text
53 S LEXX=$$SO^LEXASO(LEXX,LEXDSP,1,$G(LEXVDT)) Q LEXX
54SUB(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
Note: See TracBrowser for help on using the repository browser.