source: WorldVistAEHR/trunk/r/LEXICON_UTILITY-LEX-GMPT/LEXDFSI.m@ 846

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

initial load of WorldVistAEHR

File size: 2.7 KB
Line 
1LEXDFSI ; ISL Default Filter - Include Semantics ; 09-23-96
2 ;;2.0;LEXICON UTILITY;;Sep 23, 1996;Build 1
3 ;
4 ;
5 ; Called from LEXDFSB (set the INCLUDE/EXCLUDE string)
6 ;
7 ; LEXC Counter
8 ; LEXCC Semantic Class Mnemonic
9 ; LEXCCN Semantic Class Counter
10 ; LEXCCOK Semantic Class OK (Y/N)
11 ; LEXCCR Semantic Class Pointer in #757.11
12 ; LEXF Flag for user input
13 ; LEXS Semantic Type Sources from #757.03
14 ; LEXX String returned to LEXDSTS
15 ;
16EN(LEXX) ; Semantic Type string INCLUDE/EXCLUDE
17 K LEXA N LEXF S LEXX="",LEXF=1
18 D CLASS Q LEXX
19 ;
20CLASS ; Semantic Classes
21 N LEXCCOK,LEXCC,LEXCCR,LEXCCN S (LEXCCOK,LEXCC)=""
22 F S LEXCC=$O(^LEX(757.11,"B",LEXCC)) Q:LEXCC=""!(LEXCCOK[U) D
23 . S LEXCCOK=0 I LEXCC'="UNK" D Q:LEXCCOK[U
24 . . S LEXCCR=$$IEN(LEXCC),LEXCCN=+($G(LEXCCN))+1
25 . . W !!,$J(LEXCCN,2),": ",$$CC(LEXCCR)," ",$$NAME(LEXCCR),!
26 . . D SY(LEXCCR),CAT(LEXCCR)
27 . . D:+($G(LEXF)) INCLUDE I LEXCCOK D SAVE(LEXCCR)
28 . Q:LEXCCOK["^" I LEXCCOK D EXCLUDE
29 I +($G(LEXF))>0 S LEXX=LEXCCOK
30 Q
31 ;
32SY(LEXX) ; List Classification Systems
33 N LEXS,LEXC Q:'$D(^LEX(757.11,LEXX,2,"B")) S LEXS="",LEXC=0
34 W !!,?4,"This Semantic Class contains terms from, or mapped to,"
35 W !,?4,"the following classification systems: ",!
36 F S LEXS=$O(^LEX(757.11,LEXX,2,"B",LEXS)) Q:LEXS="" D
37 . S LEXC=LEXC+1 W:LEXC=1 ! W:LEXC=1 ?8,LEXS
38 . W:LEXC=2 ?32,LEXS W:LEXC=3 ?56,LEXS S:LEXC=3 LEXC=0
39 W ! Q
40CAT(LEXX) ; List semantic types
41 N LEXC S LEXC=0 Q:'$D(^LEX(757.11,LEXX,1,0))
42 W !!,?4,"Semantic Types: ",!
43 F S LEXC=$O(^LEX(757.11,LEXX,1,LEXC)) Q:+LEXC=0 D
44 . W !,?4,^LEX(757.11,LEXX,1,LEXC,0)
45 Q
46CC(LEXX) ; Semantic Class Mnemonic
47 Q $P(^LEX(757.11,LEXX,0),U,1)
48NAME(LEXX) ; Semantic Class Name
49 Q $P(^LEX(757.11,LEXX,0),U,2)
50IEN(LEXX) ; Internal Entry number based on Semantic Class
51 S LEXX=$O(^LEX(757.11,"B",LEXX,0)) Q LEXX
52 ;
53INCLUDE ; Include a Semantic Classes
54 W ! N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
55 S DIR("A")="Include this class: "
56 S (DIR("??"),DIR("?"))="^D INH^LEXDFSI"
57 S DIR("B")="YES",DIR(0)="YAO"
58 D ^DIR K DIR S LEXCCOK=Y Q
59 ;
60INH ; Include help
61 W !!," Semantic Class: "
62 W $$CC(LEXCCR)," - ",$$NAME(LEXCCR) Q
63 ;
64EXCLUDE ; Exclude Semantic Types
65 W ! N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
66 S DIR("A",1)="Do you want to ""exclude"" any of"
67 S DIR("A")="the semantic types listed above: "
68 S DIR("B")="NO",(DIR("?"),DIR("??"))="^D EXH^LEXDFSI",DIR(0)="YAO"
69 D ^DIR K DIR S LEXCCOK=0 S:Y["^^" LEXCCOK=Y D:+Y>0 EN^LEXDFSE(LEXCCR) Q
70EXH ; Exclude help
71 W !!,"By including the semantical class ",$$CC(LEXCCR)
72 W " you will also be including"
73 W !,"all of the semantical types contained within the class." Q
74 ;
75SAVE(LEXX) ; Save Semantic Class
76 Q:LEXCCOK[U N LEXC S LEXCCOK=1,LEXC=$G(LEXA(0))+1
77 S LEXA(0)=LEXC,LEXA(LEXC,0)=$$CC(LEXX),LEXA(LEXC,1,0)=0,LEXA(LEXC,2,0)=0 Q
Note: See TracBrowser for help on using the repository browser.