LEXMTLU ;ISL/KER - Setup Appl/User Defaults for Look-up ;04/21/2014
;;2.0;LEXICON UTILITY;**11,80**;Sep 23, 1996;Build 1
;
; 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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLEXMTLU 1748 printed Apr 09, 2024@21:08:11 Page 2
LEXMTLU ;ISL/KER - Setup Appl/User Defaults for Look-up ;04/21/2014
+1 ;;2.0;LEXICON UTILITY;**11,80**;Sep 23, 1996;Build 1
+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
