LEXDDTF ;ISL/KER - Display Defaults - Filter ;04/21/2014
;;2.0;LEXICON UTILITY;**80**;Sep 23, 1996;Build 1
;
; Global Variables
; None
;
; External References
; None
;
SC ; Filter by Semantic Classifications
; Required LEXDICS in the format I $$SC^LEXU...
N LEXTC,LEXTCTR,LEXTI,LEXTIC,LEXTIE,LEXTSTR
Q:'$L($G(LEXDICS)) Q:LEXDICS'["$$SC^LEXU"
S LEX=$TR($P($P(LEXDICS,"Y,",2),")",1),"""","")
S LEXTCTR=0,LEX("I")=$P(LEX,";",1)
S LEX("E")=$P(LEX,";",2),LEX("L")=$P(LEX,";",3)
S LEX("I","H")="Include expressions which relate to",LEXTCTR=0
N LEXTIC,LEXTIE,LEXTI F LEXTI=1:1:$L(LEX("I"),"/") D
. S LEXTIC=$P(LEX("I"),"/",LEXTI) Q:LEXTIC="UNK"
. S LEXTCTR=LEXTCTR+1,LEX("I",LEXTCTR)=$$SN(LEXTIC)
S LEX("I",0)=LEXTCTR
S LEX("E","H")="Exclude expressions which relate to",LEXTCTR=0
F LEXTI=1:1:$L(LEX("E"),"/") D
. S LEXTIC=$P(LEX("E"),"/",LEXTI) Q:LEXTIC="UNK"
. S LEXTCTR=LEXTCTR+1,LEX("E",LEXTCTR)=$$SN(LEXTIC)
S LEX("E",0)=LEXTCTR
S LEX("L","H")="Also include expressions which are linked to"
S LEX("L","T")="coding system",LEXTCTR=0
F LEXTI=1:1:$L(LEX("L"),"/") D
. S LEXTIC=$P(LEX("L"),"/",LEXTI) Q:LEXTIC="UND" S LEXTCTR=LEXTCTR+1,LEX("L",LEXTCTR)=$$CN(LEXTIC)
S:LEXTCTR>1 LEX("L","T")=LEX("L","T")_"s"
S LEX("L","T")=LEX("L","T")_"."
S LEX("L",0)=LEXTCTR
S:'$D(LEXSTLN) LEXSTLN=56 K LEX("T") S LEXTCTR=0 N LEXT,LEXTSTR
D:$G(LEX("I",0)) INC
D:$G(LEX("E",0)) EXC
D:$G(LEX("L",0)) LNK
D EOC^LEXDDT2
Q
SO ; Filter by Sources
; Required LEXDICS in the format I $$SO^LEXU...
N LEXTC,LEXTCTR,LEXTI,LEXTIC,LEXTIE,LEXTSTR
Q:'$L($G(LEXDICS)) Q:LEXDICS'["$$SO^LEXU"
S LEX=$TR($P($P(LEXDICS,"Y,",2),")",1),"""","")
S LEXTCTR=0,LEX("L")=LEX
S LEX("L","H")="Include expressions which are linked to"
S LEX("L","T")="coding system",LEXTCTR=0
F LEXTI=1:1:$L(LEX("L"),"/") D
. S LEXTIC=$P(LEX("L"),"/",LEXTI) Q:LEXTIC="UND" S LEXTCTR=LEXTCTR+1,LEX("L",LEXTCTR)=$$CN(LEXTIC)
S:LEXTCTR>1 LEX("L","T")=LEX("L","T")_"s"
S LEX("L","T")=LEX("L","T")_"."
S LEX("L",0)=LEXTCTR
S:'$D(LEXSTLN) LEXSTLN=56 K LEX("T") S LEXTCTR=0 N LEXT,LEXTSTR
S LEXTSTR="" D:$G(LEX("L",0)) LNK
D EOC^LEXDDT2
Q
INC ; Inclusion Data Elements
S LEXTSTR="",LEXT="I",LEXTCTR=0 D CONCAT^LEXDDT2 K LEX("I")
Q
EXC ; Exclusion Data Elements
S LEXT="E",LEXTCTR=+($G(LEX(0)))
I $D(LEXTSTR) D
. S:$E(LEXTSTR,$L(LEXTSTR))["," LEXTSTR=$E(LEXTSTR,1,($L(LEXTSTR)-1))
. I $L(LEXTSTR)'>(LEXSTLN+2) S LEXTSTR=LEXTSTR_" " Q
. D SET^LEXDDT2
. S LEXTSTR=""
D CONCAT^LEXDDT2 K LEX("E")
Q
LNK ; Linked Sources Data Elements
S LEXT="L",LEXTCTR=+($G(LEX(0)))
I $D(LEXTSTR) D
. S:$E(LEXTSTR,$L(LEXTSTR))["," LEXTSTR=$E(LEXTSTR,1,($L(LEXTSTR)-1))
. I $L(LEXTSTR)'>(LEXSTLN+2) S LEXTSTR=LEXTSTR_" " Q
. D SET^LEXDDT2
. S LEXTSTR=""
D CONCAT^LEXDDT2 K LEX("L")
Q
SN(LEXSTR) ; Get Semantic Data Element Name
N LEXTEMP S LEXTEMP=LEXSTR I LEXTEMP?3U D
. S LEXSTR=$O(^LEX(757.11,"B",LEXTEMP,0)) S:+LEXSTR=0 LEXSTR=""
. S:+LEXSTR>0 LEXSTR=$P($G(^LEX(757.11,+LEXSTR,0)),"^",2)
I LEXTEMP?1N.N D
. S LEXSTR=+LEXTEMP
. S LEXSTR=$S($D(^LEX(757.12,LEXSTR,0)):$P($G(^LEX(757.12,LEXSTR,0)),"^",2),1:"")
Q LEXSTR
CN(LEXSTR) ; Get Classification System Data Element Name
N LEXTEMP,LEXTC S LEXTC=LEXSTR,LEXTEMP=$E(LEXSTR,1,2)_$C($A($E(LEXSTR,3))-1)_"~"
S LEXSTR=""
F S LEXTEMP=$O(^LEX(757.03,"B",LEXTEMP)) Q:LEXTEMP=""!(LEXSTR'="") D Q:LEXTEMP=""!(LEXSTR'="")
. I LEXTEMP[LEXTC S LEXSTR=$O(^LEX(757.03,"B",LEXTEMP,0))
S LEXSTR=+LEXSTR S:LEXSTR=0 LEXSTR=""
I +LEXSTR>0,$D(^LEX(757.03,+LEXSTR)) S LEXSTR=$P($G(^LEX(757.03,+LEXSTR,0)),"^",2)
Q LEXSTR
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLEXDDTF 3696 printed Oct 16, 2024@18:08:15 Page 2
LEXDDTF ;ISL/KER - Display Defaults - Filter ;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 ; None
+8 ;
SC ; Filter by Semantic Classifications
+1 ; Required LEXDICS in the format I $$SC^LEXU...
+2 NEW LEXTC,LEXTCTR,LEXTI,LEXTIC,LEXTIE,LEXTSTR
+3 if '$LENGTH($GET(LEXDICS))
QUIT
if LEXDICS'["$$SC^LEXU"
QUIT
+4 SET LEX=$TRANSLATE($PIECE($PIECE(LEXDICS,"Y,",2),")",1),"""","")
+5 SET LEXTCTR=0
SET LEX("I")=$PIECE(LEX,";",1)
+6 SET LEX("E")=$PIECE(LEX,";",2)
SET LEX("L")=$PIECE(LEX,";",3)
+7 SET LEX("I","H")="Include expressions which relate to"
SET LEXTCTR=0
+8 NEW LEXTIC,LEXTIE,LEXTI
FOR LEXTI=1:1:$LENGTH(LEX("I"),"/")
Begin DoDot:1
+9 SET LEXTIC=$PIECE(LEX("I"),"/",LEXTI)
if LEXTIC="UNK"
QUIT
+10 SET LEXTCTR=LEXTCTR+1
SET LEX("I",LEXTCTR)=$$SN(LEXTIC)
End DoDot:1
+11 SET LEX("I",0)=LEXTCTR
+12 SET LEX("E","H")="Exclude expressions which relate to"
SET LEXTCTR=0
+13 FOR LEXTI=1:1:$LENGTH(LEX("E"),"/")
Begin DoDot:1
+14 SET LEXTIC=$PIECE(LEX("E"),"/",LEXTI)
if LEXTIC="UNK"
QUIT
+15 SET LEXTCTR=LEXTCTR+1
SET LEX("E",LEXTCTR)=$$SN(LEXTIC)
End DoDot:1
+16 SET LEX("E",0)=LEXTCTR
+17 SET LEX("L","H")="Also include expressions which are linked to"
+18 SET LEX("L","T")="coding system"
SET LEXTCTR=0
+19 FOR LEXTI=1:1:$LENGTH(LEX("L"),"/")
Begin DoDot:1
+20 SET LEXTIC=$PIECE(LEX("L"),"/",LEXTI)
if LEXTIC="UND"
QUIT
SET LEXTCTR=LEXTCTR+1
SET LEX("L",LEXTCTR)=$$CN(LEXTIC)
End DoDot:1
+21 if LEXTCTR>1
SET LEX("L","T")=LEX("L","T")_"s"
+22 SET LEX("L","T")=LEX("L","T")_"."
+23 SET LEX("L",0)=LEXTCTR
+24 if '$DATA(LEXSTLN)
SET LEXSTLN=56
KILL LEX("T")
SET LEXTCTR=0
NEW LEXT,LEXTSTR
+25 if $GET(LEX("I",0))
DO INC
+26 if $GET(LEX("E",0))
DO EXC
+27 if $GET(LEX("L",0))
DO LNK
+28 DO EOC^LEXDDT2
+29 QUIT
SO ; Filter by Sources
+1 ; Required LEXDICS in the format I $$SO^LEXU...
+2 NEW LEXTC,LEXTCTR,LEXTI,LEXTIC,LEXTIE,LEXTSTR
+3 if '$LENGTH($GET(LEXDICS))
QUIT
if LEXDICS'["$$SO^LEXU"
QUIT
+4 SET LEX=$TRANSLATE($PIECE($PIECE(LEXDICS,"Y,",2),")",1),"""","")
+5 SET LEXTCTR=0
SET LEX("L")=LEX
+6 SET LEX("L","H")="Include expressions which are linked to"
+7 SET LEX("L","T")="coding system"
SET LEXTCTR=0
+8 FOR LEXTI=1:1:$LENGTH(LEX("L"),"/")
Begin DoDot:1
+9 SET LEXTIC=$PIECE(LEX("L"),"/",LEXTI)
if LEXTIC="UND"
QUIT
SET LEXTCTR=LEXTCTR+1
SET LEX("L",LEXTCTR)=$$CN(LEXTIC)
End DoDot:1
+10 if LEXTCTR>1
SET LEX("L","T")=LEX("L","T")_"s"
+11 SET LEX("L","T")=LEX("L","T")_"."
+12 SET LEX("L",0)=LEXTCTR
+13 if '$DATA(LEXSTLN)
SET LEXSTLN=56
KILL LEX("T")
SET LEXTCTR=0
NEW LEXT,LEXTSTR
+14 SET LEXTSTR=""
if $GET(LEX("L",0))
DO LNK
+15 DO EOC^LEXDDT2
+16 QUIT
INC ; Inclusion Data Elements
+1 SET LEXTSTR=""
SET LEXT="I"
SET LEXTCTR=0
DO CONCAT^LEXDDT2
KILL LEX("I")
+2 QUIT
EXC ; Exclusion Data Elements
+1 SET LEXT="E"
SET LEXTCTR=+($GET(LEX(0)))
+2 IF $DATA(LEXTSTR)
Begin DoDot:1
+3 if $EXTRACT(LEXTSTR,$LENGTH(LEXTSTR))[","
SET LEXTSTR=$EXTRACT(LEXTSTR,1,($LENGTH(LEXTSTR)-1))
+4 IF $LENGTH(LEXTSTR)'>(LEXSTLN+2)
SET LEXTSTR=LEXTSTR_" "
QUIT
+5 DO SET^LEXDDT2
+6 SET LEXTSTR=""
End DoDot:1
+7 DO CONCAT^LEXDDT2
KILL LEX("E")
+8 QUIT
LNK ; Linked Sources Data Elements
+1 SET LEXT="L"
SET LEXTCTR=+($GET(LEX(0)))
+2 IF $DATA(LEXTSTR)
Begin DoDot:1
+3 if $EXTRACT(LEXTSTR,$LENGTH(LEXTSTR))[","
SET LEXTSTR=$EXTRACT(LEXTSTR,1,($LENGTH(LEXTSTR)-1))
+4 IF $LENGTH(LEXTSTR)'>(LEXSTLN+2)
SET LEXTSTR=LEXTSTR_" "
QUIT
+5 DO SET^LEXDDT2
+6 SET LEXTSTR=""
End DoDot:1
+7 DO CONCAT^LEXDDT2
KILL LEX("L")
+8 QUIT
SN(LEXSTR) ; Get Semantic Data Element Name
+1 NEW LEXTEMP
SET LEXTEMP=LEXSTR
IF LEXTEMP?3U
Begin DoDot:1
+2 SET LEXSTR=$ORDER(^LEX(757.11,"B",LEXTEMP,0))
if +LEXSTR=0
SET LEXSTR=""
+3 if +LEXSTR>0
SET LEXSTR=$PIECE($GET(^LEX(757.11,+LEXSTR,0)),"^",2)
End DoDot:1
+4 IF LEXTEMP?1N.N
Begin DoDot:1
+5 SET LEXSTR=+LEXTEMP
+6 SET LEXSTR=$SELECT($DATA(^LEX(757.12,LEXSTR,0)):$PIECE($GET(^LEX(757.12,LEXSTR,0)),"^",2),1:"")
End DoDot:1
+7 QUIT LEXSTR
CN(LEXSTR) ; Get Classification System Data Element Name
+1 NEW LEXTEMP,LEXTC
SET LEXTC=LEXSTR
SET LEXTEMP=$EXTRACT(LEXSTR,1,2)_$CHAR($ASCII($EXTRACT(LEXSTR,3))-1)_"~"
+2 SET LEXSTR=""
+3 FOR
SET LEXTEMP=$ORDER(^LEX(757.03,"B",LEXTEMP))
if LEXTEMP=""!(LEXSTR'="")
QUIT
Begin DoDot:1
+4 IF LEXTEMP[LEXTC
SET LEXSTR=$ORDER(^LEX(757.03,"B",LEXTEMP,0))
End DoDot:1
if LEXTEMP=""!(LEXSTR'="")
QUIT
+5 SET LEXSTR=+LEXSTR
if LEXSTR=0
SET LEXSTR=""
+6 IF +LEXSTR>0
IF $DATA(^LEX(757.03,+LEXSTR))
SET LEXSTR=$PIECE($GET(^LEX(757.03,+LEXSTR,0)),"^",2)
+7 QUIT LEXSTR
