- 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 Feb 18, 2025@23:33:57 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