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 Dec 13, 2024@02:06:56 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
