LEXAR3.m

LEXAR3 ;ISL/KER - Look-up Response (Help, Def, MAX) ;05/23/2017

 ;;2.0;LEXICON UTILITY;**73,80,103**;Sep 23, 1996;Build 2

 ;               

 ; Global Variables

 ;    ^TMP("LEXHIT")      SACC 2.3.2.5.1

 ;    ^TMP("LEXSCH")      SACC 2.3.2.5.1

 ;               

 ; External References

 ;    $$IMP^ICDEX         ICR   5747

 ;    $$DT^XLFDT          ICR  10103

 ;               

 ; Local Variables NEWed or KILLed Elsewhere

 ;     LEXLL   List Length NEWed in LEXAR

 ;     LEXUR   User's Response NEWed in LEXAR

 ;     LEXVDT  Versioning Date NEWed in LEXAR

 ;               

HLP ; Help

 N LEXRP,LEXMAX K LEX("HLP")

 S LEXMAX=+($G(^TMP("LEXSCH",$J,"LST",0)))

 I LEXUR["??" D EXT Q

 S LEXRP=+($P(LEXUR,"?",2,229))

 I LEXRP>0,LEXRP'>LEXMAX D  Q

 . S LEXRP=+($G(^TMP("LEXHIT",$J,LEXRP))) D DEF(LEXRP)

 I LEXUR["?",LEXRP'["?",+LEXRP'>0 D STD

 Q

STD ; Standard Help   LEX("HLP",

 I +($G(LEX))=1 D STD2 Q

 N LEXC S LEXC=+($G(LEX("HLP",0))),LEXC=LEXC+1,LEX("HLP",0)=LEXC

 S:LEX'>LEXMAX LEX("HLP",LEXC)="Select 1-"_LEXMAX_", ^ (quit), or ?# (help on a term)"

 S:LEX>LEXMAX LEX("HLP",LEXC)="Select 1-"_LEXMAX_", ^ (quit), ^# (jump - "_LEX_"), ?# (term help), or <Return> for more"

 D:$D(LEX("LIST")) LST^LEXAR

 Q

STD2 ; Standard Help   LEX("HLP",

 K LEX("HLP") S LEXRP=+($G(^TMP("LEXHIT",$J,1))) D DEF(LEXRP)

 N LEXC S LEXC=+($G(LEX("HLP",0))) I LEXC>0 S LEXC=LEXC+1,LEX("HLP",LEXC)="",LEX("HLP",0)=LEXC

 S LEXC=LEXC+1,LEX("HLP",0)=LEXC,LEX("HLP",LEXC)="Enter ""Yes"" to select, ""No"" to ignore, ""^"" to quit or ""?"" for term help"

 D:$D(LEX("LIST")) LST^LEXAR

 Q

EXT ; Extended Help   LEX("HLP",

 Q:+($G(LEX))'>0  Q:+($G(LEXLL))'>0  I +($G(LEX))=1 D EXT2 Q

 N LEXCP,LEXTP,LEXM S LEXTP=LEX\LEXLL S:LEX#LEXLL>0 LEXTP=LEXTP+1

 S LEXCP=LEXMAX\LEXLL S:LEXMAX#LEXLL>0 LEXCP=LEXCP+1

 S LEXM=$S(LEXTP>LEXCP:1,1:0) N LEXS,LEXE,LEXJ,LEXH,LEXR,LEXSTR,LEXC

 S LEXC=+($G(LEX("HLP",0))) S LEXC=LEXC+1

 S (LEXS,LEXE,LEXJ,LEXH,LEXR,LEXSTR)=""

 S LEXS="You may select 1-"_LEXMAX

 S LEXE="enter an ^ to quit" S:LEXM LEXJ="enter ^# to jump to another entry on the list (up to "_LEX_")"

 S LEXH="enter ?# to display the definition of an entry marked with an asterisk (*)"

 S:LEXM LEXR="or press <Return> to continue."

 S:'LEXM LEXR="or press <Return> to quit without making a selection."

 S LEXSTR=LEXS S:LEXE'="" LEXSTR=LEXSTR_", "_LEXE S:LEXJ'="" LEXSTR=LEXSTR_", "_LEXJ

 S:LEXH'="" LEXSTR=LEXSTR_", "_LEXH S:LEXR'="" LEXSTR=LEXSTR_", "_LEXR

 I $L(LEXSTR)>74 D

 . F  Q:$L(LEXSTR)'>74  D

 . . N LEXI F LEXI=74:-1:1 Q:$E(LEXSTR,LEXI)=" "

 . . S LEX("HLP",LEXC)=$E(LEXSTR,1,(LEXI-1)),LEX("HLP",0)=LEXC

 . . S LEXC=LEXC+1,LEXSTR=$E(LEXSTR,(LEXI+1),$L(LEXSTR))

 . I $L(LEXSTR)>0,$L(LEXSTR)'>74 S LEXC=LEXC+1,LEX("HLP",LEXC)=LEXSTR,LEX("HLP",0)=LEXC

 D:$D(LEX("LIST")) LST^LEXAR

 Q

EXT2 ; Extended help for one

 N LEXS,LEXE,LEXH,LEXSTR,LEXC,LEXDEF,LEXRP

 S (LEXS,LEXE,LEXJ,LEXC,LEXH,LEXR,LEXSTR)=""

 S LEXRP=+($G(^TMP("LEXHIT",$J,1))) D DEF(LEXRP)

 S LEXC=+($G(LEX("HLP",0))) I LEXC>0 S LEXC=LEXC+1,LEX("HLP",LEXC)="",LEX("HLP",0)=LEXC

 S LEXC=LEXC+1

 S LEXDEF=+($G(^TMP("LEXHIT",$J,1)))

 S LEXDEF=$S($D(^LEX(757.01,+LEXDEF,3)):1,1:0)

 S LEXS="There was only one term found.  Enter ""Yes"" to select, ""No"" to ignore"

 S LEXE="or an ""^"" to quit"

 S LEXH="" S:+LEXDEF>0 LEXH="""?"" to display the term definition"

 S LEXSTR=LEXS

 S:LEXH'="" LEXSTR=LEXSTR_", "_LEXH

 S:LEXE'="" LEXSTR=LEXSTR_", "_LEXE

 I $L(LEXSTR)>74 D

 . F  Q:$L(LEXSTR)'>74  D

 . . N LEXI F LEXI=74:-1:1 Q:$E(LEXSTR,LEXI)=" "

 . . S LEX("HLP",LEXC)=$E(LEXSTR,1,(LEXI-1)),LEX("HLP",0)=LEXC

 . . S LEXC=LEXC+1,LEXSTR=$E(LEXSTR,(LEXI+1),$L(LEXSTR))

 . I $L(LEXSTR)>0,$L(LEXSTR)'>74 S LEXC=LEXC+1,LEX("HLP",LEXC)=LEXSTR,LEX("HLP",0)=LEXC

 D:$D(LEX("LIST")) LST^LEXAR

 Q

DH ; Display Help

 N LEXI S LEXI=0

 F  S LEXI=$O(LEX("HLP",LEXI)) Q:+LEXI=0  W !,"  ",LEX("HLP",LEXI)

 Q

DA ; Display List

 Q

 N LEXI S LEXI=0

 F  S LEXI=$O(LEX("LIST",LEXI)) Q:+LEXI=0  W !,"  ",LEX("LIST",LEXI)

 Q

DEF(LEXIEN) ; Definition Help LEX("HLP",

 N LEXR,LEXLN,LEXMC,LEXTY,LEXC

 S (LEXR,LEXIEN)=+($G(LEXIEN))

 S LEXTY=$P($G(^LEX(757.01,LEXIEN,1)),"^",2)

 D:$D(LEX("LIST")) LST^LEXAR Q:LEXIEN'>0

 N LEXLN,LEXMC,LEXC S (LEXLN,LEXC)=0 K LEX("HLP")

 I '$D(^LEX(757.01,LEXIEN,3,1)),LEXTY'=1 D

 . S LEXIEN=+($G(^LEX(757.01,LEXIEN,1)))

 . S LEXIEN=+($G(^LEX(757,LEXIEN,0)))

 I $D(^LEX(757.01,LEXIEN,0)),$L($G(^LEX(757.01,LEXIEN,3,1,0))) D

 . S LEXC=1,LEX("HLP",LEXC)=$G(^LEX(757.01,LEXIEN,0)) S LEXC=LEXC+1

 . S LEX("HLP",LEXC)="",LEXC("HLP",0)=LEXC

 . F  S LEXLN=$O(^LEX(757.01,LEXIEN,3,LEXLN)) Q:+LEXLN=0  D

 . . S LEXC=LEXC+1 S LEX("HLP",LEXC)=^LEX(757.01,LEXIEN,3,LEXLN,0)

 . . S LEX("HLP",0)=LEXC

 I '$D(LEX("HLP")) D

 . K LEX("HLP")

 . S LEX("HLP",1)="No definition found"

 . I $L($G(^LEX(757.01,LEXR,0))) D

 . . N LEXEXP S LEXEXP=$G(^LEX(757.01,LEXR,0)) Q:'$L(LEXEXP)

 . . S LEX("HLP",1)=LEX("HLP",1)_" found for "_$C(34)_LEXEXP_$C(34)

 . S:'$L($G(^LEX(757.01,LEXR,0))) LEX("HLP",1)="No definition found"

 D:$D(LEX("LIST")) LST^LEXAR

 Q

 ;

QMH(X) ; Question Mark Help (system sensitive)

 K LEX N LEX2,LEX3,LEX4,LEXA,LEXC,LEXCT,LEXD,LEXEX,LEXF,LEXFIL,LEXHDT

 N LEXI,LEXIDT,LEXLEN,LEXO,LEXOK,LEXP,LEXS,LEXSP,LEXT,LEXU,LEXX,LEXY,Y

 S LEXHDT=$G(LEXVDT) S:LEXHDT'?7N LEXHDT=$G(^TMP("LEXSCH",$J,"VDT",0))

 S:LEXHDT'?7N LEXHDT=$G(DT) S:LEXHDT'?7N LEXHDT=$$DT^XLFDT

 S LEXFIL=$G(^TMP("LEXSCH",$J,"FIL",0))

 S LEXY=$$HSYS^LEXHLP2(LEXFIL,LEXHDT),LEXIDT=$$IMP^ICDEX("10D")

 S:$L(LEXY,"/")>2 LEXY=LEXY_" etc" S LEXX=$G(X),(LEX2,LEX3,LEX4)=""

 S (LEXC,LEXS,LEXEX)="",LEXF=0 D:LEXX["??" HTXT

 I LEXX["??"&($L(LEX2))&($L(LEX3))&($L(LEX4)) D

 . S:$L(LEXC)&($L(LEXS))&($L(LEXEX)) LEXF=1

 S LEXOK=0 I LEXHDT?7N,LEXIDT?7N,LEXHDT<LEXIDT D

 . I LEXFIL["$$"&(LEXFIL["ONE^") D

 . . D:LEXFIL["$$10P"&(LEXFIL'["$$10D") N10P^LEXHLP2

 . . D:LEXFIL'["$$10P"&(LEXFIL["$$10D") N10D^LEXHLP2

 . . D:LEXFIL["$$10P"&(LEXFIL["$$10D") N10^LEXHLP2

 . I LEXFIL["$$SO^LEXU" D

 . . D:LEXFIL["10P"&(LEXFIL'["10D") N10P^LEXHLP2

 . . D:LEXFIL'["10P"&(LEXFIL["10D") N10D^LEXHLP2

 . . D:LEXFIL["10P"&(LEXFIL["10D") N10^LEXHLP2

 I 'LEXOK,LEXX["?"&(LEXX'["^") D

 . N LEXP,LEXSP,LEXI,LEXCT S LEXSP="      "

 . K LEXP S LEXP(1)="Enter a ""free text"" term.  "

 . S LEXP(1)=LEXP(1)_"Best results occur using two to four full "

 . S LEXP(1)=LEXP(1)_"or partial words without a suffix"

 . S:LEXF>0 LEXP(2)="(i.e., """_LEX2_""", """_LEX3_""", """_LEX4_""")"

 . D PR^LEXU(.LEXP,70) S LEXCT=$O(LEX("HLP"," "),-1),LEXI=0

 . F  S LEXI=$O(LEXP(LEXI)) Q:+LEXI'>0  D

 . . N LEXT S LEXT=$G(LEXP(LEXI)),LEXCT=LEXCT+1

 . . S LEX("HLP",LEXCT)=LEXSP_LEXT

 . S LEXCT=$O(LEX("HLP"," "),-1)+1

 . S LEX("HLP",LEXCT)="  or  "

 . K LEXP S LEXP(1)="Enter a classification code "

 . S:$L(LEXY) LEXP(1)=LEXP(1)_"("_LEXY_") "

 . S LEXP(1)=LEXP(1)_"to find the term associated with the code."

 . I LEXF>0 D

 . . S LEXP(2)="Example; a lookup of "_LEXS_" code "_LEXC_" "

 . . S LEXP(2)=LEXP(2)_"returns one and only one term.  "

 . . S LEXP(2)=LEXP(2)_"That term is the preferred term for the code "

 . . S LEXP(2)=LEXP(2)_LEXC_", """_LEXEX_""""

 . D PR^LEXU(.LEXP,70) S LEXCT=$O(LEX("HLP"," "),-1),LEXI=0

 . F  S LEXI=$O(LEXP(LEXI)) Q:+LEXI'>0  D

 . . N LEXT S LEXT=$G(LEXP(LEXI)),LEXCT=LEXCT+1

 . . S LEX("HLP",LEXCT)=LEXSP_LEXT

 . S LEXCT=$O(LEX("HLP"," "),-1)+1

 . S LEX("HLP",LEXCT)="  or  "

 . K LEXP S LEXP(1)="Enter a classification code "

 . S:$L(LEXY) LEXP(1)=LEXP(1)_"("_LEXY_") "

 . S LEXP(1)=LEXP(1)_"followed by a plus sign (+) to retrieve "

 . S LEXP(1)=LEXP(1)_"all terms associated with the code."

 . I LEXF>0 D

 . . S LEXP(2)="Example; a lookup of "_LEXS_" code "_LEXC

 . . S LEXP(2)=LEXP(2)_"+ returns all terms that are linked to "

 . . S LEXP(2)=LEXP(2)_"the code "_LEXC_"."

 . D PR^LEXU(.LEXP,70) S LEXCT=$O(LEX("HLP"," "),-1),LEXI=0

 . F  S LEXI=$O(LEXP(LEXI)) Q:+LEXI'>0  D

 . . N LEXT S LEXT=$G(LEXP(LEXI)),LEXCT=LEXCT+1

 . . S LEX("HLP",LEXCT)=LEXSP_LEXT

 S LEXC=$O(LEX("HLP"," "),-1) I LEXC>0 D

 . S LEX=0,LEX("HLP",0)=LEXC S:$L($G(LEXX)) LEX("NAR")=$G(LEXX)

 Q

HTXT ;   Help Text (expanded)

 N LEXF,LEXOK,LEXU

 S LEXOK=0,LEXU=$G(LEXX) S LEXF=$G(^TMP("LEXSCH",$J,"FIL",0))

 S (LEX2,LEX3,LEX4,LEXC,LEXS,LEXEX)="",LEXOK=0 D:'$L(LEXF) HICD^LEXHLP2

 Q:LEXOK  D:LEXF["$$DX^LEXU" HICD^LEXHLP2  Q:LEXOK

 I LEXF["$$"&(LEXF["ONE^") D  Q:LEXOK

 . D:LEXF["$$10P"&(LEXF'["$$10D") H10P^LEXHLP2 D:LEXF["$$10D" H10D^LEXHLP2 Q:LEXOK

 . D:LEXF["$$CPC"&(LEXF'["$$CPT") HCPC^LEXHLP2 D:LEXF["$$CPT" HCPT^LEXHLP2 Q:LEXOK

 I LEXF["$$SO^LEXU" D  Q:LEXOK

 . D:LEXF["10P"&(LEXF'["10D") H10P^LEXHLP2 D:LEXF["10D" H10D^LEXHLP2 Q:LEXOK

 . D:LEXF["CPC"&(LEXF'["CPT") HCPC^LEXHLP2 D:LEXF["CPT" HCPT^LEXHLP2 Q:LEXOK

 . D:LEXF["SCC" HSCC^LEXHLP2 Q:LEXOK  D:LEXF["DS3"!(LEXF["DS4") HDS4^LEXHLP2 Q:LEXOK

 . D:LEXF["OMA"&(LEXF'["NAN") HOMA^LEXHLP2 D:LEXF["NAN" HNAN^LEXHLP2 Q:LEXOK

 D HICD^LEXHLP2

 Q

 ; 

 ; Miscellaneous

SA ;   Show Array

 N LEXI S LEXI=0 F  S LEXI=$O(LEX("HLP",LEXI)) Q:+LEXI'>0  D

 . W !,LEX("HLP",LEXI)

 Q

TM(X,Y) ;   Trim Character Y - Default " "

 S X=$G(X) Q:X="" X  S Y=$G(Y) S:'$L(Y) Y=" "

 F  Q:$E(X,1)'=Y  S X=$E(X,2,$L(X))

 F  Q:$E(X,$L(X))'=Y  S X=$E(X,1,($L(X)-1))

 Q X

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---LEXAR3   9231     printed  Feb 18, 2025@23:33:06                                                                                                                                                                                                      Page 2

LEXAR3    ;ISL/KER - Look-up Response (Help, Def, MAX) ;05/23/2017

 +1       ;;2.0;LEXICON UTILITY;**73,80,103**;Sep 23, 1996;Build 2

 +2       ;               

 +3       ; Global Variables

 +4       ;    ^TMP("LEXHIT")      SACC 2.3.2.5.1

 +5       ;    ^TMP("LEXSCH")      SACC 2.3.2.5.1

 +6       ;               

 +7       ; External References

 +8       ;    $$IMP^ICDEX         ICR   5747

 +9       ;    $$DT^XLFDT          ICR  10103

 +10      ;               

 +11      ; Local Variables NEWed or KILLed Elsewhere

 +12      ;     LEXLL   List Length NEWed in LEXAR

 +13      ;     LEXUR   User's Response NEWed in LEXAR

 +14      ;     LEXVDT  Versioning Date NEWed in LEXAR

 +15      ;               

HLP       ; Help

 +1        NEW LEXRP,LEXMAX

           KILL LEX("HLP")

 +2        SET LEXMAX=+($GET(^TMP("LEXSCH",$JOB,"LST",0)))

 +3        IF LEXUR["??"

               DO EXT

               QUIT 

 +4        SET LEXRP=+($PIECE(LEXUR,"?",2,229))

 +5        IF LEXRP>0

               IF LEXRP'>LEXMAX

                   Begin DoDot:1

 +6                    SET LEXRP=+($GET(^TMP("LEXHIT",$JOB,LEXRP)))

                       DO DEF(LEXRP)

                   End DoDot:1

                   QUIT 

 +7        IF LEXUR["?"

               IF LEXRP'["?"

                   IF +LEXRP'>0

                       DO STD

 +8        QUIT 

STD       ; Standard Help   LEX("HLP",

 +1        IF +($GET(LEX))=1

               DO STD2

               QUIT 

 +2        NEW LEXC

           SET LEXC=+($GET(LEX("HLP",0)))

           SET LEXC=LEXC+1

           SET LEX("HLP",0)=LEXC

 +3        if LEX'>LEXMAX

               SET LEX("HLP",LEXC)="Select 1-"_LEXMAX_", ^ (quit), or ?# (help on a term)"

 +4        if LEX>LEXMAX

               SET LEX("HLP",LEXC)="Select 1-"_LEXMAX_", ^ (quit), ^# (jump - "_LEX_"), ?# (term help), or <Return> for more"

 +5        if $DATA(LEX("LIST"))

               DO LST^LEXAR

 +6        QUIT 

STD2      ; Standard Help   LEX("HLP",

 +1        KILL LEX("HLP")

           SET LEXRP=+($GET(^TMP("LEXHIT",$JOB,1)))

           DO DEF(LEXRP)

 +2        NEW LEXC

           SET LEXC=+($GET(LEX("HLP",0)))

           IF LEXC>0

               SET LEXC=LEXC+1

               SET LEX("HLP",LEXC)=""

               SET LEX("HLP",0)=LEXC

 +3        SET LEXC=LEXC+1

           SET LEX("HLP",0)=LEXC

           SET LEX("HLP",LEXC)="Enter ""Yes"" to select, ""No"" to ignore, ""^"" to quit or ""?"" for term help"

 +4        if $DATA(LEX("LIST"))

               DO LST^LEXAR

 +5        QUIT 

EXT       ; Extended Help   LEX("HLP",

 +1        if +($GET(LEX))'>0

               QUIT 

           if +($GET(LEXLL))'>0

               QUIT 

           IF +($GET(LEX))=1

               DO EXT2

               QUIT 

 +2        NEW LEXCP,LEXTP,LEXM

           SET LEXTP=LEX\LEXLL

           if LEX#LEXLL>0

               SET LEXTP=LEXTP+1

 +3        SET LEXCP=LEXMAX\LEXLL

           if LEXMAX#LEXLL>0

               SET LEXCP=LEXCP+1

 +4        SET LEXM=$SELECT(LEXTP>LEXCP:1,1:0)

           NEW LEXS,LEXE,LEXJ,LEXH,LEXR,LEXSTR,LEXC

 +5        SET LEXC=+($GET(LEX("HLP",0)))

           SET LEXC=LEXC+1

 +6        SET (LEXS,LEXE,LEXJ,LEXH,LEXR,LEXSTR)=""

 +7        SET LEXS="You may select 1-"_LEXMAX

 +8        SET LEXE="enter an ^ to quit"

           if LEXM

               SET LEXJ="enter ^# to jump to another entry on the list (up to "_LEX_")"

 +9        SET LEXH="enter ?# to display the definition of an entry marked with an asterisk (*)"

 +10       if LEXM

               SET LEXR="or press <Return> to continue."

 +11       if 'LEXM

               SET LEXR="or press <Return> to quit without making a selection."

 +12       SET LEXSTR=LEXS

           if LEXE'=""

               SET LEXSTR=LEXSTR_", "_LEXE

           if LEXJ'=""

               SET LEXSTR=LEXSTR_", "_LEXJ

 +13       if LEXH'=""

               SET LEXSTR=LEXSTR_", "_LEXH

           if LEXR'=""

               SET LEXSTR=LEXSTR_", "_LEXR

 +14       IF $LENGTH(LEXSTR)>74

               Begin DoDot:1

 +15               FOR 

                       if $LENGTH(LEXSTR)'>74

                           QUIT 

                       Begin DoDot:2

 +16                       NEW LEXI

                           FOR LEXI=74:-1:1

                               if $EXTRACT(LEXSTR,LEXI)=" "

                                   QUIT 

 +17                       SET LEX("HLP",LEXC)=$EXTRACT(LEXSTR,1,(LEXI-1))

                           SET LEX("HLP",0)=LEXC

 +18                       SET LEXC=LEXC+1

                           SET LEXSTR=$EXTRACT(LEXSTR,(LEXI+1),$LENGTH(LEXSTR))

                       End DoDot:2

 +19               IF $LENGTH(LEXSTR)>0

                       IF $LENGTH(LEXSTR)'>74

                           SET LEXC=LEXC+1

                           SET LEX("HLP",LEXC)=LEXSTR

                           SET LEX("HLP",0)=LEXC

               End DoDot:1

 +20       if $DATA(LEX("LIST"))

               DO LST^LEXAR

 +21       QUIT 

EXT2      ; Extended help for one

 +1        NEW LEXS,LEXE,LEXH,LEXSTR,LEXC,LEXDEF,LEXRP

 +2        SET (LEXS,LEXE,LEXJ,LEXC,LEXH,LEXR,LEXSTR)=""

 +3        SET LEXRP=+($GET(^TMP("LEXHIT",$JOB,1)))

           DO DEF(LEXRP)

 +4        SET LEXC=+($GET(LEX("HLP",0)))

           IF LEXC>0

               SET LEXC=LEXC+1

               SET LEX("HLP",LEXC)=""

               SET LEX("HLP",0)=LEXC

 +5        SET LEXC=LEXC+1

 +6        SET LEXDEF=+($GET(^TMP("LEXHIT",$JOB,1)))

 +7        SET LEXDEF=$SELECT($DATA(^LEX(757.01,+LEXDEF,3)):1,1:0)

 +8        SET LEXS="There was only one term found.  Enter ""Yes"" to select, ""No"" to ignore"

 +9        SET LEXE="or an ""^"" to quit"

 +10       SET LEXH=""

           if +LEXDEF>0

               SET LEXH="""?"" to display the term definition"

 +11       SET LEXSTR=LEXS

 +12       if LEXH'=""

               SET LEXSTR=LEXSTR_", "_LEXH

 +13       if LEXE'=""

               SET LEXSTR=LEXSTR_", "_LEXE

 +14       IF $LENGTH(LEXSTR)>74

               Begin DoDot:1

 +15               FOR 

                       if $LENGTH(LEXSTR)'>74

                           QUIT 

                       Begin DoDot:2

 +16                       NEW LEXI

                           FOR LEXI=74:-1:1

                               if $EXTRACT(LEXSTR,LEXI)=" "

                                   QUIT 

 +17                       SET LEX("HLP",LEXC)=$EXTRACT(LEXSTR,1,(LEXI-1))

                           SET LEX("HLP",0)=LEXC

 +18                       SET LEXC=LEXC+1

                           SET LEXSTR=$EXTRACT(LEXSTR,(LEXI+1),$LENGTH(LEXSTR))

                       End DoDot:2

 +19               IF $LENGTH(LEXSTR)>0

                       IF $LENGTH(LEXSTR)'>74

                           SET LEXC=LEXC+1

                           SET LEX("HLP",LEXC)=LEXSTR

                           SET LEX("HLP",0)=LEXC

               End DoDot:1

 +20       if $DATA(LEX("LIST"))

               DO LST^LEXAR

 +21       QUIT 

DH        ; Display Help

 +1        NEW LEXI

           SET LEXI=0

 +2        FOR 

               SET LEXI=$ORDER(LEX("HLP",LEXI))

               if +LEXI=0

                   QUIT 

               WRITE !,"  ",LEX("HLP",LEXI)

 +3        QUIT 

DA        ; Display List

 +1        QUIT 

 +2        NEW LEXI

           SET LEXI=0

 +3        FOR 

               SET LEXI=$ORDER(LEX("LIST",LEXI))

               if +LEXI=0

                   QUIT 

               WRITE !,"  ",LEX("LIST",LEXI)

 +4        QUIT 

DEF(LEXIEN) ; Definition Help LEX("HLP",

 +1        NEW LEXR,LEXLN,LEXMC,LEXTY,LEXC

 +2        SET (LEXR,LEXIEN)=+($GET(LEXIEN))

 +3        SET LEXTY=$PIECE($GET(^LEX(757.01,LEXIEN,1)),"^",2)

 +4        if $DATA(LEX("LIST"))

               DO LST^LEXAR

           if LEXIEN'>0

               QUIT 

 +5        NEW LEXLN,LEXMC,LEXC

           SET (LEXLN,LEXC)=0

           KILL LEX("HLP")

 +6        IF '$DATA(^LEX(757.01,LEXIEN,3,1))

               IF LEXTY'=1

                   Begin DoDot:1

 +7                    SET LEXIEN=+($GET(^LEX(757.01,LEXIEN,1)))

 +8                    SET LEXIEN=+($GET(^LEX(757,LEXIEN,0)))

                   End DoDot:1

 +9        IF $DATA(^LEX(757.01,LEXIEN,0))

               IF $LENGTH($GET(^LEX(757.01,LEXIEN,3,1,0)))

                   Begin DoDot:1

 +10                   SET LEXC=1

                       SET LEX("HLP",LEXC)=$GET(^LEX(757.01,LEXIEN,0))

                       SET LEXC=LEXC+1

 +11                   SET LEX("HLP",LEXC)=""

                       SET LEXC("HLP",0)=LEXC

 +12                   FOR 

                           SET LEXLN=$ORDER(^LEX(757.01,LEXIEN,3,LEXLN))

                           if +LEXLN=0

                               QUIT 

                           Begin DoDot:2

 +13                           SET LEXC=LEXC+1

                               SET LEX("HLP",LEXC)=^LEX(757.01,LEXIEN,3,LEXLN,0)

 +14                           SET LEX("HLP",0)=LEXC

                           End DoDot:2

                   End DoDot:1

 +15       IF '$DATA(LEX("HLP"))

               Begin DoDot:1

 +16               KILL LEX("HLP")

 +17               SET LEX("HLP",1)="No definition found"

 +18               IF $LENGTH($GET(^LEX(757.01,LEXR,0)))

                       Begin DoDot:2

 +19                       NEW LEXEXP

                           SET LEXEXP=$GET(^LEX(757.01,LEXR,0))

                           if '$LENGTH(LEXEXP)

                               QUIT 

 +20                       SET LEX("HLP",1)=LEX("HLP",1)_" found for "_$CHAR(34)_LEXEXP_$CHAR(34)

                       End DoDot:2

 +21               if '$LENGTH($GET(^LEX(757.01,LEXR,0)))

                       SET LEX("HLP",1)="No definition found"

               End DoDot:1

 +22       if $DATA(LEX("LIST"))

               DO LST^LEXAR

 +23       QUIT 

 +24      ;

QMH(X)    ; Question Mark Help (system sensitive)

 +1        KILL LEX

           NEW LEX2,LEX3,LEX4,LEXA,LEXC,LEXCT,LEXD,LEXEX,LEXF,LEXFIL,LEXHDT

 +2        NEW LEXI,LEXIDT,LEXLEN,LEXO,LEXOK,LEXP,LEXS,LEXSP,LEXT,LEXU,LEXX,LEXY,Y

 +3        SET LEXHDT=$GET(LEXVDT)

           if LEXHDT'?7N

               SET LEXHDT=$GET(^TMP("LEXSCH",$JOB,"VDT",0))

 +4        if LEXHDT'?7N

               SET LEXHDT=$GET(DT)

           if LEXHDT'?7N

               SET LEXHDT=$$DT^XLFDT

 +5        SET LEXFIL=$GET(^TMP("LEXSCH",$JOB,"FIL",0))

 +6        SET LEXY=$$HSYS^LEXHLP2(LEXFIL,LEXHDT)

           SET LEXIDT=$$IMP^ICDEX("10D")

 +7        if $LENGTH(LEXY,"/")>2

               SET LEXY=LEXY_" etc"

           SET LEXX=$GET(X)

           SET (LEX2,LEX3,LEX4)=""

 +8        SET (LEXC,LEXS,LEXEX)=""

           SET LEXF=0

           if LEXX["??"

               DO HTXT

 +9        IF LEXX["??"&($LENGTH(LEX2))&($LENGTH(LEX3))&($LENGTH(LEX4))

               Begin DoDot:1

 +10               if $LENGTH(LEXC)&($LENGTH(LEXS))&($LENGTH(LEXEX))

                       SET LEXF=1

               End DoDot:1

 +11       SET LEXOK=0

           IF LEXHDT?7N

               IF LEXIDT?7N

                   IF LEXHDT<LEXIDT

                       Begin DoDot:1

 +12                       IF LEXFIL["$$"&(LEXFIL["ONE^")

                               Begin DoDot:2

 +13                               if LEXFIL["$$10P"&(LEXFIL'["$$10D")

                                       DO N10P^LEXHLP2

 +14                               if LEXFIL'["$$10P"&(LEXFIL["$$10D")

                                       DO N10D^LEXHLP2

 +15                               if LEXFIL["$$10P"&(LEXFIL["$$10D")

                                       DO N10^LEXHLP2

                               End DoDot:2

 +16                       IF LEXFIL["$$SO^LEXU"

                               Begin DoDot:2

 +17                               if LEXFIL["10P"&(LEXFIL'["10D")

                                       DO N10P^LEXHLP2

 +18                               if LEXFIL'["10P"&(LEXFIL["10D")

                                       DO N10D^LEXHLP2

 +19                               if LEXFIL["10P"&(LEXFIL["10D")

                                       DO N10^LEXHLP2

                               End DoDot:2

                       End DoDot:1

 +20       IF 'LEXOK

               IF LEXX["?"&(LEXX'["^")

                   Begin DoDot:1

 +21                   NEW LEXP,LEXSP,LEXI,LEXCT

                       SET LEXSP="      "

 +22                   KILL LEXP

                       SET LEXP(1)="Enter a ""free text"" term.  "

 +23                   SET LEXP(1)=LEXP(1)_"Best results occur using two to four full "

 +24                   SET LEXP(1)=LEXP(1)_"or partial words without a suffix"

 +25                   if LEXF>0

                           SET LEXP(2)="(i.e., """_LEX2_""", """_LEX3_""", """_LEX4_""")"

 +26                   DO PR^LEXU(.LEXP,70)

                       SET LEXCT=$ORDER(LEX("HLP"," "),-1)

                       SET LEXI=0

 +27                   FOR 

                           SET LEXI=$ORDER(LEXP(LEXI))

                           if +LEXI'>0

                               QUIT 

                           Begin DoDot:2

 +28                           NEW LEXT

                               SET LEXT=$GET(LEXP(LEXI))

                               SET LEXCT=LEXCT+1

 +29                           SET LEX("HLP",LEXCT)=LEXSP_LEXT

                           End DoDot:2

 +30                   SET LEXCT=$ORDER(LEX("HLP"," "),-1)+1

 +31                   SET LEX("HLP",LEXCT)="  or  "

 +32                   KILL LEXP

                       SET LEXP(1)="Enter a classification code "

 +33                   if $LENGTH(LEXY)

                           SET LEXP(1)=LEXP(1)_"("_LEXY_") "

 +34                   SET LEXP(1)=LEXP(1)_"to find the term associated with the code."

 +35                   IF LEXF>0

                           Begin DoDot:2

 +36                           SET LEXP(2)="Example; a lookup of "_LEXS_" code "_LEXC_" "

 +37                           SET LEXP(2)=LEXP(2)_"returns one and only one term.  "

 +38                           SET LEXP(2)=LEXP(2)_"That term is the preferred term for the code "

 +39                           SET LEXP(2)=LEXP(2)_LEXC_", """_LEXEX_""""

                           End DoDot:2

 +40                   DO PR^LEXU(.LEXP,70)

                       SET LEXCT=$ORDER(LEX("HLP"," "),-1)

                       SET LEXI=0

 +41                   FOR 

                           SET LEXI=$ORDER(LEXP(LEXI))

                           if +LEXI'>0

                               QUIT 

                           Begin DoDot:2

 +42                           NEW LEXT

                               SET LEXT=$GET(LEXP(LEXI))

                               SET LEXCT=LEXCT+1

 +43                           SET LEX("HLP",LEXCT)=LEXSP_LEXT

                           End DoDot:2

 +44                   SET LEXCT=$ORDER(LEX("HLP"," "),-1)+1

 +45                   SET LEX("HLP",LEXCT)="  or  "

 +46                   KILL LEXP

                       SET LEXP(1)="Enter a classification code "

 +47                   if $LENGTH(LEXY)

                           SET LEXP(1)=LEXP(1)_"("_LEXY_") "

 +48                   SET LEXP(1)=LEXP(1)_"followed by a plus sign (+) to retrieve "

 +49                   SET LEXP(1)=LEXP(1)_"all terms associated with the code."

 +50                   IF LEXF>0

                           Begin DoDot:2

 +51                           SET LEXP(2)="Example; a lookup of "_LEXS_" code "_LEXC

 +52                           SET LEXP(2)=LEXP(2)_"+ returns all terms that are linked to "

 +53                           SET LEXP(2)=LEXP(2)_"the code "_LEXC_"."

                           End DoDot:2

 +54                   DO PR^LEXU(.LEXP,70)

                       SET LEXCT=$ORDER(LEX("HLP"," "),-1)

                       SET LEXI=0

 +55                   FOR 

                           SET LEXI=$ORDER(LEXP(LEXI))

                           if +LEXI'>0

                               QUIT 

                           Begin DoDot:2

 +56                           NEW LEXT

                               SET LEXT=$GET(LEXP(LEXI))

                               SET LEXCT=LEXCT+1

 +57                           SET LEX("HLP",LEXCT)=LEXSP_LEXT

                           End DoDot:2

                   End DoDot:1

 +58       SET LEXC=$ORDER(LEX("HLP"," "),-1)

           IF LEXC>0

               Begin DoDot:1

 +59               SET LEX=0

                   SET LEX("HLP",0)=LEXC

                   if $LENGTH($GET(LEXX))

                       SET LEX("NAR")=$GET(LEXX)

               End DoDot:1

 +60       QUIT 

HTXT      ;   Help Text (expanded)

 +1        NEW LEXF,LEXOK,LEXU

 +2        SET LEXOK=0

           SET LEXU=$GET(LEXX)

           SET LEXF=$GET(^TMP("LEXSCH",$JOB,"FIL",0))