LEXDFSE ;ISL/KER - Default Filter - Exclude Semantics ;04/21/2014
;;2.0;LEXICON UTILITY;**80**;Sep 23, 1996;Build 1
;
; Global Variables
; None
;
; External References
; $$UP^XLFSTR ICR 10103
; ^DIR ICR 10026
;
; Called from LEXDFSI (set the EXCLUDE string)
;
; LEXC Counter
; LEXCCOK Semantic Class OK (Y/N)
; LEXCCR Semantic Class Pointer in # 757.11
; LEXCLS Semantic Class
; LEXCMN Semantic Class Mnemonic
; LEXCT Semantic Type Mnemonic (IEN)
; LEXCTN Semantic Type Counter
; LEXCTOK Semantic Type OK (Y/N)
; LEXCTR Semantic Type Pointer in # 757.12
; LEXF Flag for user input
; LEXI Incremental counter
; LEXLST Array (list) of examples
; LEXMC Pointer to Major Concept in # 757
; LEXS Semantic Type Sources from #757.03
; LEXSPL Sample Term of a Semantic Type
; LEXX String returned to LEXDSTI
;
EN(LEXCCR) ; Exclude types
N LEXF S LEXF=1 D TYPES(LEXCCR) Q
TYPES(LEXCCR) ; Semantic Types
N LEXCTOK,LEXCT,LEXCTR,LEXCTN,LEXCMN,LEXCLS
S LEXCTOK="",LEXCT=0,LEXCMN=$$MNEMONIC(LEXCCR)
F S (LEXCT,LEXCTR)=$O(^LEX(757.12,"C",LEXCMN,LEXCT)) Q:+LEXCT=0!(LEXCTOK[U) D Q:LEXCTOK[U
. Q:'$D(^LEX(757.12,LEXCTR,1,"B"))
. Q:'$D(^LEX(757.12,LEXCTR,0)) S LEXCTN=$S('$D(LEXCTN):1,1:LEXCTN+1)
. W !!,"Semantic Type: ",$P(^LEX(757.12,LEXCTR,0),U,2)
. D STYPE(LEXCTR),EXAMPLE(LEXCTR) D:+($G(LEXF)) EXCLUDE
Q
STYPE(LEXCTR) ; Sources of Semantic Type
I '$D(^LEX(757.12,LEXCTR,1,"B")) D Q
. W !!,?5,"There are no terms with this Semantic Type in "
. W "the Lexicon"
W !!,?5,"This Semantic Type contains terms from, or mapped to,"
W !,?5,"the following classification systems: ",!
N LEXS,LEXC S LEXS="",LEXC=0
F S LEXS=$O(^LEX(757.12,LEXCTR,1,"B",LEXS)) Q:LEXS="" D
. S LEXC=LEXC+1 W:LEXC=1 !,?9,LEXS W:LEXC=2 ?33,LEXS
. W:LEXC=3 ?57,LEXS S:LEXC=3 LEXC=0
Q
EXAMPLE(LEXX) ; List examples
W !!,?5,"Examples of Semantic Type: ",$$NAME(LEXX),!
I '$D(^LEX(757.1,"ASTT",LEXX)) D Q
. W !,?8,"No examples found"
N LEXI,LEXSPL,LEXMC,LEXC S LEXMC="",LEXC=0
F LEXI=1:1:10 D Q:+LEXC>2
. S LEXMC=$O(^LEX(757.1,"ASTT",LEXX,LEXMC)) Q:+LEXMC'>0
. S LEXSPL=$$SAMPLE(LEXMC)
. I '$D(LEXLST($$UP^XLFSTR(LEXSPL))) D
. . S LEXC=LEXC+1 W !,?5,$J(LEXC,2),": ",LEXSPL
. S LEXLST($$UP^XLFSTR(LEXSPL))=""
K LEXLST
Q
MNEMONIC(LEXX) ; Semantic Class Mnemonic
Q $P(^LEX(757.11,LEXX,0),U,1)
CLSNAME(LEXX) ; Semantic Class Name
Q $P(^LEX(757.11,LEXX,0),U,2)
NAME(LEXX) ; Semantic Type Name
Q $P($G(^LEX(757.12,LEXX,0)),"^",2)
SAMPLE(LEXX) ; Sample term of a Semantic Type
N LEXS S LEXS=$E(^LEX(757.01,+(^LEX(757,LEXX,0)),0),1,70)
S:LEXS[" (" LEXS=$P(LEXS," (",1)
S:LEXS[" <" LEXS=$P(LEXS," <",1)
S LEXX=LEXS Q LEXX
EXCLUDE ; Exclude Semantic Type? (Y/N)
N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT W !
S DIR("A")="Exclude this type: "
S DIR("B")="NO",(DIR("?"),DIR("??"))="^D EXH^LEXDFSE"
S DIR(0)="YAO" D ^DIR K DIR S:Y["^" LEXCTOK=U
S:Y["^^" (LEXCCOK,LEXCTOK)="^^" Q:Y["^^" Q:LEXCTOK[U
D:+Y>0 REM D:+Y'>0 SAV Q
EXH ; Exclude help
W !!,?4,"Include semantic class: "
W $$MNEMONIC(LEXCCR)," - ",$$CLSNAME(LEXCCR)
W !,?4,"Excluding the semantic type: ",$$NAME(LEXCTR) Q
REM ; Remove Semantic Type from the list (excluded)
Q:+($G(LEXA(0)))=0 S LEXCTOK=0
N LEXC S LEXC=+($G(LEXA(0)))
S LEXA(LEXC,2,0)=$S('$D(LEXA(LEXC,2,0)):1,1:LEXA(LEXC,2,0)+1)
S LEXA(LEXC,2,LEXA(LEXC,2,0),0)=LEXCTR Q
SAV ; Save the Semantic Type (included)
Q:+($G(LEXA(0)))=0 S LEXCTOK=1
N LEXC S LEXC=+($G(LEXA(0)))
S LEXA(LEXC,1,0)=$S('$D(LEXA(LEXC,1,0)):1,1:LEXA(LEXC,1,0)+1)
S LEXA(LEXC,1,LEXA(LEXC,1,0),0)=LEXCTR Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLEXDFSE 3766 printed Apr 09, 2024@21:09:42 Page 2
LEXDFSE ;ISL/KER - Default Filter - Exclude Semantics ;04/21/2014
+1 ;;2.0;LEXICON UTILITY;**80**;Sep 23, 1996;Build 1
+2 ;
+3 ; Global Variables
+4 ; None
+5 ;
+6 ; External References
+7 ; $$UP^XLFSTR ICR 10103
+8 ; ^DIR ICR 10026
+9 ;
+10 ; Called from LEXDFSI (set the EXCLUDE string)
+11 ;
+12 ; LEXC Counter
+13 ; LEXCCOK Semantic Class OK (Y/N)
+14 ; LEXCCR Semantic Class Pointer in # 757.11
+15 ; LEXCLS Semantic Class
+16 ; LEXCMN Semantic Class Mnemonic
+17 ; LEXCT Semantic Type Mnemonic (IEN)
+18 ; LEXCTN Semantic Type Counter
+19 ; LEXCTOK Semantic Type OK (Y/N)
+20 ; LEXCTR Semantic Type Pointer in # 757.12
+21 ; LEXF Flag for user input
+22 ; LEXI Incremental counter
+23 ; LEXLST Array (list) of examples
+24 ; LEXMC Pointer to Major Concept in # 757
+25 ; LEXS Semantic Type Sources from #757.03
+26 ; LEXSPL Sample Term of a Semantic Type
+27 ; LEXX String returned to LEXDSTI
+28 ;
EN(LEXCCR) ; Exclude types
+1 NEW LEXF
SET LEXF=1
DO TYPES(LEXCCR)
QUIT
TYPES(LEXCCR) ; Semantic Types
+1 NEW LEXCTOK,LEXCT,LEXCTR,LEXCTN,LEXCMN,LEXCLS
+2 SET LEXCTOK=""
SET LEXCT=0
SET LEXCMN=$$MNEMONIC(LEXCCR)
+3 FOR
SET (LEXCT,LEXCTR)=$ORDER(^LEX(757.12,"C",LEXCMN,LEXCT))
if +LEXCT=0!(LEXCTOK[U)
QUIT
Begin DoDot:1
+4 if '$DATA(^LEX(757.12,LEXCTR,1,"B"))
QUIT
+5 if '$DATA(^LEX(757.12,LEXCTR,0))
QUIT
SET LEXCTN=$SELECT('$DATA(LEXCTN):1,1:LEXCTN+1)
+6 WRITE !!,"Semantic Type: ",$PIECE(^LEX(757.12,LEXCTR,0),U,2)
+7 DO STYPE(LEXCTR)
DO EXAMPLE(LEXCTR)
if +($GET(LEXF))
DO EXCLUDE
End DoDot:1
if LEXCTOK[U
QUIT
+8 QUIT
STYPE(LEXCTR) ; Sources of Semantic Type
+1 IF '$DATA(^LEX(757.12,LEXCTR,1,"B"))
Begin DoDot:1
+2 WRITE !!,?5,"There are no terms with this Semantic Type in "
+3 WRITE "the Lexicon"
End DoDot:1
QUIT
+4 WRITE !!,?5,"This Semantic Type contains terms from, or mapped to,"
+5 WRITE !,?5,"the following classification systems: ",!
+6 NEW LEXS,LEXC
SET LEXS=""
SET LEXC=0
+7 FOR
SET LEXS=$ORDER(^LEX(757.12,LEXCTR,1,"B",LEXS))
if LEXS=""
QUIT
Begin DoDot:1
+8 SET LEXC=LEXC+1
if LEXC=1
WRITE !,?9,LEXS
if LEXC=2
WRITE ?33,LEXS
+9 if LEXC=3
WRITE ?57,LEXS
if LEXC=3
SET LEXC=0
End DoDot:1
+10 QUIT
EXAMPLE(LEXX) ; List examples
+1 WRITE !!,?5,"Examples of Semantic Type: ",$$NAME(LEXX),!
+2 IF '$DATA(^LEX(757.1,"ASTT",LEXX))
Begin DoDot:1
+3 WRITE !,?8,"No examples found"
End DoDot:1
QUIT
+4 NEW LEXI,LEXSPL,LEXMC,LEXC
SET LEXMC=""
SET LEXC=0
+5 FOR LEXI=1:1:10
Begin DoDot:1
+6 SET LEXMC=$ORDER(^LEX(757.1,"ASTT",LEXX,LEXMC))
if +LEXMC'>0
QUIT
+7 SET LEXSPL=$$SAMPLE(LEXMC)
+8 IF '$DATA(LEXLST($$UP^XLFSTR(LEXSPL)))
Begin DoDot:2
+9 SET LEXC=LEXC+1
WRITE !,?5,$JUSTIFY(LEXC,2),": ",LEXSPL
End DoDot:2
+10 SET LEXLST($$UP^XLFSTR(LEXSPL))=""
End DoDot:1
if +LEXC>2
QUIT
+11 KILL LEXLST
+12 QUIT
MNEMONIC(LEXX) ; Semantic Class Mnemonic
+1 QUIT $PIECE(^LEX(757.11,LEXX,0),U,1)
CLSNAME(LEXX) ; Semantic Class Name
+1 QUIT $PIECE(^LEX(757.11,LEXX,0),U,2)
NAME(LEXX) ; Semantic Type Name
+1 QUIT $PIECE($GET(^LEX(757.12,LEXX,0)),"^",2)
SAMPLE(LEXX) ; Sample term of a Semantic Type
+1 NEW LEXS
SET LEXS=$EXTRACT(^LEX(757.01,+(^LEX(757,LEXX,0)),0),1,70)
+2 if LEXS[" ("
SET LEXS=$PIECE(LEXS," (",1)
+3 if LEXS[" <"
SET LEXS=$PIECE(LEXS," <",1)
+4 SET LEXX=LEXS
QUIT LEXX
EXCLUDE ; Exclude Semantic Type? (Y/N)
+1 NEW DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
WRITE !
+2 SET DIR("A")="Exclude this type: "
+3 SET DIR("B")="NO"
SET (DIR("?"),DIR("??"))="^D EXH^LEXDFSE"
+4 SET DIR(0)="YAO"
DO ^DIR
KILL DIR
if Y["^"
SET LEXCTOK=U
+5 if Y["^^"
SET (LEXCCOK,LEXCTOK)="^^"
if Y["^^"
QUIT
if LEXCTOK[U
QUIT
+6 if +Y>0
DO REM
if +Y'>0
DO SAV
QUIT
EXH ; Exclude help
+1 WRITE !!,?4,"Include semantic class: "
+2 WRITE $$MNEMONIC(LEXCCR)," - ",$$CLSNAME(LEXCCR)
+3 WRITE !,?4,"Excluding the semantic type: ",$$NAME(LEXCTR)
QUIT
REM ; Remove Semantic Type from the list (excluded)
+1 if +($GET(LEXA(0)))=0
QUIT
SET LEXCTOK=0
+2 NEW LEXC
SET LEXC=+($GET(LEXA(0)))
+3 SET LEXA(LEXC,2,0)=$SELECT('$DATA(LEXA(LEXC,2,0)):1,1:LEXA(LEXC,2,0)+1)
+4 SET LEXA(LEXC,2,LEXA(LEXC,2,0),0)=LEXCTR
QUIT
SAV ; Save the Semantic Type (included)
+1 if +($GET(LEXA(0)))=0
QUIT
SET LEXCTOK=1
+2 NEW LEXC
SET LEXC=+($GET(LEXA(0)))
+3 SET LEXA(LEXC,1,0)=$SELECT('$DATA(LEXA(LEXC,1,0)):1,1:LEXA(LEXC,1,0)+1)
+4 SET LEXA(LEXC,1,LEXA(LEXC,1,0),0)=LEXCTR
QUIT
