source: WorldVistAEHR/trunk/r/LEXICON_UTILITY-LEX-GMPT/LEXDD4.m@ 623

Last change on this file since 623 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.4 KB
Line 
1LEXDD4 ; ISL Display Defaults - List Elements ; 09-23-96
2 ;;2.0;LEXICON UTILITY;;Sep 23, 1996;Build 1
3 ;
4 ; Create the Display for a user
5NAME ; Name
6 S:'$D(LEXD(0)) LEXD(0)=0
7 N LEXDATA,LEXSPC S LEXSPC="",LEXDATA=$P(^VA(200,LEXDUZ,0),U,1)
8 N LEXLN,LEXFN
9 S LEXDATA=$$FL(LEXDATA)
10 K LEXITL D STRING
11 Q
12SEV ; Service
13 N LEXDATA S LEXDATA=$P($G(^VA(200,LEXDUZ,5)),U,1),LEXDATA=+LEXDATA
14 Q:'LEXDATA Q:$P($G(^DIC(49,LEXDATA,0)),U,1)=""
15 S LEXDATA=$P($G(^DIC(49,LEXDATA,0)),U,1)
16 I $L(LEXDATA) S LEXITL=" Service: " D STRING
17 Q
18LOC ; Hospital Location
19 N LEXDATA S LEXDATA=$P($G(^VA(200,LEXDUZ,100.1)),U,7)
20 S LEXDATA=+LEXDATA Q:'LEXDATA Q:$P($G(^SC(LEXDATA,0)),U,1)=""
21 S LEXDATA=$P($G(^SC(LEXDATA,0)),U,1)
22 I $L(LEXDATA) S LEXITL=" Location: " D STRING
23 Q
24APP ; Application Name
25 Q:+($G(LEXAP))<1 Q:'$D(^LEXT(757.2,+LEXAP,0))
26 N LEXDATA,LEXSPC S LEXDATA=$P(^LEXT(757.2,LEXAP,0),U,1)
27 S LEXDATA=LEXDATA_":",LEXSPC=" " K LEXITL D STRING
28 Q
29DEF ; Defaults for user
30 D:$L($G(LEXSUB)) DEFS($G(LEXSUB),$G(LEXSUB(0)),3),BLANK
31 D:$L($G(LEXSHOW)) DEFS($G(LEXSHOW),$G(LEXSHOW(0)),2),BLANK
32 D:$L($G(LEXDICS)) DEFS($G(LEXDICS),$G(LEXDICS(0)),1),BLANK
33 D:$L($G(LEXCTX)) DEFS($G(LEXCTX),$G(LEXCTX(0)),4)
34 Q
35 ;
36DEFS(LEXV,LEXN,LEXO) ; Create local array
37 Q:'$L($G(LEXV)) N LEXITL,LEXA,LEXSTLN,LEXSTR
38 S:$G(LEXN)[" (" LEXN=$P(LEXN," (",1)
39 K LEX S LEX(0)=0 S LEXSTLN=56
40 S:$G(LEXO)=1 LEX(1)=" Filter: "_$G(LEXN),LEX(0)=1
41 S:$G(LEXO)=2 LEX(1)=" Display: "_$G(LEXN),LEX(0)=1
42 S:$G(LEXO)=3 LEX(1)=" Vocabulary: "_$G(LEXN),LEX(0)=1
43 S:$G(LEXO)=4 LEX(1)=" Shortcuts: "_$G(LEXN),LEX(0)=1
44 S LEXITL="" D:$G(LEX(1))'="" ARRAY K LEX S LEXITL=""
45 ;
46 S LEXITL=" "
47 D:$G(LEXO)=1 DICS^LEXDDT1 D:$G(LEXO)=2 SHOW^LEXDDT1
48 D:$G(LEXO)=3 SUB^LEXDDT1 D:$G(LEXO)=4 CON^LEXDDT1
49 D:$G(LEX(1))'="" ARRAY K LEX
50 ;W !!
51 ;ZW
52 ;W !!
53 Q
54 ;
55 D:$G(LEXO)=1 FV^LEXDDT1 D:$G(LEXO)=2 DV^LEXDDT1
56 D:$G(LEXO)=3 VV^LEXDDT1 D:$G(LEXO)=4 CV^LEXDDT1
57 S LEXITL=" " D:$D(LEX(0)) ARRAY K LEX
58 Q
59BLANK ; Store a blank line
60 N LEXDATA,LEXSPC S (LEXDATA,LEXSPC)="" K LEXITL D STRING
61 Q
62STRING ; Store a string LEXDATA
63 S:'$D(LEXD(0)) LEXD(0)=0 N LEXCTR,LEXFIL
64 S LEXCTR=LEXD(0) S:'$D(LEXSPC) LEXSPC=" "
65 S:$D(LEXITL)&($D(LEXDATA)) LEXFIL=LEXITL
66 S:'$D(LEXITL)&($D(LEXDATA)) LEXFIL=LEXSPC
67 I $L($G(LEXFIL)) D
68 . S LEXCTR=LEXCTR+1,LEXD(LEXCTR)=LEXFIL_LEXDATA,LEXD(0)=LEXCTR
69 I '$L($G(LEXFIL)) D
70 . S LEXCTR=LEXCTR+1,LEXD(LEXCTR)=LEXDATA,LEXD(0)=LEXCTR
71 K LEXSPC,LEXDATA,LEXITL
72 Q
73ARRAY ; Store local array LEX
74 S:'$D(LEXD(0)) LEXD(0)=0
75 N LEXI,LEXCTR,LEXSPC S LEXCTR=LEXD(0),LEXSPC=" "
76 F LEXI=1:1:LEX(0) D
77 . S LEXCTR=LEXCTR+1
78 . I LEXI=1 S LEXD(LEXCTR)=LEXITL_LEX(LEXI) Q
79 . S LEXD(LEXCTR)=LEXSPC_LEX(LEXI)
80 S LEXD(0)=LEXCTR
81 Q
82FL(X) ; First and Last Name, Mixed Case
83 I X["," D Q X
84 . N LEXLN,LEXFN
85 . S LEXLN=$P(X,",",1)
86 . S LEXLN=$$UP^XLFSTR($E(LEXLN,1))_$$LOW^XLFSTR($E(LEXLN,2,$L(LEXLN)))
87 . S LEXFN=$P($P(X,",",2)," ",1)
88 . S LEXFN=$$UP^XLFSTR($E(LEXFN,1))_$$LOW^XLFSTR($E(LEXFN,2,$L(LEXFN)))
89 . S X=LEXFN_" "_LEXLN
90 I X'[",",X[" " D Q X
91 . N LEXLN,LEXFN
92 . S LEXLN=$P($P(X," ",2)," ",1)
93 . S LEXLN=$$UP^XLFSTR($E(LEXLN,1))_$$LOW^XLFSTR($E(LEXLN,2,$L(LEXLN)))
94 . S LEXFN=$P(X," ",1)
95 . S LEXFN=$$UP^XLFSTR($E(LEXFN,1))_$$LOW^XLFSTR($E(LEXFN,2,$L(LEXFN)))
96 . S X=LEXFN_" "_LEXLN
97 I X'[",",X'[" " D Q X
98 . S X=$$UP^XLFSTR($E(X,1))_$$LOW^XLFSTR($E(X,2,$L(X)))
99 Q X
Note: See TracBrowser for help on using the repository browser.