- LEXERI ;ISL/KER - Exc/Rep Word Input Transformations ;04/21/2014
- ;;2.0;LEXICON UTILITY;**80**;Sep 23, 1996;Build 1
- ;
- ; Global Variables
- ; None
- ;
- ; External References
- ; $$UP^XLFSTR ICR 10103
- ; HOME^%ZIS ICR 10086
- ; ^%ZTLOAD ICR 10063
- ; ^DIK ICR 10013
- ;
- Q
- EXC ; Input transformation for ^LEX(757.04, - .01
- Q:'$D(X) S LEXX=X
- I LEXX[" " D K X Q
- . W !,$C(34),X,$C(34)," contains a space"
- S LEXX=$$CVT(LEXX)
- I $D(^LEX(757.04,"AB",$E(LEXX,1,40))) D Q
- . N LEXDA S LEXDA=$G(DA) I +LEXDA>0,$D(^LEX(757.04,"AB",$E(LEXX,1,40),LEXDA)) Q
- . W !,$C(34),LEXX,$C(34)," is already defined as an excluded word" K X
- I $D(^LEX(757.05,"AB",$E(LEXX,1,40))) D Q
- . W !,$C(34),LEXX,$C(34)," has been defined as a replacement word (file #757.05)"
- . W !!,"You can not exclude a word from a search which is to be replaced"
- . W !,"by another expression prior to performing the search"
- I $D(^LEX(757.05,"C",$E($$UP^XLFSTR(LEXX),1,40))) D K X Q
- . W !,$C(34),LEXX,$C(34)," has been defined as a replacement word (file #757.05)"
- . W !!,"You can not exclude a word from a search which is to be inserted"
- . W !,"as replacement text prior to performing the search"
- S X=LEXX
- Q
- REP ; Input Transformation for ^LEX(757.05, - .01
- Q:'$D(X) S LEXX=X
- N LEXOK,LEXPSN S LEXOK=1 F LEXPSN=1:1:$L(LEXX) D
- . I $E(LEXX,LEXPSN)'?1A&($E(LEXX,LEXPSN)'="/") S LEXOK=0
- I 'LEXOK D K X Q
- . W !,"Alpha-numeric expression. The only punctuation allowed is the slash ""/"""
- S LEXX=$$CVT(LEXX)
- I $D(^LEX(757.04,"AB",$E(X,1,40))) N LEX S LEX=0 D I 'LEX K X Q
- . W !!,$C(7),$C(34),LEXX,$C(34)," already exist in the Excluded Words file."
- . W !,"Do you want to delete it from the Excluded Words file"
- . W !,"and continue to add it as a replacement word? No// "
- REP2 . R LEX:300 I '$T!(LEX="")!(LEX[U) S LEX=0 Q
- . I LEX["?" D G REP2
- . . W !!,"Yes",!,"Add ",LEXX," to the Replacement Words file and delete it",!,"from the Excluded Words file"
- . . W !!,"No",!,"Do not add ",LEXX," to the Replacement Words file and ",!,"retain it in the Excluded Words file"
- . . W !!,"",!,"Delete? No// "
- . I $E(LEX,1)'="Y"&($E(LEX,1)'="N")&($E(LEX,1)'="y")&($E(LEX,1)'="n") W !!,"",!,"Delete? No// " G REP2
- . I $E(LEX,1)="Y"!($E(LEX,1)="y") S LEX=1 D Q
- . . S ZTSAVE("X")="",ZTRTN="DEXC^LEXERI",ZTDESC="Deleting "_X_" from Excluded Words file #757.04"
- . . S ZTIO="",ZTDTH=$H D ^%ZTLOAD,HOME^%ZIS W:$D(ZTSK) !!,"Deleting "_X_" from Excluded Words file #757.04" K Y,ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN
- . S LEX=0
- I $D(^LEX(757.05,"AB",$E(X,1,40))) D K:+($G(LEX)) LEX,LEXR Q
- . I $O(^LEX(757.05,"AB",$E(X,1,40),0))=+DA Q
- . S (LEX,LEXR)=0 F S LEXR=$O(^LEX(757.05,"AB",$E(X,1,40),LEXR)) D Q:+LEXR=0
- . . I +LEXR>0,$D(^LEX(757.05,LEXR,0)),$P(^LEX(757.05,LEXR,0),"^",3)="R" D S LEXR=0
- . . . W !!,$C(34),LEXX,$C(34)," already exist in the Replacement Words file (#757.05)"
- . . . W !,"as a (R)eplaced word. You may alter the original entry to be a"
- . . . W !,"(L)inked word, but you can not (R)eplace ",$C(34),LEXX,$C(34)," with multiple"
- . . . W !,"expressions/concepts",!!
- . . . S LEX=1
- S X=LEXX
- Q
- DEXC ; Delete entry from Excluded Words file #757.04
- Q:'$D(X) Q:'$D(^LEX(757.04,"AB",$E(X,1,40))) S DA=$O(^LEX(757.04,"AB",$E(X,1,40),0)),DIK="^LEX(757.04," D ^DIK K DA,DIK S:$D(ZTQUEUED) ZTREQ="@" Q
- REPBY ; Input Transformation for ^LEX(757.05, - 1
- Q:'$D(X) N LEXX S LEXX=$$CVT(X)
- Q:$D(^LEX(757.05,"C",$E(LEXX,1,40),DA))
- I '+($$EXIST^LEXERF(LEXX)) D K X,LEXX Q
- . W !!,$C(34),LEXX,$C(34)," does not exist in the Lexicon. You"
- . W !,"may not replace a word with text not found in the Lexicon,"
- . W !,"resulting in unsuccessful searches."
- N LEXOK,LEXJ,LEXI S (LEXOK,LEXJ)=1,LEXI=""
- F S LEXI=$P(LEXX," ",LEXJ) D S LEXJ=LEXJ+1 I 'LEXOK!($P(LEXX," ",LEXJ)="") Q
- . I $D(^LEX(757.05,"AB",$E(LEXI,1,40))) D
- . . N LEXR S LEXR=0 W !,LEXI
- . . F S LEXR=$O(^LEX(757.05,"AB",$E(LEXI,1,40),LEXR)) D Q:+LEXR=0
- . . . I +LEXR'=0,$D(^LEX(757.05,LEXR,0)),$P(^LEX(757.05,LEXR,0),"^",3)="R" D S LEXR=0
- . . . . W !!,"WARNING: Your input contains the word ",$C(34),LEXI,$C(34)," which is"
- . . . . W !,"already defined in the Replacement Words file (#757.05) as a (R)eplaced"
- . . . . W !,"word. This may cause problems (i.e., circular definition of a word) "
- . . . . W !,"resulting in an unsuccessful search in the Lexicon."
- . . . . W !!," Example of a circular definition:"
- . . . . W !!," Replace: CA with CANCER and"
- . . . . W !," Replace: CALCIUM with CA ",!!
- . . . . W !!," Searching for ",$C(34),"CALCIUM",$C(34)," may result in a listing of CANCER's,"
- . . . . W !," depending on the order of replacement."
- . . . . S LEXOK=0
- S X=LEXX K:'LEXOK X K LEXOK,LEXI,LEXJ,LEXR,LEXX
- Q
- CVT(LEXX) ; Convert Text
- S LEXX=$$UP^XLFSTR(LEXX) N LEXI,LEXJ S LEXJ="" F LEXI=1:1:$L(LEXX) D
- . I $A($E(LEXX,LEXI))=47!($A($E(LEXX,LEXI))>64&($A($E(LEXX,LEXI))<91)) S LEXJ=LEXJ_$E(LEXX,LEXI)
- . E S LEXJ=LEXJ_" "
- S LEXX=LEXJ K LEXI,LEXJ Q LEXX
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLEXERI 5169 printed Feb 18, 2025@23:34:06 Page 2
- LEXERI ;ISL/KER - Exc/Rep Word Input Transformations ;04/21/2014
- +1 ;;2.0;LEXICON UTILITY;**80**;Sep 23, 1996;Build 1
- +2 ;
- +3 ; Global Variables
- +4 ; None
- +5 ;
- +6 ; External References
- +7 ; $$UP^XLFSTR ICR 10103
- +8 ; HOME^%ZIS ICR 10086
- +9 ; ^%ZTLOAD ICR 10063
- +10 ; ^DIK ICR 10013
- +11 ;
- +12 QUIT
- EXC ; Input transformation for ^LEX(757.04, - .01
- +1 if '$DATA(X)
- QUIT
- SET LEXX=X
- +2 IF LEXX[" "
- Begin DoDot:1
- +3 WRITE !,$CHAR(34),X,$CHAR(34)," contains a space"
- End DoDot:1
- KILL X
- QUIT
- +4 SET LEXX=$$CVT(LEXX)
- +5 IF $DATA(^LEX(757.04,"AB",$EXTRACT(LEXX,1,40)))
- Begin DoDot:1
- +6 NEW LEXDA
- SET LEXDA=$GET(DA)
- IF +LEXDA>0
- IF $DATA(^LEX(757.04,"AB",$EXTRACT(LEXX,1,40),LEXDA))
- QUIT
- +7 WRITE !,$CHAR(34),LEXX,$CHAR(34)," is already defined as an excluded word"
- KILL X
- End DoDot:1
- QUIT
- +8 IF $DATA(^LEX(757.05,"AB",$EXTRACT(LEXX,1,40)))
- Begin DoDot:1
- +9 WRITE !,$CHAR(34),LEXX,$CHAR(34)," has been defined as a replacement word (file #757.05)"
- +10 WRITE !!,"You can not exclude a word from a search which is to be replaced"
- +11 WRITE !,"by another expression prior to performing the search"
- End DoDot:1
- QUIT
- +12 IF $DATA(^LEX(757.05,"C",$EXTRACT($$UP^XLFSTR(LEXX),1,40)))
- Begin DoDot:1
- +13 WRITE !,$CHAR(34),LEXX,$CHAR(34)," has been defined as a replacement word (file #757.05)"
- +14 WRITE !!,"You can not exclude a word from a search which is to be inserted"
- +15 WRITE !,"as replacement text prior to performing the search"
- End DoDot:1
- KILL X
- QUIT
- +16 SET X=LEXX
- +17 QUIT
- REP ; Input Transformation for ^LEX(757.05, - .01
- +1 if '$DATA(X)
- QUIT
- SET LEXX=X
- +2 NEW LEXOK,LEXPSN
- SET LEXOK=1
- FOR LEXPSN=1:1:$LENGTH(LEXX)
- Begin DoDot:1
- +3 IF $EXTRACT(LEXX,LEXPSN)'?1A&($EXTRACT(LEXX,LEXPSN)'="/")
- SET LEXOK=0
- End DoDot:1
- +4 IF 'LEXOK
- Begin DoDot:1
- +5 WRITE !,"Alpha-numeric expression. The only punctuation allowed is the slash ""/"""
- End DoDot:1
- KILL X
- QUIT
- +6 SET LEXX=$$CVT(LEXX)
- +7 IF $DATA(^LEX(757.04,"AB",$EXTRACT(X,1,40)))
- NEW LEX
- SET LEX=0
- Begin DoDot:1
- +8 WRITE !!,$CHAR(7),$CHAR(34),LEXX,$CHAR(34)," already exist in the Excluded Words file."
- +9 WRITE !,"Do you want to delete it from the Excluded Words file"
- +10 WRITE !,"and continue to add it as a replacement word? No// "
- REP2 READ LEX:300
- IF '$TEST!(LEX="")!(LEX[U)
- SET LEX=0
- QUIT
- +1 IF LEX["?"
- Begin DoDot:2
- +2 WRITE !!,"Yes",!,"Add ",LEXX," to the Replacement Words file and delete it",!,"from the Excluded Words file"
- +3 WRITE !!,"No",!,"Do not add ",LEXX," to the Replacement Words file and ",!,"retain it in the Excluded Words file"
- +4 WRITE !!,"",!,"Delete? No// "
- End DoDot:2
- GOTO REP2
- +5 IF $EXTRACT(LEX,1)'="Y"&($EXTRACT(LEX,1)'="N")&($EXTRACT(LEX,1)'="y")&($EXTRACT(LEX,1)'="n")
- WRITE !!,"",!,"Delete? No// "
- GOTO REP2
- +6 IF $EXTRACT(LEX,1)="Y"!($EXTRACT(LEX,1)="y")
- SET LEX=1
- Begin DoDot:2
- +7 SET ZTSAVE("X")=""
- SET ZTRTN="DEXC^LEXERI"
- SET ZTDESC="Deleting "_X_" from Excluded Words file #757.04"
- +8 SET ZTIO=""
- SET ZTDTH=$HOROLOG
- DO ^%ZTLOAD
- DO HOME^%ZIS
- if $DATA(ZTSK)
- WRITE !!,"Deleting "_X_" from Excluded Words file #757.04"
- KILL Y,ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN
- End DoDot:2
- QUIT
- +9 SET LEX=0
- End DoDot:1
- IF 'LEX
- KILL X
- QUIT
- +10 IF $DATA(^LEX(757.05,"AB",$EXTRACT(X,1,40)))
- Begin DoDot:1
- +11 IF $ORDER(^LEX(757.05,"AB",$EXTRACT(X,1,40),0))=+DA
- QUIT
- +12 SET (LEX,LEXR)=0
- FOR
- SET LEXR=$ORDER(^LEX(757.05,"AB",$EXTRACT(X,1,40),LEXR))
- Begin DoDot:2
- +13 IF +LEXR>0
- IF $DATA(^LEX(757.05,LEXR,0))
- IF $PIECE(^LEX(757.05,LEXR,0),"^",3)="R"
- Begin DoDot:3
- +14 WRITE !!,$CHAR(34),LEXX,$CHAR(34)," already exist in the Replacement Words file (#757.05)"
- +15 WRITE !,"as a (R)eplaced word. You may alter the original entry to be a"
- +16 WRITE !,"(L)inked word, but you can not (R)eplace ",$CHAR(34),LEXX,$CHAR(34)," with multiple"
- +17 WRITE !,"expressions/concepts",!!
- +18 SET LEX=1
- End DoDot:3
- SET LEXR=0
- End DoDot:2
- if +LEXR=0
- QUIT
- End DoDot:1
- if +($GET(LEX))
- KILL LEX,LEXR
- QUIT
- +19 SET X=LEXX
- +20 QUIT
- DEXC ; Delete entry from Excluded Words file #757.04
- +1 if '$DATA(X)
- QUIT
- if '$DATA(^LEX(757.04,"AB",$EXTRACT(X,1,40)))
- QUIT
- SET DA=$ORDER(^LEX(757.04,"AB",$EXTRACT(X,1,40),0))
- SET DIK="^LEX(757.04,"
- DO ^DIK
- KILL DA,DIK
- if $DATA(ZTQUEUED)
- SET ZTREQ="@"
- QUIT
- REPBY ; Input Transformation for ^LEX(757.05, - 1
- +1 if '$DATA(X)
- QUIT
- NEW LEXX
- SET LEXX=$$CVT(X)
- +2 if $DATA(^LEX(757.05,"C",$EXTRACT(LEXX,1,40),DA))
- QUIT
- +3 IF '+($$EXIST^LEXERF(LEXX))
- Begin DoDot:1
- +4 WRITE !!,$CHAR(34),LEXX,$CHAR(34)," does not exist in the Lexicon. You"
- +5 WRITE !,"may not replace a word with text not found in the Lexicon,"
- +6 WRITE !,"resulting in unsuccessful searches."
- End DoDot:1
- KILL X,LEXX
- QUIT
- +7 NEW LEXOK,LEXJ,LEXI
- SET (LEXOK,LEXJ)=1
- SET LEXI=""
- +8 FOR
- SET LEXI=$PIECE(LEXX," ",LEXJ)
- Begin DoDot:1
- +9 IF $DATA(^LEX(757.05,"AB",$EXTRACT(LEXI,1,40)))
- Begin DoDot:2
- +10 NEW LEXR
- SET LEXR=0
- WRITE !,LEXI
- +11 FOR
- SET LEXR=$ORDER(^LEX(757.05,"AB",$EXTRACT(LEXI,1,40),LEXR))
- Begin DoDot:3
- +12 IF +LEXR'=0
- IF $DATA(^LEX(757.05,LEXR,0))
- IF $PIECE(^LEX(757.05,LEXR,0),"^",3)="R"
- Begin DoDot:4
- +13 WRITE !!,"WARNING: Your input contains the word ",$CHAR(34),LEXI,$CHAR(34)," which is"
- +14 WRITE !,"already defined in the Replacement Words file (#757.05) as a (R)eplaced"
- +15 WRITE !,"word. This may cause problems (i.e., circular definition of a word) "
- +16 WRITE !,"resulting in an unsuccessful search in the Lexicon."
- +17 WRITE !!," Example of a circular definition:"
- +18 WRITE !!," Replace: CA with CANCER and"
- +19 WRITE !," Replace: CALCIUM with CA ",!!
- +20 WRITE !!," Searching for ",$CHAR(34),"CALCIUM",$CHAR(34)," may result in a listing of CANCER's,"
- +21 WRITE !," depending on the order of replacement."
- +22 SET LEXOK=0
- End DoDot:4
- SET LEXR=0
- End DoDot:3
- if +LEXR=0
- QUIT
- End DoDot:2
- End DoDot:1
- SET LEXJ=LEXJ+1
- IF 'LEXOK!($PIECE(LEXX," ",LEXJ)="")
- QUIT
- +23 SET X=LEXX
- if 'LEXOK
- KILL X
- KILL LEXOK,LEXI,LEXJ,LEXR,LEXX
- +24 QUIT
- CVT(LEXX) ; Convert Text
- +1 SET LEXX=$$UP^XLFSTR(LEXX)
- NEW LEXI,LEXJ
- SET LEXJ=""
- FOR LEXI=1:1:$LENGTH(LEXX)
- Begin DoDot:1
- +2 IF $ASCII($EXTRACT(LEXX,LEXI))=47!($ASCII($EXTRACT(LEXX,LEXI))>64&($ASCII($EXTRACT(LEXX,LEXI))<91))
- SET LEXJ=LEXJ_$EXTRACT(LEXX,LEXI)
- +3 IF '$TEST
- SET LEXJ=LEXJ_" "
- End DoDot:1
- +4 SET LEXX=LEXJ
- KILL LEXI,LEXJ
- QUIT LEXX