LEXDFSS ;ISL/KER - Default Filter - Semantics/Sources ;04/21/2014
;;2.0;LEXICON UTILITY;**80**;Sep 23, 1996;Build 1
;
; Global Variables
; ^TMP("LEXTSAB") SACC 2.3.2.5.1
;
; External References
; ^DIR ICR 10026
;
; Entry: S X=$$EN^LEXDFSS
;
; LEXFIL Filter (executable)
; LEXNAM Filter Name
; LEXPRO Y/N response to proceed with building filter
; LEXSTR Filter parameters (string)
; LEXSRC Classification system (sources) portion of filter
; LEXSTY Semantic Class/Type portion of filter
; LEXX Filter returned
;
EN(LEXX) ; Entry point S X=$$EN^LEXDFSS
N LEXSTY,LEXSRC,LEXFIL,LEXPRO
S (LEXSTY,LEXSRC,LEXX)="",LEXFIL=0 D INTRO S LEXPRO=$$PRO
Q:LEXPRO["^" LEXPRO Q:LEXPRO'=1 "^No filter selected"
S LEXSTY=$$EN^LEXDFSB Q:LEXSTY["^^" "^^"
S LEXFIL=0 S LEXSRC=$$EN^LEXDCCC Q:LEXSRC["^^" "^^"
Q:$P(LEXSTY,"^",1)="" "^No filter selected"
S LEXSTY=$P(LEXSTY,"^",1),LEXSRC=$P(LEXSRC,"^",1)
Q:'$L((LEXSTY_LEXSRC)) "^No filter selected"
S LEXFIL=1 I $L(LEXSTY),'$L(LEXSRC) D
. N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT W !
. S DIR("A",1)="You have selected semantic classes/types to Include/Exclude in your filter"
. S DIR("A",2)="but have not selected any classification coding systems to include in the"
. S DIR("A",3)="filter. Do you want to contine to build the filter based solely on the"
. S DIR("A")="semantic classes/types you selected? "
. S DIR("B")="YES",DIR("?")="Answer Yes or No",DIR(0)="YAO" D ^DIR
. K DIR S LEXFIL=0,LEXX="^^" S:+Y>0 LEXFIL=+Y,LEXX=""
D:LEXFIL ASSEM Q LEXX
INTRO ; Introduction/Proceed
N LEXSAB D SAB W @IOF
;W !,"FILTER BY BOTH SEMANTIC CLASSES/TYPES AND CLASSIFICATION CODES"
W !!,"This search filter is in two segments. The first segment limits the search"
W !,"based on the semantical classification of the terms. The second segment "
W !,"limits the search based on classification coding systems."
W !!,"First, you will be provided with ",($P(^LEX(757.11,0),U,4))-1," semantic classes. By selecting"
W !,"a semantic class, each term which is found during a search of the "
W !,"Lexicon, and belongs to that class, will be displayed for your selection."
W !,"Additionally, each semantic class contains semantic types (or sub-categories)"
W !,"which may be excluded during the search Terms belonging to an ""included"" "
W !,"semantic class will be displayed unless they also belong to an ""excluded"" "
W !,"semantic type. This segment is mandatory (can not be null)."
;
W !!,"Secondly, you will be presented with ",LEXSAB," classification systems to include."
W !,"By selecting a classification system to include (i.e., ICD), any term which"
W !,"is linked to a code from that system will be displayed for selection. "
W !,"Inclusion by classification code will over ride ""exclusion by sematical"
W !,"class or type"". This segment is optional (may be null)."
K LEXSAB
Q
SAB N LEXI S LEXI="",LEXSAB=0
F S LEXI=$O(^LEX(757.03,"B",LEXI)) Q:LEXI="" D
. Q:'$D(^LEX(757.02,"ASRC",$E(LEXI,1,3)))
. S:'$D(^TMP("LEXTSAB",$J,$E(LEXI,1,3))) ^TMP("LEXTSAB",$J,$E(LEXI,1,3))="",LEXSAB=LEXSAB+1
K ^TMP("LEXTSAB",$J)
Q
PRO(LEXX) ; OK to proceed Y/N
N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT W !!
S DIR("A")="Do you wish to continue: ",DIR("B")="YES"
S DIR("?")="Answer Yes or No",DIR("??")="^D PROH^LEXDFSS"
S DIR(0)="YAO" D ^DIR S LEXX=Y Q LEXX
PROH ; Proceed help
W !!,?2,"Answer"
W !!,?4,"Yes Build a filter based Semantic Types and Classification Codes"
W !,?4,"No Exit without building a filter",! Q
ASSEM ; Assemble the return value FILTER^NAME
N LEXSTR,LEXNAM,LEXFIL S (LEXNAM,LEXFIL)=""
I $L($G(LEXSTY)),$D(LEXSRC) D
. S LEXSTR=LEXSTY
. I $L($G(LEXSRC)),$G(LEXSRC)'[U S LEXSTR=LEXSTY_";"_LEXSRC
. S LEXFIL="I $$SC^LEXU(Y,"_""""_LEXSTR_""""_")"
I LEXFIL[U S LEXNAM=$$NAME^LEXDM3 I LEXNAM="^^" S LEXX="^^"
S:LEXX["^^" LEXFIL="",LEXNAM="^" S LEXX=LEXFIL_"^"_LEXNAM Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLEXDFSS 4044 printed Apr 09, 2024@21:09:57 Page 2
LEXDFSS ;ISL/KER - Default Filter - Semantics/Sources ;04/21/2014
+1 ;;2.0;LEXICON UTILITY;**80**;Sep 23, 1996;Build 1
+2 ;
+3 ; Global Variables
+4 ; ^TMP("LEXTSAB") SACC 2.3.2.5.1
+5 ;
+6 ; External References
+7 ; ^DIR ICR 10026
+8 ;
+9 ; Entry: S X=$$EN^LEXDFSS
+10 ;
+11 ; LEXFIL Filter (executable)
+12 ; LEXNAM Filter Name
+13 ; LEXPRO Y/N response to proceed with building filter
+14 ; LEXSTR Filter parameters (string)
+15 ; LEXSRC Classification system (sources) portion of filter
+16 ; LEXSTY Semantic Class/Type portion of filter
+17 ; LEXX Filter returned
+18 ;
EN(LEXX) ; Entry point S X=$$EN^LEXDFSS
+1 NEW LEXSTY,LEXSRC,LEXFIL,LEXPRO
+2 SET (LEXSTY,LEXSRC,LEXX)=""
SET LEXFIL=0
DO INTRO
SET LEXPRO=$$PRO
+3 if LEXPRO["^"
QUIT LEXPRO
if LEXPRO'=1
QUIT "^No filter selected"
+4 SET LEXSTY=$$EN^LEXDFSB
if LEXSTY["^^"
QUIT "^^"
+5 SET LEXFIL=0
SET LEXSRC=$$EN^LEXDCCC
if LEXSRC["^^"
QUIT "^^"
+6 if $PIECE(LEXSTY,"^",1)=""
QUIT "^No filter selected"
+7 SET LEXSTY=$PIECE(LEXSTY,"^",1)
SET LEXSRC=$PIECE(LEXSRC,"^",1)
+8 if '$LENGTH((LEXSTY_LEXSRC))
QUIT "^No filter selected"
+9 SET LEXFIL=1
IF $LENGTH(LEXSTY)
IF '$LENGTH(LEXSRC)
Begin DoDot:1
+10 NEW DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
WRITE !
+11 SET DIR("A",1)="You have selected semantic classes/types to Include/Exclude in your filter"
+12 SET DIR("A",2)="but have not selected any classification coding systems to include in the"
+13 SET DIR("A",3)="filter. Do you want to contine to build the filter based solely on the"
+14 SET DIR("A")="semantic classes/types you selected? "
+15 SET DIR("B")="YES"
SET DIR("?")="Answer Yes or No"
SET DIR(0)="YAO"
DO ^DIR
+16 KILL DIR
SET LEXFIL=0
SET LEXX="^^"
if +Y>0
SET LEXFIL=+Y
SET LEXX=""
End DoDot:1
+17 if LEXFIL
DO ASSEM
QUIT LEXX
INTRO ; Introduction/Proceed
+1 NEW LEXSAB
DO SAB
WRITE @IOF
+2 ;W !,"FILTER BY BOTH SEMANTIC CLASSES/TYPES AND CLASSIFICATION CODES"
+3 WRITE !!,"This search filter is in two segments. The first segment limits the search"
+4 WRITE !,"based on the semantical classification of the terms. The second segment "
+5 WRITE !,"limits the search based on classification coding systems."
+6 WRITE !!,"First, you will be provided with ",($PIECE(^LEX(757.11,0),U,4))-1," semantic classes. By selecting"
+7 WRITE !,"a semantic class, each term which is found during a search of the "
+8 WRITE !,"Lexicon, and belongs to that class, will be displayed for your selection."
+9 WRITE !,"Additionally, each semantic class contains semantic types (or sub-categories)"
+10 WRITE !,"which may be excluded during the search Terms belonging to an ""included"" "
+11 WRITE !,"semantic class will be displayed unless they also belong to an ""excluded"" "
+12 WRITE !,"semantic type. This segment is mandatory (can not be null)."
+13 ;
+14 WRITE !!,"Secondly, you will be presented with ",LEXSAB," classification systems to include."
+15 WRITE !,"By selecting a classification system to include (i.e., ICD), any term which"
+16 WRITE !,"is linked to a code from that system will be displayed for selection. "
+17 WRITE !,"Inclusion by classification code will over ride ""exclusion by sematical"
+18 WRITE !,"class or type"". This segment is optional (may be null)."
+19 KILL LEXSAB
+20 QUIT
SAB NEW LEXI
SET LEXI=""
SET LEXSAB=0
+1 FOR
SET LEXI=$ORDER(^LEX(757.03,"B",LEXI))
if LEXI=""
QUIT
Begin DoDot:1
+2 if '$DATA(^LEX(757.02,"ASRC",$EXTRACT(LEXI,1,3)))
QUIT
+3 if '$DATA(^TMP("LEXTSAB",$JOB,$EXTRACT(LEXI,1,3)))
SET ^TMP("LEXTSAB",$JOB,$EXTRACT(LEXI,1,3))=""
SET LEXSAB=LEXSAB+1
End DoDot:1
+4 KILL ^TMP("LEXTSAB",$JOB)
+5 QUIT
PRO(LEXX) ; OK to proceed Y/N
+1 NEW DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
WRITE !!
+2 SET DIR("A")="Do you wish to continue: "
SET DIR("B")="YES"
+3 SET DIR("?")="Answer Yes or No"
SET DIR("??")="^D PROH^LEXDFSS"
+4 SET DIR(0)="YAO"
DO ^DIR
SET LEXX=Y
QUIT LEXX
PROH ; Proceed help
+1 WRITE !!,?2,"Answer"
+2 WRITE !!,?4,"Yes Build a filter based Semantic Types and Classification Codes"
+3 WRITE !,?4,"No Exit without building a filter",!
QUIT
ASSEM ; Assemble the return value FILTER^NAME
+1 NEW LEXSTR,LEXNAM,LEXFIL
SET (LEXNAM,LEXFIL)=""
+2 IF $LENGTH($GET(LEXSTY))
IF $DATA(LEXSRC)
Begin DoDot:1
+3 SET LEXSTR=LEXSTY
+4 IF $LENGTH($GET(LEXSRC))
IF $GET(LEXSRC)'[U
SET LEXSTR=LEXSTY_";"_LEXSRC
+5 SET LEXFIL="I $$SC^LEXU(Y,"_""""_LEXSTR_""""_")"
End DoDot:1
+6 IF LEXFIL[U
SET LEXNAM=$$NAME^LEXDM3
IF LEXNAM="^^"
SET LEXX="^^"
+7 if LEXX["^^"
SET LEXFIL=""
SET LEXNAM="^"
SET LEXX=LEXFIL_"^"_LEXNAM
QUIT
