SDEC19 ;ALB/SAT - VISTA SCHEDULING RPCS ;JAN 15, 2016
;;5.3;Scheduling;**627**;Aug 13, 1993;Build 249
;
Q
;
ADDRG(SDECY,SDECVAL) ;ADD/EDIT RESOURCE GROUP
;ADDRG(SDECY,SDECVAL) external parameter tag is in SDEC
;Add a new SDEC RESOURCE GROUP entry
;INPUT:
; SDECVAL - IEN | NAME
; IEN = (integer) Resource Group ID - Pointer to the SDEC RESOURCE GROUP file
; NAME = (text) Value to be put into the NAME field of the SDEC RESOURCE GROUP file
;RETURN:
; IEN of added/edited entry or 0 if error
;
N SDECIENS,SDECFDA,SDECMSG,SDECIEN,SDEC,SDECNAM
S SDECY="^TMP(""SDEC"","_$J_")"
K @SDECY
S ^TMP("SDEC",$J,0)="I00020RESOURCEGROUPID^T00030ERRORTEXT"_$C(30)
I SDECVAL="" D ERR(0,"SDEC19: Invalid null input Parameter") Q
S SDECIEN=$P(SDECVAL,"|")
I SDECIEN'="" I '$D(^SDEC(409.832,SDECIEN,0)) D ERR(0,"SDEC19: Invalid Resource Group ID.")
S SDECNAM=$P(SDECVAL,"|",2)
I +SDECIEN D
. S SDEC="EDIT"
. S SDECIENS=SDECIEN_","
E D
. S SDEC="ADD"
. S SDECIENS="+1,"
I SDEC="ADD",SDECNAM="" D ERR(0,"SDEC16: Resource Group ID is required.") ;name required for ADD
;
;Prevent adding entry with duplicate name
I SDECNAM'="",$D(^SDEC(409.832,"B",SDECNAM)),$O(^SDEC(409.832,"B",SDECNAM,0))'=SDECIEN D Q
. D ERR(0,"SDEC19: Cannot have two Resource Groups with the same name.")
. Q
;
S SDECFDA(409.832,SDECIENS,.01)=SDECNAM ;NAME
I SDEC="ADD" D
. K SDECIEN
. D UPDATE^DIE("","SDECFDA","SDECIEN","SDECMSG")
. S SDECIEN=+$G(SDECIEN(1))
E D
. D FILE^DIE("","SDECFDA","SDECMSG")
S ^TMP("SDEC",$J,1)=$G(SDECIEN)_"^"_$C(30)_$C(31)
Q
;
DELRESGP(SDECY,SDECGRP) ;Deletes entry name SDECGRP from SDEC RESOURCE GROUP file
;DELRESGP(SDECY,SDECGRP) external parameter tag is in SDEC
;Return recordset containing error message or "" if no error
;
N SDECI,DIK,DA,SDECIEN
S SDECI=0
S SDECY="^TMP(""SDEC"","_$J_")"
K @SDECY
S ^TMP("SDEC",$J,0)="I00020RESOURCEGROUPID^T00030ERRORTEXT"_$C(30)
I SDECGRP="" D ERR(0,"DELRG~SDEC19: Invalid null Resource Group Name") Q
S SDECIEN=$O(^SDEC(409.832,"B",SDECGRP,0))
I '+SDECIEN D ERR(0,"DELRG~SDEC19: Invalid Resource Group Name") Q
I '$D(^SDEC(409.832,SDECIEN,0)) D ERR(0,"DELRG~SDEC19: Invalid Resource Group IEN") Q
;Delete entry SDECIEN
S DIK="^SDEC(409.832,"
S DA=SDECIEN
D ^DIK
;
S SDECI=SDECI+1
S ^TMP("SDEC",$J,SDECI)=SDECIEN_"^"_$C(30)_$C(31)
Q
;
ERR(SDECERID,ERRTXT) ;Error processing
S:'+$G(SDECI) SDECI=999999
S SDECI=SDECI+1
S ^TMP("SDEC",$J,SDECI)=SDECERID_"^"_ERRTXT_$C(30)
S SDECI=SDECI+1
S ^TMP("SDEC",$J,SDECI)=$C(31)
Q
;
ERROR ;
D ^%ZTER
I '+$G(SDECI) N SDECI S SDECI=999999
S SDECI=SDECI+1
D ERR(0,"SDEC19 Error")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDEC19 2726 printed Dec 13, 2024@02:50:12 Page 2
SDEC19 ;ALB/SAT - VISTA SCHEDULING RPCS ;JAN 15, 2016
+1 ;;5.3;Scheduling;**627**;Aug 13, 1993;Build 249
+2 ;
+3 QUIT
+4 ;
ADDRG(SDECY,SDECVAL) ;ADD/EDIT RESOURCE GROUP
+1 ;ADDRG(SDECY,SDECVAL) external parameter tag is in SDEC
+2 ;Add a new SDEC RESOURCE GROUP entry
+3 ;INPUT:
+4 ; SDECVAL - IEN | NAME
+5 ; IEN = (integer) Resource Group ID - Pointer to the SDEC RESOURCE GROUP file
+6 ; NAME = (text) Value to be put into the NAME field of the SDEC RESOURCE GROUP file
+7 ;RETURN:
+8 ; IEN of added/edited entry or 0 if error
+9 ;
+10 NEW SDECIENS,SDECFDA,SDECMSG,SDECIEN,SDEC,SDECNAM
+11 SET SDECY="^TMP(""SDEC"","_$JOB_")"
+12 KILL @SDECY
+13 SET ^TMP("SDEC",$JOB,0)="I00020RESOURCEGROUPID^T00030ERRORTEXT"_$CHAR(30)
+14 IF SDECVAL=""
DO ERR(0,"SDEC19: Invalid null input Parameter")
QUIT
+15 SET SDECIEN=$PIECE(SDECVAL,"|")
+16 IF SDECIEN'=""
IF '$DATA(^SDEC(409.832,SDECIEN,0))
DO ERR(0,"SDEC19: Invalid Resource Group ID.")
+17 SET SDECNAM=$PIECE(SDECVAL,"|",2)
+18 IF +SDECIEN
Begin DoDot:1
+19 SET SDEC="EDIT"
+20 SET SDECIENS=SDECIEN_","
End DoDot:1
+21 IF '$TEST
Begin DoDot:1
+22 SET SDEC="ADD"
+23 SET SDECIENS="+1,"
End DoDot:1
+24 ;name required for ADD
IF SDEC="ADD"
IF SDECNAM=""
DO ERR(0,"SDEC16: Resource Group ID is required.")
+25 ;
+26 ;Prevent adding entry with duplicate name
+27 IF SDECNAM'=""
IF $DATA(^SDEC(409.832,"B",SDECNAM))
IF $ORDER(^SDEC(409.832,"B",SDECNAM,0))'=SDECIEN
Begin DoDot:1
+28 DO ERR(0,"SDEC19: Cannot have two Resource Groups with the same name.")
+29 QUIT
End DoDot:1
QUIT
+30 ;
+31 ;NAME
SET SDECFDA(409.832,SDECIENS,.01)=SDECNAM
+32 IF SDEC="ADD"
Begin DoDot:1
+33 KILL SDECIEN
+34 DO UPDATE^DIE("","SDECFDA","SDECIEN","SDECMSG")
+35 SET SDECIEN=+$GET(SDECIEN(1))
End DoDot:1
+36 IF '$TEST
Begin DoDot:1
+37 DO FILE^DIE("","SDECFDA","SDECMSG")
End DoDot:1
+38 SET ^TMP("SDEC",$JOB,1)=$GET(SDECIEN)_"^"_$CHAR(30)_$CHAR(31)
+39 QUIT
+40 ;
DELRESGP(SDECY,SDECGRP) ;Deletes entry name SDECGRP from SDEC RESOURCE GROUP file
+1 ;DELRESGP(SDECY,SDECGRP) external parameter tag is in SDEC
+2 ;Return recordset containing error message or "" if no error
+3 ;
+4 NEW SDECI,DIK,DA,SDECIEN
+5 SET SDECI=0
+6 SET SDECY="^TMP(""SDEC"","_$JOB_")"
+7 KILL @SDECY
+8 SET ^TMP("SDEC",$JOB,0)="I00020RESOURCEGROUPID^T00030ERRORTEXT"_$CHAR(30)
+9 IF SDECGRP=""
DO ERR(0,"DELRG~SDEC19: Invalid null Resource Group Name")
QUIT
+10 SET SDECIEN=$ORDER(^SDEC(409.832,"B",SDECGRP,0))
+11 IF '+SDECIEN
DO ERR(0,"DELRG~SDEC19: Invalid Resource Group Name")
QUIT
+12 IF '$DATA(^SDEC(409.832,SDECIEN,0))
DO ERR(0,"DELRG~SDEC19: Invalid Resource Group IEN")
QUIT
+13 ;Delete entry SDECIEN
+14 SET DIK="^SDEC(409.832,"
+15 SET DA=SDECIEN
+16 DO ^DIK
+17 ;
+18 SET SDECI=SDECI+1
+19 SET ^TMP("SDEC",$JOB,SDECI)=SDECIEN_"^"_$CHAR(30)_$CHAR(31)
+20 QUIT
+21 ;
ERR(SDECERID,ERRTXT) ;Error processing
+1 if '+$GET(SDECI)
SET SDECI=999999
+2 SET SDECI=SDECI+1
+3 SET ^TMP("SDEC",$JOB,SDECI)=SDECERID_"^"_ERRTXT_$CHAR(30)
+4 SET SDECI=SDECI+1
+5 SET ^TMP("SDEC",$JOB,SDECI)=$CHAR(31)
+6 QUIT
+7 ;
ERROR ;
+1 DO ^%ZTER
+2 IF '+$GET(SDECI)
NEW SDECI
SET SDECI=999999
+3 SET SDECI=SDECI+1
+4 DO ERR(0,"SDEC19 Error")
+5 QUIT
