SDESADDRG ;ALB/ANU - VISTA SCHEDULING RPCS - ROUTINE ADD RESOURCE GROUP ;Sept 20, 2022@14:21
;;5.3;Scheduling;**825,826**;Aug 13, 1993;Build 18
;;Per VHA Directive 6402, this routine should not be modified
;
;External References
;-------------------
; Reference to $$GETS^DIQ,$$GETS1^DIQ in ICR #2056
;
Q
;
;
RGADDEDIT(RETURNJSON,SDRGIEN,SDRGNAME) ;ADD/EDIT RESOURCE GROUP
;
; Input:
; SDRGIEN [Optional] = Resoruce Group IEN
; SDRGNAME [Required] = Resource Group Name
;
; Output:
; RETURNJSON = Returns IEN of added/edited entry or 0 if error.
;
N RETURN,HASFIELDS,ELGFIELDSARRAY,ELGRETURN
N ISRGIENVALID,ISRGNAMEVALID
S (RETURN,ELGFIELDSARRAY,HASFIELDS)=""
;
S ISRGIENVALID=$$VALIDATERGIEN(.ERRORS,$G(SDRGIEN))
S ISRGNAMEVALID=$$VALIDATERGNAME(.ERRORS,$G(SDRGNAME))
;
I $D(ERRORS) M RETURN=ERRORS
I '$D(ERRORS) S HASFIELDS=$$RGMOD(.ELGFIELDSARRAY,$G(SDRGIEN),SDRGNAME)
I HASFIELDS M RETURN=ELGFIELDSARRAY
;
D BUILDJSON^SDESBUILDJSON(.RETURNJSON,.RETURN)
D CLEANUP
Q
;
DELRESGP(RETURNJSON,SDRGNAME) ;Deletes entry name SDRGNAME from SDEC RESOURCE GROUP file
; Input:
; SDRGNAME [Required] = Resource Group Name
;
; Output:
; RETURNJSON - Returns Status (Success or Failure)
;
; Called by SDES DELETE RESGRP
;
N RETURN,HASFIELDS,ELGFIELDSARRAY,ELGRETURN
N ISRGNAMEVALID
S (RETURN,ELGFIELDSARRAY,HASFIELDS)=""
;
S ISRGNAMEVALID=$$VALIDATERGNAME1(.ERRORS,$G(SDRGNAME))
;
I $D(ERRORS) M RETURN=ERRORS
I '$D(ERRORS) S HASFIELDS=$$RGMOD1(.ELGFIELDSARRAY,SDRGNAME)
I HASFIELDS M RETURN=ELGFIELDSARRAY
;
D BUILDJSON^SDESBUILDJSON(.RETURNJSON,.RETURN)
D CLEANUP
Q
;
VALIDATERGIEN(ERRORS,SDRGIEN) ; Validate Resource Group IEN
N ERRORFLAG
I SDRGIEN'="" I '$D(^SDEC(409.832,SDRGIEN,0)) S ERRORFLAG=1 D ERRLOG^SDESJSON(.ERRORS,276) Q $D(ERRORFLAG)
Q $D(ERRORFLAG)
;
VALIDATERGNAME(ERRORS,SDRGNAME) ; Validate Resource Group Name
N ERRORFLAG
I SDRGNAME="" S ERRORFLAG=1 D ERRLOG^SDESJSON(.ERRORS,275) Q $D(ERRORFLAG) ;Name required
I ($L($$TRIM^XLFSTR(SDRGNAME))<3)!($L($$TRIM^XLFSTR(SDRGNAME))>30) S ERRORFLAG=1 D ERRLOG^SDESJSON(.ERRORS,310) Q $D(ERRORFLAG) ;Length is wrong
;I SDRGNAME'="" I '$D(^SDEC(409.832,SDRGNAME,0)) S ERRORFLAG=1 D ERRLOG^SDESJSON(.ERRORS,276) Q $D(ERRORFLAG) ; Invalid Resource Group/Resource Grp not found
;Prevent adding entry with duplicate name
I SDRGNAME'="",$D(^SDEC(409.832,"B",SDRGNAME)),$O(^SDEC(409.832,"B",SDRGNAME,0))'=$G(SDRGIEN) D Q $D(ERRORFLAG)
. S ERRORFLAG=1 D ERRLOG^SDESJSON(.ERRORS,274) ;Cannot have two Resource Groups with the same name.
. Q
Q $D(ERRORFLAG)
;
VALIDATERGNAME1(ERRORS,SDRGNAME) ; Validate Resource Group Name
N ERRORFLAG
I SDRGNAME="" S ERRORFLAG=1 D ERRLOG^SDESJSON(.ERRORS,275) Q $D(ERRORFLAG) ;Name required
I SDRGNAME'="" I '$D(^SDEC(409.832,"B",SDRGNAME)) S ERRORFLAG=1 D ERRLOG^SDESJSON(.ERRORS,315) Q $D(ERRORFLAG) ; RESOURCE GROUP NAME NOT FOUND
Q $D(ERRORFLAG)
;
RGMOD(ELGARRAY,SDRGIEN,SDRGNAME) ; Add or Edit Resource Group Name
N SDRGIENS,SDRGFDA,SDRGMSG,HASDATA,SDRGM1
S ELGARRAY("Status","IEN")=0
S ELGARRAY("Status","Message")=""
S SDRGM1=""
I +SDRGIEN D
. S SDRGIENS=SDRGIEN_","
. S SDRGFDA(409.832,SDRGIENS,.01)=SDRGNAME ;NAME
. D FILE^DIE("","SDRGFDA","SDRGMSG")
. S SDRGM1="Successfully updated."
I '+SDRGIEN D
. S SDRGIENS="+1,"
. K SDRGIEN
. S SDRGFDA(409.832,SDRGIENS,.01)=SDRGNAME ;NAME
. D UPDATE^DIE("","SDRGFDA","SDRGIENS","SDRGMSG")
. S SDRGIEN=+$G(SDRGIENS(1))
. S SDRGM1="Successfully added."
S ELGARRAY("Status","IEN")=$G(SDRGIEN)
S ELGARRAY("Status","Message")=$G(SDRGM1)
S HASDATA=($D(ELGARRAY)>1)
Q HASDATA
;
RGMOD1(ELGARRAY,SDRGNAME) ; Delete Resource Group Name
N HASDATA,SDFDA,SDMSG,SDESIEN,DA,DIK
S SDESIEN=$O(^SDEC(409.832,"B",SDRGNAME,0))
;Delete entry SDECIEN
S DIK="^SDEC(409.832,"
S DA=SDESIEN
D ^DIK
;
K SDESIEN
S SDESIEN=$O(^SDEC(409.832,"B",SDRGNAME,0))
I $G(SDESIEN)'="" S ELGARRAY("Status")="0^Error in deleting Resource Group."
I $G(SDESIEN)="" S ELGARRAY("Status")="1^Resource Group is successfully deleted."
S HASDATA=($D(ELGARRAY)>1)
Q HASDATA
;
CLEANUP ;
K RETURNERROR,ERRORFLAG,ERRORS,ISRGNAMEVALID,ISRGIENVALID
K SDRGIENS,SDRGFDA,SDRGMSG
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDESADDRG 4315 printed Dec 13, 2024@02:55:34 Page 2
SDESADDRG ;ALB/ANU - VISTA SCHEDULING RPCS - ROUTINE ADD RESOURCE GROUP ;Sept 20, 2022@14:21
+1 ;;5.3;Scheduling;**825,826**;Aug 13, 1993;Build 18
+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 QUIT
+9 ;
+10 ;
RGADDEDIT(RETURNJSON,SDRGIEN,SDRGNAME) ;ADD/EDIT RESOURCE GROUP
+1 ;
+2 ; Input:
+3 ; SDRGIEN [Optional] = Resoruce Group IEN
+4 ; SDRGNAME [Required] = Resource Group Name
+5 ;
+6 ; Output:
+7 ; RETURNJSON = Returns IEN of added/edited entry or 0 if error.
+8 ;
+9 NEW RETURN,HASFIELDS,ELGFIELDSARRAY,ELGRETURN
+10 NEW ISRGIENVALID,ISRGNAMEVALID
+11 SET (RETURN,ELGFIELDSARRAY,HASFIELDS)=""
+12 ;
+13 SET ISRGIENVALID=$$VALIDATERGIEN(.ERRORS,$GET(SDRGIEN))
+14 SET ISRGNAMEVALID=$$VALIDATERGNAME(.ERRORS,$GET(SDRGNAME))
+15 ;
+16 IF $DATA(ERRORS)
MERGE RETURN=ERRORS
+17 IF '$DATA(ERRORS)
SET HASFIELDS=$$RGMOD(.ELGFIELDSARRAY,$GET(SDRGIEN),SDRGNAME)
+18 IF HASFIELDS
MERGE RETURN=ELGFIELDSARRAY
+19 ;
+20 DO BUILDJSON^SDESBUILDJSON(.RETURNJSON,.RETURN)
+21 DO CLEANUP
+22 QUIT
+23 ;
DELRESGP(RETURNJSON,SDRGNAME) ;Deletes entry name SDRGNAME from SDEC RESOURCE GROUP file
+1 ; Input:
+2 ; SDRGNAME [Required] = Resource Group Name
+3 ;
+4 ; Output:
+5 ; RETURNJSON - Returns Status (Success or Failure)
+6 ;
+7 ; Called by SDES DELETE RESGRP
+8 ;
+9 NEW RETURN,HASFIELDS,ELGFIELDSARRAY,ELGRETURN
+10 NEW ISRGNAMEVALID
+11 SET (RETURN,ELGFIELDSARRAY,HASFIELDS)=""
+12 ;
+13 SET ISRGNAMEVALID=$$VALIDATERGNAME1(.ERRORS,$GET(SDRGNAME))
+14 ;
+15 IF $DATA(ERRORS)
MERGE RETURN=ERRORS
+16 IF '$DATA(ERRORS)
SET HASFIELDS=$$RGMOD1(.ELGFIELDSARRAY,SDRGNAME)
+17 IF HASFIELDS
MERGE RETURN=ELGFIELDSARRAY
+18 ;
+19 DO BUILDJSON^SDESBUILDJSON(.RETURNJSON,.RETURN)
+20 DO CLEANUP
+21 QUIT
+22 ;
VALIDATERGIEN(ERRORS,SDRGIEN) ; Validate Resource Group IEN
+1 NEW ERRORFLAG
+2 IF SDRGIEN'=""
IF '$DATA(^SDEC(409.832,SDRGIEN,0))
SET ERRORFLAG=1
DO ERRLOG^SDESJSON(.ERRORS,276)
QUIT $DATA(ERRORFLAG)
+3 QUIT $DATA(ERRORFLAG)
+4 ;
VALIDATERGNAME(ERRORS,SDRGNAME) ; Validate Resource Group Name
+1 NEW ERRORFLAG
+2 ;Name required
IF SDRGNAME=""
SET ERRORFLAG=1
DO ERRLOG^SDESJSON(.ERRORS,275)
QUIT $DATA(ERRORFLAG)
+3 ;Length is wrong
IF ($LENGTH($$TRIM^XLFSTR(SDRGNAME))<3)!($LENGTH($$TRIM^XLFSTR(SDRGNAME))>30)
SET ERRORFLAG=1
DO ERRLOG^SDESJSON(.ERRORS,310)
QUIT $DATA(ERRORFLAG)
+4 ;I SDRGNAME'="" I '$D(^SDEC(409.832,SDRGNAME,0)) S ERRORFLAG=1 D ERRLOG^SDESJSON(.ERRORS,276) Q $D(ERRORFLAG) ; Invalid Resource Group/Resource Grp not found
+5 ;Prevent adding entry with duplicate name
+6 IF SDRGNAME'=""
IF $DATA(^SDEC(409.832,"B",SDRGNAME))
IF $ORDER(^SDEC(409.832,"B",SDRGNAME,0))'=$GET(SDRGIEN)
Begin DoDot:1
+7 ;Cannot have two Resource Groups with the same name.
SET ERRORFLAG=1
DO ERRLOG^SDESJSON(.ERRORS,274)
+8 QUIT
End DoDot:1
QUIT $DATA(ERRORFLAG)
+9 QUIT $DATA(ERRORFLAG)
+10 ;
VALIDATERGNAME1(ERRORS,SDRGNAME) ; Validate Resource Group Name
+1 NEW ERRORFLAG
+2 ;Name required
IF SDRGNAME=""
SET ERRORFLAG=1
DO ERRLOG^SDESJSON(.ERRORS,275)
QUIT $DATA(ERRORFLAG)
+3 ; RESOURCE GROUP NAME NOT FOUND
IF SDRGNAME'=""
IF '$DATA(^SDEC(409.832,"B",SDRGNAME))
SET ERRORFLAG=1
DO ERRLOG^SDESJSON(.ERRORS,315)
QUIT $DATA(ERRORFLAG)
+4 QUIT $DATA(ERRORFLAG)
+5 ;
RGMOD(ELGARRAY,SDRGIEN,SDRGNAME) ; Add or Edit Resource Group Name
+1 NEW SDRGIENS,SDRGFDA,SDRGMSG,HASDATA,SDRGM1
+2 SET ELGARRAY("Status","IEN")=0
+3 SET ELGARRAY("Status","Message")=""
+4 SET SDRGM1=""
+5 IF +SDRGIEN
Begin DoDot:1
+6 SET SDRGIENS=SDRGIEN_","
+7 ;NAME
SET SDRGFDA(409.832,SDRGIENS,.01)=SDRGNAME
+8 DO FILE^DIE("","SDRGFDA","SDRGMSG")
+9 SET SDRGM1="Successfully updated."
End DoDot:1
+10 IF '+SDRGIEN
Begin DoDot:1
+11 SET SDRGIENS="+1,"
+12 KILL SDRGIEN
+13 ;NAME
SET SDRGFDA(409.832,SDRGIENS,.01)=SDRGNAME
+14 DO UPDATE^DIE("","SDRGFDA","SDRGIENS","SDRGMSG")
+15 SET SDRGIEN=+$GET(SDRGIENS(1))
+16 SET SDRGM1="Successfully added."
End DoDot:1
+17 SET ELGARRAY("Status","IEN")=$GET(SDRGIEN)
+18 SET ELGARRAY("Status","Message")=$GET(SDRGM1)
+19 SET HASDATA=($DATA(ELGARRAY)>1)
+20 QUIT HASDATA
+21 ;
RGMOD1(ELGARRAY,SDRGNAME) ; Delete Resource Group Name
+1 NEW HASDATA,SDFDA,SDMSG,SDESIEN,DA,DIK
+2 SET SDESIEN=$ORDER(^SDEC(409.832,"B",SDRGNAME,0))
+3 ;Delete entry SDECIEN
+4 SET DIK="^SDEC(409.832,"
+5 SET DA=SDESIEN
+6 DO ^DIK
+7 ;
+8 KILL SDESIEN
+9 SET SDESIEN=$ORDER(^SDEC(409.832,"B",SDRGNAME,0))
+10 IF $GET(SDESIEN)'=""
SET ELGARRAY("Status")="0^Error in deleting Resource Group."
+11 IF $GET(SDESIEN)=""
SET ELGARRAY("Status")="1^Resource Group is successfully deleted."
+12 SET HASDATA=($DATA(ELGARRAY)>1)
+13 QUIT HASDATA
+14 ;
CLEANUP ;
+1 KILL RETURNERROR,ERRORFLAG,ERRORS,ISRGNAMEVALID,ISRGIENVALID
+2 KILL SDRGIENS,SDRGFDA,SDRGMSG
+3 QUIT
+4 ;
