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 ---[H[J[2J[HLEXDD4 3579 printed Dec 13, 2024@02:07:25 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
