131 lines
6.7 KiB
Mathematica
131 lines
6.7 KiB
Mathematica
LEXHLP ; ISL Help/input transformations ; 05/25/1998
|
|
;;2.0;LEXICON UTILITY;**11**;Sep 23, 1996;Build 1
|
|
;
|
|
EXC ; Excluded Word Help
|
|
I '$D(X) Q
|
|
S X=$$UP^XLFSTR(X) I $D(^LEX(757.05,"AB",$E(X,1,40))) D Q
|
|
. W !!,$C(7),"""",X,""""," already exist in the Replacement Words file."
|
|
. W !,"You can not exclude a word which is to be replaced",!!
|
|
. K X
|
|
S X=$$UP^XLFSTR(X) I $D(^LEX(757.04,"C",$E(X,1,40))) D Q
|
|
. W !!,$C(7),"""",X,""""," already exist in the Replacement Words file."
|
|
. W !,"You can not exclude a replacement word",!!
|
|
. K X
|
|
Q
|
|
REP ; Replacement Words Help (replace)
|
|
I '$D(X) Q
|
|
S X=$$UP^XLFSTR(X) I $D(^LEX(757.04,"AB",$E(X,1,40))) D Q
|
|
. W !!,$C(7),"""",X,""""," already exist in the Excluded Words file."
|
|
. W !,"You can not replace an excluded word.",!!
|
|
. K X
|
|
I $D(^LEX(757.01,"AWRD",X)) D Q
|
|
. W !!,$C(7),"""",X,""""," is indexed as a key word for: ",!
|
|
. S LEXREC=0 F S LEXREC=$O(^LEX(757.01,"AWRD",X,LEXREC)) Q:+LEXREC=0 D
|
|
. . W !,?2,^LEX(757.01,LEXREC,0)
|
|
. W !!,"You can not alter this keyword/term linkage.",!!
|
|
. K LEXREC,X
|
|
Q
|
|
REPBY ; Replacement Words Help (insert)
|
|
I '$D(X) Q
|
|
S X=$$UP^XLFSTR(X) I $D(^LEX(757.04,"AB",$E(X,1,40))) D Q
|
|
. W !!,$C(7),"""",X,""""," already exist in the Excluded Words file."
|
|
. W !,"You can not replace an excluded word.",!!
|
|
. K X
|
|
Q
|
|
APPS(X) ; Input Help for ^LEX(757.2 field 8
|
|
N LEXOK S LEXOK=1
|
|
I '$D(X)!('$D(DA)) Q 0
|
|
I $L(X)>3!($L(X)<3) W !,"3 characters, please ",! Q 0
|
|
N LEXI,LEXC F LEXI=1:1:3 S LEXC=$A($E(X,LEXI)) D
|
|
. I ((LEXC>64)&(LEXC<91))!((LEXC>47)&(LEXC<58)) Q
|
|
. S LEXOK=0
|
|
K LEXI,LEXC
|
|
I 'LEXOK K LEXOK W !,"Invalid characters detected, use any combination of uppercase or numeric ",! Q 0
|
|
I X=$P(^LEXT(757.2,DA,0),"^",2) W !,"Cannot be the same as the Short TitLe",LEXOK,! Q 0
|
|
Q 1
|
|
XTLK ; MTLY Help
|
|
; Uses ^TMP("XTLKHITS",$J), XTLKH, XTLKI, XTLKKSCH("DSPLY"),
|
|
; XTLKKSCH("GBL"), XTLKMULT, XTLKREF0 and XTLKREF1
|
|
N LEXHLPF S LEXHLPF=1
|
|
Q:'$D(XTLKHLP) D XTLKONE:^TMP("XTLKHITS",$J)=1,XTLKSEL:^TMP("XTLKHITS",$J)>1 Q
|
|
XTLKONE ; Help for a single entry on the selection list
|
|
N LEXMC,LEXLN
|
|
S LEXMC=$S(LEXSUB="WRD":$P(^LEX(757.01,XTLKI,1),U,1),1:$P(^LEX(757.01,+(@(DIC_XTLKI_",0)")),1),U,1))
|
|
S LEXEXP=0 S:+LEXMC>0 LEXEXP=+(^LEX(757,LEXMC,0))
|
|
I +LEXEXP'=0,$D(^LEX(757.01,LEXEXP,3,0)) D
|
|
. F LEXLN=1:1:$P(^LEX(757.01,LEXEXP,3,0),U,4) D
|
|
. . I $D(^LEX(757.01,LEXEXP,3,LEXLN,0)) W !,?2,^LEX(757.01,LEXEXP,3,LEXLN,0)
|
|
. . I '(+(LEXLN#5)) D XTLKCON
|
|
I $D(LEXLN),(+(LEXLN#5)) D XTLKCON W !
|
|
I +LEXEXP'=0,'$D(^LEX(757.01,LEXEXP,3,0)) W !,"Only one match found, select: ",^LEX(757.01,$S(LEXSUB="WRD":XTLKI,1:+(@(DIC_XTLKI_",0)"))),0),!
|
|
K LEXEXP,LEXMC,LEXLN Q
|
|
XTLKSEL ; Help for a multiple entries on the selection list
|
|
I X?1"?"1N.N!(X?2"?"1N.N) D XTLKDEF,XTLKEND W:XTLKH<6 !! Q
|
|
D XTLKEND,XTLKRED Q
|
|
XTLKDEF ; Display an Expression Defintion as part of the Help
|
|
S X=$E(X,2,$L(X)) G:X["?" XTLKDEF I +X<1!(+X>XTLKH) Q
|
|
N LEXMC,LEXLN,LEXEXP
|
|
S LEXMC=$S(LEXSUB="WRD":$P(^LEX(757.01,^TMP("XTLKHITS",$J,+X),1),U,1),1:$P(^LEX(757.01,+(@(DIC_^TMP("XTLKHITS",$J,+X)_",0)")),1),U,1))
|
|
S LEXEXP=0 S:+LEXMC>0 LEXEXP=+(^LEX(757,LEXMC,0)) I +LEXEXP'=0,$D(^LEX(757.01,LEXEXP,3,0)) D
|
|
. F LEXLN=1:1:$P(^LEX(757.01,LEXEXP,3,0),U,4) D
|
|
. . I $D(^LEX(757.01,LEXEXP,3,LEXLN,0)) D
|
|
. . . W:LEXLN=1 ! W !,?2,^LEX(757.01,LEXEXP,3,LEXLN,0)
|
|
. . I '(+(LEXLN#5)) D XTLKCON
|
|
I $D(LEXLN),(+(LEXLN#5)) D XTLKCON
|
|
; W !
|
|
K LEXMC,LEXLN,LEXEXP Q
|
|
XTLKCON ; End of Page
|
|
Q:'$D(VALM) W ! N X,Y,DTOUT,DUOUT,DIRUT,DIROUT,DIR
|
|
S DIR("A")="Press <Return> to continue "
|
|
S DIR("?")="Press the <Return> key to continue ",DIR(0)="EA" D ^DIR Q
|
|
XTLKEND ; End of Help
|
|
W !!,"Answer with # (1-",XTLKH,"), ^ (quit), ^# (jump - ",^TMP("XTLKHITS",$J)," choices), or ?# (help on a term)" Q
|
|
XTLKRED ; Post-Help, redisplay the last segment of the list
|
|
N LEXSTRT,LEXEND S LEXSTRT=(((XTLKH-1)\5)*5)+1,LEXEND=XTLKH
|
|
F XTLKH=LEXSTRT:1:LEXEND D
|
|
. S (Y,XTLKI)=^TMP("XTLKHITS",$J,XTLKH)
|
|
. S XTLKREF0=XTLKREF1_XTLKI_",0)" W:XTLKH=1 !!
|
|
. I $D(XTLKKSCH("DSPLY")) D @XTLKKSCH("DSPLY") Q
|
|
. W:XTLKMULT $J(XTLKH,4),": " W $P(@(XTLKREF1_"XTLKI,0)"),"^",1),!
|
|
W ! K LEXSTRT,LEXEND Q
|
|
SUB(LEXS) ; Subset help
|
|
W ! N X,Y,LEXDICA,LEXDIC0,LEXDICW,LEXDIC S LEXS=""
|
|
S:$D(DIC)#2>0 LEXDIC=DIC S:$D(DIC(0)) LEXDIC0=DIC(0) S:$D(DIC("A")) LEXDICA=DIC("A") S:$D(DIC("W")) LEXDICW=DIC("W")
|
|
S DIC("A")="Enter the name of a vocabulary to use: ",DIC("W")="",DIC(0)="AEQM",DIC="^LEXT(757.2," D ^DIC
|
|
I +Y>0,$D(^LEXT(757.2,+Y,0)) D
|
|
. I $P(^LEXT(757.2,+Y,0),"^",2)'="" S LEXS=$P(^LEXT(757.2,+Y,0),"^",2) Q
|
|
. I $D(^LEXT(757.2,+Y,5)),$P(^LEXT(757.2,+Y,5),"^",1)'="" S LEXS=$P(^LEXT(757.2,+Y,5),"^",1) Q
|
|
S:$D(LEXDIC) DIC=LEXDIC S:$D(LEXDICW) DIC("W")=LEXDICW S:$D(LEXDIC0) DIC(0)=LEXDIC0 S:$D(LEXDICA) DIC("A")=LEXDICA K:'$D(LEXDICA) DIC("A")
|
|
Q LEXS
|
|
SQ(X) ; Single question mark help for DIR("?") based on DIC("S") PCH 11
|
|
N LEXD,LEXI,LEXA,LEXT,LEXC,LEXN,LEXJ
|
|
I $D(^TMP("LEXSCH",$J)) D
|
|
. S LEXD=$G(^TMP("LEXSCH",$J,"FIL",0)),LEXI=$G(^TMP("LEXSCH",$J,"IDX",0)),LEXA=$G(^TMP("LEXSCH",$J,"APP",1))
|
|
I '$D(^TMP("LEXSCH",$J)) D
|
|
. N LEXTNS,LEXTSS,LEXONS,LEXOSS
|
|
. S (LEXONS,LEXTNS)=$G(LEXAP),LEXTNS=+LEXTNS S:LEXTNS=0 LEXTNS=1
|
|
. S (LEXOSS,LEXTSS)=$G(LEXSUB) S:LEXTSS="" LEXTSS="WRD"
|
|
. D CONFIG^LEXSET(LEXTNS,LEXTSS)
|
|
. S LEXD=$G(^TMP("LEXSCH",$J,"FIL",0)),LEXI=$G(^TMP("LEXSCH",$J,"IDX",0)),LEXA=$G(^TMP("LEXSCH",$J,"APP",1))
|
|
. K ^TMP("LEXSCH",$J) S:$L(LEXONS) LEXAP=LEXONS S:$L(LEXOSS) LEXSUB=LEXOSS
|
|
S (LEXT,LEXC)="",X=""
|
|
S:'$L($G(LEXD))&($L($G(DIC("S")))) LEXD=$G(DIC("S"))
|
|
I $L($G(LEXI)),$G(LEXI)'["WRD" D Q X
|
|
. F LEXJ="DEN;Dental","IMM;Immunologic","NUR;Nursing","SOC;Social Work" S:LEXI[$P(LEXJ,";",1) LEXT=" "_$P(LEXJ,";",2)
|
|
. S X="Enter a ""free text"""_LEXT_" term"
|
|
I $L($G(LEXD)) D Q X
|
|
. I LEXD'["SRC^LEXU" D Q
|
|
. . F LEXJ="ICD;ICD","CPT;CPT","CPC;HCPCS","DS4;DSM","NAN;NANDA" D
|
|
. . . S:LEXD[$P(LEXJ,";",1)&(LEXC'[$P(LEXJ,";",2)) LEXC=LEXC_", "_$P(LEXJ,";",2)
|
|
. . . S:LEXD[$P(LEXJ,";",1)&("NAN^ICD^DSM^DS4^DS3"[$P(LEXJ,";",1))&(LEXT'["diagnosis") LEXT=LEXT_"/diagnosis"
|
|
. . . S:LEXD[$P(LEXJ,";",1)&("CPT^CPC"[$P(LEXJ,";",1))&(LEXT'["procedure") LEXT=LEXT_"/procedure"
|
|
. . S:$E(LEXT,1)="/" LEXT=$E(LEXT,2,$L(LEXT)) S:$E(LEXC,1,2)=", " LEXC=$E(LEXC,3,$L(LEXC))
|
|
. . S:$L(LEXC,", ")>1 LEXC=$P(LEXC,", ",1,($L(LEXC,", ")-1))_" or "_$P(LEXC,", ",$L(LEXC,", ")) S:$L(LEXC) LEXC=$S($E(LEXC,1)="I":("an "_LEXC),1:("a "_LEXC)) S:$L(LEXC) LEXC=LEXC_" code"
|
|
. . S X="Enter a ""free text""" S:$L(LEXT) X=X_" "_LEXT S:'$L(LEXT) X=X_" term" S:$L(LEXC) X=X_" or "_LEXC
|
|
. I LEXD["SRC^LEXU",$L(LEXA) D Q
|
|
. . N LEXN1,LEXN2 S LEXN1=LEXA,LEXN2="" I LEXA[" (",$L($P($P(LEXA," (",2),")",1)) D
|
|
. . . S LEXN1=$P(LEXA," (",1),LEXN2="("_$P(LEXA," (",2),LEXN2=$P(LEXN2,")",1)_")"
|
|
. . S X="Enter a ""free text""" S:$L(LEXN1) X=X_" "_LEXN1 S:$L(LEXN2) X=X_" "_LEXN2 S X=X_" term"
|
|
S X="Enter a ""free text"" term"
|
|
Q X
|