SDESLOC ;ALB/ANU - VISTA SCHEDULING RPCS - USERS FOR HOSPITAL LOCATION ; May 09, 2022@15:20
;;5.3;Scheduling;**819**;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
;
;Global References
;-----------------
; Reference to LIST^DIC(200 is supported by IA #10060
;
Q
UPDPRIV(ELGRETURN,ADDFLAG,LOCIEN,USRIEN) ;Update the list of privileged user for a hospital location
; This RPC adds privileged user to a hospital location.
; Input:
; ELGRETURN - [required] - Success or Error message
; ADDFLAG - [required] - 1 (Add User), 0 (Delete User)
; LOCIEN - [required] - The Hopspital Location IEN
; USRIEN - [required] - The New Person IEN
;
N HASVLDERRORS,RETURN,HASFIELDS,ELGFIELDSARRAY,VLDERRORS
S (RETURN,VLDERRORS,ELGFIELDSARRAY,HASFIELDS)=""
;
S HASVLDERRORS=$$VALIDATE(.VLDERRORS,ADDFLAG,LOCIEN,USRIEN)
I HASVLDERRORS M RETURN=VLDERRORS
I 'HASVLDERRORS D
. I ADDFLAG S HASFIELDS=$$ADDUSR(.ELGFIELDSARRAY,LOCIEN,USRIEN)
. I 'ADDFLAG S HASFIELDS=$$RMVUSR(.ELGFIELDSARRAY,LOCIEN,USRIEN)
I HASFIELDS M RETURN=ELGFIELDSARRAY
;
D BUILDJSON^SDESBUILDJSON(.ELGRETURN,.RETURN)
D CLEANUP
Q
;
RMVALLUSR(ELGRETURN,LOCIEN) ;Remove all privileged user for a hospital location
; This RPC removes privileged user to a hospital location.
; Input:
; ELGRETURN - [required] - Success or Error message
; LOCIEN - [required] - The Hopspital Location IEN
;
N HASVLDERRORS,RETURN,HASFIELDS,ELGFIELDSARRAY,VLDERRORS
S (RETURN,VLDERRORS,ELGFIELDSARRAY,HASFIELDS)=""
;
S HASVLDERRORS=$$VALIDATER(.VLDERRORS,LOCIEN)
I HASVLDERRORS M RETURN=VLDERRORS
I 'HASVLDERRORS S HASFIELDS=$$RMVAUSR(.ELGFIELDSARRAY,LOCIEN)
I HASFIELDS M RETURN=ELGFIELDSARRAY
;
D BUILDJSON^SDESBUILDJSON(.ELGRETURN,.RETURN)
D CLEANUP
Q
;
RTNALLUSR(ELGRETURN,LOCIEN) ;Return all privileged user for a hospital location
; This RPC removes privileged user to a hospital location.
; Input:
; ELGRETURN - [required] - Success or Error message
; LOCIEN - [required] - The Hopspital Location IEN
;
N HASVLDERRORS,RETURN,HASFIELDS,ELGFIELDSARRAY,VLDERRORS
S (RETURN,VLDERRORS,ELGFIELDSARRAY,HASFIELDS)=""
;
S HASVLDERRORS=$$VALIDATER(.VLDERRORS,LOCIEN)
I HASVLDERRORS M RETURN=VLDERRORS
I 'HASVLDERRORS S HASFIELDS=$$RTNAUSR(.ELGFIELDSARRAY,LOCIEN)
I HASFIELDS M RETURN=ELGFIELDSARRAY
;
D EMPTYJSON(.RETURN)
D BUILDJSON^SDESBUILDJSON(.ELGRETURN,.RETURN)
D CLEANUP
Q
;
VALIDATE(ERRORS,ADDFLAG,LOCIEN,USRIEN) ; Validate Location IEN, User IEN
N ERRORFLAG
;
; ADDFLAG
I (($G(ADDFLAG)'=1)&($G(ADDFLAG)'=0)) S ERRORFLAG=1 D ERRLOG^SDESJSON(.ERRORS,222) Q $D(ERRORFLAG)
; Location IEN
I LOCIEN="" S ERRORFLAG=1 D ERRLOG^SDESJSON(.ERRORS,18) Q $D(ERRORFLAG)
I '$D(^SC(LOCIEN,0)) S ERRORFLAG=1 D ERRLOG^SDESJSON(.ERRORS,19) Q $D(ERRORFLAG)
; User IEN
I USRIEN="" S ERRORFLAG=1 D ERRLOG^SDESJSON(.ERRORS,223) Q $D(ERRORFLAG)
I '$D(^VA(200,$G(USRIEN),0)) S ERRORFLAG=1 D ERRLOG^SDESJSON(.ERRORS,44) Q $D(ERRORFLAG)
I ADDFLAG,$$GET1^DIQ(44.04,USRIEN_","_LOCIEN,.01)'="" S ERRORFLAG=1 D ERRLOG^SDESJSON(.ERRORS,220) Q $D(ERRORFLAG)
I 'ADDFLAG,$$GET1^DIQ(44.04,USRIEN_","_LOCIEN,.01)="" S ERRORFLAG=1 D ERRLOG^SDESJSON(.ERRORS,221) Q $D(ERRORFLAG)
Q $D(ERRORFLAG)
;
VALIDATER(ERRORS,LOCIEN) ; Validate Location IEN
N ERRORFLAG
;
; Location IEN
I LOCIEN="" S ERRORFLAG=1 D ERRLOG^SDESJSON(.ERRORS,18) Q $D(ERRORFLAG)
I '$D(^SC(LOCIEN,0)) S ERRORFLAG=1 D ERRLOG^SDESJSON(.ERRORS,19) Q $D(ERRORFLAG)
Q $D(ERRORFLAG)
;
ADDUSR(ELGARRAY,LOCIEN,USRIEN) ; Add User
N HASDATA,CNT,IEN,IENS,ERR,FDA
S CNT=1
S IENS(CNT)=+USRIEN
S IEN="+"_CNT_","
S FDA(44.04,IEN_LOCIEN_",",.01)=+USRIEN
D UPDATE^DIE(,"FDA","IENS","ERR")
I $D(ERR) D
.S ELGARRAY("Error",1)="Error adding User to Hospital Location: "_$G(ERR("DIERR",1,"TEXT",1))
I '$D(ERR) S ELGARRAY("Success")="User is successfully added."
S HASDATA=($D(ELGARRAY)>1)
Q HASDATA
;
RMVUSR(ELGARRAY,LOCIEN,USRIEN) ; Delete User
N DIK,DA
S DIK="^SC("_LOCIEN_",""SDPRIV"","
S DA(1)=LOCIEN
S DA=USRIEN
D ^DIK
S ELGARRAY("Success")="User is successfully deleted."
S HASDATA=($D(ELGARRAY)>1)
Q HASDATA
;
RMVAUSR(ELGARRAY,LOCIEN) ; Delete Users
N DIK,DA
S DIK="^SC("_LOCIEN_",""SDPRIV"","
S DA(1)=LOCIEN
S DA=999999999 F S DA=$O(^SC(LOCIEN,"SDPRIV",DA),-1) Q:'DA D ^DIK
S ELGARRAY("Success")="All Users are successfully deleted."
S HASDATA=($D(ELGARRAY)>1)
Q HASDATA
;
RTNAUSR(ELGARRAY,LOCIEN) ; Return all Users
N USRCNT,USRIEN,USRNAME
S (USRCNT,USRIEN)=0
F S USRIEN=$O(^SC(LOCIEN,"SDPRIV",USRIEN)) Q:'USRIEN D
.S USRCNT=USRCNT+1
.S ELGARRAY("Privileged User",USRCNT,"IEN")=USRIEN
.S ELGARRAY("Privileged User",USRCNT,"Name")=$$GET1^DIQ(44.04,USRIEN_","_LOCIEN,.01)
I USRCNT=0 S ELGARRAY("Error",1)="No privileged users are found."
S HASDATA=($D(ELGARRAY)>1)
Q HASDATA
;
EMPTYJSON(RETURN) ;return an empty string JSON Format if an Error occur or no data found
N USRCNT
I ($O(RETURN("Error",""))'="")!($G(RETURN("Success"))'="") D
.S USRCNT=1
.S RETURN("Privileged User",USRCNT,"IEN")=""
.S RETURN("Privileged User",USRCNT,"Name")=""
Q
;
CLEANUP ; Cleanup
K HASVLDERRORS,RETURN,HASFIELDS,ELGFIELDSARRAY
K ERRORFLAG
K HASDATA
K JSONERROR
K DIK,DA
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDESLOC 5448 printed Sep 23, 2025@20:34:09 Page 2
SDESLOC ;ALB/ANU - VISTA SCHEDULING RPCS - USERS FOR HOSPITAL LOCATION ; May 09, 2022@15:20
+1 ;;5.3;Scheduling;**819**;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 ;
+8 ;Global References
+9 ;-----------------
+10 ; Reference to LIST^DIC(200 is supported by IA #10060
+11 ;
+12 QUIT
UPDPRIV(ELGRETURN,ADDFLAG,LOCIEN,USRIEN) ;Update the list of privileged user for a hospital location
+1 ; This RPC adds privileged user to a hospital location.
+2 ; Input:
+3 ; ELGRETURN - [required] - Success or Error message
+4 ; ADDFLAG - [required] - 1 (Add User), 0 (Delete User)
+5 ; LOCIEN - [required] - The Hopspital Location IEN
+6 ; USRIEN - [required] - The New Person IEN
+7 ;
+8 NEW HASVLDERRORS,RETURN,HASFIELDS,ELGFIELDSARRAY,VLDERRORS
+9 SET (RETURN,VLDERRORS,ELGFIELDSARRAY,HASFIELDS)=""
+10 ;
+11 SET HASVLDERRORS=$$VALIDATE(.VLDERRORS,ADDFLAG,LOCIEN,USRIEN)
+12 IF HASVLDERRORS
MERGE RETURN=VLDERRORS
+13 IF 'HASVLDERRORS
Begin DoDot:1
+14 IF ADDFLAG
SET HASFIELDS=$$ADDUSR(.ELGFIELDSARRAY,LOCIEN,USRIEN)
+15 IF 'ADDFLAG
SET HASFIELDS=$$RMVUSR(.ELGFIELDSARRAY,LOCIEN,USRIEN)
End DoDot:1
+16 IF HASFIELDS
MERGE RETURN=ELGFIELDSARRAY
+17 ;
+18 DO BUILDJSON^SDESBUILDJSON(.ELGRETURN,.RETURN)
+19 DO CLEANUP
+20 QUIT
+21 ;
RMVALLUSR(ELGRETURN,LOCIEN) ;Remove all privileged user for a hospital location
+1 ; This RPC removes privileged user to a hospital location.
+2 ; Input:
+3 ; ELGRETURN - [required] - Success or Error message
+4 ; LOCIEN - [required] - The Hopspital Location IEN
+5 ;
+6 NEW HASVLDERRORS,RETURN,HASFIELDS,ELGFIELDSARRAY,VLDERRORS
+7 SET (RETURN,VLDERRORS,ELGFIELDSARRAY,HASFIELDS)=""
+8 ;
+9 SET HASVLDERRORS=$$VALIDATER(.VLDERRORS,LOCIEN)
+10 IF HASVLDERRORS
MERGE RETURN=VLDERRORS
+11 IF 'HASVLDERRORS
SET HASFIELDS=$$RMVAUSR(.ELGFIELDSARRAY,LOCIEN)
+12 IF HASFIELDS
MERGE RETURN=ELGFIELDSARRAY
+13 ;
+14 DO BUILDJSON^SDESBUILDJSON(.ELGRETURN,.RETURN)
+15 DO CLEANUP
+16 QUIT
+17 ;
RTNALLUSR(ELGRETURN,LOCIEN) ;Return all privileged user for a hospital location
+1 ; This RPC removes privileged user to a hospital location.
+2 ; Input:
+3 ; ELGRETURN - [required] - Success or Error message
+4 ; LOCIEN - [required] - The Hopspital Location IEN
+5 ;
+6 NEW HASVLDERRORS,RETURN,HASFIELDS,ELGFIELDSARRAY,VLDERRORS
+7 SET (RETURN,VLDERRORS,ELGFIELDSARRAY,HASFIELDS)=""
+8 ;
+9 SET HASVLDERRORS=$$VALIDATER(.VLDERRORS,LOCIEN)
+10 IF HASVLDERRORS
MERGE RETURN=VLDERRORS
+11 IF 'HASVLDERRORS
SET HASFIELDS=$$RTNAUSR(.ELGFIELDSARRAY,LOCIEN)
+12 IF HASFIELDS
MERGE RETURN=ELGFIELDSARRAY
+13 ;
+14 DO EMPTYJSON(.RETURN)
+15 DO BUILDJSON^SDESBUILDJSON(.ELGRETURN,.RETURN)
+16 DO CLEANUP
+17 QUIT
+18 ;
VALIDATE(ERRORS,ADDFLAG,LOCIEN,USRIEN) ; Validate Location IEN, User IEN
+1 NEW ERRORFLAG
+2 ;
+3 ; ADDFLAG
+4 IF (($GET(ADDFLAG)'=1)&($GET(ADDFLAG)'=0))
SET ERRORFLAG=1
DO ERRLOG^SDESJSON(.ERRORS,222)
QUIT $DATA(ERRORFLAG)
+5 ; Location IEN
+6 IF LOCIEN=""
SET ERRORFLAG=1
DO ERRLOG^SDESJSON(.ERRORS,18)
QUIT $DATA(ERRORFLAG)
+7 IF '$DATA(^SC(LOCIEN,0))
SET ERRORFLAG=1
DO ERRLOG^SDESJSON(.ERRORS,19)
QUIT $DATA(ERRORFLAG)
+8 ; User IEN
+9 IF USRIEN=""
SET ERRORFLAG=1
DO ERRLOG^SDESJSON(.ERRORS,223)
QUIT $DATA(ERRORFLAG)
+10 IF '$DATA(^VA(200,$GET(USRIEN),0))
SET ERRORFLAG=1
DO ERRLOG^SDESJSON(.ERRORS,44)
QUIT $DATA(ERRORFLAG)
+11 IF ADDFLAG
IF $$GET1^DIQ(44.04,USRIEN_","_LOCIEN,.01)'=""
SET ERRORFLAG=1
DO ERRLOG^SDESJSON(.ERRORS,220)
QUIT $DATA(ERRORFLAG)
+12 IF 'ADDFLAG
IF $$GET1^DIQ(44.04,USRIEN_","_LOCIEN,.01)=""
SET ERRORFLAG=1
DO ERRLOG^SDESJSON(.ERRORS,221)
QUIT $DATA(ERRORFLAG)
+13 QUIT $DATA(ERRORFLAG)
+14 ;
VALIDATER(ERRORS,LOCIEN) ; Validate Location IEN
+1 NEW ERRORFLAG
+2 ;
+3 ; Location IEN
+4 IF LOCIEN=""
SET ERRORFLAG=1
DO ERRLOG^SDESJSON(.ERRORS,18)
QUIT $DATA(ERRORFLAG)
+5 IF '$DATA(^SC(LOCIEN,0))
SET ERRORFLAG=1
DO ERRLOG^SDESJSON(.ERRORS,19)
QUIT $DATA(ERRORFLAG)
+6 QUIT $DATA(ERRORFLAG)
+7 ;
ADDUSR(ELGARRAY,LOCIEN,USRIEN) ; Add User
+1 NEW HASDATA,CNT,IEN,IENS,ERR,FDA
+2 SET CNT=1
+3 SET IENS(CNT)=+USRIEN
+4 SET IEN="+"_CNT_","
+5 SET FDA(44.04,IEN_LOCIEN_",",.01)=+USRIEN
+6 DO UPDATE^DIE(,"FDA","IENS","ERR")
+7 IF $DATA(ERR)
Begin DoDot:1
+8 SET ELGARRAY("Error",1)="Error adding User to Hospital Location: "_$GET(ERR("DIERR",1,"TEXT",1))
End DoDot:1
+9 IF '$DATA(ERR)
SET ELGARRAY("Success")="User is successfully added."
+10 SET HASDATA=($DATA(ELGARRAY)>1)
+11 QUIT HASDATA
+12 ;
RMVUSR(ELGARRAY,LOCIEN,USRIEN) ; Delete User
+1 NEW DIK,DA
+2 SET DIK="^SC("_LOCIEN_",""SDPRIV"","
+3 SET DA(1)=LOCIEN
+4 SET DA=USRIEN
+5 DO ^DIK
+6 SET ELGARRAY("Success")="User is successfully deleted."
+7 SET HASDATA=($DATA(ELGARRAY)>1)
+8 QUIT HASDATA
+9 ;
RMVAUSR(ELGARRAY,LOCIEN) ; Delete Users
+1 NEW DIK,DA
+2 SET DIK="^SC("_LOCIEN_",""SDPRIV"","
+3 SET DA(1)=LOCIEN
+4 SET DA=999999999
FOR
SET DA=$ORDER(^SC(LOCIEN,"SDPRIV",DA),-1)
if 'DA
QUIT
DO ^DIK
+5 SET ELGARRAY("Success")="All Users are successfully deleted."
+6 SET HASDATA=($DATA(ELGARRAY)>1)
+7 QUIT HASDATA
+8 ;
RTNAUSR(ELGARRAY,LOCIEN) ; Return all Users
+1 NEW USRCNT,USRIEN,USRNAME
+2 SET (USRCNT,USRIEN)=0
+3 FOR
SET USRIEN=$ORDER(^SC(LOCIEN,"SDPRIV",USRIEN))
if 'USRIEN
QUIT
Begin DoDot:1
+4 SET USRCNT=USRCNT+1
+5 SET ELGARRAY("Privileged User",USRCNT,"IEN")=USRIEN
+6 SET ELGARRAY("Privileged User",USRCNT,"Name")=$$GET1^DIQ(44.04,USRIEN_","_LOCIEN,.01)
End DoDot:1
+7 IF USRCNT=0
SET ELGARRAY("Error",1)="No privileged users are found."
+8 SET HASDATA=($DATA(ELGARRAY)>1)
+9 QUIT HASDATA
+10 ;
EMPTYJSON(RETURN) ;return an empty string JSON Format if an Error occur or no data found
+1 NEW USRCNT
+2 IF ($ORDER(RETURN("Error",""))'="")!($GET(RETURN("Success"))'="")
Begin DoDot:1
+3 SET USRCNT=1
+4 SET RETURN("Privileged User",USRCNT,"IEN")=""
+5 SET RETURN("Privileged User",USRCNT,"Name")=""
End DoDot:1
+6 QUIT
+7 ;
CLEANUP ; Cleanup
+1 KILL HASVLDERRORS,RETURN,HASFIELDS,ELGFIELDSARRAY
+2 KILL ERRORFLAG
+3 KILL HASDATA
+4 KILL JSONERROR
+5 KILL DIK,DA
+6 QUIT
