89 lines
4.7 KiB
Mathematica
89 lines
4.7 KiB
Mathematica
LEXAMD ; ISL/KER Look-up Modifiers ; 05/14/2003
|
|
;;2.0;LEXICON UTILITY;**6,25**;Sep 23, 1996;Build 1
|
|
;
|
|
; LEXX IEN file 757.01 of an expression w/Modifiers
|
|
; LEXVDT Date to screen against
|
|
;
|
|
EN(LEXX,LEXVDT) ; Look-up Modifiers
|
|
S LEXX=+($G(LEXX)) Q:+($G(^TMP("LEXSCH",$J,"MOD",0)))=0
|
|
Q:+($G(LEXX))'>2 Q:'$D(^LEX(757.01,+($G(LEXX)),0))
|
|
Q:+($P($G(^LEX(757.01,+LEXX,1)),"^",6))=0
|
|
Q:'$D(^LEX(757.01,"APAR",LEXX)) N LEXXN D ARY
|
|
Q
|
|
ARY ; Build Array of Modified Terms
|
|
N LEXLVL,LEXO,LEXI,LEXN,LEXA,LEXT,LEXDSP,LEXDES,LEXL
|
|
S LEXI=0,LEXXN=$G(^LEX(757.01,LEXX,0)),LEXA(0)=1
|
|
S LEXA(1,LEXX)=LEXXN,LEXLVL=+($G(LEX("LVL"))) S:LEXLVL=0 LEXLVL=1
|
|
F S LEXI=$O(^LEX(757.01,"APAR",LEXX,LEXI)) Q:+LEXI=0 D
|
|
. S LEXN=$G(^LEX(757.01,LEXI,1)) Q:LEXN="" S LEXT=+($P(LEXN,"^",2)) Q:LEXT'=7
|
|
. S LEXO=+($P(LEXN,"^",10)) S:LEXO'=0 LEXO=LEXO+1 S:LEXO=0 LEXO=99999 I $D(LEXA(LEXO)) F Q:'$D(LEXA(LEXO)) S LEXO=LEXO+1
|
|
. S LEXA(LEXO,LEXI)=$G(^LEX(757.01,LEXI,0)),LEXA(0)=+($G(LEXA(0)))+1
|
|
; Quit if no Modified Terms Found
|
|
Q:+($G(LEXA(0)))'>1 S (LEXO,LEXI)=0 D FND
|
|
Q
|
|
FND ; Build List of Modifiers Found (LEXFND)
|
|
K ^TMP("LEXSCH",$J,"EXM"),^TMP("LEXSCH",$J,"NAR"),^TMP("LEXSCH",$J,"SCH"),^TMP("LEXSCH",$J,"TOL"),^TMP("LEXSCH",$J,"NUM"),^TMP("LEXFND",$J)
|
|
F S LEXO=$O(LEXA(LEXO)) Q:+LEXO=0 D
|
|
. S LEXI=0 F S LEXI=$O(LEXA(LEXO,LEXI)) Q:+LEXI=0 D
|
|
. . I LEXO=1 S LEXDES=$$DES(LEXI),LEXDSP=$$SO^LEXASO(LEXI,$G(LEXSHOW),1,$G(LEXVDT))
|
|
. . I LEXO>1 S (LEXDES,LEXDSP)=""
|
|
. . S LEXT=$G(LEXA(LEXO,LEXI)) Q:'$L(LEXT)
|
|
. . S:$L(LEXDES) LEXT=LEXT_" "_LEXDES
|
|
. . S:$L(LEXDSP) LEXT=LEXT_" "_LEXDSP
|
|
. . S LEXN=-999999999+($G(LEXO))
|
|
. . S ^TMP("LEXFND",$J,LEXN,LEXI)=LEXT
|
|
. . S ^TMP("LEXSCH",$J,"NUM",0)=$G(^TMP("LEXSCH",$J,"NUM",0))+1
|
|
HIT ; Build HIT list
|
|
I $D(^TMP("LEXFND",$J)) D Q
|
|
. K LEX,^TMP("LEXHIT",$J) S LEX=+($G(LEXA(0))),LEX("LVL")=+($G(LEXLVL))+1 S:+LEX>0 (^TMP("LEXSCH",$J,"MAT",0),LEX("MAT"))=+LEX_" matches found for """_LEXXN_"""" D SCH,BEG,NAR
|
|
I '$D(^TMP("LEXFND",$J)) D NOM
|
|
Q
|
|
SCH ; Search Conditions/Results
|
|
K ^TMP("LEXSCH",$J,"EXM") S ^TMP("LEXSCH",$J,"NAR",0)=$$UP(LEXXN),^TMP("LEXSCH",$J,"SCH",0)=$$UP(LEXXN),^TMP("LEXSCH",$J,"TOL",0)=1,^TMP("LEXSCH",$J,"NUM",0)=+($G(^TMP("LEXSCH",$J,"NUM",0)))
|
|
Q
|
|
NOM ; No Modifiers
|
|
K LEX,^TMP("LEXFND",$J),^TMP("LEXHIT",$J),^TMP("LEXSCH",$J,"EXM"),^TMP("LEXSCH",$J,"NAR"),^TMP("LEXSCH",$J,"SCH"),^TMP("LEXSCH",$J,"TOL")
|
|
S ^TMP("LEXSCH",$J,"NUM",0)=0 S:$L($G(LEXXN)) ^TMP("LEXSCH",$J,"NAR",0)=$$UP(LEXXN) S:$L($G(LEXXN)) ^TMP("LEXSCH",$J,"SCH",0)=$$UP(LEXXN)
|
|
Q
|
|
NAR ; Narrative
|
|
S:+($G(^TMP("LEXSCH",$J,"UNR",0)))>0&($L($G(^TMP("LEXSCH",$J,"NAR",0)))) LEX("NAR")=$G(^TMP("LEXSCH",$J,"NAR",0))
|
|
Q
|
|
DES(LEXX) ; Get description flag
|
|
N LEXDES,LEXE,LEXM S LEXDES="",LEXE=+LEXX
|
|
S LEXM=$P($G(^LEX(757.01,+($G(LEXX)),1)),"^",1),LEXM=+($G(^LEX(757,+($G(LEXM)),0))) S:$D(^LEX(757.01,LEXM,3)) LEXDES="*" S LEXX=$G(LEXDES) Q LEXX
|
|
BEG ; Begin List
|
|
S:+($G(^TMP("LEXSCH",$J,"UNR",0)))>0&($L($G(^TMP("LEXSCH",$J,"NAR",0)))) LEX("NAR")=$G(^TMP("LEXSCH",$J,"NAR",0))
|
|
Q:'$D(^TMP("LEXFND",$J))
|
|
N LEXRL,LEXJ,LEXI,LEXA,LEXSTR,LEXDP,LEXLL
|
|
S LEXRL=0,LEXLL=+($G(^TMP("LEXSCH",$J,"LEN",0)))
|
|
S:+LEXLL=0 (LEXRL,LEXLL)=5 S LEXJ=0,LEXI=-9999999999
|
|
; Hit List ^TMP("LEXHIT",$J,#)
|
|
F S LEXI=$O(^TMP("LEXFND",$J,LEXI)) Q:+LEXI=0 D
|
|
. S LEXA=0
|
|
. F S LEXA=$O(^TMP("LEXFND",$J,LEXI,LEXA)) Q:+LEXA=0!(LEXJ=LEXLL) D Q:+LEXA=0!(LEXJ=LEXLL)
|
|
. . S LEXJ=LEXJ+1,LEXDP=^TMP("LEXFND",$J,LEXI,LEXA)
|
|
. . S ^TMP("LEXHIT",$J,0)=LEXJ
|
|
. . S ^TMP("LEXHIT",$J,LEXJ)=LEXA_"^"_LEXDP
|
|
. . S:+($G(^TMP("LEXSCH",$J,"EXM",0)))=+LEXA ^TMP("LEXSCH",$J,"EXM",2)=LEXJ_"^"_$G(^LEX(757.01,+LEXA,0))
|
|
. . S:+($G(^TMP("LEXSCH",$J,"EXC",0)))=+LEXA ^TMP("LEXSCH",$J,"EXC",2)=LEXJ_"^"_$G(^LEX(757.01,+LEXA,0))
|
|
. . K ^TMP("LEXFND",$J,LEXI,LEXA)
|
|
; List LEX("LIST")
|
|
I $D(^TMP("LEXSCH",$J,"NUM",0)) S LEX=+($G(^TMP("LEXSCH",$J,"NUM",0)))
|
|
I LEXLL>0 D
|
|
. N LEXI,LEXJ S (LEXJ,LEXI)=0
|
|
. F S LEXJ=$O(^TMP("LEXHIT",$J,LEXJ)) Q:+LEXJ=0!(+LEXI=LEXLL) D Q:+LEXI=LEXLL
|
|
. . S LEXI=LEXI+1,LEX("LIST",LEXI)=^TMP("LEXHIT",$J,LEXJ)
|
|
. . S LEX("LIST",0)=LEXI_"^"_LEXI
|
|
. . S (LEX("MAX"),^TMP("LEXSCH",$J,"LST",0))=LEXI
|
|
S ^TMP("LEXSCH",$J,"TOL",0)=0 S:$D(LEX("LIST",1)) ^TMP("LEXSCH",$J,"TOL",0)=1
|
|
S LEX=+($G(^TMP("LEXSCH",$J,"NUM",0)))
|
|
S:^TMP("LEXSCH",$J,"TOL",0)=1&(+($G(LEX))>0) LEX("MAT")=+LEX_" match"_$S(+LEX>1:"es",1:"")_" found"
|
|
S:+($G(LEX("MAX")))>0 LEX("MIN")=1
|
|
I $L($G(^TMP("LEXSCH",$J,"EXM",2))) S LEX("EXM")=^TMP("LEXSCH",$J,"EXM",2)
|
|
I $L($G(^TMP("LEXSCH",$J,"EXC",2))) S LEX("EXC")=^TMP("LEXSCH",$J,"EXC",2)
|
|
S:+($G(^TMP("LEXSCH",$J,"UNR",0)))>0&($L($G(^TMP("LEXSCH",$J,"NAR",0)))) LEX("NAR")=$G(^TMP("LEXSCH",$J,"NAR",0))
|
|
Q:'$D(^TMP("LEXFND",$J)) K:+($G(LEXRL))>0 LEXLL
|
|
Q
|
|
UP(X) Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
|
|
CLR K X,Y,LEXLL,LEXSHOW,LEX,^TMP("LEXSCH"),^TMP("LEXHIT"),^TMP("LEXFND") Q
|