LEXLK.m

LEXLK ;ISL/KER - Demo Look Up ;05/23/2017

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

 ;               

 ; Global Variables

 ;    None

 ;               

 ; External References

 ;    YN^DICN             ICR  10009

 ;               

EN ; Initialize variables

 W @IOF N LEXSF,LEXCONT,LEXCLAS,LEXDEF,LEXDIS,LEXEXP,LEXFORM

 N LEXFM,LEXMC,LEXCODE,LEXSRC,LEXSO,LEXLINE,LEXSPC,LEXNOM

 N LEXX,LEXY,LEXYPE,LEXEMP,LEXCHK,X,Y,LEXAP S LEXSF=1

 W @IOF D LOOK G EXIT

LOOK ; Look-up term

 W !! K X S LEXAP=1 D ^LEXA1 K DIC D:+($$Y) MORE

AGAIN ; Try again?

 W !,"Try another" S %=$S(+($$X):1,1:2)

 D YN^DICN I %=-1!(%=2) Q

 I '% W !!,"You have searched for a term in the Lexicon, do you want to" G AGAIN

 I +($$X)&(%=1) G LOOK

 I '+($$X)&(%=1) G LOOK

 I (+($$X)&(%=2))!('+($$X)&(%=1)) Q

 G LOOK Q

MORE ; Do you want more information?

 W !!,"Do you want more information" S %=1 D YN^DICN Q:%=-1

 I '% D  G MORE

 . W !!,"The Lexicon also contains definitions (on most major concepts),"

 . W !,"codes (from major coding systems, i.e., ICD, CPT, NANDA, etc.),"

 . W !,"synonyms, lexical variants, and semantic classifications for each"

 . W !,"term by class and type."

 Q:%=2  D:%=1 DISP

 Q

DISP ; If requested, get and display information

 Q:'+($$Y)  D GET^LEXLK2(Y) Q:'$G(LEX(0))

 D DEV^LEXLK2

 Q

EXIT ; Clean up environment and quit

 K %,DIC,DIR,DIROUT,DIRUT,DTOUT,DUOUT,LEX,LEXB,LEXC,LEXCHK,LEXCL

 K LEXCLAS,LEXCODE,LEXCT,LEXCONT,LEXDEF,LEXDIS,LEXE,LEXEMP

 K LEXEXP,LEXF,LEXFM,LEXFORM,LEXLC,LEXLINE,LEXLN,LEXMC,LEXMCE

 K LEXNOM,LEXSCP,LEXSF,LEXSO,LEXSPC,LEXSPCR,LEXSR,LEXSRC

 K LEXSTR,LEXT,LEXTT,LEXX,LEXY,LEXYPE,X,Y

 Q

X(LEX) ; Evaluate X

 Q:$L($G(X)) 1  Q 0

Y(LEX) ; Evaluate Y

 Q:+($G(Y))>1 1  Q 0

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---LEXLK   1743     printed  Apr 09, 2024@21:13:36                                                                                                                                                                                                       Page 2

LEXLK     ;ISL/KER - Demo Look Up ;05/23/2017

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

 +2       ;               

 +3       ; Global Variables

 +4       ;    None

 +5       ;               

 +6       ; External References

 +7       ;    YN^DICN             ICR  10009

 +8       ;               

EN        ; Initialize variables

 +1        WRITE @IOF

           NEW LEXSF,LEXCONT,LEXCLAS,LEXDEF,LEXDIS,LEXEXP,LEXFORM

 +2        NEW LEXFM,LEXMC,LEXCODE,LEXSRC,LEXSO,LEXLINE,LEXSPC,LEXNOM

 +3        NEW LEXX,LEXY,LEXYPE,LEXEMP,LEXCHK,X,Y,LEXAP

           SET LEXSF=1

 +4        WRITE @IOF

           DO LOOK

           GOTO EXIT

LOOK      ; Look-up term

 +1        WRITE !!

           KILL X

           SET LEXAP=1

           DO ^LEXA1

           KILL DIC

           if +($$Y)

               DO MORE

AGAIN     ; Try again?

 +1        WRITE !,"Try another"

           SET %=$SELECT(+($$X):1,1:2)

 +2        DO YN^DICN

           IF %=-1!(%=2)

               QUIT 

 +3        IF '%

               WRITE !!,"You have searched for a term in the Lexicon, do you want to"

               GOTO AGAIN

 +4        IF +($$X)&(%=1)

               GOTO LOOK

 +5        IF '+($$X)&(%=1)

               GOTO LOOK

 +6        IF (+($$X)&(%=2))!('+($$X)&(%=1))

               QUIT 

 +7        GOTO LOOK

           QUIT 

MORE      ; Do you want more information?

 +1        WRITE !!,"Do you want more information"

           SET %=1

           DO YN^DICN

           if %=-1

               QUIT 

 +2        IF '%

               Begin DoDot:1

 +3                WRITE !!,"The Lexicon also contains definitions (on most major concepts),"

 +4                WRITE !,"codes (from major coding systems, i.e., ICD, CPT, NANDA, etc.),"

 +5                WRITE !,"synonyms, lexical variants, and semantic classifications for each"

 +6                WRITE !,"term by class and type."

               End DoDot:1

               GOTO MORE

 +7        if %=2

               QUIT 

           if %=1

               DO DISP

 +8        QUIT 

DISP      ; If requested, get and display information

 +1        if '+($$Y)

               QUIT 

           DO GET^LEXLK2(Y)

           if '$GET(LEX(0))

               QUIT 

 +2        DO DEV^LEXLK2

 +3        QUIT 

EXIT      ; Clean up environment and quit

 +1        KILL %,DIC,DIR,DIROUT,DIRUT,DTOUT,DUOUT,LEX,LEXB,LEXC,LEXCHK,LEXCL

 +2        KILL LEXCLAS,LEXCODE,LEXCT,LEXCONT,LEXDEF,LEXDIS,LEXE,LEXEMP

 +3        KILL LEXEXP,LEXF,LEXFM,LEXFORM,LEXLC,LEXLINE,LEXLN,LEXMC,LEXMCE

 +4        KILL LEXNOM,LEXSCP,LEXSF,LEXSO,LEXSPC,LEXSPCR,LEXSR,LEXSRC

 +5        KILL LEXSTR,LEXT,LEXTT,LEXX,LEXY,LEXYPE,X,Y

 +6        QUIT 

X(LEX)    ; Evaluate X

 +1        if $LENGTH($GET(X))

               QUIT 1

           QUIT 0

Y(LEX)    ; Evaluate Y

 +1        if +($GET(Y))>1

               QUIT 1

           QUIT 0