LEXDFSB ;ISL/KER - Default Filter - Include/Exclude ;04/21/2014
;;2.0;LEXICON UTILITY;**80**;Sep 23, 1996;Build 1
;
; Entry: S X=$$EN^LEXDFSB
;
; Functions returns the Include/Exclude string for filters
; which use the semantic class and types.
;
; String format:
;
; INC/INC/INC/INC/...ETC;EXC/EXC/EXC/EXC/...EXC
;
; Where INC is a semantic class or type to include
; in searches, and EXC is a semantic class or type to
; exclude from searches
;
; LEXC Counter
; LEXI Include String
; LEXE Exclude String
; LEXA Local array containing include/exclude parameters
; LEXX Include;Exclude string to be returned
;
EN(LEXX) ; Create the Semantic Type String
I +$G(LEXA(0))>0 S LEXX="" D SET K LEXA Q LEXX
S LEXX=$$EN^LEXDFSI K:LEXX[U LEXA
I LEXX[U D Q LEXX
. S:LEXX["^^" LEXX="^^" Q:LEXX["^^" S:LEXX[U LEXX="^No filter selected" K LEXA
I $P(LEXX,U,1)="" S LEXX="^No filter selected" K LEXA Q LEXX
D:+$G(LEXA(0))>0 SET
K LEXA Q LEXX
;
SET ; Create Semantic Include and Exclude strings from the array
;
Q:+($G(LEXA(0)))=0
N LEXC,LEXT,LEXI,LEXE S (LEXI,LEXE)=""
F LEXC=1:1:LEXA(0) D
. I LEXA(LEXC,2,0)<LEXA(LEXC,1,0)!(LEXA(LEXC,2,0)=0) S LEXI=LEXI_"/"_LEXA(LEXC,0)
. I LEXA(LEXC,2,0)<LEXA(LEXC,1,0)&(LEXA(LEXC,2,0)'=0) D
. . F LEXT=1:1:LEXA(LEXC,2,0) D
. . . S LEXE=LEXE_"/"_LEXA(LEXC,2,LEXT,0)
. I LEXA(LEXC,2,0)'<LEXA(LEXC,1,0)&(LEXA(LEXC,2,0)'=0) D
. . F LEXT=1:1:LEXA(LEXC,1,0) D
. . . S LEXI=LEXI_"/"_LEXA(LEXC,1,LEXT,0)
S:LEXI'["UNK" LEXI=LEXI_"/UNK" S:$E(LEXI,1)="/" LEXI=$E(LEXI,2,$L(LEXI))
S:$E(LEXE,1)="/" LEXE=$E(LEXE,2,$L(LEXE)) S LEXX=LEXI_";"_LEXE
K LEXA Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLEXDFSB 1693 printed Oct 16, 2024@18:08:23 Page 2
LEXDFSB ;ISL/KER - Default Filter - Include/Exclude ;04/21/2014
+1 ;;2.0;LEXICON UTILITY;**80**;Sep 23, 1996;Build 1
+2 ;
+3 ; Entry: S X=$$EN^LEXDFSB
+4 ;
+5 ; Functions returns the Include/Exclude string for filters
+6 ; which use the semantic class and types.
+7 ;
+8 ; String format:
+9 ;
+10 ; INC/INC/INC/INC/...ETC;EXC/EXC/EXC/EXC/...EXC
+11 ;
+12 ; Where INC is a semantic class or type to include
+13 ; in searches, and EXC is a semantic class or type to
+14 ; exclude from searches
+15 ;
+16 ; LEXC Counter
+17 ; LEXI Include String
+18 ; LEXE Exclude String
+19 ; LEXA Local array containing include/exclude parameters
+20 ; LEXX Include;Exclude string to be returned
+21 ;
EN(LEXX) ; Create the Semantic Type String
+1 IF +$GET(LEXA(0))>0
SET LEXX=""
DO SET
KILL LEXA
QUIT LEXX
+2 SET LEXX=$$EN^LEXDFSI
if LEXX[U
KILL LEXA
+3 IF LEXX[U
Begin DoDot:1
+4 if LEXX["^^"
SET LEXX="^^"
if LEXX["^^"
QUIT
if LEXX[U
SET LEXX="^No filter selected"
KILL LEXA
End DoDot:1
QUIT LEXX
+5 IF $PIECE(LEXX,U,1)=""
SET LEXX="^No filter selected"
KILL LEXA
QUIT LEXX
+6 if +$GET(LEXA(0))>0
DO SET
+7 KILL LEXA
QUIT LEXX
+8 ;
SET ; Create Semantic Include and Exclude strings from the array
+1 ;
+2 if +($GET(LEXA(0)))=0
QUIT
+3 NEW LEXC,LEXT,LEXI,LEXE
SET (LEXI,LEXE)=""
+4 FOR LEXC=1:1:LEXA(0)
Begin DoDot:1
+5 IF LEXA(LEXC,2,0)<LEXA(LEXC,1,0)!(LEXA(LEXC,2,0)=0)
SET LEXI=LEXI_"/"_LEXA(LEXC,0)
+6 IF LEXA(LEXC,2,0)<LEXA(LEXC,1,0)&(LEXA(LEXC,2,0)'=0)
Begin DoDot:2
+7 FOR LEXT=1:1:LEXA(LEXC,2,0)
Begin DoDot:3
+8 SET LEXE=LEXE_"/"_LEXA(LEXC,2,LEXT,0)
End DoDot:3
End DoDot:2
+9 IF LEXA(LEXC,2,0)'<LEXA(LEXC,1,0)&(LEXA(LEXC,2,0)'=0)
Begin DoDot:2
+10 FOR LEXT=1:1:LEXA(LEXC,1,0)
Begin DoDot:3
+11 SET LEXI=LEXI_"/"_LEXA(LEXC,1,LEXT,0)
End DoDot:3
End DoDot:2
End DoDot:1
+12 if LEXI'["UNK"
SET LEXI=LEXI_"/UNK"
if $EXTRACT(LEXI,1)="/"
SET LEXI=$EXTRACT(LEXI,2,$LENGTH(LEXI))
+13 if $EXTRACT(LEXE,1)="/"
SET LEXE=$EXTRACT(LEXE,2,$LENGTH(LEXE))
SET LEXX=LEXI_";"_LEXE
+14 KILL LEXA
QUIT
