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 ---[H[J[2J[HLEXLK 1743 printed Nov 22, 2024@17:18:16 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
