SDES2PRIVUSERS ;ALB/MCB - SDES2 ADD,DELETE, DELETE ALL, GET PRIVILEGED USERS ; July 13,2026
;;5.3;Scheduling;**951**;Aug 13, 1993;Build 5
;;Per VHA Directive 6402, this routine should not be modified
;
;External References
;-------------------
; Reference to $$GETS^DIQ,$$GETS1^DIQ in ICR #2056
; Reference to DUZ^XUP is supported by IA #7487
;
;Global References
;-----------------
; Reference to LIST^DIC(200 is supported by IA #10060
;
Q
;
; Input: Add and Delete PRIV USER
; S SDINPUT("Clinic IEN")- [required] - The Hopspital Location IEN
; S SDINPUT("PRIV DUZ")- [required] - The New Person IEN (#200)
;
ADDPRIV(JSON,SDCONTEXT,SDINPUT) ; SDES2 ADD PRIV USER
N RETURN,ERRORS,CLINDATA
; Leaking Variables
N SDECI,TYPE
; Validate SDCONTEXT
D VALCONTEXT^SDES2VALCONTEXT(.ERRORS,.SDCONTEXT)
I $D(ERRORS) S ERRORS("Clinic IEN",1)="" D BUILDJSON^SDES2JSON(.JSON,.ERRORS) Q
I $G(SDCONTEXT("USER DUZ"))'="" N DUZ D DUZ^XUP(SDCONTEXT("USER DUZ"))
;
D VALIDATE(.ERRORS,.SDINPUT)
I $D(ERRORS) S ERRORS("Clinic IEN",1)="" D BUILDJSON^SDES2JSON(.JSON,.ERRORS) Q
;
D ADDUSER(.ERRORS,SDINPUT("Clinic IEN"),SDINPUT("PRIV DUZ"))
I $D(ERRORS) S ERRORS("Clinic IEN",1)="" D BUILDJSON^SDES2JSON(.JSON,.ERRORS) Q
D EASAUDIT(.ERRORS,SDINPUT("Clinic IEN"),.SDCONTEXT) S CLINDATA("Success")="User is successfully added."
;
D BLDCLNREC^SDES2CLININFO(.CLINDATA,SDINPUT("Clinic IEN"))
D BUILDJSON^SDES2JSON(.JSON,.CLINDATA)
Q
;
DELPRIV(JSON,SDCONTEXT,SDINPUT) ; SDES2 DELETE PRIV USER
N RETURN,ERRORS,CLINDATA
; Leaking Variables
N SDECI,X,Y
; Validate SDCONTEXT
D VALCONTEXT^SDES2VALCONTEXT(.ERRORS,.SDCONTEXT)
I $D(ERRORS) S ERRORS("Clinic IEN",1)="" D BUILDJSON^SDES2JSON(.JSON,.ERRORS) Q
I $G(SDCONTEXT("USER DUZ"))'="" N DUZ D DUZ^XUP(SDCONTEXT("USER DUZ"))
;
D VALIDATE(.ERRORS,.SDINPUT)
I $D(ERRORS) S ERRORS("Clinic IEN",1)="" D BUILDJSON^SDES2JSON(.JSON,.ERRORS) Q
;
D DELUSER(.ERRORS,SDINPUT("Clinic IEN"),SDINPUT("PRIV DUZ"))
I $D(ERRORS) S ERRORS("Clinic IEN",1)="" D BUILDJSON^SDES2JSON(.RETURN,.ERRORS) Q
D EASAUDIT(.ERRORS,SDINPUT("Clinic IEN"),.SDCONTEXT) S CLINDATA("Success")="User is successfully deleted."
;
D BLDCLNREC^SDES2CLININFO(.CLINDATA,SDINPUT("Clinic IEN"))
D BUILDJSON^SDES2JSON(.JSON,.CLINDATA)
Q
;
DELALLPRIV(JSON,SDCONTEXT,SDINPUT) ; SDES2 DELETE(DEL) ALL PRIV USERS
; Input:
; S SDINPUT("Clinic IEN")-[required]-The Hopspital Location IEN
; Leaking Variables
N SDECI,X,Y
N RETURN,ERRORS,CLINDATA
; Validate SDCONTEXT
D VALCONTEXT^SDES2VALCONTEXT(.ERRORS,.SDCONTEXT)
I $D(ERRORS) S ERRORS("Clinic IEN",1)="" D BUILDJSON^SDES2JSON(.JSON,.ERRORS) Q
I $G(SDCONTEXT("USER DUZ"))'="" N DUZ D DUZ^XUP(SDCONTEXT("USER DUZ"))
;
D VALIDATER(.ERRORS,.SDINPUT)
I $D(ERRORS) S ERRORS("Clinic IEN",1)="" D BUILDJSON^SDES2JSON(.JSON,.ERRORS) Q
;
D DELALUSERS(.ERRORS,SDINPUT("Clinic IEN"))
I $D(ERRORS) S ERRORS("Clinic IEN",1)="" D BUILDJSON^SDES2JSON(.RETURN,.ERRORS) Q
D EASAUDIT(.ERRORS,SDINPUT("Clinic IEN"),.SDCONTEXT) S CLINDATA("Success")="All Users are successfully deleted."
;
D BLDCLNREC^SDES2CLININFO(.CLINDATA,SDINPUT("Clinic IEN"))
D BUILDJSON^SDES2JSON(.JSON,.CLINDATA)
Q
;
GETPRIV(JSON,SDCONTEXT,SDINPUT) ;SDES2 GET PRIV USERS
; Input:
; S SDINPUT("Clinic IEN")-[required]-The Hopspital Location IEN
;
N ERRORS,CLINDATA
; Validate SDCONTEXT
D VALCONTEXT^SDES2VALCONTEXT(.ERRORS,.SDCONTEXT)
I $D(ERRORS) S ERRORS("Clinic IEN",1)="" D BUILDJSON^SDES2JSON(.JSON,.ERRORS) Q
I $G(SDCONTEXT("USER DUZ"))'="" N DUZ D DUZ^XUP(SDCONTEXT("USER DUZ"))
;
D VALIDATER(.ERRORS,.SDINPUT)
I $D(ERRORS) S ERRORS("Clinic IEN",1)="" D BUILDJSON^SDES2JSON(.JSON,.ERRORS) Q
;
D GETUSRLIST(.CLINDATA,.SDINPUT)
;
D BUILDJSON^SDES2JSON(.JSON,.CLINDATA)
Q
;
VALIDATE(ERRORS,SDINPUT) ; Validate Clinic IEN, Privileged DUZ
N ERRORFLAG,CLININE,PRIVDUZ
; Location IEN
S CLINIEN=$G(SDINPUT("Clinic IEN"))
I CLINIEN="" S ERRORFLAG=1 D ERRLOG^SDESJSON(.ERRORS,18) Q $D(ERRORFLAG)
I '$D(^SC(CLINIEN,0)) S ERRORFLAG=1 D ERRLOG^SDESJSON(.ERRORS,19) Q $D(ERRORFLAG)
; User IEN
S PRIVDUZ=$G(SDINPUT("PRIV DUZ"))
I PRIVDUZ="" S ERRORFLAG=1 D ERRLOG^SDESJSON(.ERRORS,223) Q $D(ERRORFLAG)
I '$D(^VA(200,$G(PRIVDUZ),0)) S ERRORFLAG=1 D ERRLOG^SDESJSON(.ERRORS,44) Q $D(ERRORFLAG)
Q $D(ERRORFLAG)
;
VALIDATER(ERRORS,SDINPUT) ; Validate Clinic IEN
N ERRORFLAG,CLINIEN
;
; Location IEN
S CLINIEN=$G(SDINPUT("Clinic IEN"))
I CLINIEN="" S ERRORFLAG=1 D ERRLOG^SDESJSON(.ERRORS,18) Q $D(ERRORFLAG)
I '$D(^SC(CLINIEN,0)) S ERRORFLAG=1 D ERRLOG^SDESJSON(.ERRORS,19) Q $D(ERRORFLAG)
Q $D(ERRORFLAG)
;
ADDUSER(ERRORS,CLINIEN,PRIVDUZ) ; Add User
N IENS,ERR,FDA
S IENS(1)=+PRIVDUZ
S FDA(44.04,"+1,"_CLINIEN_",",.01)=+PRIVDUZ
D UPDATE^DIE(,"FDA","IENS","ERR")
I $D(ERR) D
.S ERRORS("Error",1)="Error adding User to Hospital Location: "_$G(ERR("DIERR",1,"TEXT",1))
Q
;
DELUSER(ERRORS,CLINIEN,PRIVDUZ) ; Delete User
N DIK,DA,ERRORS
S DIK="^SC("_CLINIEN_",""SDPRIV"","
S DA(1)=CLINIEN
S DA=PRIVDUZ
D ^DIK
Q
;
DELALUSERS(ERRORS,CLINIEN) ; Delete All Users
N DIK,DA,ERRORS
S DIK="^SC("_CLINIEN_",""SDPRIV"","
S DA(1)=CLINIEN
S DA=999999999 F S DA=$O(^SC(CLINIEN,"SDPRIV",DA),-1) Q:'DA D ^DIK
Q
;
GETUSRLIST(ELGARRAY,SDINPUT) ; Return all Users
N USRCNT,PRIVDUZ,USRNAME,CLINIEN
S CLINIEN=$G(SDINPUT("Clinic IEN"))
S PRIVDUZ=$G(SDINPUT("PRIV DUZ"))
S (USRCNT,PRIVDUZ)=0
F S PRIVDUZ=$O(^SC(CLINIEN,"SDPRIV",PRIVDUZ)) Q:'PRIVDUZ D
.S USRCNT=USRCNT+1
.S ELGARRAY("Privileged User",USRCNT,"IEN")=PRIVDUZ
.S ELGARRAY("Privileged User",USRCNT,"Name")=$$GET1^DIQ(44.04,PRIVDUZ_","_CLINIEN,.01)
I USRCNT=0 S ELGARRAY("Error",1)="No privileged users are found."
Q
;
EASAUDIT(ERRORS,CLINIEN,SDCONTEXT) ; Update EAS Audit Fields
N FDA,ERR
S FDA(44,CLINIEN_",",100)=$G(SDCONTEXT("ACHERON AUDIT ID"))
S FDA(44,CLINIEN_",",100.2)=$G(SDCONTEXT("APPID"))
S FDA(44,CLINIEN_",",100.1)=$G(XWB(2,"RPC"))
D FILE^DIE(,"FDA","ERR")
I $D(ERR) S ERRORS("Error",1)="Error adding User to Hospital Location: "_$G(ERR("DIERR",1,"TEXT",1))
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDES2PRIVUSERS 6190 printed Sep 17, 2026@21:40:55 Page 2
SDES2PRIVUSERS ;ALB/MCB - SDES2 ADD,DELETE, DELETE ALL, GET PRIVILEGED USERS ; July 13,2026
+1 ;;5.3;Scheduling;**951**;Aug 13, 1993;Build 5
+2 ;;Per VHA Directive 6402, this routine should not be modified
+3 ;
+4 ;External References
+5 ;-------------------
+6 ; Reference to $$GETS^DIQ,$$GETS1^DIQ in ICR #2056
+7 ; Reference to DUZ^XUP is supported by IA #7487
+8 ;
+9 ;Global References
+10 ;-----------------
+11 ; Reference to LIST^DIC(200 is supported by IA #10060
+12 ;
+13 QUIT
+14 ;
+15 ; Input: Add and Delete PRIV USER
+16 ; S SDINPUT("Clinic IEN")- [required] - The Hopspital Location IEN
+17 ; S SDINPUT("PRIV DUZ")- [required] - The New Person IEN (#200)
+18 ;
ADDPRIV(JSON,SDCONTEXT,SDINPUT) ; SDES2 ADD PRIV USER
+1 NEW RETURN,ERRORS,CLINDATA
+2 ; Leaking Variables
+3 NEW SDECI,TYPE
+4 ; Validate SDCONTEXT
+5 DO VALCONTEXT^SDES2VALCONTEXT(.ERRORS,.SDCONTEXT)
+6 IF $DATA(ERRORS)
SET ERRORS("Clinic IEN",1)=""
DO BUILDJSON^SDES2JSON(.JSON,.ERRORS)
QUIT
+7 IF $GET(SDCONTEXT("USER DUZ"))'=""
NEW DUZ
DO DUZ^XUP(SDCONTEXT("USER DUZ"))
+8 ;
+9 DO VALIDATE(.ERRORS,.SDINPUT)
+10 IF $DATA(ERRORS)
SET ERRORS("Clinic IEN",1)=""
DO BUILDJSON^SDES2JSON(.JSON,.ERRORS)
QUIT
+11 ;
+12 DO ADDUSER(.ERRORS,SDINPUT("Clinic IEN"),SDINPUT("PRIV DUZ"))
+13 IF $DATA(ERRORS)
SET ERRORS("Clinic IEN",1)=""
DO BUILDJSON^SDES2JSON(.JSON,.ERRORS)
QUIT
+14 DO EASAUDIT(.ERRORS,SDINPUT("Clinic IEN"),.SDCONTEXT)
SET CLINDATA("Success")="User is successfully added."
+15 ;
+16 DO BLDCLNREC^SDES2CLININFO(.CLINDATA,SDINPUT("Clinic IEN"))
+17 DO BUILDJSON^SDES2JSON(.JSON,.CLINDATA)
+18 QUIT
+19 ;
DELPRIV(JSON,SDCONTEXT,SDINPUT) ; SDES2 DELETE PRIV USER
+1 NEW RETURN,ERRORS,CLINDATA
+2 ; Leaking Variables
+3 NEW SDECI,X,Y
+4 ; Validate SDCONTEXT
+5 DO VALCONTEXT^SDES2VALCONTEXT(.ERRORS,.SDCONTEXT)
+6 IF $DATA(ERRORS)
SET ERRORS("Clinic IEN",1)=""
DO BUILDJSON^SDES2JSON(.JSON,.ERRORS)
QUIT
+7 IF $GET(SDCONTEXT("USER DUZ"))'=""
NEW DUZ
DO DUZ^XUP(SDCONTEXT("USER DUZ"))
+8 ;
+9 DO VALIDATE(.ERRORS,.SDINPUT)
+10 IF $DATA(ERRORS)
SET ERRORS("Clinic IEN",1)=""
DO BUILDJSON^SDES2JSON(.JSON,.ERRORS)
QUIT
+11 ;
+12 DO DELUSER(.ERRORS,SDINPUT("Clinic IEN"),SDINPUT("PRIV DUZ"))
+13 IF $DATA(ERRORS)
SET ERRORS("Clinic IEN",1)=""
DO BUILDJSON^SDES2JSON(.RETURN,.ERRORS)
QUIT
+14 DO EASAUDIT(.ERRORS,SDINPUT("Clinic IEN"),.SDCONTEXT)
SET CLINDATA("Success")="User is successfully deleted."
+15 ;
+16 DO BLDCLNREC^SDES2CLININFO(.CLINDATA,SDINPUT("Clinic IEN"))
+17 DO BUILDJSON^SDES2JSON(.JSON,.CLINDATA)
+18 QUIT
+19 ;
DELALLPRIV(JSON,SDCONTEXT,SDINPUT) ; SDES2 DELETE(DEL) ALL PRIV USERS
+1 ; Input:
+2 ; S SDINPUT("Clinic IEN")-[required]-The Hopspital Location IEN
+3 ; Leaking Variables
+4 NEW SDECI,X,Y
+5 NEW RETURN,ERRORS,CLINDATA
+6 ; Validate SDCONTEXT
+7 DO VALCONTEXT^SDES2VALCONTEXT(.ERRORS,.SDCONTEXT)
+8 IF $DATA(ERRORS)
SET ERRORS("Clinic IEN",1)=""
DO BUILDJSON^SDES2JSON(.JSON,.ERRORS)
QUIT
+9 IF $GET(SDCONTEXT("USER DUZ"))'=""
NEW DUZ
DO DUZ^XUP(SDCONTEXT("USER DUZ"))
+10 ;
+11 DO VALIDATER(.ERRORS,.SDINPUT)
+12 IF $DATA(ERRORS)
SET ERRORS("Clinic IEN",1)=""
DO BUILDJSON^SDES2JSON(.JSON,.ERRORS)
QUIT
+13 ;
+14 DO DELALUSERS(.ERRORS,SDINPUT("Clinic IEN"))
+15 IF $DATA(ERRORS)
SET ERRORS("Clinic IEN",1)=""
DO BUILDJSON^SDES2JSON(.RETURN,.ERRORS)
QUIT
+16 DO EASAUDIT(.ERRORS,SDINPUT("Clinic IEN"),.SDCONTEXT)
SET CLINDATA("Success")="All Users are successfully deleted."
+17 ;
+18 DO BLDCLNREC^SDES2CLININFO(.CLINDATA,SDINPUT("Clinic IEN"))
+19 DO BUILDJSON^SDES2JSON(.JSON,.CLINDATA)
+20 QUIT
+21 ;
GETPRIV(JSON,SDCONTEXT,SDINPUT) ;SDES2 GET PRIV USERS
+1 ; Input:
+2 ; S SDINPUT("Clinic IEN")-[required]-The Hopspital Location IEN
+3 ;
+4 NEW ERRORS,CLINDATA
+5 ; Validate SDCONTEXT
+6 DO VALCONTEXT^SDES2VALCONTEXT(.ERRORS,.SDCONTEXT)
+7 IF $DATA(ERRORS)
SET ERRORS("Clinic IEN",1)=""
DO BUILDJSON^SDES2JSON(.JSON,.ERRORS)
QUIT
+8 IF $GET(SDCONTEXT("USER DUZ"))'=""
NEW DUZ
DO DUZ^XUP(SDCONTEXT("USER DUZ"))
+9 ;
+10 DO VALIDATER(.ERRORS,.SDINPUT)
+11 IF $DATA(ERRORS)
SET ERRORS("Clinic IEN",1)=""
DO BUILDJSON^SDES2JSON(.JSON,.ERRORS)
QUIT
+12 ;
+13 DO GETUSRLIST(.CLINDATA,.SDINPUT)
+14 ;
+15 DO BUILDJSON^SDES2JSON(.JSON,.CLINDATA)
+16 QUIT
+17 ;
VALIDATE(ERRORS,SDINPUT) ; Validate Clinic IEN, Privileged DUZ
+1 NEW ERRORFLAG,CLININE,PRIVDUZ
+2 ; Location IEN
+3 SET CLINIEN=$GET(SDINPUT("Clinic IEN"))
+4 IF CLINIEN=""
SET ERRORFLAG=1
DO ERRLOG^SDESJSON(.ERRORS,18)
QUIT $DATA(ERRORFLAG)
+5 IF '$DATA(^SC(CLINIEN,0))
SET ERRORFLAG=1
DO ERRLOG^SDESJSON(.ERRORS,19)
QUIT $DATA(ERRORFLAG)
+6 ; User IEN
+7 SET PRIVDUZ=$GET(SDINPUT("PRIV DUZ"))
+8 IF PRIVDUZ=""
SET ERRORFLAG=1
DO ERRLOG^SDESJSON(.ERRORS,223)
QUIT $DATA(ERRORFLAG)
+9 IF '$DATA(^VA(200,$GET(PRIVDUZ),0))
SET ERRORFLAG=1
DO ERRLOG^SDESJSON(.ERRORS,44)
QUIT $DATA(ERRORFLAG)
+10 QUIT $DATA(ERRORFLAG)
+11 ;
VALIDATER(ERRORS,SDINPUT) ; Validate Clinic IEN
+1 NEW ERRORFLAG,CLINIEN
+2 ;
+3 ; Location IEN
+4 SET CLINIEN=$GET(SDINPUT("Clinic IEN"))
+5 IF CLINIEN=""
SET ERRORFLAG=1
DO ERRLOG^SDESJSON(.ERRORS,18)
QUIT $DATA(ERRORFLAG)
+6 IF '$DATA(^SC(CLINIEN,0))
SET ERRORFLAG=1
DO ERRLOG^SDESJSON(.ERRORS,19)
QUIT $DATA(ERRORFLAG)
+7 QUIT $DATA(ERRORFLAG)
+8 ;
ADDUSER(ERRORS,CLINIEN,PRIVDUZ) ; Add User
+1 NEW IENS,ERR,FDA
+2 SET IENS(1)=+PRIVDUZ
+3 SET FDA(44.04,"+1,"_CLINIEN_",",.01)=+PRIVDUZ
+4 DO UPDATE^DIE(,"FDA","IENS","ERR")
+5 IF $DATA(ERR)
Begin DoDot:1
+6 SET ERRORS("Error",1)="Error adding User to Hospital Location: "_$GET(ERR("DIERR",1,"TEXT",1))
End DoDot:1
+7 QUIT
+8 ;
DELUSER(ERRORS,CLINIEN,PRIVDUZ) ; Delete User
+1 NEW DIK,DA,ERRORS
+2 SET DIK="^SC("_CLINIEN_",""SDPRIV"","
+3 SET DA(1)=CLINIEN
+4 SET DA=PRIVDUZ
+5 DO ^DIK
+6 QUIT
+7 ;
DELALUSERS(ERRORS,CLINIEN) ; Delete All Users
+1 NEW DIK,DA,ERRORS
+2 SET DIK="^SC("_CLINIEN_",""SDPRIV"","
+3 SET DA(1)=CLINIEN
+4 SET DA=999999999
FOR
SET DA=$ORDER(^SC(CLINIEN,"SDPRIV",DA),-1)
if 'DA
QUIT
DO ^DIK
+5 QUIT
+6 ;
GETUSRLIST(ELGARRAY,SDINPUT) ; Return all Users
+1 NEW USRCNT,PRIVDUZ,USRNAME,CLINIEN
+2 SET CLINIEN=$GET(SDINPUT("Clinic IEN"))
+3 SET PRIVDUZ=$GET(SDINPUT("PRIV DUZ"))
+4 SET (USRCNT,PRIVDUZ)=0
+5 FOR
SET PRIVDUZ=$ORDER(^SC(CLINIEN,"SDPRIV",PRIVDUZ))
if 'PRIVDUZ
QUIT
Begin DoDot:1
+6 SET USRCNT=USRCNT+1
+7 SET ELGARRAY("Privileged User",USRCNT,"IEN")=PRIVDUZ
+8 SET ELGARRAY("Privileged User",USRCNT,"Name")=$$GET1^DIQ(44.04,PRIVDUZ_","_CLINIEN,.01)
End DoDot:1
+9 IF USRCNT=0
SET ELGARRAY("Error",1)="No privileged users are found."
+10 QUIT
+11 ;
EASAUDIT(ERRORS,CLINIEN,SDCONTEXT) ; Update EAS Audit Fields
+1 NEW FDA,ERR
+2 SET FDA(44,CLINIEN_",",100)=$GET(SDCONTEXT("ACHERON AUDIT ID"))
+3 SET FDA(44,CLINIEN_",",100.2)=$GET(SDCONTEXT("APPID"))
+4 SET FDA(44,CLINIEN_",",100.1)=$GET(XWB(2,"RPC"))
+5 DO FILE^DIE(,"FDA","ERR")
+6 IF $DATA(ERR)
SET ERRORS("Error",1)="Error adding User to Hospital Location: "_$GET(ERR("DIERR",1,"TEXT",1))
+7 QUIT
+8 ;
