- 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 Feb 19, 2025@00:22:05 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 ;