- 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 Mar 13, 2025@21:12:04 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
