- LEXAI ;ISL/KER - Look-up by IEN ;05/23/2017
- ;;2.0;LEXICON UTILITY;**103**;Sep 23, 1996;Build 2
- ;
- ; Global Variables
- ; ^LEX(757.01 SACC 1.3
- ; ^TMP("LEXFND",$J) SACC 2.3.2.5.1
- ; ^TMP("LEXHIT",$J) SACC 2.3.2.5.1
- ; ^TMP("LEXSCH",$J) SACC 2.3.2.5.1
- ;
- ; External References
- ; None
- ;
- ; Local Variables NEWed or KILLed Elsewhere
- ; LEX Output Array
- ; LEXAFMT Output Format
- ;
- EN(LEXNAR,LEXVDT) ; Look-up by IEN
- S LEXNAR=$G(LEXNAR),LEXVDT=$G(LEXVDT) Q:$E(LEXNAR)'="`" 0 S LEXNAR=$E(LEXNAR,2,$L(LEXNAR)) Q:LEXNAR'?1N.N 0
- Q:'$D(^LEX(757.01,+LEXNAR,0)) 0 D VDT^LEXU N LEXE,LEXUN,LEXM,LEXL,LEXSOA,LEXLL
- S:$G(^TMP("LEXSCH",$J,"LEN",0))>0 LEXLL=$G(^TMP("LEXSCH",$J,"LEN",0)) S:$G(LEXLL)'>0 LEXLL=5
- I $D(^TMP("LEXSCH",$J,"FMT",0)) S:'$D(LEXAFMT)!($G(LEXAFMT)'?1N) LEXAFMT=$G(^TMP("LEXSCH",$J,"FMT",0))
- S LEXE=LEXNAR,LEXUN=+$G(^TMP("LEXSCH",$J,"UNR",0)) I +($G(LEXAFMT))'>0 D
- . D ADDL^LEXAL(LEXE,$$DES^LEXASC(LEXE),$$SO^LEXASO(LEXE,$G(^TMP("LEXSCH",$J,"DIS",0)),1,$G(LEXVDT)))
- I +($G(LEXAFMT))>0 D
- . N LEXD,LEXT,LEXS S LEXSOA="" S LEXS=$$SOA^LEXASO(LEXE,$G(^TMP("LEXSCH",$J,"DIS",0)),1,$G(LEXVDT),.LEXSOA)
- . D ADDL^LEXAL(LEXE,$$DES^LEXASC(LEXE),"")
- I $D(^TMP("LEXFND",$J)) D BEG^LEXAL
- I $L($G(^TMP("LEXSCH",$J,"NAR",0))) S LEX("NAR")=$G(^TMP("LEXSCH",$J,"NAR",0))
- I $L($G(^LEX(757.01,+$G(LEXE),0))) S LEX("NAR")=$G(^LEX(757.01,+$G(LEXE),0))
- S:$L($G(LEX("NAR"))) ^TMP("LEXSCH",$J,"NAR",0)=$G(LEX("NAR"))
- S LEXM=$O(LEX("LIST"," "),-1),LEXL=$O(LEX("LIST",0))
- S:LEXM>0 LEX=LEXM,LEX("MAT")=(LEXM_" match"_$S(LEXM'>1:" ",1:"es ")_"found"),^TMP("LEXSCH",$J,"NUM",0)=LEXM
- S:LEXM>0&(LEXL>0) LEX("MAX")=LEXM,LEX("MIN")=LEXL,LEX("LIST",0)=(LEXM_"^"_LEXL)
- Q:$D(^TMP("LEXHIT",$J)) 1
- Q 0
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLEXAI 1849 printed Mar 13, 2025@21:11:26 Page 2
- LEXAI ;ISL/KER - Look-up by IEN ;05/23/2017
- +1 ;;2.0;LEXICON UTILITY;**103**;Sep 23, 1996;Build 2
- +2 ;
- +3 ; Global Variables
- +4 ; ^LEX(757.01 SACC 1.3
- +5 ; ^TMP("LEXFND",$J) SACC 2.3.2.5.1
- +6 ; ^TMP("LEXHIT",$J) SACC 2.3.2.5.1
- +7 ; ^TMP("LEXSCH",$J) SACC 2.3.2.5.1
- +8 ;
- +9 ; External References
- +10 ; None
- +11 ;
- +12 ; Local Variables NEWed or KILLed Elsewhere
- +13 ; LEX Output Array
- +14 ; LEXAFMT Output Format
- +15 ;
- EN(LEXNAR,LEXVDT) ; Look-up by IEN
- +1 SET LEXNAR=$GET(LEXNAR)
- SET LEXVDT=$GET(LEXVDT)
- if $EXTRACT(LEXNAR)'="`"
- QUIT 0
- SET LEXNAR=$EXTRACT(LEXNAR,2,$LENGTH(LEXNAR))
- if LEXNAR'?1N.N
- QUIT 0
- +2 if '$DATA(^LEX(757.01,+LEXNAR,0))
- QUIT 0
- DO VDT^LEXU
- NEW LEXE,LEXUN,LEXM,LEXL,LEXSOA,LEXLL
- +3 if $GET(^TMP("LEXSCH",$JOB,"LEN",0))>0
- SET LEXLL=$GET(^TMP("LEXSCH",$JOB,"LEN",0))
- if $GET(LEXLL)'>0
- SET LEXLL=5
- +4 IF $DATA(^TMP("LEXSCH",$JOB,"FMT",0))
- if '$DATA(LEXAFMT)!($GET(LEXAFMT)'?1N)
- SET LEXAFMT=$GET(^TMP("LEXSCH",$JOB,"FMT",0))
- +5 SET LEXE=LEXNAR
- SET LEXUN=+$GET(^TMP("LEXSCH",$JOB,"UNR",0))
- IF +($GET(LEXAFMT))'>0
- Begin DoDot:1
- +6 DO ADDL^LEXAL(LEXE,$$DES^LEXASC(LEXE),$$SO^LEXASO(LEXE,$GET(^TMP("LEXSCH",$JOB,"DIS",0)),1,$GET(LEXVDT)))
- End DoDot:1
- +7 IF +($GET(LEXAFMT))>0
- Begin DoDot:1
- +8 NEW LEXD,LEXT,LEXS
- SET LEXSOA=""
- SET LEXS=$$SOA^LEXASO(LEXE,$GET(^TMP("LEXSCH",$JOB,"DIS",0)),1,$GET(LEXVDT),.LEXSOA)
- +9 DO ADDL^LEXAL(LEXE,$$DES^LEXASC(LEXE),"")
- End DoDot:1
- +10 IF $DATA(^TMP("LEXFND",$JOB))
- DO BEG^LEXAL
- +11 IF $LENGTH($GET(^TMP("LEXSCH",$JOB,"NAR",0)))
- SET LEX("NAR")=$GET(^TMP("LEXSCH",$JOB,"NAR",0))
- +12 IF $LENGTH($GET(^LEX(757.01,+$GET(LEXE),0)))
- SET LEX("NAR")=$GET(^LEX(757.01,+$GET(LEXE),0))
- +13 if $LENGTH($GET(LEX("NAR")))
- SET ^TMP("LEXSCH",$JOB,"NAR",0)=$GET(LEX("NAR"))
- +14 SET LEXM=$ORDER(LEX("LIST"," "),-1)
- SET LEXL=$ORDER(LEX("LIST",0))
- +15 if LEXM>0
- SET LEX=LEXM
- SET LEX("MAT")=(LEXM_" match"_$SELECT(LEXM'>1:" ",1:"es ")_"found")
- SET ^TMP("LEXSCH",$JOB,"NUM",0)=LEXM
- +16 if LEXM>0&(LEXL>0)
- SET LEX("MAX")=LEXM
- SET LEX("MIN")=LEXL
- SET LEX("LIST",0)=(LEXM_"^"_LEXL)
- +17 if $DATA(^TMP("LEXHIT",$JOB))
- QUIT 1
- +18 QUIT 0
