SDEC19.m

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 ---SDEC19   2726     printed  Feb 19, 2025@00:16:38                                                                                                                                                                                                      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