- 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 Mar 13, 2025@21:14:06 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
