source: FOIAVistA/trunk/r/LEXICON_UTILITY-LEX-GMPT/LEXERI.m@ 1801

Last change on this file since 1801 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 4.7 KB
Line 
1LEXERI ; ISL Exc/Rep Word Input Transformations ; 09-23-96
2 ;;2.0;LEXICON UTILITY;;Sep 23, 1996
3 Q
4 ;
5EXC ; Input transformation for ^LEX(757.04, - .01
6 Q:'$D(X) S LEXX=X
7 I LEXX[" " D K X Q
8 . W !,$C(34),X,$C(34)," contains a space"
9 S LEXX=$$CVT(LEXX)
10 I $D(^LEX(757.04,"AB",$E(LEXX,1,40))) D Q
11 . N LEXDA S LEXDA=$G(DA) I +LEXDA>0,$D(^LEX(757.04,"AB",$E(LEXX,1,40),LEXDA)) Q
12 . W !,$C(34),LEXX,$C(34)," is already defined as an excluded word" K X
13 I $D(^LEX(757.05,"AB",$E(LEXX,1,40))) D Q
14 . W !,$C(34),LEXX,$C(34)," has been defined as a replacement word (file #757.05)"
15 . W !!,"You can not exclude a word from a search which is to be replaced"
16 . W !,"by another expression prior to performing the search"
17 I $D(^LEX(757.05,"C",$E($$UP^XLFSTR(LEXX),1,40))) D K X Q
18 . W !,$C(34),LEXX,$C(34)," has been defined as a replacement word (file #757.05)"
19 . W !!,"You can not exclude a word from a search which is to be inserted"
20 . W !,"as replacement text prior to performing the search"
21 S X=LEXX
22 Q
23REP ; Input Transformation for ^LEX(757.05, - .01
24 Q:'$D(X) S LEXX=X
25 N LEXOK,LEXPSN S LEXOK=1 F LEXPSN=1:1:$L(LEXX) D
26 . I $E(LEXX,LEXPSN)'?1A&($E(LEXX,LEXPSN)'="/") S LEXOK=0
27 I 'LEXOK D K X Q
28 . W !,"Alpha-numeric expression. The only punctuation allowed is the slash ""/"""
29 S LEXX=$$CVT(LEXX)
30 I $D(^LEX(757.04,"AB",$E(X,1,40))) N LEX S LEX=0 D I 'LEX K X Q
31 . W !!,$C(7),$C(34),LEXX,$C(34)," already exist in the Excluded Words file."
32 . W !,"Do you want to delete it from the Excluded Words file"
33 . W !,"and continue to add it as a replacement word? No// "
34REP2 . R LEX:300 I '$T!(LEX="")!(LEX[U) S LEX=0 Q
35 . I LEX["?" D G REP2
36 . . W !!,"Yes",!,"Add ",LEXX," to the Replacement Words file and delete it",!,"from the Excluded Words file"
37 . . W !!,"No",!,"Do not add ",LEXX," to the Replacement Words file and ",!,"retain it in the Excluded Words file"
38 . . W !!,"",!,"Delete? No// "
39 . I $E(LEX,1)'="Y"&($E(LEX,1)'="N")&($E(LEX,1)'="y")&($E(LEX,1)'="n") W !!,"",!,"Delete? No// " G REP2
40 . I $E(LEX,1)="Y"!($E(LEX,1)="y") S LEX=1 D Q
41 . . S ZTSAVE("X")="",ZTRTN="DEXC^LEXERI",ZTDESC="Deleting "_X_" from Excluded Words file #757.04"
42 . . 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
43 . S LEX=0
44 I $D(^LEX(757.05,"AB",$E(X,1,40))) D K:+($G(LEX)) LEX,LEXR Q
45 . I $O(^LEX(757.05,"AB",$E(X,1,40),0))=+DA Q
46 . S (LEX,LEXR)=0 F S LEXR=$O(^LEX(757.05,"AB",$E(X,1,40),LEXR)) D Q:+LEXR=0
47 . . I +LEXR>0,$D(^LEX(757.05,LEXR,0)),$P(^LEX(757.05,LEXR,0),"^",3)="R" D S LEXR=0
48 . . . W !!,$C(34),LEXX,$C(34)," already exist in the Replacement Words file (#757.05)"
49 . . . W !,"as a (R)eplaced word. You may alter the original entry to be a"
50 . . . W !,"(L)inked word, but you can not (R)eplace ",$C(34),LEXX,$C(34)," with multiple"
51 . . . W !,"expressions/concepts",!!
52 . . . S LEX=1
53 S X=LEXX
54 Q
55DEXC ; Delete entry from Excluded Words file #757.04
56 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
57REPBY ; Input Transformation for ^LEX(757.05, - 1
58 Q:'$D(X) N LEXX S LEXX=$$CVT(X)
59 Q:$D(^LEX(757.05,"C",$E(LEXX,1,40),DA))
60 I '+($$EXIST^LEXERF(LEXX)) D K X,LEXX Q
61 . W !!,$C(34),LEXX,$C(34)," does not exist in the Lexicon. You"
62 . W !,"may not replace a word with text not found in the Lexicon,"
63 . W !,"resulting in unsuccessful searches."
64 N LEXOK,LEXJ,LEXI S (LEXOK,LEXJ)=1,LEXI=""
65 F S LEXI=$P(LEXX," ",LEXJ) D S LEXJ=LEXJ+1 I 'LEXOK!($P(LEXX," ",LEXJ)="") Q
66 . I $D(^LEX(757.05,"AB",$E(LEXI,1,40))) D
67 . . N LEXR S LEXR=0 W !,LEXI
68 . . F S LEXR=$O(^LEX(757.05,"AB",$E(LEXI,1,40),LEXR)) D Q:+LEXR=0
69 . . . I +LEXR'=0,$D(^LEX(757.05,LEXR,0)),$P(^LEX(757.05,LEXR,0),"^",3)="R" D S LEXR=0
70 . . . . W !!,"WARNING: Your input contains the word ",$C(34),LEXI,$C(34)," which is"
71 . . . . W !,"already defined in the Replacement Words file (#757.05) as a (R)eplaced"
72 . . . . W !,"word. This may cause problems (i.e., circular definition of a word) "
73 . . . . W !,"resulting in an unsuccessful search in the Lexicon."
74 . . . . W !!," Example of a circular definition:"
75 . . . . W !!," Replace: CA with CANCER and"
76 . . . . W !," Replace: CALCIUM with CA ",!!
77 . . . . W !!," Searching for ",$C(34),"CALCIUM",$C(34)," may result in a listing of CANCER's,"
78 . . . . W !," depending on the order of replacement."
79 . . . . S LEXOK=0
80 S X=LEXX K:'LEXOK X K LEXOK,LEXI,LEXJ,LEXR,LEXX
81 Q
82CVT(LEXX) ; Convert Text
83 S LEXX=$$UP^XLFSTR(LEXX) N LEXI,LEXJ S LEXJ="" F LEXI=1:1:$L(LEXX) D
84 . I $A($E(LEXX,LEXI))=47!($A($E(LEXX,LEXI))>64&($A($E(LEXX,LEXI))<91)) S LEXJ=LEXJ_$E(LEXX,LEXI)
85 . E S LEXJ=LEXJ_" "
86 S LEXX=LEXJ K LEXI,LEXJ Q LEXX
Note: See TracBrowser for help on using the repository browser.