SDEC22 ;ALB/SAT - VISTA SCHEDULING RPCS ;JAN 15, 2016
;;5.3;Scheduling;**627**;Aug 13, 1993;Build 249
;
Q
;
DELAGI(SDECY,SDECIEN,SDECIEN1) ;Deletes entry having Access Group SDECIEN and Access Type SDECIEN1 the SDEC ACCESS GROUP TYPE file
;DELAGI(SDECY,SDECIEN,SDECIEN1) external parameter tag is in SDEC
;INPUT:
; SDECIEN - Access group ID pointer to SDEC ACCESS GROUP file
; SDECIEN1 - Access Type ID pointer to SDEC ACCESS TYPE file
;Return recordset containing error message or "" if no error
;
N SDECI,DIK,DA,SDECIEN2,SDI
S SDECI=0
S SDECY="^TMP(""SDEC"","_$J_")"
K @SDECY
S ^TMP("SDEC",$J,0)="I00020ACCESSGROUPTYPEID^T00030ERRORTEXT"_$C(30)
I '+SDECIEN D ERR(0,"SDEC22: Invalid Access Group ID") Q
I '+SDECIEN1 D ERR(0,"SDEC22: Invalid Access Type ID") Q
S SDI=0 F S SDI=$O(^SDEC(409.824,"B",SDECIEN,SDI)) Q:SDI'>0 D
.S SDECIEN2=$$GET1^DIQ(409.824,SDI_",",.02,"I")
.I SDECIEN2=SDECIEN1 D
..;Delete entry
..S DIK="^SDEC(409.824,"
..S DA=SDI
..D ^DIK
S SDECI=SDECI+1
S ^TMP("SDEC",$J,SDECI)=SDECIEN2_"^"_"-1"_$C(30)_$C(31)
Q
;
ADDAGI(SDECY,SDECIEN,SDECIEN1) ;Add access group item - Adds SDEC ACCESS GROUP TYPE file entry
;ADDAGI(SDECY,SDECIEN,SDECIEN1) external parameter tag is in SDEC
;INPUT:
; SDECIEN Access Group pointer to the SDEC ACCESS GROUP file
; SDECIEN1 Access Type pointer to the SDEC ACCESS TYPE file
;Adds SDEC ACCESS GROUP TYPE file entry having access group SDECIEN and access type SDECIEN1
;RETURN:
; recordset containing added entry number error message or "" if no error
;
N SDECI,SDECIEN2,SDECIENS,SDECMSG,SDECFDA,SDFOUND
S (SDECI,SDFOUND)=0
S SDECY="^TMP(""SDEC"","_$J_")"
K @SDECY
;S ^TMP("SDEC",$J,0)="I00020ACCESSGROUPTYPEID^I00020ERRORID"_$C(30)
S ^TMP("SDEC",$J,0)="I00020ACCESSGROUPTYPEID^T00030ERRORTEXT"_$C(30)
I '+SDECIEN D ERR(0,"SDEC22: Invalid null Access Group ID") Q
I '+SDECIEN1 D ERR(0,"SDEC22: Invalid null Access Type ID") Q
I '$D(^SDEC(409.822,SDECIEN,0)) D ERR(0,"SDEC22: Invalid Access Group ID") Q
I '$D(^SDEC(409.823,SDECIEN1,0)) D ERR(0,"SDEC22: Invalid Access Type ID") Q
S SDI=0 F S SDI=$O(^SDEC(409.824,"B",SDECIEN,SDI)) Q:SDI'>0 D Q:SDFOUND=1
.S SDECIEN2=$$GET1^DIQ(409.824,SDI_",",.02,"I")
.I SDECIEN2=SDECIEN1 S SDFOUND=1 S ^TMP("SDEC",$J,SDECI+1)=+SDECIENS_"^"_$C(30)_$C(31)
Q:SDFOUND=1
S SDECIENS="+1,"
S SDECFDA(409.824,SDECIENS,.01)=SDECIEN ;ACCESS GROUP ID
S SDECFDA(409.824,SDECIENS,.02)=SDECIEN1 ;ACCESS TYPE ID
K SDECIEN
D UPDATE^DIE("","SDECFDA","SDECIEN","SDECMSG")
S SDECI=SDECI+1
S ^TMP("SDEC",$J,SDECI)=+$G(SDECIEN(1))_"^"_$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,"SDEC22 Error")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDEC22 2951 printed Nov 22, 2024@18:00:16 Page 2
SDEC22 ;ALB/SAT - VISTA SCHEDULING RPCS ;JAN 15, 2016
+1 ;;5.3;Scheduling;**627**;Aug 13, 1993;Build 249
+2 ;
+3 QUIT
+4 ;
DELAGI(SDECY,SDECIEN,SDECIEN1) ;Deletes entry having Access Group SDECIEN and Access Type SDECIEN1 the SDEC ACCESS GROUP TYPE file
+1 ;DELAGI(SDECY,SDECIEN,SDECIEN1) external parameter tag is in SDEC
+2 ;INPUT:
+3 ; SDECIEN - Access group ID pointer to SDEC ACCESS GROUP file
+4 ; SDECIEN1 - Access Type ID pointer to SDEC ACCESS TYPE file
+5 ;Return recordset containing error message or "" if no error
+6 ;
+7 NEW SDECI,DIK,DA,SDECIEN2,SDI
+8 SET SDECI=0
+9 SET SDECY="^TMP(""SDEC"","_$JOB_")"
+10 KILL @SDECY
+11 SET ^TMP("SDEC",$JOB,0)="I00020ACCESSGROUPTYPEID^T00030ERRORTEXT"_$CHAR(30)
+12 IF '+SDECIEN
DO ERR(0,"SDEC22: Invalid Access Group ID")
QUIT
+13 IF '+SDECIEN1
DO ERR(0,"SDEC22: Invalid Access Type ID")
QUIT
+14 SET SDI=0
FOR
SET SDI=$ORDER(^SDEC(409.824,"B",SDECIEN,SDI))
if SDI'>0
QUIT
Begin DoDot:1
+15 SET SDECIEN2=$$GET1^DIQ(409.824,SDI_",",.02,"I")
+16 IF SDECIEN2=SDECIEN1
Begin DoDot:2
+17 ;Delete entry
+18 SET DIK="^SDEC(409.824,"
+19 SET DA=SDI
+20 DO ^DIK
End DoDot:2
End DoDot:1
+21 SET SDECI=SDECI+1
+22 SET ^TMP("SDEC",$JOB,SDECI)=SDECIEN2_"^"_"-1"_$CHAR(30)_$CHAR(31)
+23 QUIT
+24 ;
ADDAGI(SDECY,SDECIEN,SDECIEN1) ;Add access group item - Adds SDEC ACCESS GROUP TYPE file entry
+1 ;ADDAGI(SDECY,SDECIEN,SDECIEN1) external parameter tag is in SDEC
+2 ;INPUT:
+3 ; SDECIEN Access Group pointer to the SDEC ACCESS GROUP file
+4 ; SDECIEN1 Access Type pointer to the SDEC ACCESS TYPE file
+5 ;Adds SDEC ACCESS GROUP TYPE file entry having access group SDECIEN and access type SDECIEN1
+6 ;RETURN:
+7 ; recordset containing added entry number error message or "" if no error
+8 ;
+9 NEW SDECI,SDECIEN2,SDECIENS,SDECMSG,SDECFDA,SDFOUND
+10 SET (SDECI,SDFOUND)=0
+11 SET SDECY="^TMP(""SDEC"","_$JOB_")"
+12 KILL @SDECY
+13 ;S ^TMP("SDEC",$J,0)="I00020ACCESSGROUPTYPEID^I00020ERRORID"_$C(30)
+14 SET ^TMP("SDEC",$JOB,0)="I00020ACCESSGROUPTYPEID^T00030ERRORTEXT"_$CHAR(30)
+15 IF '+SDECIEN
DO ERR(0,"SDEC22: Invalid null Access Group ID")
QUIT
+16 IF '+SDECIEN1
DO ERR(0,"SDEC22: Invalid null Access Type ID")
QUIT
+17 IF '$DATA(^SDEC(409.822,SDECIEN,0))
DO ERR(0,"SDEC22: Invalid Access Group ID")
QUIT
+18 IF '$DATA(^SDEC(409.823,SDECIEN1,0))
DO ERR(0,"SDEC22: Invalid Access Type ID")
QUIT
+19 SET SDI=0
FOR
SET SDI=$ORDER(^SDEC(409.824,"B",SDECIEN,SDI))
if SDI'>0
QUIT
Begin DoDot:1
+20 SET SDECIEN2=$$GET1^DIQ(409.824,SDI_",",.02,"I")
+21 IF SDECIEN2=SDECIEN1
SET SDFOUND=1
SET ^TMP("SDEC",$JOB,SDECI+1)=+SDECIENS_"^"_$CHAR(30)_$CHAR(31)
End DoDot:1
if SDFOUND=1
QUIT
+22 if SDFOUND=1
QUIT
+23 SET SDECIENS="+1,"
+24 ;ACCESS GROUP ID
SET SDECFDA(409.824,SDECIENS,.01)=SDECIEN
+25 ;ACCESS TYPE ID
SET SDECFDA(409.824,SDECIENS,.02)=SDECIEN1
+26 KILL SDECIEN
+27 DO UPDATE^DIE("","SDECFDA","SDECIEN","SDECMSG")
+28 SET SDECI=SDECI+1
+29 SET ^TMP("SDEC",$JOB,SDECI)=+$GET(SDECIEN(1))_"^"_$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)
+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,"SDEC22 Error")
+5 QUIT
