LEXDD4.m

LEXDD4 ;ISL/KER - Display Defaults - List Elements ;04/21/2014

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

 ;               

 ; Global Variables

 ;    ^DIC(49)            ICR  10093

 ;               

 ; External References

 ;    $$GET1^DIQ          ICR   2056

 ;    $$LOW^XLFSTR        ICR  10103

 ;    $$UP^XLFSTR         ICR  10103

 ;               

 ;

 ; Create the Display for a user

NAME ;     Name

 S:'$D(LEXD(0)) LEXD(0)=0

 N LEXDATA,LEXSPC S LEXSPC="",LEXDATA=$$GET1^DIQ(200,+($G(LEXDUZ)),.01)

 N LEXLN,LEXFN

 S LEXDATA=$$FL(LEXDATA)

 K LEXITL D STRING

 Q

SEV ;     Service

 N LEXDATA S LEXDATA=$$GET1^DIQ(200,+($G(LEXDUZ)),29),LEXDATA=+LEXDATA

 Q:'LEXDATA  Q:$P($G(^DIC(49,LEXDATA,0)),U,1)=""

 S LEXDATA=$P($G(^DIC(49,LEXDATA,0)),U,1)

 I $L(LEXDATA) S LEXITL="    Service:   " D STRING

 Q

APP ;     Application Name

 Q:+($G(LEXAP))<1  Q:'$D(^LEXT(757.2,+LEXAP,0))

 N LEXDATA,LEXSPC S LEXDATA=$P(^LEXT(757.2,LEXAP,0),U,1)

 S LEXDATA=LEXDATA_":",LEXSPC="    " K LEXITL D STRING

 Q

DEF ; Defaults for user

 D:$L($G(LEXSUB)) DEFS($G(LEXSUB),$G(LEXSUB(0)),3),BLANK

 D:$L($G(LEXSHOW)) DEFS($G(LEXSHOW),$G(LEXSHOW(0)),2),BLANK

 D:$L($G(LEXDICS)) DEFS($G(LEXDICS),$G(LEXDICS(0)),1),BLANK

 D:$L($G(LEXCTX)) DEFS($G(LEXCTX),$G(LEXCTX(0)),4)

 Q

 ;

