BSDX19 ; IHS/OIT/HMW/MSC/SAT - WINDOWS SCHEDULING RPCS ;
;;3.0;IHS WINDOWS SCHEDULING;;DEC 09, 2010
;
;
ADDRGD(BSDXY,BSDXVAL) ;EP
;Entry point for debugging
;
;D DEBUG^%Serenji("ADDRG^BSDX19(.BSDXY,BSDXVAL)")
Q
;
ADDRG(BSDXY,BSDXVAL) ;EP
;Called by BSDX ADD/EDIT RESOURCE GROUP
;Add a new BSDX RESOURCE GROUP entry
;BSDXVAL is IEN|NAME of the entry
;Returns IEN of added/edited entry or 0 if error
;
S X="ERROR^BSDX19",@^%ZOSF("TRAP")
N BSDXIENS,BSDXFDA,BSDXMSG,BSDXIEN,BSDX,BSDXNAM
S BSDXY="^BSDXTMP("_$J_")"
S ^BSDXTMP($J,0)="I00020RESOURCEGROUPID^T00030ERRORTEXT"_$C(30)
I BSDXVAL="" D ERR(0,"BSDX16: Invalid null input Parameter") Q
S BSDXIEN=$P(BSDXVAL,"|")
S BSDXNAM=$P(BSDXVAL,"|",2)
I +BSDXIEN D
. S BSDX="EDIT"
. S BSDXIENS=BSDXIEN_","
E D
. S BSDX="ADD"
. S BSDXIENS="+1,"
;
;Prevent adding entry with duplicate name
I $D(^BSDXDEPT("B",BSDXNAM)),$O(^BSDXDEPT("B",BSDXNAM,0))'=BSDXIEN D Q
. D ERR(0,"BSDX19: Cannot have two Resource Groups with the same name.")
. Q
;
S BSDXFDA(9002018.2,BSDXIENS,.01)=BSDXNAM ;NAME
I BSDX="ADD" D
. K BSDXIEN
. D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG")
. S BSDXIEN=+$G(BSDXIEN(1))
E D
. D FILE^DIE("","BSDXFDA","BSDXMSG")
S ^BSDXTMP($J,1)=$G(BSDXIEN)_"^"_$C(30)_$C(31)
Q
;
DELRGD(BSDXY,BSDXGRP) ;EP
;Entry point for debugging
;
;D DEBUG^%Serenji("DELRG^BSDX19(.BSDXY,BSDXGRP)")
Q
;
DELRG(BSDXY,BSDXGRP) ;EP
;Deletes entry name BSDXGRP from BSDX RESOURCE GROUP file
;Return recordset containing error message or "" if no error
;Called by BSDX DELETE RESOURCE GROUP
;Test Line:
;D DELRU^BSDX18(.RES,99)
;
N BSDXI,DIK,DA,BSDXIEN
S BSDXI=0
S BSDXY="^BSDXTMP("_$J_")"
S ^BSDXTMP($J,0)="I00020RESOURCEGROUPID^T00030ERRORTEXT"_$C(30)
I BSDXGRP="" D ERR(0,"DELRG~BSDX19: Invalid null Resource Group Name") Q
S BSDXIEN=$O(^BSDXDEPT("B",BSDXGRP,0))
I '+BSDXIEN D ERR(0,"DELRG~BSDX19: Invalid Resource Group Name") Q
I '$D(^BSDXDEPT(BSDXIEN,0)) D ERR(0,"DELRG~BSDX19: Invalid Resource Group IEN") Q
;Delete entry BSDXIEN
S DIK="^BSDXDEPT("
S DA=BSDXIEN
D ^DIK
;
S BSDXI=BSDXI+1
S ^BSDXTMP($J,BSDXI)=BSDXIEN_"^"_$C(30)_$C(31)
Q
;
ERR(BSDXERID,ERRTXT) ;Error processing
S:'+$G(BSDXI) BSDXI=999999
S BSDXI=BSDXI+1
S ^BSDXTMP($J,BSDXI)=BSDXERID_"^"_ERRTXT_$C(30)
S BSDXI=BSDXI+1
S ^BSDXTMP($J,BSDXI)=$C(31)
Q
;
ERROR ;
D ^%ZTER
I '+$G(BSDXI) N BSDXI S BSDXI=999999
S BSDXI=BSDXI+1
D ERR(0,"BSDX19 M Error: <"_$G(%ZTERROR)_">")
Q
BSDX19 ; IHS/OIT/HMW/MSC/SAT - WINDOWS SCHEDULING RPCS ;
+1 ;;3.0;IHS WINDOWS SCHEDULING;;DEC 09, 2010
+2 ;
+3 ;
ADDRGD(BSDXY,BSDXVAL) ;EP
+1 ;Entry point for debugging
+2 ;
+3 ;D DEBUG^%Serenji("ADDRG^BSDX19(.BSDXY,BSDXVAL)")
+4 QUIT
+5 ;
ADDRG(BSDXY,BSDXVAL) ;EP
+1 ;Called by BSDX ADD/EDIT RESOURCE GROUP
+2 ;Add a new BSDX RESOURCE GROUP entry
+3 ;BSDXVAL is IEN|NAME of the entry
+4 ;Returns IEN of added/edited entry or 0 if error
+5 ;
+6 SET X="ERROR^BSDX19"
SET @^%ZOSF("TRAP")
+7 NEW BSDXIENS,BSDXFDA,BSDXMSG,BSDXIEN,BSDX,BSDXNAM
+8 SET BSDXY="^BSDXTMP("_$JOB_")"
+9 SET ^BSDXTMP($JOB,0)="I00020RESOURCEGROUPID^T00030ERRORTEXT"_$CHAR(30)
+10 IF BSDXVAL=""
DO ERR(0,"BSDX16: Invalid null input Parameter")
QUIT
+11 SET BSDXIEN=$PIECE(BSDXVAL,"|")
+12 SET BSDXNAM=$PIECE(BSDXVAL,"|",2)
+13 IF +BSDXIEN
Begin DoDot:1
+14 SET BSDX="EDIT"
+15 SET BSDXIENS=BSDXIEN_","
End DoDot:1
+16 IF '$TEST
Begin DoDot:1
+17 SET BSDX="ADD"
+18 SET BSDXIENS="+1,"
End DoDot:1
+19 ;
+20 ;Prevent adding entry with duplicate name
+21 IF $DATA(^BSDXDEPT("B",BSDXNAM))
IF $ORDER(^BSDXDEPT("B",BSDXNAM,0))'=BSDXIEN
Begin DoDot:1
+22 DO ERR(0,"BSDX19: Cannot have two Resource Groups with the same name.")
+23 QUIT
End DoDot:1
QUIT
+24 ;
+25 ;NAME
SET BSDXFDA(9002018.2,BSDXIENS,.01)=BSDXNAM
+26 IF BSDX="ADD"
Begin DoDot:1
+27 KILL BSDXIEN
+28 DO UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG")
+29 SET BSDXIEN=+$GET(BSDXIEN(1))
End DoDot:1
+30 IF '$TEST
Begin DoDot:1
+31 DO FILE^DIE("","BSDXFDA","BSDXMSG")
End DoDot:1
+32 SET ^BSDXTMP($JOB,1)=$GET(BSDXIEN)_"^"_$CHAR(30)_$CHAR(31)
+33 QUIT
+34 ;
DELRGD(BSDXY,BSDXGRP) ;EP
+1 ;Entry point for debugging
+2 ;
+3 ;D DEBUG^%Serenji("DELRG^BSDX19(.BSDXY,BSDXGRP)")
+4 QUIT
+5 ;
DELRG(BSDXY,BSDXGRP) ;EP
+1 ;Deletes entry name BSDXGRP from BSDX RESOURCE GROUP file
+2 ;Return recordset containing error message or "" if no error
+3 ;Called by BSDX DELETE RESOURCE GROUP
+4 ;Test Line:
+5 ;D DELRU^BSDX18(.RES,99)
+6 ;
+7 NEW BSDXI,DIK,DA,BSDXIEN
+8 SET BSDXI=0
+9 SET BSDXY="^BSDXTMP("_$JOB_")"
+10 SET ^BSDXTMP($JOB,0)="I00020RESOURCEGROUPID^T00030ERRORTEXT"_$CHAR(30)
+11 IF BSDXGRP=""
DO ERR(0,"DELRG~BSDX19: Invalid null Resource Group Name")
QUIT
+12 SET BSDXIEN=$ORDER(^BSDXDEPT("B",BSDXGRP,0))
+13 IF '+BSDXIEN
DO ERR(0,"DELRG~BSDX19: Invalid Resource Group Name")
QUIT
+14 IF '$DATA(^BSDXDEPT(BSDXIEN,0))
DO ERR(0,"DELRG~BSDX19: Invalid Resource Group IEN")
QUIT
+15 ;Delete entry BSDXIEN
+16 SET DIK="^BSDXDEPT("
+17 SET DA=BSDXIEN
+18 DO ^DIK
+19 ;
+20 SET BSDXI=BSDXI+1
+21 SET ^BSDXTMP($JOB,BSDXI)=BSDXIEN_"^"_$CHAR(30)_$CHAR(31)
+22 QUIT
+23 ;
ERR(BSDXERID,ERRTXT) ;Error processing
+1 IF '+$GET(BSDXI)
SET BSDXI=999999
+2 SET BSDXI=BSDXI+1
+3 SET ^BSDXTMP($JOB,BSDXI)=BSDXERID_"^"_ERRTXT_$CHAR(30)
+4 SET BSDXI=BSDXI+1
+5 SET ^BSDXTMP($JOB,BSDXI)=$CHAR(31)
+6 QUIT
+7 ;
ERROR ;
+1 DO ^%ZTER
+2 IF '+$GET(BSDXI)
NEW BSDXI
SET BSDXI=999999
+3 SET BSDXI=BSDXI+1
+4 DO ERR(0,"BSDX19 M Error: <"_$GET(%ZTERROR)_">")
+5 QUIT
