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

SDESLOC.m

Go to the documentation of this file.
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