LEXDFSB.m

LEXDFSB ;ISL/KER - Default Filter - Include/Exclude ;04/21/2014

 ;;2.0;LEXICON UTILITY;**80**;Sep 23, 1996;Build 10

 ;

 ; 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

LEXDFSB   ;ISL/KER - Default Filter - Include/Exclude ;04/21/2014

 +1       ;;2.0;LEXICON UTILITY;**80**;Sep 23, 1996;Build 10

 +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