LEXDCC.m

LEXDCC ;ISL/KER - Default Display ;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^LEXDCC            LEXAP is unknown

 ;

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

 ;

 ; Single user entry point - Saves Default Display 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

 K LEXFIL N LEXCA,LEXCM,LEXDVAL,LEXDNAM,LEXFLD

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

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

 S:LEXCM=1 LEXDVAL=$$EN^LEXDCCS S:LEXCM=2 LEXDVAL=$$EN^LEXDCCC Q:LEXDVAL="^^"

 S LEXDNAM=$P(LEXDVAL,"^",2),LEXDVAL=$P(LEXDVAL,"^",1) D SET

 Q

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

 ; Do not save display, return value to manager option

 N LEXCA,LEXCM,LEXDVAL S LEXCA=$$MOD^LEXDM(2) Q:LEXCA=0 "^" Q:(LEXCA="^^") "^^"

 Q:LEXCA="@" "@^Delete display" W ! S LEXCM=$$MTH^LEXDM(2) Q:LEXCM["^" "^No display selected" Q:(LEXCM="^^") "^^"

 S:LEXCM=1 LEXDVAL=$$EN^LEXDCCS S:LEXCM=2 LEXDVAL=$$EN^LEXDCCC Q:LEXDVAL="^^" "^^"

 S LEXX=LEXDVAL Q LEXX

SET ; Set default display

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

KILL ; Kill default display

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

LEXDCC    ;ISL/KER - Default Display ;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^LEXDCC            LEXAP is unknown

 +11      ;

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

 +13      ;

 +14      ; Single user entry point - Saves Default Display 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        KILL LEXFIL

           NEW LEXCA,LEXCM,LEXDVAL,LEXDNAM,LEXFLD

 +9        SET LEXFLD=2

           SET LEXCA=$$MOD^LEXDM(2)

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

               QUIT 

 +10       IF LEXCA="@"

               DO KILL

           IF LEXCA="@"

               QUIT 

           WRITE !

           SET LEXCM=$$MTH^LEXDM(2)

           IF LEXCM["^"

               QUIT 

 +11       IF LEXCM=1

               SET LEXDVAL=$$EN^LEXDCCS

           IF LEXCM=2

               SET LEXDVAL=$$EN^LEXDCCC

           IF LEXDVAL="^^"

               QUIT 

 +12       SET LEXDNAM=$PIECE(LEXDVAL,"^",2)

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

           DO SET

 +13       QUIT 

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

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

 +2        NEW LEXCA,LEXCM,LEXDVAL

           SET LEXCA=$$MOD^LEXDM(2)

           IF LEXCA=0

               QUIT "^"

           IF (LEXCA="^^")

               QUIT "^^"

 +3        IF LEXCA="@"

               QUIT "@^Delete display"

           WRITE !

           SET LEXCM=$$MTH^LEXDM(2)

           IF LEXCM["^"

               QUIT "^No display selected"

           IF (LEXCM="^^")

               QUIT "^^"

 +4        IF LEXCM=1

               SET LEXDVAL=$$EN^LEXDCCS

           IF LEXCM=2

               SET LEXDVAL=$$EN^LEXDCCC

           IF LEXDVAL="^^"

               QUIT "^^"

 +5        SET LEXX=LEXDVAL

           QUIT LEXX

SET       ; Set default display

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

           QUIT 

KILL      ; Kill default display

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

           QUIT