LEXSC2 ;ISL/KER - Shortcuts Add/Delete ;04/21/2014
;;2.0;LEXICON UTILITY;**11,80**;Sep 23, 1996;Build 1
;
; Global Variables
; ^DISV( ICR 510
;
; External References
; ^DIR ICR 10026
;
WRT(LEXSTR) ;
W ! N LEXI,LEXLEN S LEXLEN=70 F D Q:$L(LEXSTR)<LEXLEN
. F LEXI=(LEXLEN+1):-1:0 Q:$E(LEXSTR,LEXI)=" "!(LEXI=0)
. I LEXI>0 W !,?2,$E(LEXSTR,1,(LEXI-1)) S LEXSTR=$E(LEXSTR,(LEXI+1),$L(LEXSTR)) Q
. I LEXI=0 W:$L(LEXSTR) !,?2,LEXSTR S LEXSTR=""
I $L(LEXSTR) W !,?2,LEXSTR
W !
Q
DELOK(X) ; Ok to delete?
N DIR,Y,DTOUT,DUOUT,DIRUT,DIROUT
S DIR("A")="Delete current shortcut: ",DIR("B")="NO",DIR(0)="YAO" D ^DIR
S:X[U LEXRP=U S:X["^^" LEXRP="^^" W ! S X=$S(+($G(Y))=1:1,1:0) Q X
Q
ADDOK(X) ; Ok to add?
N DIR,Y,DTOUT,DUOUT,DIRUT,DIROUT
S DIR("A")="Add shortcut: ",DIR("B")="NO",DIR(0)="YAO" D ^DIR
S:X[U LEXRP=U S:X["^^" LEXRP="^^" W ! S X=$S(+($G(Y))=1:1,1:0) Q X
SC(X) ; Get shortcut
S DIR("A")="Enter shortcut keyword(s): "
S DIR("?")="Enter one or more words (up to 63 characters) to use as a shortcut for a term"
S DIR("??")="^D SCHLP^LEXSC2" N Y S DIR(0)="FAO^2:63" D ^DIR
S:X="" LEXRP=U S:X[U LEXRP=U S:X["^^" LEXRP="^^" F Q:$E(X,1)'=" " S X=$E(X,2,$L(X))
W:$D(DTOUT) !,"Try later.",! S:$D(DTOUT) X="",LEXRP=U
S:X[U DUOUT=1 K DIR,DIRUT,DIROUT
Q X
SCHLP ; Look-up help
W !!,"Enter one or more words (up to 63 characters) to use as a shortcut to quickly"
W !,"locate a single term without conducting a word search. This shortcut should"
W !,"be unique to the term as used in the context """,LEXCXN,""""
Q
TERM(X) ; Get expression
N DIR,Y S DIR("A")="Select a term for the shortcut: "
S DIR("?")=" "_$$SQ^LEXHLP ; PCH 11
S DIR("??")="^D TERMHLP^LEXSC2" N Y S DIR(0)="FAO^2:245" D ^DIR
S DIC="^LEX(757.01," S:X[U LEXRP=U S:X["^^" LEXRP="^^" Q:LEXRP[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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLEXSC2 2479 printed Oct 16, 2024@18:10:17 Page 2
LEXSC2 ;ISL/KER - Shortcuts Add/Delete ;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 ;
WRT(LEXSTR) ;
+1 WRITE !
NEW LEXI,LEXLEN
SET LEXLEN=70
FOR
Begin DoDot:1
+2 FOR LEXI=(LEXLEN+1):-1:0
if $EXTRACT(LEXSTR,LEXI)=" "!(LEXI=0)
QUIT
+3 IF LEXI>0
WRITE !,?2,$EXTRACT(LEXSTR,1,(LEXI-1))
SET LEXSTR=$EXTRACT(LEXSTR,(LEXI+1),$LENGTH(LEXSTR))
QUIT
+4 IF LEXI=0
if $LENGTH(LEXSTR)
WRITE !,?2,LEXSTR
SET LEXSTR=""
End DoDot:1
if $LENGTH(LEXSTR)<LEXLEN
QUIT
+5 IF $LENGTH(LEXSTR)
WRITE !,?2,LEXSTR
+6 WRITE !
+7 QUIT
DELOK(X) ; Ok to delete?
+1 NEW DIR,Y,DTOUT,DUOUT,DIRUT,DIROUT
+2 SET DIR("A")="Delete current shortcut: "
SET DIR("B")="NO"
SET DIR(0)="YAO"
DO ^DIR
+3 if X[U
SET LEXRP=U
if X["^^"
SET LEXRP="^^"
WRITE !
SET X=$SELECT(+($GET(Y))=1:1,1:0)
QUIT X
+4 QUIT
ADDOK(X) ; Ok to add?
+1 NEW DIR,Y,DTOUT,DUOUT,DIRUT,DIROUT
+2 SET DIR("A")="Add shortcut: "
SET DIR("B")="NO"
SET DIR(0)="YAO"
DO ^DIR
+3 if X[U
SET LEXRP=U
if X["^^"
SET LEXRP="^^"
WRITE !
SET X=$SELECT(+($GET(Y))=1:1,1:0)
QUIT X
SC(X) ; Get shortcut
+1 SET DIR("A")="Enter shortcut keyword(s): "
+2 SET DIR("?")="Enter one or more words (up to 63 characters) to use as a shortcut for a term"
+3 SET DIR("??")="^D SCHLP^LEXSC2"
NEW Y
SET DIR(0)="FAO^2:63"
DO ^DIR
+4 if X=""
SET LEXRP=U
if X[U
SET LEXRP=U
if X["^^"
SET LEXRP="^^"
FOR
if $EXTRACT(X,1)'=" "
QUIT
SET X=$EXTRACT(X,2,$LENGTH(X))
+5 if $DATA(DTOUT)
WRITE !,"Try later.",!
if $DATA(DTOUT)
SET X=""
SET LEXRP=U
+6 if X[U
SET DUOUT=1
KILL DIR,DIRUT,DIROUT
+7 QUIT X
SCHLP ; Look-up help
+1 WRITE !!,"Enter one or more words (up to 63 characters) to use as a shortcut to quickly"
+2 WRITE !,"locate a single term without conducting a word search. This shortcut should"
+3 WRITE !,"be unique to the term as used in the context """,LEXCXN,""""
+4 QUIT
TERM(X) ; Get expression
+1 NEW DIR,Y
SET DIR("A")="Select a term for the shortcut: "
+2 ; PCH 11
SET DIR("?")=" "_$$SQ^LEXHLP
+3 SET DIR("??")="^D TERMHLP^LEXSC2"
NEW Y
SET DIR(0)="FAO^2:245"
DO ^DIR
+4 SET DIC="^LEX(757.01,"
if X[U
SET LEXRP=U
if X["^^"
SET LEXRP="^^"
if LEXRP[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
