VistA-WorldVistAEHR/r/LEXICON_UTILITY-LEX-GMPT/LEXDD4.m

100 lines
3.4 KiB
Mathematica

LEXDD4 ; ISL Display Defaults - List Elements ; 09-23-96
;;2.0;LEXICON UTILITY;;Sep 23, 1996;Build 1
;
; Create the Display for a user
NAME ; Name
S:'$D(LEXD(0)) LEXD(0)=0
N LEXDATA,LEXSPC S LEXSPC="",LEXDATA=$P(^VA(200,LEXDUZ,0),U,1)
N LEXLN,LEXFN
S LEXDATA=$$FL(LEXDATA)
K LEXITL D STRING
Q
SEV ; Service
N LEXDATA S LEXDATA=$P($G(^VA(200,LEXDUZ,5)),U,1),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
LOC ; Hospital Location
N LEXDATA S LEXDATA=$P($G(^VA(200,LEXDUZ,100.1)),U,7)
S LEXDATA=+LEXDATA Q:'LEXDATA Q:$P($G(^SC(LEXDATA,0)),U,1)=""
S LEXDATA=$P($G(^SC(LEXDATA,0)),U,1)
I $L(LEXDATA) S LEXITL=" Location: " 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
;W !!
;ZW
;W !!
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