- LEXDCC ;ISL/KER - Default Display ;04/21/2014
- ;;2.0;LEXICON UTILITY;**80**;Sep 23, 1996;Build 1
- ;
- ; 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLEXDCC 2047 printed Jan 18, 2025@03:08:13 Page 2
- LEXDCC ;ISL/KER - Default Display ;04/21/2014
- +1 ;;2.0;LEXICON UTILITY;**80**;Sep 23, 1996;Build 1
- +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