SDES2ADDRG ;ALB/RN - VISTA SCHEDULING RPCS - ROUTINE ADD/EDIT RESOURCE GROUP; Aug 11,2026
;;5.3;Scheduling;**952**;Aug 13, 1993;Build 4;RGADDEDIT
;;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
;
Q
;
RGADDEDIT(RETURNJSON,SDCONTEXT,SDINPUT) ;;ADD/EDIT RESOURCE GROUP
N RETURN,ELGFIELDSARRAY,ELGRETURN,RETN,ERRORS
D VALCONTEXT^SDES2VALCONTEXT(.ERRORS,.SDCONTEXT)
I $D(ERRORS) S ERRORS("Status")="",ERRORS("RSGroup",1)="" D BUILDJSON^SDES2JSON(.RETURNJSON,.ERRORS) Q
I $G(SDCONTEXT("USER DUZ"))'="" N DUZ D DUZ^XUP(SDCONTEXT("USER DUZ"))
S (RETURN,ELGFIELDSARRAY)=""
D VALDINPUT(.ERRORS,.SDINPUT)
I $D(ERRORS) S ERRORS("Status")="",ERRORS("RSGroup",1)="" D BUILDJSON^SDES2JSON(.RETURNJSON,.ERRORS) Q
D RGMOD(.ELGFIELDSARRAY,.SDINPUT)
I $D(ELGFIELDSARRAY("Error")) D BUILDJSON^SDES2JSON(.RETURNJSON,.ELGFIELDSARRAY) Q
D FILEEASINFO(.ERRORS,$G(SDINPUT("RESOURCE GROUP IEN")),.SDCONTEXT)
K RETN
D BUILDGROUP^SDES2GETRESGROUP(.RETN,$G(SDINPUT("RESOURCE GROUP IEN")))
M RETN=ELGFIELDSARRAY
D BUILDJSON^SDES2JSON(.RETURNJSON,.RETN)
Q
;
RGMOD(ELGARRAY,SDINPUT) ; Add or Edit Resource Group Name
N SDRGIENS,SDRGFDA,SDRGMSG,SDRGM1,SDESRGIEN,SDESRGNAME
S ELGARRAY("Status")=""
S SDESRGIEN=$G(SDINPUT("RESOURCE GROUP IEN"))
S SDESRGNAME=SDINPUT("RESOURCE GROUP NAME")
S SDRGM1=""
I +SDESRGIEN D
. S SDRGIENS=SDESRGIEN_","
. S SDRGFDA(409.832,SDRGIENS,.01)=SDESRGNAME ;NAME
. D FILE^DIE("","SDRGFDA","SDRGMSG")
. I $D(SDRGMSG) S ELGARRAY("Error")="Error in updating Resource Group. "_$G(SDRGMSG("DIERR",1,"TEXT",1)) Q
. I '$D(SDRGMSG) S SDRGM1="Resource Group successfully updated."
I '+SDESRGIEN D
. S SDRGIENS="+1,"
. K SDESRGIEN
. S SDRGFDA(409.832,SDRGIENS,.01)=SDESRGNAME ;NAME
. D UPDATE^DIE("","SDRGFDA","SDRGIENS","SDRGMSG")
. I $D(SDRGMSG) S ELGARRAY("Error")="Error in adding Resource Group. "_$G(SDRGMSG("DIERR",1,"TEXT",1)) Q
. S SDESRGIEN=+$G(SDRGIENS(1))
. I '$D(SDRGMSG) S SDRGM1="Resource Group successfully added."
. S SDESRGIEN=$O(^SDEC(409.832,"B",SDESRGNAME,0))
. S SDINPUT("RESOURCE GROUP IEN")=SDESRGIEN
S ELGARRAY("Status")=$G(SDRGM1)
Q
VALDINPUT(ERRORS,SDINPUT) ;Validate Input Array
N SDDA,SDESRGIEN,SDESRGNAME
S SDESRGIEN=$G(SDINPUT("RESOURCE GROUP IEN"))
S SDESRGNAME=$G(SDINPUT("RESOURCE GROUP NAME"))
; Invalid Resource Group IEN
I SDESRGIEN'="" I '$D(^SDEC(409.832,SDESRGIEN,0)) D ERRLOG^SDES2JSON(.ERRORS,276) Q
; Missing Resource Group Name
I SDESRGNAME="" D ERRLOG^SDES2JSON(.ERRORS,275) Q
; Resource Group Name Length Invalid
I ($L($$TRIM^XLFSTR(SDESRGNAME))<3)!($L($$TRIM^XLFSTR(SDESRGNAME))>30) D ERRLOG^SDES2JSON(.ERRORS,310)
I $D(^SDEC(409.832,"B",SDESRGNAME)) S SDESRGIEN=$O(^SDEC(409.832,"B",SDESRGNAME,0)) D
. S SDINPUT("RESOURCE GROUP IEN")=SDESRGIEN
Q
FILEEASINFO(ERRORS,SDESRGIEN,SDCONTEXT) ; STORE EAS TRACKING INFO
K SDFDA,SDMSG
S SDFDA(409.832,SDESRGIEN_",",100)=$G(SDCONTEXT("ACHERON AUDIT ID"))
S SDFDA(409.832,SDESRGIEN_",",101)=$G(XWB(2,"RPC"))
S SDFDA(409.832,SDESRGIEN_",",102)=$G(SDCONTEXT("APPID"))
D FILE^DIE("","SDFDA","SDMSG")
I $D(SDMSG) S ERRORS("Error")="Error in adding EAS INFO "_$G(SDMSG("DIERR",1,"TEXT",1))
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDES2ADDRG 3366 printed Oct 28, 2026@01:47:20 Page 2
SDES2ADDRG ;ALB/RN - VISTA SCHEDULING RPCS - ROUTINE ADD/EDIT RESOURCE GROUP; Aug 11,2026
+1 ;;5.3;Scheduling;**952**;Aug 13, 1993;Build 4;RGADDEDIT
+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 QUIT
+10 ;
RGADDEDIT(RETURNJSON,SDCONTEXT,SDINPUT) ;;ADD/EDIT RESOURCE GROUP
+1 NEW RETURN,ELGFIELDSARRAY,ELGRETURN,RETN,ERRORS
+2 DO VALCONTEXT^SDES2VALCONTEXT(.ERRORS,.SDCONTEXT)
+3 IF $DATA(ERRORS)
SET ERRORS("Status")=""
SET ERRORS("RSGroup",1)=""
DO BUILDJSON^SDES2JSON(.RETURNJSON,.ERRORS)
QUIT
+4 IF $GET(SDCONTEXT("USER DUZ"))'=""
NEW DUZ
DO DUZ^XUP(SDCONTEXT("USER DUZ"))
+5 SET (RETURN,ELGFIELDSARRAY)=""
+6 DO VALDINPUT(.ERRORS,.SDINPUT)
+7 IF $DATA(ERRORS)
SET ERRORS("Status")=""
SET ERRORS("RSGroup",1)=""
DO BUILDJSON^SDES2JSON(.RETURNJSON,.ERRORS)
QUIT
+8 DO RGMOD(.ELGFIELDSARRAY,.SDINPUT)
+9 IF $DATA(ELGFIELDSARRAY("Error"))
DO BUILDJSON^SDES2JSON(.RETURNJSON,.ELGFIELDSARRAY)
QUIT
+10 DO FILEEASINFO(.ERRORS,$GET(SDINPUT("RESOURCE GROUP IEN")),.SDCONTEXT)
+11 KILL RETN
+12 DO BUILDGROUP^SDES2GETRESGROUP(.RETN,$GET(SDINPUT("RESOURCE GROUP IEN")))
+13 MERGE RETN=ELGFIELDSARRAY
+14 DO BUILDJSON^SDES2JSON(.RETURNJSON,.RETN)
+15 QUIT
+16 ;
RGMOD(ELGARRAY,SDINPUT) ; Add or Edit Resource Group Name
+1 NEW SDRGIENS,SDRGFDA,SDRGMSG,SDRGM1,SDESRGIEN,SDESRGNAME
+2 SET ELGARRAY("Status")=""
+3 SET SDESRGIEN=$GET(SDINPUT("RESOURCE GROUP IEN"))
+4 SET SDESRGNAME=SDINPUT("RESOURCE GROUP NAME")
+5 SET SDRGM1=""
+6 IF +SDESRGIEN
Begin DoDot:1
+7 SET SDRGIENS=SDESRGIEN_","
+8 ;NAME
SET SDRGFDA(409.832,SDRGIENS,.01)=SDESRGNAME
+9 DO FILE^DIE("","SDRGFDA","SDRGMSG")
+10 IF $DATA(SDRGMSG)
SET ELGARRAY("Error")="Error in updating Resource Group. "_$GET(SDRGMSG("DIERR",1,"TEXT",1))
QUIT
+11 IF '$DATA(SDRGMSG)
SET SDRGM1="Resource Group successfully updated."
End DoDot:1
+12 IF '+SDESRGIEN
Begin DoDot:1
+13 SET SDRGIENS="+1,"
+14 KILL SDESRGIEN
+15 ;NAME
SET SDRGFDA(409.832,SDRGIENS,.01)=SDESRGNAME
+16 DO UPDATE^DIE("","SDRGFDA","SDRGIENS","SDRGMSG")
+17 IF $DATA(SDRGMSG)
SET ELGARRAY("Error")="Error in adding Resource Group. "_$GET(SDRGMSG("DIERR",1,"TEXT",1))
QUIT
+18 SET SDESRGIEN=+$GET(SDRGIENS(1))
+19 IF '$DATA(SDRGMSG)
SET SDRGM1="Resource Group successfully added."
+20 SET SDESRGIEN=$ORDER(^SDEC(409.832,"B",SDESRGNAME,0))
+21 SET SDINPUT("RESOURCE GROUP IEN")=SDESRGIEN
End DoDot:1
+22 SET ELGARRAY("Status")=$GET(SDRGM1)
+23 QUIT
VALDINPUT(ERRORS,SDINPUT) ;Validate Input Array
+1 NEW SDDA,SDESRGIEN,SDESRGNAME
+2 SET SDESRGIEN=$GET(SDINPUT("RESOURCE GROUP IEN"))
+3 SET SDESRGNAME=$GET(SDINPUT("RESOURCE GROUP NAME"))
+4 ; Invalid Resource Group IEN
+5 IF SDESRGIEN'=""
IF '$DATA(^SDEC(409.832,SDESRGIEN,0))
DO ERRLOG^SDES2JSON(.ERRORS,276)
QUIT
+6 ; Missing Resource Group Name
+7 IF SDESRGNAME=""
DO ERRLOG^SDES2JSON(.ERRORS,275)
QUIT
+8 ; Resource Group Name Length Invalid
+9 IF ($LENGTH($$TRIM^XLFSTR(SDESRGNAME))<3)!($LENGTH($$TRIM^XLFSTR(SDESRGNAME))>30)
DO ERRLOG^SDES2JSON(.ERRORS,310)
+10 IF $DATA(^SDEC(409.832,"B",SDESRGNAME))
SET SDESRGIEN=$ORDER(^SDEC(409.832,"B",SDESRGNAME,0))
Begin DoDot:1
+11 SET SDINPUT("RESOURCE GROUP IEN")=SDESRGIEN
End DoDot:1
+12 QUIT
FILEEASINFO(ERRORS,SDESRGIEN,SDCONTEXT) ; STORE EAS TRACKING INFO
+1 KILL SDFDA,SDMSG
+2 SET SDFDA(409.832,SDESRGIEN_",",100)=$GET(SDCONTEXT("ACHERON AUDIT ID"))
+3 SET SDFDA(409.832,SDESRGIEN_",",101)=$GET(XWB(2,"RPC"))
+4 SET SDFDA(409.832,SDESRGIEN_",",102)=$GET(SDCONTEXT("APPID"))
+5 DO FILE^DIE("","SDFDA","SDMSG")
+6 IF $DATA(SDMSG)
SET ERRORS("Error")="Error in adding EAS INFO "_$GET(SDMSG("DIERR",1,"TEXT",1))
+7 QUIT
+8 ;
