LEXMTLU.m

LEXMTLU ;ISL/KER - Setup Appl/User Defaults for Look-up ;04/21/2014

 ;;2.0;LEXICON UTILITY;**11,80**;Sep 23, 1996;Build 10

 ;               

 ; Global Variables

 ;    ^DISV(              ICR    510

 ;               

 ; External References

 ;    ^DIR                ICR  10026

 ;    ^XTLKKWL            ICR  10122

 ;               

EN ; X not set

 D MTLU^LEXSET5 S X=$$TERM Q:X=""!(X["^")

 I $D(X),$G(X)'[U,$G(X)'="",$G(X)'=" " D XTLK

 Q

XTLK ;

 N LEXQ S LEXQ=0 D MTLU^LEXSET5

 I '$D(X)!($G(X)[U)!($G(X)="")!($G(X)=" ") S X=$$TERM

 Q:X=""!(X["^")  S XTLKX=X D ^XTLKKWL

 K DIC,LEXAP,LEXLL,LEXSHOW,LEXSUB,LEXUN

 K XTLKKSCH,XTLKSAY,XTLKWD2,XTLKX,XTLKHLP S:+Y'>0 X=""

 Q

TERM(X) ; Get expression

 N DIR,Y S DIR("A")="Enter an expression:  "

 S DIR("?")="    "_$$SQ^LEXHLP  ; PCH 11

 S DIR("??")="^D TERMHLP^LEXMTLU" N Y S DIR(0)="FAO^2:245" D ^DIR

 S DIC="^LEX(757.01," S:X[U&(X'["^^") X=U S:X["^^" X="^^" Q:X[U "^"

 I X=" ",+($G(^DISV(DUZ,DIC)))>0 S X=@(DIC_+($G(^DISV(DUZ,DIC)))_",0)") W " ",X

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

 W:$D(DTOUT) !,"Try later.",! S:$D(DTOUT) X=""

 S:X[U DUOUT=1 K DIR,DIRUT,DIROUT Q X

TERMHLP ; Look-up help  PCH 11

 N X S X="" S:$L($G(DIR("?"))) X=$G(DIR("?")) S:'$L(X) X="    "_$$SQ^LEXHLP

 W:$L(X) !!,X,!

 W !,"    Best results occur using one to three full or partial words without"

 W !,"    a suffix (i.e., ""DIABETES"",""DIAB MELL"",""DIAB MELL INSUL"") or"

 W !,"    a classification code (ICD, CPT, HCPCS, etc)"

 Q

DD ; Display Defaults in ^TMP("LEXSCH",$J)

 N LEXNODE S LEXNODE="^TMP(""LEXSCH"","_$J_")"

 N LEXOK S LEXOK=1 F  S LEXNODE=$Q(@LEXNODE) Q:'LEXOK  D  Q:'LEXOK

 . I LEXNODE'["LEXSCH" S LEXOK=0 Q

 . I LEXNODE'[$J S LEXOK=0 Q

 . W !,LEXNODE,"=",@LEXNODE

 Q

LEXMTLU   ;ISL/KER - Setup Appl/User Defaults for Look-up ;04/21/2014

 +1       ;;2.0;LEXICON UTILITY;**11,80**;Sep 23, 1996;Build 10

 +2       ;               

 +3       ; Global Variables

 +4       ;    ^DISV(              ICR    510

 +5       ;               

 +6       ; External References

 +7       ;    ^DIR                ICR  10026

 +8       ;    ^XTLKKWL            ICR  10122

 +9       ;               

EN        ; X not set

 +1        DO MTLU^LEXSET5

           SET X=$$TERM

           IF X=""!(X["^")

               QUIT 

 +2        IF $DATA(X)

               IF $GET(X)'[U

                   IF $GET(X)'=""

                       IF $GET(X)'=" "

                           DO XTLK

 +3        QUIT 

XTLK      ;

 +1        NEW LEXQ

           SET LEXQ=0

           DO MTLU^LEXSET5

 +2        IF '$DATA(X)!($GET(X)[U)!($GET(X)="")!($GET(X)=" ")

               SET X=$$TERM

 +3        IF X=""!(X["^")

               QUIT 

           SET XTLKX=X

           DO ^XTLKKWL

 +4        KILL DIC,LEXAP,LEXLL,LEXSHOW,LEXSUB,LEXUN

 +5        KILL XTLKKSCH,XTLKSAY,XTLKWD2,XTLKX,XTLKHLP

           IF +Y'>0

               SET X=""

 +6        QUIT 

TERM(X)   ; Get expression

 +1        NEW DIR,Y

           SET DIR("A")="Enter an expression:  "

 +2       ; PCH 11

           SET DIR("?")="    "_$$SQ^LEXHLP

 +3        SET DIR("??")="^D TERMHLP^LEXMTLU"

           NEW Y

           SET DIR(0)="FAO^2:245"

           DO ^DIR

 +4        SET DIC="^LEX(757.01,"

           IF X[U&(X'["^^")

               SET X=U

           IF X["^^"

               SET X="^^"

           IF X[U

               QUIT "^"

 +5        IF X=" "

               IF +($GET(^DISV(DUZ,DIC)))>0

                   SET X=@(DIC_+($GET(^DISV(DUZ,DIC)))_",0)")

                   WRITE " ",X

 +6        FOR 

               IF $EXTRACT(X,1)'=" "

                   QUIT 

               SET X=$EXTRACT(X,2,$LENGTH(X))

 +7        IF $DATA(DTOUT)

               WRITE !,"Try later.",!

           IF $DATA(DTOUT)

               SET X=""

 +8        IF X[U

               SET DUOUT=1

           KILL DIR,DIRUT,DIROUT

           QUIT X

TERMHLP   ; Look-up help  PCH 11

 +1        NEW X

           SET X=""

           IF $LENGTH($GET(DIR("?")))

               SET X=$GET(DIR("?"))

           IF '$LENGTH(X)

               SET X="    "_$$SQ^LEXHLP

 +2        IF $LENGTH(X)

               WRITE !!,X,!

 +3        WRITE !,"    Best results occur using one to three full or partial words without"

 +4        WRITE !,"    a suffix (i.e., ""DIABETES"",""DIAB MELL"",""DIAB MELL INSUL"") or"

 +5        WRITE !,"    a classification code (ICD, CPT, HCPCS, etc)"

 +6        QUIT 

DD        ; Display Defaults in ^TMP("LEXSCH",$J)

 +1        NEW LEXNODE

           SET LEXNODE="^TMP(""LEXSCH"","_$JOB_")"

 +2        NEW LEXOK

           SET LEXOK=1

           FOR 

               SET LEXNODE=$QUERY(@LEXNODE)

               IF 'LEXOK

                   QUIT 

               Begin DoDot:1

 +3                IF LEXNODE'["LEXSCH"

                       SET LEXOK=0

                       QUIT 

 +4                IF LEXNODE'[$JOB

                       SET LEXOK=0

                       QUIT 

 +5                WRITE !,LEXNODE,"=",@LEXNODE

               End DoDot:1

               IF 'LEXOK

                   QUIT 

 +6        QUIT