1 | LEXDD1 ; ISL Display Defaults ; 09-23-96
|
---|
2 | ;;2.0;LEXICON UTILITY;;Sep 23, 1996;Build 1
|
---|
3 | ;
|
---|
4 | SHOW ; Show user defaults
|
---|
5 | W @IOF
|
---|
6 | N LEXMODE,LEXUSER,LEXSERV
|
---|
7 | SELUSR ; Select user/user group
|
---|
8 | K LEXD,LEXMODE
|
---|
9 | W !!,"Show User Defaults for"
|
---|
10 | W !!," 1: All users with defaults"
|
---|
11 | W !," 2: A Single User"
|
---|
12 | W !," 3: Users in a Service",!
|
---|
13 | BYUSR ; Get response to user/user group
|
---|
14 | K ZTSAVE S LEXMODE=$$USR G:LEXMODE[U SHOWQ
|
---|
15 | I LEXMODE=1 D G SELUSR
|
---|
16 | . S ZTRTN="ALL^LEXDD1" D DEV,HOME^%ZIS
|
---|
17 | I LEXMODE=2 D G:+($G(LEXDUZ))'<1 SELUSR
|
---|
18 | . W ! S LEXDUZ=$$USER^LEXDM4,LEXDUZ=+LEXDUZ
|
---|
19 | . I +LEXDUZ'<1 D
|
---|
20 | . . S ZTRTN="ONE^LEXDD1"
|
---|
21 | . . S ZTSAVE("LEXDUZ")=""
|
---|
22 | . . D DEV,HOME^%ZIS
|
---|
23 | I LEXMODE=3 D G SELUSR
|
---|
24 | . W ! S LEXSERV=$$SERV^LEXDM4
|
---|
25 | . I +LEXSERV>0 D
|
---|
26 | . . S ZTRTN="SERV^LEXDD1"
|
---|
27 | . . S ZTSAVE("LEXSERV")=""
|
---|
28 | . . D DEV,HOME^%ZIS
|
---|
29 | G SHOWQ
|
---|
30 | Q
|
---|
31 | DEV ; Request a device
|
---|
32 | N LEXCNT,LEXLC,LEXC S (LEXCNT,LEXLC)=0,LEXC=""
|
---|
33 | S (ZTSAVE("LEXC"),ZTSAVE("LEXCNT"),ZTSAVE("LEXLC"))=""
|
---|
34 | N %ZIS,IOP S %ZIS="PQ" D ^%ZIS Q:POP I $D(IO("Q")) D QUE Q
|
---|
35 | NOQUE ; Local display
|
---|
36 | W @IOF D @ZTRTN,^%ZISC K ZTSAVE Q
|
---|
37 | QUE ; Queue task to a selected device
|
---|
38 | N %,ZTDESC,ZTDTH,ZTIO,ZTSK Q:'$D(ZTRTN) K IO("Q")
|
---|
39 | S ZTDESC="Lexicon Defaults",ZTIO=ION,ZTDTH=$H
|
---|
40 | D ^%ZTLOAD
|
---|
41 | W !,$S($D(ZTSK):"Request Queued",1:"Request Cancelled"),!
|
---|
42 | K ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE D ^%ZISC
|
---|
43 | Q
|
---|
44 | ALL ; Display for all users
|
---|
45 | N LEXUSR,LEXDUZ,LEXITLE
|
---|
46 | S LEXUSR=""
|
---|
47 | S LEXITLE="Lexicon User Defaults (all users with defaults)"
|
---|
48 | W !,LEXITLE W:IOST["P-" !! S LEXLC=$S(IOST["P-":LEXLC+3,1:LEXLC+1)
|
---|
49 | F S LEXUSR=$O(^LEXT(757.2,"AUD",LEXUSR)) Q:LEXUSR="" D
|
---|
50 | . N LEXDUZ S LEXDUZ=0
|
---|
51 | . F S LEXDUZ=$O(^LEXT(757.2,"AUD",LEXUSR,LEXDUZ)) Q:+LEXDUZ=0 D
|
---|
52 | . . I +LEXDUZ'<1 D
|
---|
53 | . . . S LEXOK=$$DEF I LEXOK D BUILD^LEXDD2 S LEXCNT=LEXCNT+1
|
---|
54 | I +LEXCNT=0 D
|
---|
55 | . W !!,"No users found with defaults set."
|
---|
56 | D ^%ZISC I $D(ZTQUEUED) S ZTREQ="@"
|
---|
57 | Q
|
---|
58 | ONE ; Display for one user
|
---|
59 | Q:+($G(LEXDUZ))<1 N LEXITLE,LEXOK
|
---|
60 | S LEXITLE="Lexicon User Defaults (Single User)"
|
---|
61 | W !,LEXITLE W:IOST["P-" !! S LEXLC=$S(IOST["P-":LEXLC+3,1:LEXLC+1)
|
---|
62 | I LEXDUZ'<1,$D(^VA(200,+LEXDUZ)) D
|
---|
63 | . S LEXOK=$$DEF I LEXOK D BUILD^LEXDD2 S LEXCNT=LEXCNT+1
|
---|
64 | . I 'LEXOK D
|
---|
65 | . . I $P($G(^VA(200,LEXDUZ,0)),"^",1)'="" D
|
---|
66 | . . . N LEXNAME S LEXNAME=$P($G(^VA(200,LEXDUZ,0)),"^",1)
|
---|
67 | . . . S LEXNAME=$$FL^LEXDD4(LEXNAME)
|
---|
68 | . . . W !,LEXNAME," has no defaults set",!
|
---|
69 | . . I $P($G(^VA(200,LEXDUZ,0)),"^",1)="" D
|
---|
70 | . . . W !,"User has no defaults set",!
|
---|
71 | I LEXDUZ'<1,'$D(^VA(200,+LEXDUZ)) D
|
---|
72 | . W !,"User not found",!
|
---|
73 | D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@" Q
|
---|
74 | SERV ; Display for users in a Service
|
---|
75 | Q:'$D(LEXSERV) N LEXITLE
|
---|
76 | S LEXSERV=+LEXSERV
|
---|
77 | S LEXITLE="Lexicon User Defaults in a Single Service ("_$P(^DIC(49,LEXSERV,0),U,1)_")"
|
---|
78 | W !,LEXITLE W:IOST["P-" !! S LEXLC=$S(IOST["P-":LEXLC+3,1:LEXLC+1)
|
---|
79 | S LEXUSR=""
|
---|
80 | F S LEXUSR=$O(^LEXT(757.2,"AUD",LEXUSR)) Q:LEXUSR="" D
|
---|
81 | . N LEXDUZ S LEXDUZ=0
|
---|
82 | . F S LEXDUZ=$O(^LEXT(757.2,"AUD",LEXUSR,LEXDUZ)) Q:+LEXDUZ=0 D
|
---|
83 | . . I +LEXDUZ'<1 D
|
---|
84 | . . . I $P($G(^VA(200,LEXDUZ,5)),"^",1)=LEXSERV D
|
---|
85 | . . . . S LEXOK=$$DEF
|
---|
86 | . . . . I LEXOK D BUILD^LEXDD2 S LEXCNT=LEXCNT+1
|
---|
87 | I +LEXCNT=0 D
|
---|
88 | . W !!,"No users found with defaults set in the ",$P(^DIC(49,LEXSERV,0),U,1)," service."
|
---|
89 | D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@" Q
|
---|
90 | SHOWQ ; Quit SHOW
|
---|
91 | I IOST["P-" D ^%ZISC
|
---|
92 | K ZTSAVE,ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTQUEUED,ZTREQ,ZTSK,X,Y
|
---|
93 | K DIR,DIC,DIC("S"),%,%ZIS,POP,IOP
|
---|
94 | K LEX,LEXA,LEXAP,LEXAPID,LEXC,LEXCNT,LEXCTR,LEXCTX,LEXD
|
---|
95 | K LEXDATA,LEXDICS,LEXDUZ,LEXFIL,LEXFN,LEXI,LEXIEN,LEXITL
|
---|
96 | K LEXITLE,LEXT,LEXLC,LEXLN,LEXMODE,LEXNAME,LEXOK,LEXSERV
|
---|
97 | K LEXSHOW,LEXSPC,LEXSTLN,LEXSTR,LEXSUB,LEXUSER,LEXUSR
|
---|
98 | Q
|
---|
99 | DEF(X) ; Based on DUZ determines if there are defaults defined
|
---|
100 | S X=0 Q:+($G(LEXDUZ))=0 X N LEXAPID,LEXIEN S LEXAPID=0
|
---|
101 | ; Defaults by Application
|
---|
102 | F S LEXAPID=$O(^LEXT(757.2,"ADEF",LEXAPID)) Q:+LEXAPID=0!(X) D Q:X
|
---|
103 | . S LEXIEN=0 F S LEXIEN=$O(^LEXT(757.2,"ADEF",LEXAPID,LEXIEN)) Q:+LEXIEN=0!(X) D Q:X
|
---|
104 | . . S:$L($G(^LEXT(757.2,LEXIEN,200,LEXDUZ,1))) X=1 Q:X
|
---|
105 | . . S:$L($G(^LEXT(757.2,LEXIEN,200,LEXDUZ,2))) X=1 Q:X
|
---|
106 | . . S:$L($G(^LEXT(757.2,LEXIEN,200,LEXDUZ,3))) X=1 Q:X
|
---|
107 | . . S:$L($G(^LEXT(757.2,LEXIEN,200,LEXDUZ,4))) X=1 Q:X
|
---|
108 | Q X
|
---|
109 | USR(X) ; Get response for user type/group
|
---|
110 | N Y,DTOUT,DUOUT,DIRUT,DIROUT
|
---|
111 | S DIR("A")="Select (1-3): ",DIR("B")=2
|
---|
112 | S DIR("?")="Answer must be from 1 to 3"
|
---|
113 | S DIR(0)="NAO^1:3:0" D ^DIR
|
---|
114 | S X=$S($D(DTOUT)!(X[U)!(X=""):U,1:X) K DIR Q X
|
---|