SDEC21 ;ALB/SAT - VISTA SCHEDULING RPCS ;JAN 15, 2016
;;5.3;Scheduling;**627**;Aug 13, 1993;Build 249
;
Q
;
ADDACCG(SDECY,SDECVAL) ;ADD/EDIT ACCESS GROUP
;ADDACCG(SDECY,SDECVAL) external parameter tag is in SDEC
;Add a new SDEC ACCESS GROUP entry
;INPUT:
; SDECVAL - Access Group IEN and Name separated by pipe | <IEN>|<name>
; Access Group IEN - (integer) pointer to the SDEC ACCESS GROUP file
; a new entry will be added if null
; Access Group name - (text) value to be put into the NAME field of
; the SDEC ACCESS GROUP FILE
;RETURN:
; Access Group IEN
;
N SDECIENS,SDECFDA,SDECMSG,SDECIEN,SDEC,SDECNAM
S SDECY="^TMP(""SDEC"","_$J_")"
K @SDECY
S ^TMP("SDEC",$J,0)="I00020ACCESSGROUPID^T00030ERRORTEXT"_$C(30)
I SDECVAL="" D ERR(0,"SDEC21: Invalid null input Parameter") Q
S SDECIEN=$P(SDECVAL,"|")
S SDECNAM=$P(SDECVAL,"|",2)
I +SDECIEN D
. S SDEC="EDIT"
. S SDECIENS=SDECIEN_","
E D
. S SDEC="ADD"
. S SDECIENS="+1,"
;
S SDECNAM=$P(SDECVAL,"|",2)
I SDECNAM="" D ERR(0,"SDEC14: Invalid null Access Type name.") Q
;
;Prevent adding entry with duplicate name
I $D(^SDEC(409.822,"B",SDECNAM)),$O(^SDEC(409.822,"B",SDECNAM,0))'=SDECIEN D Q
. D ERR(0,"SDEC21: Cannot have two Access Groups with the same name.")
. Q
;
S SDECFDA(409.822,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
;
DELAG(SDECY,SDECGRP) ;Deletes entry having IEN SDECGRP from SDEC ACCESS GROUP file
;DELAG(SDECY,SDECGRP) external parameter tag is in SDEC
;Also deletes all entries in SDEC ACCESS GROUP TYPE that point to this group
;Return recordset containing error message or "" if no error
;Called by SDEC DELETE ACCESS GROUP
;
N SDECI,DIK,DA,SDECIEN,SDECIEN1
S SDECI=0
S SDECY="^TMP(""SDEC"","_$J_")"
K @SDECY
S ^TMP("SDEC",$J,0)="I00020ACCESSGROUPID^T00030ERRORTEXT"_$C(30)
S SDECIEN=SDECGRP
I '+SDECIEN D ERR(SDECI,SDECIEN,70) Q
I '$D(^SDEC(409.822,SDECIEN,0)) D ERR(0,"SDEC14: Invalid Access Group ID name.") Q
;
;Delete SDECACCESS GROUP TYPE entries
;
S SDECIEN1=0 F S SDECIEN1=$O(^SDEC(409.824,"B",SDECIEN,SDECIEN1)) Q:'SDECIEN1 D
. S DIK="^SDEC(409.824,"
. S DA=SDECIEN1
. D ^DIK
. Q
;
;Delete entry SDECIEN in SDEC ACCESS GROUP
S DIK="^SDEC(409.822,"
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,31)
Q
;
ERROR ;
D ^%ZTER
I '+$G(SDECI) N SDECI S SDECI=999999
S SDECI=SDECI+1
D ERR(0,"SDEC21 Error")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDEC21 2919 printed Apr 09, 2024@21:58:48 Page 2
SDEC21 ;ALB/SAT - VISTA SCHEDULING RPCS ;JAN 15, 2016
+1 ;;5.3;Scheduling;**627**;Aug 13, 1993;Build 249
+2 ;
+3 QUIT
+4 ;
ADDACCG(SDECY,SDECVAL) ;ADD/EDIT ACCESS GROUP
+1 ;ADDACCG(SDECY,SDECVAL) external parameter tag is in SDEC
+2 ;Add a new SDEC ACCESS GROUP entry
+3 ;INPUT:
+4 ; SDECVAL - Access Group IEN and Name separated by pipe | <IEN>|<name>
+5 ; Access Group IEN - (integer) pointer to the SDEC ACCESS GROUP file
+6 ; a new entry will be added if null
+7 ; Access Group name - (text) value to be put into the NAME field of
+8 ; the SDEC ACCESS GROUP FILE
+9 ;RETURN:
+10 ; Access Group IEN
+11 ;
+12 NEW SDECIENS,SDECFDA,SDECMSG,SDECIEN,SDEC,SDECNAM
+13 SET SDECY="^TMP(""SDEC"","_$JOB_")"
+14 KILL @SDECY
+15 SET ^TMP("SDEC",$JOB,0)="I00020ACCESSGROUPID^T00030ERRORTEXT"_$CHAR(30)
+16 IF SDECVAL=""
DO ERR(0,"SDEC21: Invalid null input Parameter")
QUIT
+17 SET SDECIEN=$PIECE(SDECVAL,"|")
+18 SET SDECNAM=$PIECE(SDECVAL,"|",2)
+19 IF +SDECIEN
Begin DoDot:1
+20 SET SDEC="EDIT"
+21 SET SDECIENS=SDECIEN_","
End DoDot:1
+22 IF '$TEST
Begin DoDot:1
+23 SET SDEC="ADD"
+24 SET SDECIENS="+1,"
End DoDot:1
+25 ;
+26 SET SDECNAM=$PIECE(SDECVAL,"|",2)
+27 IF SDECNAM=""
DO ERR(0,"SDEC14: Invalid null Access Type name.")
QUIT
+28 ;
+29 ;Prevent adding entry with duplicate name
+30 IF $DATA(^SDEC(409.822,"B",SDECNAM))
IF $ORDER(^SDEC(409.822,"B",SDECNAM,0))'=SDECIEN
Begin DoDot:1
+31 DO ERR(0,"SDEC21: Cannot have two Access Groups with the same name.")
+32 QUIT
End DoDot:1
QUIT
+33 ;
+34 ;NAME
SET SDECFDA(409.822,SDECIENS,.01)=SDECNAM
+35 IF SDEC="ADD"
Begin DoDot:1
+36 KILL SDECIEN
+37 DO UPDATE^DIE("","SDECFDA","SDECIEN","SDECMSG")
+38 SET SDECIEN=+$GET(SDECIEN(1))
End DoDot:1
+39 IF '$TEST
Begin DoDot:1
+40 DO FILE^DIE("","SDECFDA","SDECMSG")
End DoDot:1
+41 SET ^TMP("SDEC",$JOB,1)=$GET(SDECIEN)_"^"_$CHAR(30)_$CHAR(31)
+42 QUIT
+43 ;
DELAG(SDECY,SDECGRP) ;Deletes entry having IEN SDECGRP from SDEC ACCESS GROUP file
+1 ;DELAG(SDECY,SDECGRP) external parameter tag is in SDEC
+2 ;Also deletes all entries in SDEC ACCESS GROUP TYPE that point to this group
+3 ;Return recordset containing error message or "" if no error
+4 ;Called by SDEC DELETE ACCESS GROUP
+5 ;
+6 NEW SDECI,DIK,DA,SDECIEN,SDECIEN1
+7 SET SDECI=0
+8 SET SDECY="^TMP(""SDEC"","_$JOB_")"
+9 KILL @SDECY
+10 SET ^TMP("SDEC",$JOB,0)="I00020ACCESSGROUPID^T00030ERRORTEXT"_$CHAR(30)
+11 SET SDECIEN=SDECGRP
+12 IF '+SDECIEN
DO ERR(SDECI,SDECIEN,70)
QUIT
+13 IF '$DATA(^SDEC(409.822,SDECIEN,0))
DO ERR(0,"SDEC14: Invalid Access Group ID name.")
QUIT
+14 ;
+15 ;Delete SDECACCESS GROUP TYPE entries
+16 ;
+17 SET SDECIEN1=0
FOR
SET SDECIEN1=$ORDER(^SDEC(409.824,"B",SDECIEN,SDECIEN1))
if 'SDECIEN1
QUIT
Begin DoDot:1
+18 SET DIK="^SDEC(409.824,"
+19 SET DA=SDECIEN1
+20 DO ^DIK
+21 QUIT
End DoDot:1
+22 ;
+23 ;Delete entry SDECIEN in SDEC ACCESS GROUP
+24 SET DIK="^SDEC(409.822,"
+25 SET DA=SDECIEN
+26 DO ^DIK
+27 ;
+28 SET SDECI=SDECI+1
+29 SET ^TMP("SDEC",$JOB,SDECI)=SDECIEN_"^"_""_$CHAR(30)_$CHAR(31)
+30 QUIT
+31 ;
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,31)
+4 QUIT
+5 ;
ERROR ;
+1 DO ^%ZTER
+2 IF '+$GET(SDECI)
NEW SDECI
SET SDECI=999999
+3 SET SDECI=SDECI+1
+4 DO ERR(0,"SDEC21 Error")
+5 QUIT
