LEXDFL.m

LEXDFL ;ISL/KER - Default Filter ;04/21/2014

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

 ;               

 ; Global Variables

 ;    None

 ;               

 ; External References

 ;    $$GET1^DIQ          ICR   2056

 ;    $$UP^XLFSTR         ICR  10103

 ;               

 ; Entry:  D EN^LEXDFL             LEXAP is unknown

 ;

 ; Entry:  D EN1^LEXDFL(LEXAP)    LEXAP is known

 ;

 ; Single user entry point - Saves Filter in file 757.2

 ;

 ; Where 

 ;

 ;      LEXAP     Pointer to file 757.2

 ;      LEXUSER   DUZ of user

 ;      LEXCA     Action (modify/delete)

 ;      LEXCM     Method (predefined/create)

 ;

EN ; Single user, LEXAP is unknown

 N LEXAP S LEXAP=$$DFI^LEXDM4 Q:+LEXAP=0  W ! D EN1(LEXAP) Q

EN1(LEXAP) ; Single user, LEXAP is known

 N LEXUSER,LEXX S LEXUSER=$G(DUZ) Q:+LEXUSER'>0  Q:'$L($$GET1^DIQ(200,+($G(DUZ)),.01))

 ;

 S LEXAP=$G(LEXAP) Q:LEXAP=""

 I '$D(^LEXT(757.2,+LEXAP,0))&('$D(^LEXT(757.2,"B",LEXAP)))&('$D(^LEXT(757.2,"C",$$UP^XLFSTR(LEXAP))))&('$D(^LEXT(757.2,"AN",LEXAP))) Q

 S:+LEXAP'>0 LEXAP=$$AP^LEXDFN2(LEXAP)

 ;

 Q:+($G(LEXAP))'>0  Q:+($P($G(^LEXT(757.2,+LEXAP,5)),"^",3))'>0

 N LEXCA,LEXCM,LEXDVAL,LEXDNAM,LEXFLD,LEXFIL S LEXFIL=""

 S LEXFLD=1,LEXCA=$$MOD^LEXDM(1) Q:LEXCA=0!(LEXCA="^^")

 D:LEXCA="@" KILL Q:LEXCA="@"  W ! S LEXCM=$$MTH^LEXDM(1) Q:LEXCM["^"

 S:LEXCM=1 LEXDVAL=$$EN^LEXDFLS

 S:LEXCM=2 LEXDVAL=$$EN^LEXDFLC Q:LEXDVAL="^^"

 S LEXDNAM=$P(LEXDVAL,"^",$L(LEXDVAL,"^")),LEXDVAL=$P(LEXDVAL,"^",1,($L(LEXDVAL,"^")-1))

 D SET

 Q

MGR(LEXX) ; Multi-user (for Manager options)

 ; Do not save filter, return value to manager option

 N LEXCA,LEXCM,LEXDVAL S LEXX=""

 S LEXCA=$$MOD^LEXDM(1) Q:LEXCA=0 "^" Q:(LEXCA="^^") "^^"

 Q:LEXCA="@" "@^Delete filter"

 W ! S LEXCM=$$MTH^LEXDM(1) S:LEXCM[U LEXX=U S:LEXCM["^^" LEXX="^^"

 Q:LEXX["^" LEXX

 S:LEXCM=1 LEXDVAL=$$EN^LEXDFLS S:LEXCM=2 LEXDVAL=$$EN^LEXDFLC

 Q:LEXDVAL="^^" "^^"

 S LEXX=LEXDVAL Q LEXX

SET ; Set default filter

 D SET^LEXDSV(LEXUSER,LEXAP,LEXDVAL,LEXDNAM,LEXFLD) Q

KILL ; Kill default filter

 D SET^LEXDSV(LEXUSER,LEXAP,"@","Delete",LEXFLD) Q

LEXDFL    ;ISL/KER - Default Filter ;04/21/2014

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

 +2       ;               

 +3       ; Global Variables

 +4       ;    None

 +5       ;               

 +6       ; External References

 +7       ;    $$GET1^DIQ          ICR   2056

 +8       ;    $$UP^XLFSTR         ICR  10103

 +9       ;               

 +10      ; Entry:  D EN^LEXDFL             LEXAP is unknown

 +11      ;

 +12      ; Entry:  D EN1^LEXDFL(LEXAP)    LEXAP is known

 +13      ;

 +14      ; Single user entry point - Saves Filter in file 757.2

 +15      ;

 +16      ; Where 

 +17      ;

 +18      ;      LEXAP     Pointer to file 757.2

 +19      ;      LEXUSER   DUZ of user

 +20      ;      LEXCA     Action (modify/delete)

 +21      ;      LEXCM     Method (predefined/create)

 +22      ;

EN        ; Single user, LEXAP is unknown

 +1        NEW LEXAP

           SET LEXAP=$$DFI^LEXDM4

           IF +LEXAP=0

               QUIT 

           WRITE !

           DO EN1(LEXAP)

           QUIT 

EN1(LEXAP) ; Single user, LEXAP is known

 +1        NEW LEXUSER,LEXX

           SET LEXUSER=$GET(DUZ)

           IF +LEXUSER'>0

               QUIT 

           IF '$LENGTH($$GET1^DIQ(200,+($GET(DUZ)),.01))

               QUIT 

 +2       ;

 +3        SET LEXAP=$GET(LEXAP)

           IF LEXAP=""

               QUIT 

 +4        IF '$DATA(^LEXT(757.2,+LEXAP,0))&('$DATA(^LEXT(757.2,"B",LEXAP)))&('$DATA(^LEXT(757.2,"C",$$UP^XLFSTR(LEXAP))))&('$DATA(^LEXT(757.2,"AN",LEXAP)))

               QUIT 

 +5        IF +LEXAP'>0

               SET LEXAP=$$AP^LEXDFN2(LEXAP)

 +6       ;

 +7        IF +($GET(LEXAP))'>0

               QUIT 

           IF +($PIECE($GET(^LEXT(757.2,+LEXAP,5)),"^",3))'>0

               QUIT 

 +8        NEW LEXCA,LEXCM,LEXDVAL,LEXDNAM,LEXFLD,LEXFIL

           SET LEXFIL=""

 +9        SET LEXFLD=1

           SET LEXCA=$$MOD^LEXDM(1)

           IF LEXCA=0!(LEXCA="^^")

               QUIT 

 +10       IF LEXCA="@"

               DO KILL

           IF LEXCA="@"

               QUIT 

           WRITE !

           SET LEXCM=$$MTH^LEXDM(1)

           IF LEXCM["^"

               QUIT 

 +11       IF LEXCM=1

               SET LEXDVAL=$$EN^LEXDFLS

 +12       IF LEXCM=2

               SET LEXDVAL=$$EN^LEXDFLC

           IF LEXDVAL="^^"

               QUIT 

 +13       SET LEXDNAM=$PIECE(LEXDVAL,"^",$LENGTH(LEXDVAL,"^"))

           SET LEXDVAL=$PIECE(LEXDVAL,"^",1,($LENGTH(LEXDVAL,"^")-1))

 +14       DO SET

 +15       QUIT 

MGR(LEXX) ; Multi-user (for Manager options)

 +1       ; Do not save filter, return value to manager option

 +2        NEW LEXCA,LEXCM,LEXDVAL

           SET LEXX=""

 +3        SET LEXCA=$$MOD^LEXDM(1)

           IF LEXCA=0

               QUIT "^"

           IF (LEXCA="^^")

               QUIT "^^"

 +4        IF LEXCA="@"

               QUIT "@^Delete filter"

 +5        WRITE !

           SET LEXCM=$$MTH^LEXDM(1)

           IF LEXCM[U

               SET LEXX=U

           IF LEXCM["^^"

               SET LEXX="^^"

 +6        IF LEXX["^"

               QUIT LEXX

 +7        IF LEXCM=1

               SET LEXDVAL=$$EN^LEXDFLS

           IF LEXCM=2

               SET LEXDVAL=$$EN^LEXDFLC

 +8        IF LEXDVAL="^^"

               QUIT "^^"

 +9        SET LEXX=LEXDVAL

           QUIT LEXX

SET       ; Set default filter

 +1        DO SET^LEXDSV(LEXUSER,LEXAP,LEXDVAL,LEXDNAM,LEXFLD)

           QUIT 

KILL      ; Kill default filter

 +1        DO SET^LEXDSV(LEXUSER,LEXAP,"@","Delete",LEXFLD)

           QUIT