DEFS(LEXV,LEXN,LEXO) ; Create local array

 Q:'$L($G(LEXV))  N LEXITL,LEXA,LEXSTLN,LEXSTR

 S:$G(LEXN)[" (" LEXN=$P(LEXN," (",1)

 K LEX S LEX(0)=0 S LEXSTLN=56

 S:$G(LEXO)=1 LEX(1)="        Filter:      "_$G(LEXN),LEX(0)=1

 S:$G(LEXO)=2 LEX(1)="        Display:     "_$G(LEXN),LEX(0)=1

 S:$G(LEXO)=3 LEX(1)="        Vocabulary:  "_$G(LEXN),LEX(0)=1

 S:$G(LEXO)=4 LEX(1)="        Shortcuts:   "_$G(LEXN),LEX(0)=1

 S LEXITL="" D:$G(LEX(1))'="" ARRAY K LEX S LEXITL=""

 ;

 S LEXITL="                     "

 D:$G(LEXO)=1 DICS^LEXDDT1 D:$G(LEXO)=2 SHOW^LEXDDT1

 D:$G(LEXO)=3 SUB^LEXDDT1 D:$G(LEXO)=4 CON^LEXDDT1

 D:$G(LEX(1))'="" ARRAY K LEX

 Q

 ;

 D:$G(LEXO)=1 FV^LEXDDT1 D:$G(LEXO)=2 DV^LEXDDT1

 D:$G(LEXO)=3 VV^LEXDDT1 D:$G(LEXO)=4 CV^LEXDDT1

 S LEXITL="                     " D:$D(LEX(0)) ARRAY K LEX

 Q

BLANK ;     Store a blank line

 N LEXDATA,LEXSPC S (LEXDATA,LEXSPC)="" K LEXITL D STRING

 Q

STRING ;     Store a string LEXDATA

 S:'$D(LEXD(0)) LEXD(0)=0 N LEXCTR,LEXFIL

 S LEXCTR=LEXD(0) S:'$D(LEXSPC) LEXSPC="                     "

 S:$D(LEXITL)&($D(LEXDATA)) LEXFIL=LEXITL

 S:'$D(LEXITL)&($D(LEXDATA)) LEXFIL=LEXSPC

 I $L($G(LEXFIL)) D

 . S LEXCTR=LEXCTR+1,LEXD(LEXCTR)=LEXFIL_LEXDATA,LEXD(0)=LEXCTR

 I '$L($G(LEXFIL)) D

 . S LEXCTR=LEXCTR+1,LEXD(LEXCTR)=LEXDATA,LEXD(0)=LEXCTR

 K LEXSPC,LEXDATA,LEXITL

 Q

ARRAY ;     Store local array LEX

 S:'$D(LEXD(0)) LEXD(0)=0

 N LEXI,LEXCTR,LEXSPC S LEXCTR=LEXD(0),LEXSPC="                     "

 F LEXI=1:1:LEX(0) D

 . S LEXCTR=LEXCTR+1

 . I LEXI=1 S LEXD(LEXCTR)=LEXITL_LEX(LEXI) Q

 . S LEXD(LEXCTR)=LEXSPC_LEX(LEXI)

 S LEXD(0)=LEXCTR

 Q

FL(X) ; First and Last Name, Mixed Case

 I X["," D  Q X

 . N LEXLN,LEXFN

 . S LEXLN=$P(X,",",1)

 . S LEXLN=$$UP^XLFSTR($E(LEXLN,1))_$$LOW^XLFSTR($E(LEXLN,2,$L(LEXLN)))

 . S LEXFN=$P($P(X,",",2)," ",1)

 . S LEXFN=$$UP^XLFSTR($E(LEXFN,1))_$$LOW^XLFSTR($E(LEXFN,2,$L(LEXFN)))

 . S X=LEXFN_" "_LEXLN

 I X'[",",X[" " D  Q X

 . N LEXLN,LEXFN

 . S LEXLN=$P($P(X," ",2)," ",1)

 . S LEXLN=$$UP^XLFSTR($E(LEXLN,1))_$$LOW^XLFSTR($E(LEXLN,2,$L(LEXLN)))

 . S LEXFN=$P(X," ",1)

 . S LEXFN=$$UP^XLFSTR($E(LEXFN,1))_$$LOW^XLFSTR($E(LEXFN,2,$L(LEXFN)))

 . S X=LEXFN_" "_LEXLN

 I X'[",",X'[" " D  Q X

 . S X=$$UP^XLFSTR($E(X,1))_$$LOW^XLFSTR($E(X,2,$L(X)))

 Q X

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---LEXDD4   3579     printed  Mar 13, 2025@21:11:55                                                                                                                                                                                                      Page 2

LEXDD4    ;ISL/KER - Display Defaults - List Elements ;04/21/2014

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

 +2       ;               

 +3       ; Global Variables

 +4       ;    ^DIC(49)            ICR  10093

 +5       ;               

 +6       ; External References

 +7       ;    $$GET1^DIQ          ICR   2056

 +8       ;    $$LOW^XLFSTR        ICR  10103

 +9       ;    $$UP^XLFSTR         ICR  10103

 +10      ;               

 +11      ;

 +12      ; Create the Display for a user

NAME      ;     Name

 +1        if '$DATA(LEXD(0))

               SET LEXD(0)=0

 +2        NEW LEXDATA,LEXSPC

           SET LEXSPC=""

           SET LEXDATA=$$GET1^DIQ(200,+($GET(LEXDUZ)),.01)

 +3        NEW LEXLN,LEXFN

 +4        SET LEXDATA=$$FL(LEXDATA)

 +5        KILL LEXITL

           DO STRING

 +6        QUIT 

SEV       ;     Service

 +1        NEW LEXDATA

           SET LEXDATA=$$GET1^DIQ(200,+($GET(LEXDUZ)),29)

           SET LEXDATA=+LEXDATA

 +2        if 'LEXDATA

               QUIT 

           if $PIECE($GET(^DIC(49,LEXDATA,0)),U,1)=""

               QUIT 

 +3        SET LEXDATA=$PIECE($GET(^DIC(49,LEXDATA,0)),U,1)

 +4        IF $LENGTH(LEXDATA)

               SET LEXITL="    Service:   "

               DO STRING

 +5        QUIT 

APP       ;     Application Name

 +1        if +($GET(LEXAP))<1

               QUIT 

           if '$DATA(^LEXT(757.2,+LEXAP,0))

               QUIT 

 +2        NEW LEXDATA,LEXSPC

           SET LEXDATA=$PIECE(^LEXT(757.2,LEXAP,0),U,1)

 +3        SET LEXDATA=LEXDATA_":"

           SET LEXSPC="    "

           KILL LEXITL

           DO STRING

 +4        QUIT 

DEF       ; Defaults for user

 +1        if $LENGTH($GET(LEXSUB))

               DO DEFS($GET(LEXSUB),$GET(LEXSUB(0)),3)

               DO BLANK

 +2        if $LENGTH($GET(LEXSHOW))

               DO DEFS($GET(LEXSHOW),$GET(LEXSHOW(0)),2)

               DO BLANK

 +3        if $LENGTH($GET(LEXDICS))

               DO DEFS($GET(LEXDICS),$GET(LEXDICS(0)),1)

               DO BLANK

 +4        if $LENGTH($GET(LEXCTX))

               DO DEFS($GET(LEXCTX),$GET(LEXCTX(0)),4)

 +5        QUIT 

 +6       ;

DEFS(LEXV,LEXN,LEXO) ; Create local array

 +1        if '$LENGTH($GET(LEXV))

               QUIT 

           NEW LEXITL,LEXA,LEXSTLN,LEXSTR

 +2        if $GET(LEXN)[" ("

               SET LEXN=$PIECE(LEXN," (",1)

 +3        KILL LEX

           SET LEX(0)=0

           SET LEXSTLN=56

 +4        if $GET(LEXO)=1

               SET LEX(1)="        Filter:      "_$GET(LEXN)

               SET LEX(0)=1

 +5        if $GET(LEXO)=2

               SET LEX(1)="        Display:     "_$GET(LEXN)

               SET LEX(0)=1

 +6        if $GET(LEXO)=3

               SET LEX(1)="        Vocabulary:  "_$GET(LEXN)

               SET LEX(0)=1

 +7        if $GET(LEXO)=4

               SET LEX(1)="        Shortcuts:   "_$GET(LEXN)

               SET LEX(0)=1

 +8        SET LEXITL=""

           if $GET(LEX(1))'=""

               DO ARRAY

           KILL LEX

           SET LEXITL=""

 +9       ;

 +10       SET LEXITL="                     "

 +11       if $GET(LEXO)=1

               DO DICS^LEXDDT1

           if $GET(LEXO)=2

               DO SHOW^LEXDDT1

 +12       if $GET(LEXO)=3

               DO SUB^LEXDDT1

           if $GET(LEXO)=4

               DO CON^LEXDDT1

 +13       if $GET(LEX(1))'=""

               DO ARRAY

           KILL LEX

 +14       QUIT 

 +15      ;

 +16       if $GET(LEXO)=1

               DO FV^LEXDDT1

           if $GET(LEXO)=2

               DO DV^LEXDDT1

 +17       if $GET(LEXO)=3

               DO VV^LEXDDT1

           if $GET(LEXO)=4

               DO CV^LEXDDT1

 +18       SET LEXITL="                     "

           if $DATA(LEX(0))

               DO ARRAY

           KILL LEX

 +19       QUIT 

BLANK     ;     Store a blank line

 +1        NEW LEXDATA,LEXSPC

           SET (LEXDATA,LEXSPC)=""

           KILL LEXITL

           DO STRING

 +2        QUIT 

STRING    ;     Store a string LEXDATA

 +1        if '$DATA(LEXD(0))

               SET LEXD(0)=0

           NEW LEXCTR,LEXFIL

 +2        SET LEXCTR=LEXD(0)

           if '$DATA(LEXSPC)

               SET LEXSPC="                     "

 +3        if $DATA(LEXITL)&($DATA(LEXDATA))

               SET LEXFIL=LEXITL

 +4        if '$DATA(LEXITL)&($DATA(LEXDATA))

               SET LEXFIL=LEXSPC

 +5        IF $LENGTH($GET(LEXFIL))

               Begin DoDot:1

 +6                SET LEXCTR=LEXCTR+1

                   SET LEXD(LEXCTR)=LEXFIL_LEXDATA

                   SET LEXD(0)=LEXCTR

               End DoDot:1

 +7        IF '$LENGTH($GET(LEXFIL))

               Begin DoDot:1

 +8                SET LEXCTR=LEXCTR+1

                   SET LEXD(LEXCTR)=LEXDATA

                   SET LEXD(0)=LEXCTR

               End DoDot:1

 +9        KILL LEXSPC,LEXDATA,LEXITL

 +10       QUIT 

ARRAY     ;     Store local array LEX

 +1        if '$DATA(LEXD(0))

               SET LEXD(0)=0

 +2        NEW LEXI,LEXCTR,LEXSPC

           SET LEXCTR=LEXD(0)

           SET LEXSPC="                     "

 +3        FOR LEXI=1:1:LEX(0)

               Begin DoDot:1

 +4                SET LEXCTR=LEXCTR+1

 +5                IF LEXI=1

                       SET LEXD(LEXCTR)=LEXITL_LEX(LEXI)

                       QUIT 

 +6                SET LEXD(LEXCTR)=LEXSPC_LEX(LEXI)

               End DoDot:1

 +7        SET LEXD(0)=LEXCTR

 +8        QUIT 

FL(X)     ; First and Last Name, Mixed Case

 +1        IF X[","

               Begin DoDot:1

 +2                NEW LEXLN,LEXFN

 +3                SET LEXLN=$PIECE(X,",",1)

 +4                SET LEXLN=$$UP^XLFSTR($EXTRACT(LEXLN,1))_$$LOW^XLFSTR($EXTRACT(LEXLN,2,$LENGTH(LEXLN)))

 +5                SET LEXFN=$PIECE($PIECE(X,",",2)," ",1)

 +6                SET LEXFN=$$UP^XLFSTR($EXTRACT(LEXFN,1))_$$LOW^XLFSTR($EXTRACT(LEXFN,2,$LENGTH(LEXFN)))

 +7                SET X=LEXFN_" "_LEXLN

               End DoDot:1

               QUIT X

 +8        IF X'[","

               IF X[" "

                   Begin DoDot:1

 +9                    NEW LEXLN,LEXFN

 +10                   SET LEXLN=$PIECE($PIECE(X," ",2)," ",1)

 +11                   SET LEXLN=$$UP^XLFSTR($EXTRACT(LEXLN,1))_$$LOW^XLFSTR($EXTRACT(LEXLN,2,$LENGTH(LEXLN)))

 +12                   SET LEXFN=$PIECE(X," ",1)

 +13                   SET LEXFN=$$UP^XLFSTR($EXTRACT(LEXFN,1))_$$LOW^XLFSTR($EXTRACT(LEXFN,2,$LENGTH(LEXFN)))

 +14                   SET X=LEXFN_" "_LEXLN

                   End DoDot:1

                   QUIT X

 +15       IF X'[","

               IF X'[" "

                   Begin DoDot:1

 +16                   SET X=$$UP^XLFSTR($EXTRACT(X,1))_$$LOW^XLFSTR($EXTRACT(X,2,$LENGTH(X)))

                   End DoDot:1

                   QUIT X

 +17       QUIT X