LEXAI.m

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 ---LEXAI   1849     printed  Apr 09, 2024@21:11:59                                                                                                                                                                                                       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