SDES2ADDDELCGI ;ALB/JDJ - ADD/DELETE CLINIC GROUP ITEM; JUL 15, 2026
;;5.3;Scheduling;**951**;Aug 13, 1993;Build 5
;;Per VHA Directive 6402, this routine should not be modified
;
; Reference to DUZ^XUP is supported by IA #7487
;
Q
;
;
; RPC: SDES2 ADD CLNGRP ITEM/SDES2 DELETE CLNGRP ITEM
;
; SDCONTEXT INPUT
;
;S SDCONTEXT("ACHERON AUDIT ID") = Up to 40 Character unique ID number. Ex: 11d9dcc6-c6a2-4785-8031-8261576fca37
;S SDCONTEXT("APPID") = Up to 40 Character unique ID number. Ex: 11d9dcc6-c6a2-4785-8031-8261576fca37
;S SDCONTEXT("USER DUZ") = The DUZ of the user taking action in the calling application.
;S SDCONTEXT("USER SECID") = The SECID of the user taking action in the calling application.
;S SDCONTEXT("PATIENT DFN") = The DFN/IEN of the target patient from the calling application.
;S SDCONTEXT("PATIENT ICN") = The ICN of the target patient from the calling application.
;
;
;S SDINPUT("RESOURCE GROUP IEN")=[Required] - Resource Group Id - Pointer to SDEC RESOURCE GROUP file 409.832
;S SDINPUT("RESOURCE")=[Required] - Pointer to SDEC RESOURCE file 409.831
;
DELGROUP(RETURNJSON,SDCONTEXT,SDINPUT) ;Deletes entry SDESIEN1 from entry SDESIEN in the SDEC RESOURCE GROUP file
N RETURN,HASFIELDS,ELGFIELDSARRAY,ELGRETURN,RETN,ERRORS
; validate context
D VALCONTEXT^SDES2VALCONTEXT(.ERRORS,.SDCONTEXT)
I $D(ERRORS) S ERRORS("Status",1)="",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,HASFIELDS)=""
;
D VALINPUT(.ERRORS,.SDINPUT,1)
I $D(ERRORS) S ERRORS("Status",1)="",ERRORS("RSGroup",1)="" M RETURN=ERRORS D BUILDJSON^SDESBUILDJSON(.RETURNJSON,.RETURN) Q
;
D RGIDEL(.ELGFIELDSARRAY,SDINPUT("RESOURCE GROUP IEN"),SDINPUT("RESOURCE"))
M RETURN=ELGFIELDSARRAY
D FILEEASINFO(.ERRORS,SDINPUT("RESOURCE GROUP IEN"),.SDCONTEXT)
;FULL OBJ RETURN
D BUILDGROUP^SDES2GETRESGROUP(.RETN,SDINPUT("RESOURCE GROUP IEN"))
M RETURN=RETN
;
D BUILDJSON^SDESBUILDJSON(.RETURNJSON,.RETURN)
Q
;
ADDRGI(RETURNJSON,SDCONTEXT,SDINPUT) ;Adds entry SDESRSIEN to SDESRGIEN in the SDEC RESOURCE GROUP file
;
N RETURN,HASFIELDS,ELGFIELDSARRAY,ELGRETURN,RETN,ERRORS
; validate context
D VALCONTEXT^SDES2VALCONTEXT(.ERRORS,.SDCONTEXT)
I $D(ERRORS) S ERRORS("Status",1)="",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,HASFIELDS)=""
;
D VALINPUT(.ERRORS,.SDINPUT,0)
I $D(ERRORS) S ERRORS("Status",1)="",ERRORS("RSGroup",1)="" D BUILDJSON^SDES2JSON(.RETURNJSON,.ERRORS) Q
I '$D(ERRORS) D RGIADD(.RETN,SDINPUT("RESOURCE GROUP IEN"),SDINPUT("RESOURCE"),.SDCONTEXT)
M RETURN=RETN
;FULL OBJ RETURN
K RETN
D BUILDGROUP^SDES2GETRESGROUP(.RETN,SDINPUT("RESOURCE GROUP IEN"))
M RETURN=RETN
;
D BUILDJSON^SDESBUILDJSON(.RETURNJSON,.RETURN)
Q
;
RGIDEL(ELGARRAY,SDESRGIEN,SDESRSIEN) ; Delete Resource ID from Resource Group File
N SDFDA,SDDA,SDMSG,X,Y
S SDDA=$O(^SDEC(409.832,SDESRGIEN,1,"B",SDESRSIEN,0))
; Delete entry SDECIEN1
S SDFDA(409.8321,SDDA_","_SDESRGIEN_",",.01)="@"
D FILE^DIE(,"SDFDA","SDMSG")
I $D(SDMSG) S ELGARRAY("Status")="0^Error in deleting Resource Item. "_$G(SDMSG("DIERR",1,"TEXT",1))
I '$D(SDMSG) S ELGARRAY("Status")="1^Resource Item is successfully deleted."
Q
;
RGIADD(ELGARRAY,SDESRGIEN,SDESRSIEN,SDCONTEXT) ; Add Resource ID to Resource Group File
N SDFDA,SDMSG,SDESIENS
;
S SDESIENS="+1,"_SDESRGIEN_","
S SDFDA(409.8321,SDESIENS,.01)=SDESRSIEN ;RESOURCEID
D UPDATE^DIE("","SDFDA",,"SDMSG")
I $D(SDMSG) S ELGARRAY("Status")="0^Error in adding Resource Item. "_$G(SDMSG("DIERR",1,"TEXT",1))
I '$D(SDMSG) S ELGARRAY("Status")="1^Resource Item is successfully added."
;FILE EASTRACKING INFO
D FILEEASINFO(.ERRORS,SDINPUT("RESOURCE GROUP IEN"),.SDCONTEXT)
;
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("Status")="0^Error in adding EAS INFO "_$G(SDMSG("DIERR",1,"TEXT",1))
Q
VALINPUT(ERRORS,SDINPUT,SDFLAG) ;Validate Parameter Array
N SDDA,SDESRGIEN,SDESRSIEN
S SDESRGIEN=$G(SDINPUT("RESOURCE GROUP IEN"))
S SDESRSIEN=$G(SDINPUT("RESOURCE"))
; Missing Resource Group IEN
I SDESRGIEN="" D ERRLOG^SDESJSON(.ERRORS,312) Q
; Invalid Resource Group
I SDESRGIEN'="" I '$D(^SDEC(409.832,SDESRGIEN,0)) D ERRLOG^SDESJSON(.ERRORS,276) Q
; Missing Resource Item IEN
I SDESRSIEN="" D ERRLOG^SDESJSON(.ERRORS,69) Q
; Invalid Resource Item
I SDESRSIEN'="" I '$D(^SDEC(409.831,SDESRSIEN,0)) D ERRLOG^SDESJSON(.ERRORS,70) Q
I +SDFLAG=1 D
.S SDDA=$O(^SDEC(409.832,SDESRGIEN,1,"B",SDESRSIEN,0))
.I $G(SDDA)="" D ERRLOG^SDESJSON(.ERRORS,313) Q
.I '$D(^SDEC(409.832,SDESRGIEN,1,SDDA,0)) D ERRLOG^SDESJSON(.ERRORS,313) Q
I +SDFLAG=0 D
.I $D(^SDEC(409.832,SDESRGIEN,1,"B",SDESRSIEN)) D ERRLOG^SDESJSON(.ERRORS,311) Q
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDES2ADDDELCGI 5234 printed Sep 17, 2026@21:39:13 Page 2
SDES2ADDDELCGI ;ALB/JDJ - ADD/DELETE CLINIC GROUP ITEM; JUL 15, 2026
+1 ;;5.3;Scheduling;**951**;Aug 13, 1993;Build 5
+2 ;;Per VHA Directive 6402, this routine should not be modified
+3 ;
+4 ; Reference to DUZ^XUP is supported by IA #7487
+5 ;
+6 QUIT
+7 ;
+8 ;
+9 ; RPC: SDES2 ADD CLNGRP ITEM/SDES2 DELETE CLNGRP ITEM
+10 ;
+11 ; SDCONTEXT INPUT
+12 ;
+13 ;S SDCONTEXT("ACHERON AUDIT ID") = Up to 40 Character unique ID number. Ex: 11d9dcc6-c6a2-4785-8031-8261576fca37
+14 ;S SDCONTEXT("APPID") = Up to 40 Character unique ID number. Ex: 11d9dcc6-c6a2-4785-8031-8261576fca37
+15 ;S SDCONTEXT("USER DUZ") = The DUZ of the user taking action in the calling application.
+16 ;S SDCONTEXT("USER SECID") = The SECID of the user taking action in the calling application.
+17 ;S SDCONTEXT("PATIENT DFN") = The DFN/IEN of the target patient from the calling application.
+18 ;S SDCONTEXT("PATIENT ICN") = The ICN of the target patient from the calling application.
+19 ;
+20 ;
+21 ;S SDINPUT("RESOURCE GROUP IEN")=[Required] - Resource Group Id - Pointer to SDEC RESOURCE GROUP file 409.832
+22 ;S SDINPUT("RESOURCE")=[Required] - Pointer to SDEC RESOURCE file 409.831
+23 ;
DELGROUP(RETURNJSON,SDCONTEXT,SDINPUT) ;Deletes entry SDESIEN1 from entry SDESIEN in the SDEC RESOURCE GROUP file
+1 NEW RETURN,HASFIELDS,ELGFIELDSARRAY,ELGRETURN,RETN,ERRORS
+2 ; validate context
+3 DO VALCONTEXT^SDES2VALCONTEXT(.ERRORS,.SDCONTEXT)
+4 IF $DATA(ERRORS)
SET ERRORS("Status",1)=""
SET ERRORS("RSGroup",1)=""
DO BUILDJSON^SDES2JSON(.RETURNJSON,.ERRORS)
QUIT
+5 IF $GET(SDCONTEXT("USER DUZ"))'=""
NEW DUZ
DO DUZ^XUP(SDCONTEXT("USER DUZ"))
+6 SET (RETURN,ELGFIELDSARRAY,HASFIELDS)=""
+7 ;
+8 DO VALINPUT(.ERRORS,.SDINPUT,1)
+9 IF $DATA(ERRORS)
SET ERRORS("Status",1)=""
SET ERRORS("RSGroup",1)=""
MERGE RETURN=ERRORS
DO BUILDJSON^SDESBUILDJSON(.RETURNJSON,.RETURN)
QUIT
+10 ;
+11 DO RGIDEL(.ELGFIELDSARRAY,SDINPUT("RESOURCE GROUP IEN"),SDINPUT("RESOURCE"))
+12 MERGE RETURN=ELGFIELDSARRAY
+13 DO FILEEASINFO(.ERRORS,SDINPUT("RESOURCE GROUP IEN"),.SDCONTEXT)
+14 ;FULL OBJ RETURN
+15 DO BUILDGROUP^SDES2GETRESGROUP(.RETN,SDINPUT("RESOURCE GROUP IEN"))
+16 MERGE RETURN=RETN
+17 ;
+18 DO BUILDJSON^SDESBUILDJSON(.RETURNJSON,.RETURN)
+19 QUIT
+20 ;
ADDRGI(RETURNJSON,SDCONTEXT,SDINPUT) ;Adds entry SDESRSIEN to SDESRGIEN in the SDEC RESOURCE GROUP file
+1 ;
+2 NEW RETURN,HASFIELDS,ELGFIELDSARRAY,ELGRETURN,RETN,ERRORS
+3 ; validate context
+4 DO VALCONTEXT^SDES2VALCONTEXT(.ERRORS,.SDCONTEXT)
+5 IF $DATA(ERRORS)
SET ERRORS("Status",1)=""
SET ERRORS("RSGroup",1)=""
DO BUILDJSON^SDES2JSON(.RETURNJSON,.ERRORS)
QUIT
+6 IF $GET(SDCONTEXT("USER DUZ"))'=""
NEW DUZ
DO DUZ^XUP(SDCONTEXT("USER DUZ"))
+7 SET (RETURN,ELGFIELDSARRAY,HASFIELDS)=""
+8 ;
+9 DO VALINPUT(.ERRORS,.SDINPUT,0)
+10 IF $DATA(ERRORS)
SET ERRORS("Status",1)=""
SET ERRORS("RSGroup",1)=""
DO BUILDJSON^SDES2JSON(.RETURNJSON,.ERRORS)
QUIT
+11 IF '$DATA(ERRORS)
DO RGIADD(.RETN,SDINPUT("RESOURCE GROUP IEN"),SDINPUT("RESOURCE"),.SDCONTEXT)
+12 MERGE RETURN=RETN
+13 ;FULL OBJ RETURN
+14 KILL RETN
+15 DO BUILDGROUP^SDES2GETRESGROUP(.RETN,SDINPUT("RESOURCE GROUP IEN"))
+16 MERGE RETURN=RETN
+17 ;
+18 DO BUILDJSON^SDESBUILDJSON(.RETURNJSON,.RETURN)
+19 QUIT
+20 ;
RGIDEL(ELGARRAY,SDESRGIEN,SDESRSIEN) ; Delete Resource ID from Resource Group File
+1 NEW SDFDA,SDDA,SDMSG,X,Y
+2 SET SDDA=$ORDER(^SDEC(409.832,SDESRGIEN,1,"B",SDESRSIEN,0))
+3 ; Delete entry SDECIEN1
+4 SET SDFDA(409.8321,SDDA_","_SDESRGIEN_",",.01)="@"
+5 DO FILE^DIE(,"SDFDA","SDMSG")
+6 IF $DATA(SDMSG)
SET ELGARRAY("Status")="0^Error in deleting Resource Item. "_$GET(SDMSG("DIERR",1,"TEXT",1))
+7 IF '$DATA(SDMSG)
SET ELGARRAY("Status")="1^Resource Item is successfully deleted."
+8 QUIT
+9 ;
RGIADD(ELGARRAY,SDESRGIEN,SDESRSIEN,SDCONTEXT) ; Add Resource ID to Resource Group File
+1 NEW SDFDA,SDMSG,SDESIENS
+2 ;
+3 SET SDESIENS="+1,"_SDESRGIEN_","
+4 ;RESOURCEID
SET SDFDA(409.8321,SDESIENS,.01)=SDESRSIEN
+5 DO UPDATE^DIE("","SDFDA",,"SDMSG")
+6 IF $DATA(SDMSG)
SET ELGARRAY("Status")="0^Error in adding Resource Item. "_$GET(SDMSG("DIERR",1,"TEXT",1))
+7 IF '$DATA(SDMSG)
SET ELGARRAY("Status")="1^Resource Item is successfully added."
+8 ;FILE EASTRACKING INFO
+9 DO FILEEASINFO(.ERRORS,SDINPUT("RESOURCE GROUP IEN"),.SDCONTEXT)
+10 ;
+11 QUIT
+12 ;
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("Status")="0^Error in adding EAS INFO "_$GET(SDMSG("DIERR",1,"TEXT",1))
+7 QUIT
VALINPUT(ERRORS,SDINPUT,SDFLAG) ;Validate Parameter Array
+1 NEW SDDA,SDESRGIEN,SDESRSIEN
+2 SET SDESRGIEN=$GET(SDINPUT("RESOURCE GROUP IEN"))
+3 SET SDESRSIEN=$GET(SDINPUT("RESOURCE"))
+4 ; Missing Resource Group IEN
+5 IF SDESRGIEN=""
DO ERRLOG^SDESJSON(.ERRORS,312)
QUIT
+6 ; Invalid Resource Group
+7 IF SDESRGIEN'=""
IF '$DATA(^SDEC(409.832,SDESRGIEN,0))
DO ERRLOG^SDESJSON(.ERRORS,276)
QUIT
+8 ; Missing Resource Item IEN
+9 IF SDESRSIEN=""
DO ERRLOG^SDESJSON(.ERRORS,69)
QUIT
+10 ; Invalid Resource Item
+11 IF SDESRSIEN'=""
IF '$DATA(^SDEC(409.831,SDESRSIEN,0))
DO ERRLOG^SDESJSON(.ERRORS,70)
QUIT
+12 IF +SDFLAG=1
Begin DoDot:1
+13 SET SDDA=$ORDER(^SDEC(409.832,SDESRGIEN,1,"B",SDESRSIEN,0))
+14 IF $GET(SDDA)=""
DO ERRLOG^SDESJSON(.ERRORS,313)
QUIT
+15 IF '$DATA(^SDEC(409.832,SDESRGIEN,1,SDDA,0))
DO ERRLOG^SDESJSON(.ERRORS,313)
QUIT
End DoDot:1
+16 IF +SDFLAG=0
Begin DoDot:1
+17 IF $DATA(^SDEC(409.832,SDESRGIEN,1,"B",SDESRSIEN))
DO ERRLOG^SDESJSON(.ERRORS,311)
QUIT
End DoDot:1
+18 QUIT
+19 ;
