source: WorldVistAEHR/trunk/r/LEXICON_UTILITY-LEX-GMPT/LEXDFSE.m@ 1361

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

initial load of WorldVistAEHR
File size: 3.4 KB
RevLine 
[613]1LEXDFSE ; ISL Default Filter - Exclude Semantics ; 09-23-96
2 ;;2.0;LEXICON UTILITY;;Sep 23, 1996;Build 1
3 ;
4 ; Called from LEXDFSI (set the EXCLUDE string)
5 ;
6 ; LEXC Counter
7 ; LEXCCOK Semantic Class OK (Y/N)
8 ; LEXCCR Semantic Class Pointer in # 757.11
9 ; LEXCLS Semantic Class
10 ; LEXCMN Semantic Class Mnemonic
11 ; LEXCT Semantic Type Mnemonic (IEN)
12 ; LEXCTN Semantic Type Counter
13 ; LEXCTOK Semantic Type OK (Y/N)
14 ; LEXCTR Semantic Type Pointer in # 757.12
15 ; LEXF Flag for user input
16 ; LEXI Incremental counter
17 ; LEXLST Array (list) of examples
18 ; LEXMC Pointer to Major Concept in # 757
19 ; LEXS Semantic Type Sources from #757.03
20 ; LEXSPL Sample Term of a Semantic Type
21 ; LEXX String returned to LEXDSTI
22 ;
23EN(LEXCCR) ; Exclude types
24 N LEXF S LEXF=1 D TYPES(LEXCCR) Q
25TYPES(LEXCCR) ; Semantic Types
26 N LEXCTOK,LEXCT,LEXCTR,LEXCTN,LEXCMN,LEXCLS
27 S LEXCTOK="",LEXCT=0,LEXCMN=$$MNEMONIC(LEXCCR)
28 F S (LEXCT,LEXCTR)=$O(^LEX(757.12,"C",LEXCMN,LEXCT)) Q:+LEXCT=0!(LEXCTOK[U) D Q:LEXCTOK[U
29 . Q:'$D(^LEX(757.12,LEXCTR,1,"B"))
30 . Q:'$D(^LEX(757.12,LEXCTR,0)) S LEXCTN=$S('$D(LEXCTN):1,1:LEXCTN+1)
31 . W !!,"Semantic Type: ",$P(^LEX(757.12,LEXCTR,0),U,2)
32 . D STYPE(LEXCTR),EXAMPLE(LEXCTR) D:+($G(LEXF)) EXCLUDE
33 Q
34STYPE(LEXCTR) ; Sources of Semantic Type
35 I '$D(^LEX(757.12,LEXCTR,1,"B")) D Q
36 . W !!,?5,"There are no terms with this Semantic Type in "
37 . W "the Lexicon"
38 W !!,?5,"This Semantic Type contains terms from, or mapped to,"
39 W !,?5,"the following classification systems: ",!
40 N LEXS,LEXC S LEXS="",LEXC=0
41 F S LEXS=$O(^LEX(757.12,LEXCTR,1,"B",LEXS)) Q:LEXS="" D
42 . S LEXC=LEXC+1 W:LEXC=1 !,?9,LEXS W:LEXC=2 ?33,LEXS
43 . W:LEXC=3 ?57,LEXS S:LEXC=3 LEXC=0
44 Q
45EXAMPLE(LEXX) ; List examples
46 W !!,?5,"Examples of Semantic Type: ",$$NAME(LEXX),!
47 I '$D(^LEX(757.1,"ASTT",LEXX)) D Q
48 . W !,?8,"No examples found"
49 N LEXI,LEXSPL,LEXMC,LEXC S LEXMC="",LEXC=0
50 F LEXI=1:1:10 D Q:+LEXC>2
51 . S LEXMC=$O(^LEX(757.1,"ASTT",LEXX,LEXMC)) Q:+LEXMC'>0
52 . S LEXSPL=$$SAMPLE(LEXMC)
53 . I '$D(LEXLST($$UP^XLFSTR(LEXSPL))) D
54 . . S LEXC=LEXC+1 W !,?5,$J(LEXC,2),": ",LEXSPL
55 . S LEXLST($$UP^XLFSTR(LEXSPL))=""
56 K LEXLST
57 Q
58MNEMONIC(LEXX) ; Semantic Class Mnemonic
59 Q $P(^LEX(757.11,LEXX,0),U,1)
60CLSNAME(LEXX) ; Semantic Class Name
61 Q $P(^LEX(757.11,LEXX,0),U,2)
62NAME(LEXX) ; Semantic Type Name
63 Q $P($G(^LEX(757.12,LEXX,0)),"^",2)
64SAMPLE(LEXX) ; Sample term of a Semantic Type
65 N LEXS S LEXS=$E(^LEX(757.01,+(^LEX(757,LEXX,0)),0),1,70)
66 S:LEXS[" (" LEXS=$P(LEXS," (",1)
67 S:LEXS[" <" LEXS=$P(LEXS," <",1)
68 S LEXX=LEXS Q LEXX
69EXCLUDE ; Exclude Semantic Type? (Y/N)
70 N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT W !
71 S DIR("A")="Exclude this type: "
72 S DIR("B")="NO",(DIR("?"),DIR("??"))="^D EXH^LEXDFSE"
73 S DIR(0)="YAO" D ^DIR K DIR S:Y["^" LEXCTOK=U
74 S:Y["^^" (LEXCCOK,LEXCTOK)="^^" Q:Y["^^" Q:LEXCTOK[U
75 D:+Y>0 REM D:+Y'>0 SAV Q
76EXH ; Exclude help
77 W !!,?4,"Include semantic class: "
78 W $$MNEMONIC(LEXCCR)," - ",$$CLSNAME(LEXCCR)
79 W !,?4,"Excluding the semantic type: ",$$NAME(LEXCTR) Q
80REM ; Remove Semantic Type from the list (excluded)
81 Q:+($G(LEXA(0)))=0 S LEXCTOK=0
82 N LEXC S LEXC=+($G(LEXA(0)))
83 S LEXA(LEXC,2,0)=$S('$D(LEXA(LEXC,2,0)):1,1:LEXA(LEXC,2,0)+1)
84 S LEXA(LEXC,2,LEXA(LEXC,2,0),0)=LEXCTR Q
85SAV ; Save the Semantic Type (included)
86 Q:+($G(LEXA(0)))=0 S LEXCTOK=1 D
87 N LEXC S LEXC=+($G(LEXA(0)))
88 S LEXA(LEXC,1,0)=$S('$D(LEXA(LEXC,1,0)):1,1:LEXA(LEXC,1,0)+1)
89 S LEXA(LEXC,1,LEXA(LEXC,1,0),0)=LEXCTR Q
Note: See TracBrowser for help on using the repository browser.