LEXDMGT ;ISL/KER - Defaults - Manager/Update ;04/21/2014
;;2.0;LEXICON UTILITY;**80**;Sep 23, 1996;Build 1
;
; Global Variables
; None
;
; External References
; $$GET1^DIQ ICR 2056
; FILE^DID ICR 2052
; HOME^%ZIS ICR 10086
; ^%ZTLOAD ICR 10063
;
; LEXDICS Filter
; LEXDICS(0) Filter name
; LEXSHOW Display
; LEXSHOW(0) Display name
; LEXSUB Vocabulary
; LEXSUB(0) Vocabulary name
; LEXCTX Shortcut Context
; LEXCTX(0) Shortcut Context name
;
; LEXAP Application
; LEXAPS Multiple Applications
; LEXDCUR Current default value (pre-edit)
; LEXDNAM Default name
; LEXDVAL Default value
; LEXFLD Default field # in 757.201
; LEXC Counter
; LEXS User Service
; LEXUSER DUZ of user to update defaults
;
; Needs:
;
; LEXAP Application
; LEXOVER Flag - Overwrite user defaults (Y/N)
; LEXLIM Limits (parameter for LEXMETH)
; LEXMETH Method, singel user, by service or all users
;
Q
UPDATE ; Update user defaults
Q:'$L($G(LEXAP)) Q:'$L($G(LEXOVER)) Q:'$L($G(LEXMETH)) Q:'$L($G(LEXLIM))
N ZTSAVE,ZTRTN,ZTDESC,ZTIO,ZTDTH,ZTSK,Y
S (ZTSAVE("LEXOVER"),ZTSAVE("LEXAP"),ZTSAVE("LEXMETH"),ZTSAVE("LEXLIM"))=""
S (ZTSAVE("LEXDICS"),ZTSAVE("LEXDICS(0)"),ZTSAVE("LEXSHOW"),ZTSAVE("LEXSHOW(0)"))=""
S (ZTSAVE("LEXSUB"),ZTSAVE("LEXSUB(0)"),ZTSAVE("LEXCTX"),ZTSAVE("LEXCTX(0)"))=""
S ZTRTN="UPDT^LEXDMGT",ZTDESC="Up-dating User Defaults"
S ZTDTH=$H,ZTIO="" D ^%ZTLOAD
W:$D(ZTSK) !!,"Task has been created to update user defaults"
W:'$D(ZTSK) !!,"Unable to create a task to update user defaults"
D HOME^%ZIS Q
UPDT ; TaskManager entry point to Update Defaults (tasked)
N LEXUSER,LEXDVAL,LEXDNAM,LEXFLD
S LEXMETH=$P(LEXMETH,U,1) Q:LEXMETH=""
ONE ; Single user
I LEXMETH="ONE" S LEXUSER=+LEXLIM D G UPDTQ
. Q:'$L($$GET1^DIQ(200,+($G(LEXUSER)),.01)) D BYAPPS
MULTI ; Multiple users
N LEXRT,LEX D FILE^DID(200,,"GLOBAL NAME","LEX")
S LEXRT=$G(LEX("GLOBAL NAME")) Q:'$L(LEXRT)
S LEXUSER=+($O(@(LEXRT_"1)"),-1))
F S LEXUSER=$O(@(LEXRT_LEXUSER_")")) Q:+LEXUSER=0 D
. Q:'$L($$GET1^DIQ(200,+($G(LEXUSER)),.01)) D BYAPPS
G UPDTQ
BYAPPS ; Process defaults by application
I LEXAP'[";" S LEXAP=+LEXAP D:+LEXAP>0 BYUSR Q
I LEXAP[";" D Q
. N LEXC,LEXAPS S LEXAPS=LEXAP
. F LEXC=1:1:$L(LEXAPS,";") S LEXAP=$P(LEXAPS,";",LEXC) D BYUSR
. S LEXAP=LEXAPS
BYUSR ; Process defaults by user
N LEXS S LEXS=$$GET1^DIQ(200,+($G(LEXUSER)),29,"I") S:LEXS="" LEXS=-1
D:LEXMETH="ALL"!(LEXMETH="ONE") UPUSR
D:LEXMETH="SEV"&(+LEXLIM=+LEXS) UPUSR
I LEXMETH="SAL" D
. I +($P(LEXLIM,U,1))>0,+($P(LEXLIM,U,1))=+LEXS D
. . I +($P(LEXLIM,U,2))>0,+($P(LEXLIM,U,2))=+LEXL D UPUSR
Q
UPUSR ; Update user defaults for user LEXUSER
N LEXDCUR,LEXDVAL,LEXDNAM,LEXFLD
UPDIC ; Filter LEXDICS
S LEXFLD=1,LEXDCUR=$G(^LEXT(757.2,LEXAP,200,LEXUSER,LEXFLD))
S LEXDVAL=$G(LEXDICS),LEXDNAM=$G(LEXDICS(0))
G:LEXDCUR'=""&('LEXOVER) UPSHOW D:LEXDVAL'="" SAVE
;
UPSHOW ; Display LEXSHOW
S LEXFLD=2,LEXDCUR=$G(^LEXT(757.2,LEXAP,200,LEXUSER,LEXFLD))
S LEXDVAL=$G(LEXSHOW),LEXDNAM=$G(LEXSHOW(0))
G:LEXDCUR'=""&('LEXOVER) UPSUB D:LEXDVAL'="" SAVE
;
UPSUB ; Vocabulary LEXSUB
S LEXFLD=3,LEXDCUR=$G(^LEXT(757.2,LEXAP,200,LEXUSER,LEXFLD))
S LEXDVAL=$G(LEXSUB),LEXDNAM=$G(LEXSUB(0))
G:LEXDCUR'=""&('LEXOVER) UPCON D:LEXDVAL'="" SAVE
;
UPCON ; Shortcut Context LEXCTX
S LEXFLD=4,LEXDCUR=$G(^LEXT(757.2,LEXAP,200,LEXUSER,LEXFLD))
S LEXDVAL=$G(LEXCTX),LEXDNAM=$G(LEXCTX(0))
G:LEXDCUR'=""&('LEXOVER) UPQ D:LEXDVAL'="" SAVE
;
UPQ ; Quit update
Q
UPDTQ ; Quit update (tasked)
S:$D(ZTQUEUED) ZTREQ="@" Q
Q
CLR ; Clear
N LEXAP,LEXOVER,LEXLIM,LEXMETH
Q
SAVE ; Save default - SET^LEXDSV(DUZ,APPLICATION,VALUE,NAME,FIELD)
I LEXDVAL'["@" D Q
. D SET^LEXDSV(LEXUSER,LEXAP,LEXDVAL,LEXDNAM,LEXFLD) Q
; Kill default - SET^LEXDSV(DUZ,APPLICATION,"@","",FIELD)
D SET^LEXDSV(LEXUSER,LEXAP,"@","",LEXFLD) Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLEXDMGT 4124 printed Apr 09, 2024@21:11:08 Page 2
LEXDMGT ;ISL/KER - Defaults - Manager/Update ;04/21/2014
+1 ;;2.0;LEXICON UTILITY;**80**;Sep 23, 1996;Build 1
+2 ;
+3 ; Global Variables
+4 ; None
+5 ;
+6 ; External References
+7 ; $$GET1^DIQ ICR 2056
+8 ; FILE^DID ICR 2052
+9 ; HOME^%ZIS ICR 10086
+10 ; ^%ZTLOAD ICR 10063
+11 ;
+12 ; LEXDICS Filter
+13 ; LEXDICS(0) Filter name
+14 ; LEXSHOW Display
+15 ; LEXSHOW(0) Display name
+16 ; LEXSUB Vocabulary
+17 ; LEXSUB(0) Vocabulary name
+18 ; LEXCTX Shortcut Context
+19 ; LEXCTX(0) Shortcut Context name
+20 ;
+21 ; LEXAP Application
+22 ; LEXAPS Multiple Applications
+23 ; LEXDCUR Current default value (pre-edit)
+24 ; LEXDNAM Default name
+25 ; LEXDVAL Default value
+26 ; LEXFLD Default field # in 757.201
+27 ; LEXC Counter
+28 ; LEXS User Service
+29 ; LEXUSER DUZ of user to update defaults
+30 ;
+31 ; Needs:
+32 ;
+33 ; LEXAP Application
+34 ; LEXOVER Flag - Overwrite user defaults (Y/N)
+35 ; LEXLIM Limits (parameter for LEXMETH)
+36 ; LEXMETH Method, singel user, by service or all users
+37 ;
+38 QUIT
UPDATE ; Update user defaults
+1 if '$LENGTH($GET(LEXAP))
QUIT
if '$LENGTH($GET(LEXOVER))
QUIT
if '$LENGTH($GET(LEXMETH))
QUIT
if '$LENGTH($GET(LEXLIM))
QUIT
+2 NEW ZTSAVE,ZTRTN,ZTDESC,ZTIO,ZTDTH,ZTSK,Y
+3 SET (ZTSAVE("LEXOVER"),ZTSAVE("LEXAP"),ZTSAVE("LEXMETH"),ZTSAVE("LEXLIM"))=""
+4 SET (ZTSAVE("LEXDICS"),ZTSAVE("LEXDICS(0)"),ZTSAVE("LEXSHOW"),ZTSAVE("LEXSHOW(0)"))=""
+5 SET (ZTSAVE("LEXSUB"),ZTSAVE("LEXSUB(0)"),ZTSAVE("LEXCTX"),ZTSAVE("LEXCTX(0)"))=""
+6 SET ZTRTN="UPDT^LEXDMGT"
SET ZTDESC="Up-dating User Defaults"
+7 SET ZTDTH=$HOROLOG
SET ZTIO=""
DO ^%ZTLOAD
+8 if $DATA(ZTSK)
WRITE !!,"Task has been created to update user defaults"
+9 if '$DATA(ZTSK)
WRITE !!,"Unable to create a task to update user defaults"
+10 DO HOME^%ZIS
QUIT
UPDT ; TaskManager entry point to Update Defaults (tasked)
+1 NEW LEXUSER,LEXDVAL,LEXDNAM,LEXFLD
+2 SET LEXMETH=$PIECE(LEXMETH,U,1)
if LEXMETH=""
QUIT
ONE ; Single user
+1 IF LEXMETH="ONE"
SET LEXUSER=+LEXLIM
Begin DoDot:1
+2 if '$LENGTH($$GET1^DIQ(200,+($GET(LEXUSER)),.01))
QUIT
DO BYAPPS
End DoDot:1
GOTO UPDTQ
MULTI ; Multiple users
+1 NEW LEXRT,LEX
DO FILE^DID(200,,"GLOBAL NAME","LEX")
+2 SET LEXRT=$GET(LEX("GLOBAL NAME"))
if '$LENGTH(LEXRT)
QUIT
+3 SET LEXUSER=+($ORDER(@(LEXRT_"1)"),-1))
+4 FOR
SET LEXUSER=$ORDER(@(LEXRT_LEXUSER_")"))
if +LEXUSER=0
QUIT
Begin DoDot:1
+5 if '$LENGTH($$GET1^DIQ(200,+($GET(LEXUSER)),.01))
QUIT
DO BYAPPS
End DoDot:1
+6 GOTO UPDTQ
BYAPPS ; Process defaults by application
+1 IF LEXAP'[";"
SET LEXAP=+LEXAP
if +LEXAP>0
DO BYUSR
QUIT
+2 IF LEXAP[";"
Begin DoDot:1
+3 NEW LEXC,LEXAPS
SET LEXAPS=LEXAP
+4 FOR LEXC=1:1:$LENGTH(LEXAPS,";")
SET LEXAP=$PIECE(LEXAPS,";",LEXC)
DO BYUSR
+5 SET LEXAP=LEXAPS
End DoDot:1
QUIT
BYUSR ; Process defaults by user
+1 NEW LEXS
SET LEXS=$$GET1^DIQ(200,+($GET(LEXUSER)),29,"I")
if LEXS=""
SET LEXS=-1
+2 if LEXMETH="ALL"!(LEXMETH="ONE")
DO UPUSR
+3 if LEXMETH="SEV"&(+LEXLIM=+LEXS)
DO UPUSR
+4 IF LEXMETH="SAL"
Begin DoDot:1
+5 IF +($PIECE(LEXLIM,U,1))>0
IF +($PIECE(LEXLIM,U,1))=+LEXS
Begin DoDot:2
+6 IF +($PIECE(LEXLIM,U,2))>0
IF +($PIECE(LEXLIM,U,2))=+LEXL
DO UPUSR
End DoDot:2
End DoDot:1
+7 QUIT
UPUSR ; Update user defaults for user LEXUSER
+1 NEW LEXDCUR,LEXDVAL,LEXDNAM,LEXFLD
UPDIC ; Filter LEXDICS
+1 SET LEXFLD=1
SET LEXDCUR=$GET(^LEXT(757.2,LEXAP,200,LEXUSER,LEXFLD))
+2 SET LEXDVAL=$GET(LEXDICS)
SET LEXDNAM=$GET(LEXDICS(0))
+3 if LEXDCUR'=""&('LEXOVER)
GOTO UPSHOW
if LEXDVAL'=""
DO SAVE
+4 ;
UPSHOW ; Display LEXSHOW
+1 SET LEXFLD=2
SET LEXDCUR=$GET(^LEXT(757.2,LEXAP,200,LEXUSER,LEXFLD))
+2 SET LEXDVAL=$GET(LEXSHOW)
SET LEXDNAM=$GET(LEXSHOW(0))
+3 if LEXDCUR'=""&('LEXOVER)
GOTO UPSUB
if LEXDVAL'=""
DO SAVE
+4 ;
UPSUB ; Vocabulary LEXSUB
+1 SET LEXFLD=3
SET LEXDCUR=$GET(^LEXT(757.2,LEXAP,200,LEXUSER,LEXFLD))
+2 SET LEXDVAL=$GET(LEXSUB)
SET LEXDNAM=$GET(LEXSUB(0))
+3 if LEXDCUR'=""&('LEXOVER)
GOTO UPCON
if LEXDVAL'=""
DO SAVE
+4 ;
UPCON ; Shortcut Context LEXCTX
+1 SET LEXFLD=4
SET LEXDCUR=$GET(^LEXT(757.2,LEXAP,200,LEXUSER,LEXFLD))
+2 SET LEXDVAL=$GET(LEXCTX)
SET LEXDNAM=$GET(LEXCTX(0))
+3 if LEXDCUR'=""&('LEXOVER)
GOTO UPQ
if LEXDVAL'=""
DO SAVE
+4 ;
UPQ ; Quit update
+1 QUIT
UPDTQ ; Quit update (tasked)
+1 if $DATA(ZTQUEUED)
SET ZTREQ="@"
QUIT
+2 QUIT
CLR ; Clear
+1 NEW LEXAP,LEXOVER,LEXLIM,LEXMETH
+2 QUIT
SAVE ; Save default - SET^LEXDSV(DUZ,APPLICATION,VALUE,NAME,FIELD)
+1 IF LEXDVAL'["@"
Begin DoDot:1
+2 DO SET^LEXDSV(LEXUSER,LEXAP,LEXDVAL,LEXDNAM,LEXFLD)
QUIT
End DoDot:1
QUIT
+3 ; Kill default - SET^LEXDSV(DUZ,APPLICATION,"@","",FIELD)
+4 DO SET^LEXDSV(LEXUSER,LEXAP,"@","",LEXFLD)
QUIT
