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

LEXDFSI.m

Go to the documentation of this file. 
  1. LEXDFSI ;ISL/KER - Default Filter - Include Semantics ;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.  ;    ^DIR                ICR  10026
  1.  ;               
  1.  ; Called from LEXDFSB (set the INCLUDE/EXCLUDE string)
  1.  ;
  1.  ; LEXC      Counter
  1.  ; LEXCC     Semantic Class Mnemonic
  1.  ; LEXCCN    Semantic Class Counter
  1.  ; LEXCCOK   Semantic Class OK (Y/N)
  1.  ; LEXCCR    Semantic Class Pointer in #757.11
  1.  ; LEXF      Flag for user input
  1.  ; LEXS      Semantic Type Sources from #757.03
  1.  ; LEXX      String returned to LEXDSTS
  1.  ;
  1. EN(LEXX) ; Semantic Type string INCLUDE/EXCLUDE
  1.  K LEXA N LEXF S LEXX="",LEXF=1
  1.  D CLASS Q LEXX
  1.  ;
  1. CLASS ; Semantic Classes
  1.  N LEXCCOK,LEXCC,LEXCCR,LEXCCN S (LEXCCOK,LEXCC)=""
  1.  F  S LEXCC=$O(^LEX(757.11,"B",LEXCC)) Q:LEXCC=""!(LEXCCOK[U)  D
  1.  . S LEXCCOK=0 I LEXCC'="UNK" D  Q:LEXCCOK[U
  1.  . . S LEXCCR=$$IEN(LEXCC),LEXCCN=+($G(LEXCCN))+1
  1.  . . W !!,$J(LEXCCN,2),": ",$$CC(LEXCCR),"   ",$$NAME(LEXCCR),!
  1.  . . D SY(LEXCCR),CAT(LEXCCR)
  1.  . . D:+($G(LEXF)) INCLUDE I LEXCCOK D SAVE(LEXCCR)
  1.  . Q:LEXCCOK["^"  I LEXCCOK D EXCLUDE
  1.  I +($G(LEXF))>0 S LEXX=LEXCCOK
  1.  Q
  1.  ;
  1. SY(LEXX) ; List Classification Systems
  1.  N LEXS,LEXC Q:'$D(^LEX(757.11,LEXX,2,"B"))  S LEXS="",LEXC=0
  1.  W !!,?4,"This Semantic Class contains terms from, or mapped to,"
  1.  W !,?4,"the following classification systems:  ",!
  1.  F  S LEXS=$O(^LEX(757.11,LEXX,2,"B",LEXS)) Q:LEXS=""  D
  1.  . S LEXC=LEXC+1 W:LEXC=1 ! W:LEXC=1 ?8,LEXS
  1.  . W:LEXC=2 ?32,LEXS W:LEXC=3 ?56,LEXS S:LEXC=3 LEXC=0
  1.  W ! Q
  1. CAT(LEXX) ; List semantic types
  1.  N LEXC S LEXC=0 Q:'$D(^LEX(757.11,LEXX,1,0))
  1.  W !!,?4,"Semantic Types:  ",!
  1.  F  S LEXC=$O(^LEX(757.11,LEXX,1,LEXC)) Q:+LEXC=0  D
  1.  . W !,?4,^LEX(757.11,LEXX,1,LEXC,0)
  1.  Q
  1. CC(LEXX) ; Semantic Class Mnemonic
  1.  Q $P(^LEX(757.11,LEXX,0),U,1)
  1. NAME(LEXX) ; Semantic Class Name
  1.  Q $P(^LEX(757.11,LEXX,0),U,2)
  1. IEN(LEXX) ; Internal Entry number based on Semantic Class
  1.  S LEXX=$O(^LEX(757.11,"B",LEXX,0)) Q LEXX
  1.  ;
  1. INCLUDE ; Include a Semantic Classes
  1.  W ! N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
  1.  S DIR("A")="Include this class:  "
  1.  S (DIR("??"),DIR("?"))="^D INH^LEXDFSI"
  1.  S DIR("B")="YES",DIR(0)="YAO"
  1.  D ^DIR K DIR S LEXCCOK=Y Q
  1.  ;
  1. INH ; Include help
  1.  W !!,"    Semantic Class:  "
  1.  W $$CC(LEXCCR)," - ",$$NAME(LEXCCR) Q
  1.  ;
  1. EXCLUDE ; Exclude Semantic Types
  1.  W ! N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
  1.  S DIR("A",1)="Do you want to ""exclude"" any of"
  1.  S DIR("A")="the semantic types listed above:  "
  1.  S DIR("B")="NO",(DIR("?"),DIR("??"))="^D EXH^LEXDFSI",DIR(0)="YAO"
  1.  D ^DIR K DIR S LEXCCOK=0 S:Y["^^" LEXCCOK=Y D:+Y>0 EN^LEXDFSE(LEXCCR) Q
  1. EXH ; Exclude help
  1.  W !!,"By including the semantical class ",$$CC(LEXCCR)
  1.  W " you will also be including"
  1.  W !,"all of the semantical types contained within the class." Q
  1.  ;
  1. SAVE(LEXX) ; Save Semantic Class
  1.  Q:LEXCCOK[U  N LEXC S LEXCCOK=1,LEXC=$G(LEXA(0))+1
  1.  S LEXA(0)=LEXC,LEXA(LEXC,0)=$$CC(LEXX),LEXA(LEXC,1,0)=0,LEXA(LEXC,2,0)=0 Q