source: WorldVistAEHR/trunk/r/LEXICON_UTILITY-LEX-GMPT/LEXDD1.m@ 1739

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

initial load of WorldVistAEHR

File size: 4.2 KB
Line 
1LEXDD1 ; ISL Display Defaults ; 09-23-96
2 ;;2.0;LEXICON UTILITY;;Sep 23, 1996;Build 1
3 ;
4SHOW ; Show user defaults
5 W @IOF
6 N LEXMODE,LEXUSER,LEXSERV
7SELUSR ; 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",!
13BYUSR ; 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
31DEV ; 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
35NOQUE ; Local display
36 W @IOF D @ZTRTN,^%ZISC K ZTSAVE Q
37QUE ; 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
44ALL ; 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
58ONE ; 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
74SERV ; 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
90SHOWQ ; 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
99DEF(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
109USR(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
Note: See TracBrowser for help on using the repository browser.