Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LEXDD1

LEXDD1.m

Go to the documentation of this file. 
  1. LEXDD1 ;ISL/KER - Display Defaults ;04/21/2014
  1.  ;;2.0;LEXICON UTILITY;**80**;Sep 23, 1996;Build 1
  1.  ;               
  1.  ; Global Variables
  1.  ;    ^DIC(49)            ICR  10093
  1.  ;               
  1.  ; External References
  1.  ;    $$GET1^DIQ          ICR   2056
  1.  ;    HOME^%ZIS           ICR  10086
  1.  ;    ^%ZIS               ICR  10086
  1.  ;    ^%ZISC              ICR  10089
  1.  ;    ^%ZTLOAD            ICR  10063
  1.  ;    ^DIR                ICR  10026
  1.  ;               
  1. SHOW ; Show user defaults
  1.  W @IOF
  1.  N LEXMODE,LEXUSER,LEXSERV
  1. SELUSR ; Select user/user group
  1.  K LEXD,LEXMODE
  1.  W !!,"Show User Defaults for"
  1.  W !!,"  1:  All users with defaults"
  1.  W !,"  2:  A Single User"
  1.  W !,"  3:  Users in a Service",!
  1. BYUSR ; Get response to user/user group
  1.  K ZTSAVE S LEXMODE=$$USR G:LEXMODE[U SHOWQ
  1.  I LEXMODE=1 D  G SELUSR
  1.  . S ZTRTN="ALL^LEXDD1" D DEV,HOME^%ZIS
  1.  I LEXMODE=2 D  G:+($G(LEXDUZ))'<1 SELUSR
  1.  . W ! S LEXDUZ=$$USER^LEXDM4,LEXDUZ=+LEXDUZ
  1.  . I +LEXDUZ'<1 D
  1.  . . S ZTRTN="ONE^LEXDD1"
  1.  . . S ZTSAVE("LEXDUZ")=""
  1.  . . D DEV,HOME^%ZIS
  1.  I LEXMODE=3 D  G SELUSR
  1.  . W ! S LEXSERV=$$SERV^LEXDM4
  1.  . I +LEXSERV>0 D
  1.  . . S ZTRTN="SERV^LEXDD1"
  1.  . . S ZTSAVE("LEXSERV")=""
  1.  . . D DEV,HOME^%ZIS
  1.  G SHOWQ
  1.  Q
  1. DEV ; Request a device
  1.  N LEXCNT,LEXLC,LEXC S (LEXCNT,LEXLC)=0,LEXC=""
  1.  S (ZTSAVE("LEXC"),ZTSAVE("LEXCNT"),ZTSAVE("LEXLC"))=""
  1.  N %ZIS,IOP S %ZIS="PQ" D ^%ZIS Q:POP  I $D(IO("Q")) D QUE Q
  1. NOQUE ; Local display
  1.  W @IOF D @ZTRTN,^%ZISC K ZTSAVE Q
  1. QUE ; Queue task to a selected device
  1.  N %,ZTDESC,ZTDTH,ZTIO,ZTSK Q:'$D(ZTRTN)  K IO("Q")
  1.  S ZTDESC="Lexicon Defaults",ZTIO=ION,ZTDTH=$H
  1.  D ^%ZTLOAD
  1.  W !,$S($D(ZTSK):"Request Queued",1:"Request Cancelled"),!
  1.  K ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE D ^%ZISC
  1.  Q
  1. ALL ; Display for all users
  1.  N LEXUSR,LEXDUZ,LEXITLE
  1.  S LEXUSR=""
  1.  S LEXITLE="Lexicon User Defaults (all users with defaults)"
  1.  W !,LEXITLE W:IOST["P-" !! S LEXLC=$S(IOST["P-":LEXLC+3,1:LEXLC+1)
  1.  F  S LEXUSR=$O(^LEXT(757.2,"AUD",LEXUSR)) Q:LEXUSR=""  D
  1.  . N LEXDUZ S LEXDUZ=0
  1.  . F  S LEXDUZ=$O(^LEXT(757.2,"AUD",LEXUSR,LEXDUZ)) Q:+LEXDUZ=0  D
  1.  . . I +LEXDUZ'<1 D
  1.  . . . S LEXOK=$$DEF I LEXOK D BUILD^LEXDD2 S LEXCNT=LEXCNT+1
  1.  I +LEXCNT=0 D
  1.  . W !!,"No users found with defaults set."
  1.  D ^%ZISC I $D(ZTQUEUED) S ZTREQ="@"
  1.  Q
  1. ONE ; Display for one user
  1.  Q:+($G(LEXDUZ))<1  N LEXITLE,LEXOK,LEXNM
  1.  S LEXITLE="Lexicon User Defaults (Single User)"
  1.  W !,LEXITLE W:IOST["P-" !! S LEXLC=$S(IOST["P-":LEXLC+3,1:LEXLC+1)
  1.  S LEXNM=$$GET1^DIQ(200,+($G(LEXDUZ)),.01)
  1.  I LEXDUZ'<1,$L(LEXNM) D
  1.  . S LEXOK=$$DEF I LEXOK D BUILD^LEXDD2 S LEXCNT=LEXCNT+1
  1.  . I 'LEXOK D
  1.  . . I LEXNM'="" D
  1.  . . . N LEXNAME S LEXNAME=LEXNM
  1.  . . . S LEXNAME=$$FL^LEXDD4(LEXNAME)
  1.  . . . W !,LEXNAME," has no defaults set",!
  1.  . . I LEXNM="" D
  1.  . . . W !,"User has no defaults set",!
  1.  I LEXDUZ'<1,'$L(LEXNM) D
  1.  . W !,"User not found",!
  1.  D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
  1.  Q
  1. SERV ; Display for users in a Service
  1.  Q:'$D(LEXSERV)  N LEXITLE,LEXNM,LEXSV
  1.  S LEXSERV=+LEXSERV
  1.  S LEXITLE="Lexicon User Defaults in a Single Service ("_$P(^DIC(49,LEXSERV,0),U,1)_")"
  1.  W !,LEXITLE W:IOST["P-" !! S LEXLC=$S(IOST["P-":LEXLC+3,1:LEXLC+1)
  1.  S LEXUSR=""
  1.  F  S LEXUSR=$O(^LEXT(757.2,"AUD",LEXUSR)) Q:LEXUSR=""  D
  1.  . N LEXDUZ S LEXDUZ=0
  1.  . F  S LEXDUZ=$O(^LEXT(757.2,"AUD",LEXUSR,LEXDUZ)) Q:+LEXDUZ=0  D
  1.  . . I +LEXDUZ'<1 D
  1.  . . . N LEXUSV S LEXUSV=$$GET1^DIQ(200,+($G(LEXDUZ)),29,"I")
  1.  . . . I LEXUSV=LEXSERV D
  1.  . . . . S LEXOK=$$DEF I LEXOK D BUILD^LEXDD2 S LEXCNT=LEXCNT+1
  1.  I +LEXCNT=0 D
  1.  . W !!,"No users found with defaults set in the ",$P(^DIC(49,LEXSERV,0),U,1)," service."
  1.  D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
  1.  Q
  1. SHOWQ ; Quit SHOW
  1.  I IOST["P-" D ^%ZISC
  1.  K ZTSAVE,ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTQUEUED,ZTREQ,ZTSK,X,Y
  1.  K DIR,DIC,DIC("S"),%,%ZIS,POP,IOP
  1.  K LEX,LEXA,LEXAP,LEXAPID,LEXC,LEXCNT,LEXCTR,LEXCTX,LEXD
  1.  K LEXDATA,LEXDICS,LEXDUZ,LEXFIL,LEXFN,LEXI,LEXIEN,LEXITL
  1.  K LEXITLE,LEXT,LEXLC,LEXLN,LEXMODE,LEXNAME,LEXOK,LEXSERV
  1.  K LEXSHOW,LEXSPC,LEXSTLN,LEXSTR,LEXSUB,LEXUSER,LEXUSR
  1.  Q
  1. DEF(X) ; Based on DUZ determines if there are defaults defined
  1.  S X=0 Q:+($G(LEXDUZ))=0 X N LEXAPID,LEXIEN S LEXAPID=0
  1.  ; Defaults by Application
  1.  F  S LEXAPID=$O(^LEXT(757.2,"ADEF",LEXAPID)) Q:+LEXAPID=0!(X)  D  Q:X
  1.  . S LEXIEN=0 F  S LEXIEN=$O(^LEXT(757.2,"ADEF",LEXAPID,LEXIEN)) Q:+LEXIEN=0!(X)  D  Q:X
  1.  . . S:$L($G(^LEXT(757.2,LEXIEN,200,LEXDUZ,1))) X=1 Q:X
  1.  . . S:$L($G(^LEXT(757.2,LEXIEN,200,LEXDUZ,2))) X=1 Q:X
  1.  . . S:$L($G(^LEXT(757.2,LEXIEN,200,LEXDUZ,3))) X=1 Q:X
  1.  . . S:$L($G(^LEXT(757.2,LEXIEN,200,LEXDUZ,4))) X=1 Q:X
  1.  Q X
  1. USR(X) ; Get response for user type/group
  1.  N Y,DTOUT,DUOUT,DIRUT,DIROUT
  1.  S DIR("A")="Select (1-3):  ",DIR("B")=2
  1.  S DIR("?")="Answer must be from 1 to 3"
  1.  S DIR(0)="NAO^1:3:0" D ^DIR
  1.  S X=$S($D(DTOUT)!(X[U)!(X=""):U,1:X) K DIR Q X