- 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 Feb 18, 2025@23:33:45 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
