Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LEXERI

LEXERI.m

Go to the documentation of this file.
  1. LEXERI ;ISL/KER - Exc/Rep Word Input Transformations ;04/21/2014
  1. ;;2.0;LEXICON UTILITY;**80**;Sep 23, 1996;Build 1
  1. ;
  1. ; Global Variables
  1. ; None
  1. ;
  1. ; External References
  1. ; $$UP^XLFSTR ICR 10103
  1. ; HOME^%ZIS ICR 10086
  1. ; ^%ZTLOAD ICR 10063
  1. ; ^DIK ICR 10013
  1. ;
  1. Q
  1. EXC ; Input transformation for ^LEX(757.04, - .01
  1. Q:'$D(X) S LEXX=X
  1. I LEXX[" " D K X Q
  1. . W !,$C(34),X,$C(34)," contains a space"
  1. S LEXX=$$CVT(LEXX)
  1. I $D(^LEX(757.04,"AB",$E(LEXX,1,40))) D Q
  1. . N LEXDA S LEXDA=$G(DA) I +LEXDA>0,$D(^LEX(757.04,"AB",$E(LEXX,1,40),LEXDA)) Q
  1. . W !,$C(34),LEXX,$C(34)," is already defined as an excluded word" K X
  1. I $D(^LEX(757.05,"AB",$E(LEXX,1,40))) D Q
  1. . W !,$C(34),LEXX,$C(34)," has been defined as a replacement word (file #757.05)"
  1. . W !!,"You can not exclude a word from a search which is to be replaced"
  1. . W !,"by another expression prior to performing the search"
  1. I $D(^LEX(757.05,"C",$E($$UP^XLFSTR(LEXX),1,40))) D K X Q
  1. . W !,$C(34),LEXX,$C(34)," has been defined as a replacement word (file #757.05)"
  1. . W !!,"You can not exclude a word from a search which is to be inserted"
  1. . W !,"as replacement text prior to performing the search"
  1. S X=LEXX
  1. Q
  1. REP ; Input Transformation for ^LEX(757.05, - .01
  1. Q:'$D(X) S LEXX=X
  1. N LEXOK,LEXPSN S LEXOK=1 F LEXPSN=1:1:$L(LEXX) D
  1. . I $E(LEXX,LEXPSN)'?1A&($E(LEXX,LEXPSN)'="/") S LEXOK=0
  1. I 'LEXOK D K X Q
  1. . W !,"Alpha-numeric expression. The only punctuation allowed is the slash ""/"""
  1. S LEXX=$$CVT(LEXX)
  1. I $D(^LEX(757.04,"AB",$E(X,1,40))) N LEX S LEX=0 D I 'LEX K X Q
  1. . W !!,$C(7),$C(34),LEXX,$C(34)," already exist in the Excluded Words file."
  1. . W !,"Do you want to delete it from the Excluded Words file"
  1. . W !,"and continue to add it as a replacement word? No// "
  1. REP2 . R LEX:300 I '$T!(LEX="")!(LEX[U) S LEX=0 Q
  1. . I LEX["?" D G REP2
  1. . . W !!,"Yes",!,"Add ",LEXX," to the Replacement Words file and delete it",!,"from the Excluded Words file"
  1. . . W !!,"No",!,"Do not add ",LEXX," to the Replacement Words file and ",!,"retain it in the Excluded Words file"
  1. . . W !!,"",!,"Delete? No// "
  1. . I $E(LEX,1)'="Y"&($E(LEX,1)'="N")&($E(LEX,1)'="y")&($E(LEX,1)'="n") W !!,"",!,"Delete? No// " G REP2
  1. . I $E(LEX,1)="Y"!($E(LEX,1)="y") S LEX=1 D Q
  1. . . S ZTSAVE("X")="",ZTRTN="DEXC^LEXERI",ZTDESC="Deleting "_X_" from Excluded Words file #757.04"
  1. . . 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
  1. . S LEX=0
  1. I $D(^LEX(757.05,"AB",$E(X,1,40))) D K:+($G(LEX)) LEX,LEXR Q
  1. . I $O(^LEX(757.05,"AB",$E(X,1,40),0))=+DA Q
  1. . S (LEX,LEXR)=0 F S LEXR=$O(^LEX(757.05,"AB",$E(X,1,40),LEXR)) D Q:+LEXR=0
  1. . . I +LEXR>0,$D(^LEX(757.05,LEXR,0)),$P(^LEX(757.05,LEXR,0),"^",3)="R" D S LEXR=0
  1. . . . W !!,$C(34),LEXX,$C(34)," already exist in the Replacement Words file (#757.05)"
  1. . . . W !,"as a (R)eplaced word. You may alter the original entry to be a"
  1. . . . W !,"(L)inked word, but you can not (R)eplace ",$C(34),LEXX,$C(34)," with multiple"
  1. . . . W !,"expressions/concepts",!!
  1. . . . S LEX=1
  1. S X=LEXX
  1. Q
  1. DEXC ; Delete entry from Excluded Words file #757.04
  1. 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
  1. REPBY ; Input Transformation for ^LEX(757.05, - 1
  1. Q:'$D(X) N LEXX S LEXX=$$CVT(X)
  1. Q:$D(^LEX(757.05,"C",$E(LEXX,1,40),DA))
  1. I '+($$EXIST^LEXERF(LEXX)) D K X,LEXX Q
  1. . W !!,$C(34),LEXX,$C(34)," does not exist in the Lexicon. You"
  1. . W !,"may not replace a word with text not found in the Lexicon,"
  1. . W !,"resulting in unsuccessful searches."
  1. N LEXOK,LEXJ,LEXI S (LEXOK,LEXJ)=1,LEXI=""
  1. F S LEXI=$P(LEXX," ",LEXJ) D S LEXJ=LEXJ+1 I 'LEXOK!($P(LEXX," ",LEXJ)="") Q
  1. . I $D(^LEX(757.05,"AB",$E(LEXI,1,40))) D
  1. . . N LEXR S LEXR=0 W !,LEXI
  1. . . F S LEXR=$O(^LEX(757.05,"AB",$E(LEXI,1,40),LEXR)) D Q:+LEXR=0
  1. . . . I +LEXR'=0,$D(^LEX(757.05,LEXR,0)),$P(^LEX(757.05,LEXR,0),"^",3)="R" D S LEXR=0
  1. . . . . W !!,"WARNING: Your input contains the word ",$C(34),LEXI,$C(34)," which is"
  1. . . . . W !,"already defined in the Replacement Words file (#757.05) as a (R)eplaced"
  1. . . . . W !,"word. This may cause problems (i.e., circular definition of a word) "
  1. . . . . W !,"resulting in an unsuccessful search in the Lexicon."
  1. . . . . W !!," Example of a circular definition:"
  1. . . . . W !!," Replace: CA with CANCER and"
  1. . . . . W !," Replace: CALCIUM with CA ",!!
  1. . . . . W !!," Searching for ",$C(34),"CALCIUM",$C(34)," may result in a listing of CANCER's,"
  1. . . . . W !," depending on the order of replacement."
  1. . . . . S LEXOK=0
  1. S X=LEXX K:'LEXOK X K LEXOK,LEXI,LEXJ,LEXR,LEXX
  1. Q
  1. CVT(LEXX) ; Convert Text
  1. S LEXX=$$UP^XLFSTR(LEXX) N LEXI,LEXJ S LEXJ="" F LEXI=1:1:$L(LEXX) D
  1. . I $A($E(LEXX,LEXI))=47!($A($E(LEXX,LEXI))>64&($A($E(LEXX,LEXI))<91)) S LEXJ=LEXJ_$E(LEXX,LEXI)
  1. . E S LEXJ=LEXJ_" "
  1. S LEXX=LEXJ K LEXI,LEXJ Q LEXX