Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LEXAL

LEXAL.m

Go to the documentation of this file.
  1. LEXAL ;ISL/KER - Look-up List (Global) ;05/23/2017
  1. ;;2.0;LEXICON UTILITY;**6,55,80,103**;Sep 23, 1996;Build 2
  1. ;
  1. ; Global Variables
  1. ; ^LEX(757 SACC 1.3
  1. ; ^LEX(757.01 SACC 1.3
  1. ; ^LEX(757.02 SACC 1.3
  1. ; ^LEX(757.1 SACC 1.3
  1. ; ^LEX(757.13 SACC 1.3
  1. ; ^LEX(757.14 SACC 1.3
  1. ; ^TMP("LEXFND") SACC 2.3.2.5.1
  1. ; ^TMP("LEXHIT") SACC 2.3.2.5.1
  1. ; ^TMP("LEXSCH") SACC 2.3.2.5.1
  1. ;
  1. ; External References
  1. ; $$DT^XLFDT ICR 10103
  1. ; $$UP^XLFSTR ICR 10103
  1. ;
  1. ; Local Variables NEWed or KILLed Elsewhere
  1. ; LEX Output Array
  1. ; LEXAFMT Output Format
  1. ; LEXSOA Code Array
  1. ; LEXTKN Token Array
  1. ; LEXVDT Versioning Date
  1. ; LEXXCT Category
  1. ; LEXXSR Category Source
  1. ;
  1. ; Add to the list
  1. ADDL(LEXI,LEXDS,LEXDP) ; Add
  1. ; LEXI Expression IEN
  1. ; LEXDS Expression IEN
  1. N LEXA S LEXA=$G(LEXI) Q:LEXA=0 Q:'$D(^LEX(757.01,LEXA)) S LEXI=$$SIEN(LEXA)
  1. S:+LEXI>0&(LEXI'=LEXA) LEXA=LEXI Q:LEXA=0 Q:'$D(^LEX(757.01,LEXA))
  1. S LEXDS=$G(LEXDS),LEXDP=$G(LEXDP)
  1. N LEXF,LEXT,LEXL,LEXC
  1. S LEXT=$G(^LEX(757.01,+LEXA,0)) S:+($G(LEXAFMT))'>0 LEXT=$$DISP(LEXA,LEXDS,LEXDP)
  1. S:$D(LEXIGN)&($P($G(^LEX(757.01,LEXA,1)),"^",5)>0) LEXT=LEXT_" (Deactivated Term)"
  1. S LEXF=$$LSTN(LEXA,"A")
  1. S:'$D(^TMP("LEXFND",$J,-LEXF,LEXA)) ^TMP("LEXSCH",$J,"NUM",0)=$G(^TMP("LEXSCH",$J,"NUM",0))+1
  1. S ^TMP("LEXFND",$J,-LEXF,LEXA)=LEXT
  1. I +($G(LEXAFMT))>0 D
  1. . N LEXI S LEXI=0 F S LEXI=$O(LEXSOA(LEXI)) Q:+LEXI'>0 D
  1. . . I $D(LEXSOA(+LEXI,"P")) S ^TMP("LEXFND",$J,-LEXF,LEXA,LEXI)=$G(LEXSOA(+LEXI,"P")) Q
  1. . . N LEXN S LEXN=$O(LEXSOA(+LEXI,0)) I LEXN>0 S ^TMP("LEXFND",$J,-LEXF,LEXA,LEXI)=$G(LEXSOA(+LEXI,+LEXN)) Q
  1. S:+LEXF'=0 ^TMP("LEXFND",$J,0)=LEXF
  1. S LEX=$G(^TMP("LEXSCH",$J,"NUM",0))
  1. Q
  1. ADDN(LEXI,LEXDS,LEXDP) ; Near match
  1. N LEXA S LEXA=$G(LEXI) Q:LEXA=0 Q:'$D(^LEX(757.01,LEXA))
  1. S LEXI=$$SIEN(LEXA) S:+LEXI>0&(LEXI'=LEXA) LEXA=LEXI Q:LEXA=0 Q:'$D(^LEX(757.01,LEXA))
  1. N LEXR,LEXN,LEXT S LEXR=LEXA Q:$D(^TMP("LEXFND",$J,-99999997,LEXA))
  1. S LEXN=-99999997
  1. F S LEXN=LEXN+1 Q:'$D(^TMP("LEXFND",$J,LEXN,0))
  1. I $P($G(^LEX(757.01,LEXA,1)),"^",2)'=1 D Q:+LEXA=0
  1. . S LEXA=+($G(^LEX(757.01,LEXA,1))),LEXA=+($G(^LEX(757,LEXA,0)))
  1. S LEXDS=$G(LEXDS),LEXDP=$G(LEXDP),LEXT=$$DISP(LEXA,LEXDS,LEXDP)
  1. S:$D(LEXIGN)&($P($G(^LEX(757.01,LEXA,1)),"^",5)>0) LEXT=LEXT_"(Deactivated Term)"
  1. S:'$D(^TMP("LEXFND",$J,-LEXF,LEXA)) ^TMP("LEXSCH",$J,"NUM",0)=$G(^TMP("LEXSCH",$J,"NUM",0))+1
  1. S ^TMP("LEXFND",$J,LEXN,LEXA)=LEXT
  1. S:LEXN<$G(^TMP("LEXFND",$J,0)) ^TMP("LEXFND",$J,0)=LEXN
  1. S LEX=$G(^TMP("LEXSCH",$J,"NUM",0))
  1. Q
  1. ADDE(LEXI,LEXDS,LEXDP) ; Exact match
  1. N LEXA S LEXA=$G(LEXI) Q:LEXA=0 Q:'$D(^LEX(757.01,LEXA)) S LEXI=$$SIEN(LEXA) S:+LEXI>0&(LEXI'=LEXA) LEXA=LEXI
  1. Q:LEXA=0 Q:'$D(^LEX(757.01,LEXA)) N LEXR,LEXT,LEXEX,LEXSR,LEXSY,LEXSI
  1. S LEXR=LEXA,LEXDS=$G(LEXDS),LEXDP=$G(LEXDP),LEXT=$$DISP(LEXA,LEXDS,LEXDP)
  1. S:$D(LEXIGN)&($P($G(^LEX(757.01,LEXA,1)),"^",5)>0) LEXT=LEXT_"(Deactivated Term)"
  1. S:'$D(^TMP("LEXFND",$J,-99999999,LEXA)) ^TMP("LEXSCH",$J,"NUM",0)=$G(^TMP("LEXSCH",$J,"NUM",0))+1
  1. S:+($G(LEXAFMT))>0 LEXT=$G(^LEX(757.01,LEXA,0))
  1. S ^TMP("LEXFND",$J,-99999999,LEXA)=LEXT,^TMP("LEXFND",$J,0)=-99999999
  1. I +($G(LEXAFMT))>0,$O(LEXSOA(0))>0 D
  1. . N LEXSI S LEXSI=0 S LEXSI=$O(LEXSOA(LEXSI)) Q:+LEXSI'>0 D
  1. . . I $D(LEXSOA(+LEXSI,"P")) S ^TMP("LEXFND",$J,-99999999,LEXA,LEXSI)=$G(LEXSOA(+LEXSI,"P")) Q
  1. . . N LEXN S LEXN=$O(LEXSOA(+LEXSI,0))
  1. . . I LEXN>0 S ^TMP("LEXFND",$J,-99999999,LEXA,LEXSI)=$G(LEXSOA(+LEXSI,+LEXN))
  1. S LEX=$G(^TMP("LEXSCH",$J,"NUM",0))
  1. Q
  1. ADDEM(LEXI,LEXDS,LEXDP) ; Exact match Major Concept
  1. N LEXA,LEXEX S LEXA=$G(LEXI) Q:LEXA=0 Q:'$D(^LEX(757.01,LEXA))
  1. S LEXI=$$SIEN(LEXA) S:+LEXI>0&(LEXI'=LEXA) LEXA=LEXI Q:LEXA=0 Q:'$D(^LEX(757.01,LEXA))
  1. S LEXEX=$G(^LEX(757.01,LEXA,0))
  1. N LEXR,LEXT S LEXR=LEXA Q:$P($G(^LEX(757.01,LEXA,1)),"^",2)'=1
  1. S LEXDS=$G(LEXDS),LEXDP=$G(LEXDP),LEXT=$$DISP(LEXA,LEXDS,LEXDP)
  1. S:+($G(LEXAFMT))>0 LEXT=$G(^LEX(757.01,LEXA,0))
  1. S:$D(LEXIGN)&($P($G(^LEX(757.01,LEXA,1)),"^",5)>0) LEXT=LEXT_"(Deactivated Term)"
  1. S:'$D(^TMP("LEXFND",$J,-99999998,LEXA)) ^TMP("LEXSCH",$J,"NUM",0)=$G(^TMP("LEXSCH",$J,"NUM",0))+1
  1. S ^TMP("LEXFND",$J,-99999998,LEXA)=LEXT,^TMP("LEXFND",$J,0)=-99999998
  1. I +($G(LEXAFMT))>0,$O(LEXSOA(0))>0 D
  1. . N LEXSI S LEXSI=0 S LEXSI=$O(LEXSOA(LEXSI)) Q:+LEXSI'>0 D
  1. . . I $D(LEXSOA(+LEXSI,"P")) S ^TMP("LEXFND",$J,-99999998,LEXA,LEXSI)=$G(LEXSOA(+LEXSI,"P")) Q
  1. . . N LEXN S LEXN=$O(LEXSOA(+LEXSI,0))
  1. . . I LEXN>0 S ^TMP("LEXFND",$J,-99999998,LEXA,LEXSI)=$G(LEXSOA(+LEXSI,+LEXN))
  1. S LEX=$G(^TMP("LEXSCH",$J,"NUM",0))
  1. Q
  1. ADDC(LEXI,LEXDS,LEXDP) ; Code
  1. N LEXA S LEXA=$G(LEXI) Q:LEXA=0 Q:'$D(^LEX(757.01,LEXA)) S LEXI=$$SIEN(LEXA) S:+LEXI>0&(LEXI'=LEXA) LEXA=LEXI Q:LEXA=0 Q:'$D(^LEX(757.01,LEXA))
  1. S LEXDS=$G(LEXDS),LEXDP=$G(LEXDP)
  1. N LEXT,LEXF,LEXC S LEXC=+($G(^LEX(757.01,LEXA,1))) Q:LEXC=0
  1. S LEXF=$G(^TMP("LEXFND",$J,0)) S:+LEXF=0 LEXF=-999999
  1. S LEXF=LEXF+1 S LEXT=$$DISP(LEXA,LEXDS,LEXDP)
  1. S:$D(LEXIGN)&($P($G(^LEX(757.01,LEXA,1)),"^",5)>0) LEXT=LEXT_"(Deactivated Term)"
  1. S:'$D(^TMP("LEXFND",$J,-LEXF,LEXA)) ^TMP("LEXSCH",$J,"NUM",0)=$G(^TMP("LEXSCH",$J,"NUM",0))+1
  1. S ^TMP("LEXFND",$J,LEXF,LEXA)=LEXT
  1. S ^TMP("LEXFND",$J,0)=LEXF
  1. S LEX=$G(^TMP("LEXSCH",$J,"NUM",0))
  1. Q
  1. DISP(LEXX,LEXDS,LEXDP) ; Display Text
  1. S LEXX=$G(^LEX(757.01,LEXX,0)) I +($G(LEXAFMT))'>0 S:$L(LEXDS) LEXX=LEXX_" "_LEXDS S:$L(LEXDP) LEXX=LEXX_" "_LEXDP
  1. Q LEXX
  1. BEG ; Begin List
  1. S:+($G(^TMP("LEXSCH",$J,"UNR",0)))>0&($L($G(^TMP("LEXSCH",$J,"NAR",0)))) LEX("NAR")=$G(^TMP("LEXSCH",$J,"NAR",0))
  1. Q:'$D(^TMP("LEXFND",$J))
  1. N LEXRL,LEXJ,LEXI,LEXA,LEXSTR,LEXDP
  1. S LEXRL=0,LEXLL=+($G(LEXLL)) S:$G(^TMP("LEXSCH",$J,"LEN",0))>0 LEXLL=$G(^TMP("LEXSCH",$J,"LEN",0))
  1. S:+LEXLL'>0 (LEXRL,LEXLL)=5 S LEXJ=0,LEXI=-9999999999
  1. ; Hit List ^TMP("LEXHIT",$J,#)
  1. F S LEXI=$O(^TMP("LEXFND",$J,LEXI)) Q:+LEXI=0 D
  1. . S LEXA=0
  1. . F S LEXA=$O(^TMP("LEXFND",$J,LEXI,LEXA)) Q:+LEXA=0!(LEXJ=LEXLL) D Q:+LEXA=0!(LEXJ=LEXLL)
  1. . . S LEXJ=LEXJ+1,LEXDP=^TMP("LEXFND",$J,LEXI,LEXA)
  1. . . S ^TMP("LEXHIT",$J,0)=LEXJ
  1. . . S ^TMP("LEXHIT",$J,LEXJ)=LEXA_"^"_LEXDP
  1. . . I $O(^TMP("LEXFND",$J,LEXI,LEXA,0))>0 D
  1. . . . N LEXK S LEXK=0 F S LEXK=$O(^TMP("LEXFND",$J,LEXI,LEXA,LEXK)) Q:+LEXK'>0 D
  1. . . . . N LEXS S LEXS=$G(^TMP("LEXFND",$J,LEXI,LEXA,LEXK))
  1. . . . . Q:'$L($P(LEXS,"^",1)) Q:'$L($P(LEXS,"^",2))
  1. . . . . S ^TMP("LEXHIT",$J,LEXJ,LEXK)=LEXS
  1. . . S:+($G(^TMP("LEXSCH",$J,"EXM",0)))=+LEXA ^TMP("LEXSCH",$J,"EXM",2)=LEXJ_"^"_$G(^LEX(757.01,+LEXA,0))
  1. . . S:+($G(^TMP("LEXSCH",$J,"EXC",0)))=+LEXA ^TMP("LEXSCH",$J,"EXC",2)=LEXJ_"^"_$G(^LEX(757.01,+LEXA,0))
  1. . . K ^TMP("LEXFND",$J,LEXI,LEXA)
  1. ; List LEX("LIST")
  1. I $D(^TMP("LEXSCH",$J,"NUM",0)) S LEX=+($G(^TMP("LEXSCH",$J,"NUM",0)))
  1. I LEXLL>0 D
  1. . N LEXI,LEXJ S (LEXJ,LEXI)=0
  1. . F S LEXJ=$O(^TMP("LEXHIT",$J,LEXJ)) Q:+LEXJ=0!(+LEXI=LEXLL) D Q:+LEXI=LEXLL
  1. . . S LEXI=LEXI+1,LEX("LIST",LEXI)=^TMP("LEXHIT",$J,LEXJ)
  1. . . I $O(^TMP("LEXHIT",$J,LEXJ,0))>0 D
  1. . . . N LEXK S LEXK=0 F S LEXK=$O(^TMP("LEXHIT",$J,LEXJ,LEXK)) Q:+LEXK'>0 D
  1. . . . . N LEXS S LEXS=$G(^TMP("LEXHIT",$J,LEXJ,LEXK))
  1. . . . . S:$L(LEXS) LEX("LIST",LEXI,LEXK)=LEXS
  1. . . S LEX("LIST",0)=LEXI_"^"_LEXI
  1. . . S (LEX("MAX"),^TMP("LEXSCH",$J,"LST",0))=LEXI
  1. S ^TMP("LEXSCH",$J,"TOL",0)=0 S:$D(LEX("LIST",1)) ^TMP("LEXSCH",$J,"TOL",0)=1
  1. S LEX=+($G(^TMP("LEXSCH",$J,"NUM",0)))
  1. S:^TMP("LEXSCH",$J,"TOL",0)=1&(+($G(LEX))>0) LEX("MAT")=+LEX_" match"_$S(+LEX>1:"es",1:"")_" found"
  1. ; Establish level of concept (1 = concept, >1= modifier) PCH 6
  1. S LEX("LVL")=+($G(LEX("LVL"))) S:LEX("LVL")=0 LEX("LVL")=1
  1. S:+($G(LEX("MAX")))>0 LEX("MIN")=1
  1. I $L($G(^TMP("LEXSCH",$J,"EXM",2))) S LEX("EXM")=^TMP("LEXSCH",$J,"EXM",2)
  1. I $L($G(^TMP("LEXSCH",$J,"EXC",2))) S LEX("EXC")=^TMP("LEXSCH",$J,"EXC",2)
  1. S:+($G(^TMP("LEXSCH",$J,"UNR",0)))>0&($L($G(^TMP("LEXSCH",$J,"NAR",0)))) LEX("NAR")=$G(^TMP("LEXSCH",$J,"NAR",0))
  1. Q:'$D(^TMP("LEXFND",$J)) K:+($G(LEXRL))>0 LEXLL
  1. Q
  1. LSTN(LEXA,LEXM) ; List Number
  1. N LEXC,LEXL,LEXF,LEXK,LEXT,LEXU,LEXN,LEXI S LEXK=0
  1. S LEXC=+($G(^LEX(757.01,LEXA,1))) Q:LEXC=0 0
  1. S LEXT=$G(^LEX(757.01,LEXA,0)) Q:'$L(LEXT) 0
  1. S LEXU=$$UP^XLFSTR(LEXT),LEXL=$L(LEXT) Q:LEXL=0 0
  1. S LEXN=$$CON(LEXU,.LEXTKN),LEXI=$P(LEXN,"^",2)
  1. S LEXN=+$P(LEXN,"^",1) S:LEXN>9 LEXN=9
  1. S LEXL=245-LEXL S:$L(LEXL)=1 LEXL="00"_LEXL
  1. N LEXC,LEXL,LEXF,LEXK S LEXK=0
  1. S LEXC=+($G(^LEX(757.01,LEXA,1))) Q:LEXC=0 0
  1. S LEXL=$L($G(^LEX(757.01,LEXA,0))) Q:LEXL=0 0
  1. S LEXL=245-LEXL S:$L(LEXL)=1 LEXL="00"_LEXL
  1. S:$L(LEXL)=2 LEXL="0"_LEXL S LEXL=$E(LEXL,1,3)
  1. ; Disable until after OCT 1, 2015
  1. ; S LEXF=$O(^LEX(757.001,"B",LEXC,0))
  1. ; S:+LEXF>0&($L($G(^LEX(757.001,+LEXF,0)))) LEXF=(+($P($G(^LEX(757.001,LEXF,0)),"^",3))+1)
  1. S LEXF=+($$FREQ(LEXC,$G(LEXVDT)))+1,LEXN=+($G(LEXN))
  1. S LEXK=$E(LEXN,1),LEXM=LEXF_"."_LEXK_LEXL
  1. Q LEXM
  1. CON(X,LEXX) ; Contains
  1. ;
  1. ; Input
  1. ;
  1. ; X Text String
  1. ; LEXX() An array of words passed by reference
  1. ; LEXX(1)=Word1
  1. ; LEXX(2)=Word2
  1. ; LEXX(n)=Wordn
  1. ;
  1. ; Output
  1. ;
  1. ; $$CON A 2 piece "^" delimited string
  1. ;
  1. ; 1 Number of words in LEXX() found in text X
  1. ; 2 The total number of words in array LEXX
  1. ;
  1. N LEXI,LEXS,LEXN,LEXT S LEXN=0,LEXT=0,LEXU=$$UP^XLFSTR($G(X)) Q:'$L(LEXU) 0
  1. S LEXI=0 F S LEXI=$O(LEXX(LEXI)) Q:+LEXI'>0 D
  1. . N LEXS S LEXT=LEXT+1,LEXS=$$UP^XLFSTR($G(LEXX(LEXI))) Q:'$L(LEXS)
  1. . I $E(LEXU,1,$L(LEXS))=LEXS S LEXN=LEXN+1 Q
  1. . F LEXC=" ","/","-","(","[","<",">","{",":",";" I LEXU[(LEXC_LEXS) S LEXN=LEXN+1 Q
  1. S X=LEXN_"^"_LEXT
  1. Q X
  1. Q
  1. SIEN(X) ; Sourced IEN (PCH 55)
  1. S X=$G(X) Q:+($G(LEXXSR))'>0&(+($G(LEXXCT))'>0) X Q:+($G(LEXXSR))>0&('$D(^LEX(757.14,+($G(LEXXSR)),0))) X Q:+($G(LEXXCT))>0&('$D(^LEX(757.13,+($G(LEXXCT)),0))) X
  1. N LEXIEN,LEXSX,LEXEX,LEXMC S (X,LEXSX,LEXIEN)=+($G(X)) Q:+LEXIEN'>0 X Q:'$D(^LEX(757.01,+LEXIEN,1)) X S LEXMC=+($G(^LEX(757.01,+LEXIEN,1))) Q:+LEXMC'>0 X Q:'$D(^LEX(757,+LEXMC,0)) X
  1. I +LEXXCT>0 D I LEXSX'=LEXIEN S X=LEXSX Q X
  1. . S LEXEX=0 F S LEXEX=$O(^LEX(757.01,"AMC",+LEXMC,LEXEX)) Q:+LEXEX'>0 D Q:LEXSX'=LEXIEN
  1. . . N LEXC S LEXC=$P($G(^LEX(757.01,+LEXEX,1)),"^",11) S:LEXC=LEXXCT LEXSX=LEXEX
  1. I +LEXXSR>0 D I LEXSX'=LEXIEN S X=LEXSX Q X
  1. . S LEXEX=0 F S LEXEX=$O(^LEX(757.01,"AMC",+LEXMC,LEXEX)) Q:+LEXEX'>0 D Q:LEXSX'=LEXIEN
  1. . . N LEXC S LEXC=$P($G(^LEX(757.01,+LEXEX,1)),"^",12) S:LEXC=LEXXSR LEXSX=LEXEX
  1. S X=LEXIEN
  1. Q X
  1. FREQ(X,Y) ; Get frequency based on codes and semantics
  1. N LEXBD,LEXBEH,LEXCLA,LEXDIA,LEXEFF,LEXHIS,LEXI10
  1. N LEXMC,LEXNF,LEXNUR,LEXPRO,LEXSAB,LEXSIEN,LEXSMC
  1. N LEXTD,SA,SIEN S LEXMC=+($G(X)),X=0 Q:'$D(^LEX(757,LEXMC,0)) X
  1. S LEXTD=$G(Y) S:LEXTD'?7N LEXTD=$$DT^XLFDT
  1. N SA,LEXSAB,LEXSMC,LEXNUR,LEXI10,LEXBEH,LEXPRO,LEXDIA
  1. S (SA,LEXNUR,LEXBEH,LEXPRO,LEXDIA,LEXI10,LEXSMC,X)=0,LEXNF=""
  1. ; ICD-10-CM 6
  1. ; ICD-10-PCS 5
  1. ; ICD-9 coded Diagnosis 4
  1. ; Behavior or non-ICD diagnosis 3
  1. ; Procedures 2
  1. ; Nursing 1
  1. D SO I +LEXI10>0 S:+LEXDIA=1 (LEXNF,X)=6 Q X
  1. I +LEXI10>0 S:+LEXDIA'=1 (LEXNF,X)=5 Q X
  1. I X=0,+LEXDIA=1 S (LEXNF,X)=4 Q X
  1. I '$L(LEXNF),+($G(LEXPRO))=1 S (LEXNF,X)=2 Q X
  1. I '$L(LEXNF),+($G(LEXNUR))=1 S (LEXNF,X)=1 Q X
  1. D SM I '$L(LEXNF),+($G(LEXSMC))>0 S (LEXNF,X)=3 Q X
  1. I '$L(LEXNF) S (LEXNF,X)=0
  1. Q X
  1. ;
  1. SO ; Codes
  1. N SIEN S LEXSIEN=0 F S LEXSIEN=$O(^LEX(757.02,"AMC",LEXMC,LEXSIEN)) Q:+LEXSIEN=0 D SOC
  1. Q
  1. SOC ; Set frequencey based on code
  1. N LEXEFF,LEXHIS
  1. S LEXEFF=$O(^LEX(757.02,LEXSIEN,4,"B",(LEXTD+.001)),-1) Q:LEXEFF'?7N
  1. S LEXHIS=$O(^LEX(757.02,LEXSIEN,4,"B",LEXEFF," "),-1)
  1. Q:$P($G(^LEX(757.02,LEXSIEN,4,+LEXHIS,0)),"^",2)'>0
  1. S LEXSAB=$P($G(^LEX(757.02,LEXSIEN,0)),"^",3)
  1. Q:LEXSAB=0
  1. ; ICD-10 CM/PCS
  1. S:LEXSAB=30!(LEXSAB=31) LEXI10=1
  1. ; Diagnosis ICD-9 and ICD-10
  1. S:LEXSAB=1!(LEXSAB=30) LEXDIA=1
  1. ; Procedures ICD-9, ICD-10, CPT and HCPCS
  1. S:LEXSAB=2!(LEXSAB=31)!(LEXSAB=3)!(LEXSAB=4) LEXPRO=1
  1. ; Behaviors DSM-III and DSM-IV
  1. S:LEXSAB=5!(LEXSAB=6) LEXBEH=1
  1. ; Nursing NANDA, NIC, NOC, HHC and Omaha
  1. S:LEXSAB>10&(LEXSAB<16) LEXNUR=1
  1. Q
  1. ;
  1. SM ; Semantics - LEXBD Behavior and Disorders
  1. S LEXSMC=0,LEXMC=+($G(LEXMC)) Q:'$D(^LEX(757,LEXMC,0)) N LEXCLA,LEXBD,LEXSIEN S (LEXBD,LEXSIEN)=0
  1. F S LEXSIEN=$O(^LEX(757.1,"B",LEXMC,LEXSIEN)) Q:+LEXSIEN=0 D SMC
  1. S LEXSMC=LEXBD
  1. Q
  1. SMC ; Set frequency based on semantic class
  1. S LEXCLA=+($P($G(^LEX(757.1,LEXSIEN,0)),U,2))
  1. ; Behavior
  1. S:LEXCLA=3&(LEXBD'>0) LEXBD=1
  1. ; Disease
  1. S:LEXCLA=6 LEXBD=2
  1. Q
  1. CLR ; Clear
  1. N LEXIGN
  1. Q