LEXDFSO ;ISL/KER - Default Filter - 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^LEXDFSO
;
; LEXFIL Filter (executable)
; LEXNAM Filter Name
; LEXPRO Y/N response to proceed with building filter
; LEXSTR Filter parameters (string)
; LEXX Filter returned
;
EN(LEXX) ; Entry point S X=$$EN^LEXDFSO
N LEXFIL,LEXPRO S LEXFIL=0 D INTRO S LEXPRO=$$PRO
Q:LEXPRO["^" LEXPRO Q:LEXPRO'=1 "^No filter selected"
S LEXX=$$EN^LEXDCCC S:LEXX="^" LEXX="^^"
Q:LEXX["^^" "^^"
Q:$P(LEXX,"^",1)="" "^No filter selected"
D:$P(LEXX,"^",1)'="" ASSEM
Q LEXX
INTRO ; Introduction/Proceed
N LEXSAB D SAB
W !!,"You will be provided with ",LEXSAB," classifications systems to either include"
W !,"or exclude during Lexicon look-up. If you select a classification system"
W !,"(i.e., ICD) to be included, any terms which qualify during the search and are"
W !,"linked to an ""included"" classification code (example ICD code) will be "
W !,"included in the selection list."
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^LEXDFSO"
S DIR(0)="YAO" D ^DIR S LEXX=Y Q LEXX
PROH ; Proceed help
W !!,?2,"Answer"
W !!,?4,"Yes Continue to build a filter based on Classification Codes"
W !,?4,"No Exit without building a filter",! Q
ASSEM ; Assemble the return value FILTER^NAME
N LEXNAM,LEXFIL S (LEXNAM,LEXFIL)="",LEXFIL=$P(LEXX,"^",1)
I $L($G(LEXFIL)) S LEXFIL="I $$SO^LEXU(Y,"_""""_LEXFIL_""""_")"
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[HLEXDFSO 2186 printed Apr 09, 2024@21:09:02 Page 2
LEXDFSO ;ISL/KER - Default Filter - 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^LEXDFSO
+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 ; LEXX Filter returned
+16 ;
EN(LEXX) ; Entry point S X=$$EN^LEXDFSO
+1 NEW LEXFIL,LEXPRO
SET LEXFIL=0
DO INTRO
SET LEXPRO=$$PRO
+2 if LEXPRO["^"
QUIT LEXPRO
if LEXPRO'=1
QUIT "^No filter selected"
+3 SET LEXX=$$EN^LEXDCCC
if LEXX="^"
SET LEXX="^^"
+4 if LEXX["^^"
QUIT "^^"
+5 if $PIECE(LEXX,"^",1)=""
QUIT "^No filter selected"
+6 if $PIECE(LEXX,"^",1)'=""
DO ASSEM
+7 QUIT LEXX
INTRO ; Introduction/Proceed
+1 NEW LEXSAB
DO SAB
+2 WRITE !!,"You will be provided with ",LEXSAB," classifications systems to either include"
+3 WRITE !,"or exclude during Lexicon look-up. If you select a classification system"
+4 WRITE !,"(i.e., ICD) to be included, any terms which qualify during the search and are"
+5 WRITE !,"linked to an ""included"" classification code (example ICD code) will be "
+6 WRITE !,"included in the selection list."
+7 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^LEXDFSO"
+4 SET DIR(0)="YAO"
DO ^DIR
SET LEXX=Y
QUIT LEXX
PROH ; Proceed help
+1 WRITE !!,?2,"Answer"
+2 WRITE !!,?4,"Yes Continue to build a filter based on Classification Codes"
+3 WRITE !,?4,"No Exit without building a filter",!
QUIT
ASSEM ; Assemble the return value FILTER^NAME
+1 NEW LEXNAM,LEXFIL
SET (LEXNAM,LEXFIL)=""
SET LEXFIL=$PIECE(LEXX,"^",1)
+2 IF $LENGTH($GET(LEXFIL))
SET LEXFIL="I $$SO^LEXU(Y,"_""""_LEXFIL_""""_")"
+3 IF LEXFIL[U
SET LEXNAM=$$NAME^LEXDM3
IF LEXNAM="^^"
SET LEXX="^^"
+4 if LEXX["^^"
SET LEXFIL=""
SET LEXNAM="^"
SET LEXX=LEXFIL_"^"_LEXNAM
QUIT
