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

LEXDFSE.m

Go to the documentation of this file. 
  1. LEXDFSE ;ISL/KER - Default Filter - Exclude 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.  ;    $$UP^XLFSTR         ICR  10103
  1.  ;    ^DIR                ICR  10026
  1.  ;               
  1.  ; Called from LEXDFSI (set the EXCLUDE string)
  1.  ;
  1.  ; LEXC      Counter
  1.  ; LEXCCOK   Semantic Class OK (Y/N)
  1.  ; LEXCCR    Semantic Class Pointer in # 757.11
  1.  ; LEXCLS    Semantic Class
  1.  ; LEXCMN    Semantic Class Mnemonic
  1.  ; LEXCT     Semantic Type Mnemonic (IEN)
  1.  ; LEXCTN    Semantic Type Counter
  1.  ; LEXCTOK   Semantic Type OK (Y/N)
  1.  ; LEXCTR    Semantic Type Pointer in # 757.12
  1.  ; LEXF      Flag for user input
  1.  ; LEXI      Incremental counter
  1.  ; LEXLST    Array (list) of examples
  1.  ; LEXMC     Pointer to Major Concept in # 757
  1.  ; LEXS      Semantic Type Sources from #757.03
  1.  ; LEXSPL    Sample Term of a Semantic Type
  1.  ; LEXX      String returned to LEXDSTI
  1.  ;
  1. EN(LEXCCR) ; Exclude types
  1.  N LEXF S LEXF=1 D TYPES(LEXCCR) Q
  1. TYPES(LEXCCR) ; Semantic Types
  1.  N LEXCTOK,LEXCT,LEXCTR,LEXCTN,LEXCMN,LEXCLS
  1.  S LEXCTOK="",LEXCT=0,LEXCMN=$$MNEMONIC(LEXCCR)
  1.  F  S (LEXCT,LEXCTR)=$O(^LEX(757.12,"C",LEXCMN,LEXCT)) Q:+LEXCT=0!(LEXCTOK[U)  D  Q:LEXCTOK[U
  1.  . Q:'$D(^LEX(757.12,LEXCTR,1,"B"))
  1.  . Q:'$D(^LEX(757.12,LEXCTR,0))  S LEXCTN=$S('$D(LEXCTN):1,1:LEXCTN+1)
  1.  . W !!,"Semantic Type:  ",$P(^LEX(757.12,LEXCTR,0),U,2)
  1.  . D STYPE(LEXCTR),EXAMPLE(LEXCTR) D:+($G(LEXF)) EXCLUDE
  1.  Q
  1. STYPE(LEXCTR) ; Sources of Semantic Type
  1.  I '$D(^LEX(757.12,LEXCTR,1,"B")) D  Q
  1.  . W !!,?5,"There are no terms with this Semantic Type in "
  1.  . W "the Lexicon"
  1.  W !!,?5,"This Semantic Type contains terms from, or mapped to,"
  1.  W !,?5,"the following classification systems:  ",!
  1.  N LEXS,LEXC S LEXS="",LEXC=0
  1.  F  S LEXS=$O(^LEX(757.12,LEXCTR,1,"B",LEXS)) Q:LEXS=""  D
  1.  . S LEXC=LEXC+1 W:LEXC=1 !,?9,LEXS W:LEXC=2 ?33,LEXS
  1.  . W:LEXC=3 ?57,LEXS S:LEXC=3 LEXC=0
  1.  Q
  1. EXAMPLE(LEXX) ; List examples
  1.  W !!,?5,"Examples of Semantic Type:   ",$$NAME(LEXX),!
  1.  I '$D(^LEX(757.1,"ASTT",LEXX)) D  Q
  1.  . W !,?8,"No examples found"
  1.  N LEXI,LEXSPL,LEXMC,LEXC S LEXMC="",LEXC=0
  1.  F LEXI=1:1:10 D  Q:+LEXC>2
  1.  . S LEXMC=$O(^LEX(757.1,"ASTT",LEXX,LEXMC)) Q:+LEXMC'>0
  1.  . S LEXSPL=$$SAMPLE(LEXMC)
  1.  . I '$D(LEXLST($$UP^XLFSTR(LEXSPL))) D
  1.  . . S LEXC=LEXC+1 W !,?5,$J(LEXC,2),": ",LEXSPL
  1.  . S LEXLST($$UP^XLFSTR(LEXSPL))=""
  1.  K LEXLST
  1.  Q
  1. MNEMONIC(LEXX) ; Semantic Class Mnemonic
  1.  Q $P(^LEX(757.11,LEXX,0),U,1)
  1. CLSNAME(LEXX) ; Semantic Class Name
  1.  Q $P(^LEX(757.11,LEXX,0),U,2)
  1. NAME(LEXX) ; Semantic Type Name
  1.  Q $P($G(^LEX(757.12,LEXX,0)),"^",2)
  1. SAMPLE(LEXX) ; Sample term of a Semantic Type
  1.  N LEXS S LEXS=$E(^LEX(757.01,+(^LEX(757,LEXX,0)),0),1,70)
  1.  S:LEXS[" (" LEXS=$P(LEXS," (",1)
  1.  S:LEXS[" <" LEXS=$P(LEXS," <",1)
  1.  S LEXX=LEXS Q LEXX
  1. EXCLUDE ; Exclude Semantic Type?  (Y/N)
  1.  N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT W !
  1.  S DIR("A")="Exclude this type:  "
  1.  S DIR("B")="NO",(DIR("?"),DIR("??"))="^D EXH^LEXDFSE"
  1.  S DIR(0)="YAO" D ^DIR K DIR S:Y["^" LEXCTOK=U
  1.  S:Y["^^" (LEXCCOK,LEXCTOK)="^^" Q:Y["^^"  Q:LEXCTOK[U
  1.  D:+Y>0 REM D:+Y'>0 SAV Q
  1. EXH ; Exclude help
  1.  W !!,?4,"Include semantic class:       "
  1.  W $$MNEMONIC(LEXCCR)," - ",$$CLSNAME(LEXCCR)
  1.  W !,?4,"Excluding the semantic type:  ",$$NAME(LEXCTR) Q
  1. REM ; Remove Semantic Type from the list (excluded)
  1.  Q:+($G(LEXA(0)))=0  S LEXCTOK=0
  1.  N LEXC S LEXC=+($G(LEXA(0)))
  1.  S LEXA(LEXC,2,0)=$S('$D(LEXA(LEXC,2,0)):1,1:LEXA(LEXC,2,0)+1)
  1.  S LEXA(LEXC,2,LEXA(LEXC,2,0),0)=LEXCTR Q
  1. SAV ; Save the Semantic Type (included)
  1.  Q:+($G(LEXA(0)))=0  S LEXCTOK=1
  1.  N LEXC S LEXC=+($G(LEXA(0)))
  1.  S LEXA(LEXC,1,0)=$S('$D(LEXA(LEXC,1,0)):1,1:LEXA(LEXC,1,0)+1)
  1.  S LEXA(LEXC,1,LEXA(LEXC,1,0),0)=LEXCTR Q