BSDX21 ; IHS/OIT/HMW/MSC/SAT - WINDOWS SCHEDULING RPCS ;
;;3.0;IHS WINDOWS SCHEDULING;;DEC 09, 2010
;
;
ADDAGD(BSDXY,BSDXVAL) ;EP
;Entry point for debugging
;
;D DEBUG^%Serenji("ADDAG^BSDX21(.BSDXY,BSDXVAL)")
Q
;
ADDAG(BSDXY,BSDXVAL) ;EP
;Called by BSDX ADD/EDIT ACCESS GROUP
;Add a new BSDX ACCESS GROUP entry
;BSDXVAL is NAME of the entry
;
S X="ERROR^BSDX21",@^%ZOSF("TRAP")
N BSDXIENS,BSDXFDA,BSDXMSG,BSDXIEN,BSDX,BSDXNAM
S BSDXY="^BSDXTMP("_$J_")"
S ^BSDXTMP($J,0)="I00020ACCESSGROUPID^T00030ERRORTEXT"_$C(30)
I BSDXVAL="" D ERR(0,"BSDX21: 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,"
;
S BSDXNAM=$P(BSDXVAL,"|",2)
I BSDXNAM="" D ERR(0,"BSDX14: Invalid null Access Type name.") Q
;
;Prevent adding entry with duplicate name
I $D(^BSDXAGP("B",BSDXNAM)),$O(^BSDXAGP("B",BSDXNAM,0))'=BSDXIEN D Q
. D ERR(0,"BSDX21: Cannot have two Access Groups with the same name.")
. Q
;
S BSDXFDA(9002018.38,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
;
DELAGD(BSDXY,BSDXGRP) ;EP
;Entry point for debugging
;
;D DEBUG^%Serenji("DELAG^BSDX21(.BSDXY,BSDXGRP)")
Q
;
DELAG(BSDXY,BSDXGRP) ;EP
;Deletes entry having IEN BSDXGRP from BSDX ACCESS GROUP file
;Also deletes all entries in BSDX ACCESS GROUP TYPE that point to this group
;Return recordset containing error message or "" if no error
;Called by BSDX DELETE ACCESS GROUP
;Test Line:
;D DELAG^BSDX21(.RES,99)
;
S X="ERROR^BSDX21",@^%ZOSF("TRAP")
N BSDXI,DIK,DA,BSDXIEN,BSDXIEN1
S BSDXI=0
S BSDXY="^BSDXTMP("_$J_")"
S ^BSDXTMP($J,0)="I00020ACCESSGROUPID^T00030ERRORTEXT"_$C(30)
S BSDXIEN=BSDXGRP
;I '$D(^BSDXAGP("B",BSDXGRP)) D ERR(BSDXI,0,0) Q
;S BSDXIEN=$O(^BSDXAGP("B",BSDXGRP,0))
I '+BSDXIEN D ERR(BSDXI,BSDXIEN,70) Q
I '$D(^BSDXAGP(BSDXIEN,0)) D ERR(0,"BSDX14: Invalid Access Group ID name.") Q
;
;Delete BSDXACCESS GROUP TYPE entries
;
S BSDXIEN1=0 F S BSDXIEN1=$O(^BSDXAGTP("B",BSDXIEN,BSDXIEN1)) Q:'BSDXIEN1 D
. S DIK="^BSDXAGTP("
. S DA=BSDXIEN1
. D ^DIK
. Q
;
;Delete entry BSDXIEN in BSDX ACCESS GROUP
S DIK="^BSDXAGP("
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,"BSDX21 M Error: <"_$G(%ZTERROR)_">")
Q
BSDX21 ; IHS/OIT/HMW/MSC/SAT - WINDOWS SCHEDULING RPCS ;
+1 ;;3.0;IHS WINDOWS SCHEDULING;;DEC 09, 2010
+2 ;
+3 ;
ADDAGD(BSDXY,BSDXVAL) ;EP
+1 ;Entry point for debugging
+2 ;
+3 ;D DEBUG^%Serenji("ADDAG^BSDX21(.BSDXY,BSDXVAL)")
+4 QUIT
+5 ;
ADDAG(BSDXY,BSDXVAL) ;EP
+1 ;Called by BSDX ADD/EDIT ACCESS GROUP
+2 ;Add a new BSDX ACCESS GROUP entry
+3 ;BSDXVAL is NAME of the entry
+4 ;
+5 SET X="ERROR^BSDX21"
SET @^%ZOSF("TRAP")
+6 NEW BSDXIENS,BSDXFDA,BSDXMSG,BSDXIEN,BSDX,BSDXNAM
+7 SET BSDXY="^BSDXTMP("_$JOB_")"
+8 SET ^BSDXTMP($JOB,0)="I00020ACCESSGROUPID^T00030ERRORTEXT"_$CHAR(30)
+9 IF BSDXVAL=""
DO ERR(0,"BSDX21: Invalid null input Parameter")
QUIT
+10 SET BSDXIEN=$PIECE(BSDXVAL,"|")
+11 SET BSDXNAM=$PIECE(BSDXVAL,"|",2)
+12 IF +BSDXIEN
Begin DoDot:1
+13 SET BSDX="EDIT"
+14 SET BSDXIENS=BSDXIEN_","
End DoDot:1
+15 IF '$TEST
Begin DoDot:1
+16 SET BSDX="ADD"
+17 SET BSDXIENS="+1,"
End DoDot:1
+18 ;
+19 SET BSDXNAM=$PIECE(BSDXVAL,"|",2)
+20 IF BSDXNAM=""
DO ERR(0,"BSDX14: Invalid null Access Type name.")
QUIT
+21 ;
+22 ;Prevent adding entry with duplicate name
+23 IF $DATA(^BSDXAGP("B",BSDXNAM))
IF $ORDER(^BSDXAGP("B",BSDXNAM,0))'=BSDXIEN
Begin DoDot:1
+24 DO ERR(0,"BSDX21: Cannot have two Access Groups with the same name.")
+25 QUIT
End DoDot:1
QUIT
+26 ;
+27 ;NAME
SET BSDXFDA(9002018.38,BSDXIENS,.01)=BSDXNAM
+28 IF BSDX="ADD"
Begin DoDot:1
+29 KILL BSDXIEN
+30 DO UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG")
+31 SET BSDXIEN=+$GET(BSDXIEN(1))
End DoDot:1
+32 IF '$TEST
Begin DoDot:1
+33 DO FILE^DIE("","BSDXFDA","BSDXMSG")
End DoDot:1
+34 SET ^BSDXTMP($JOB,1)=$GET(BSDXIEN)_"^"_$CHAR(30)_$CHAR(31)
+35 QUIT
+36 ;
DELAGD(BSDXY,BSDXGRP) ;EP
+1 ;Entry point for debugging
+2 ;
+3 ;D DEBUG^%Serenji("DELAG^BSDX21(.BSDXY,BSDXGRP)")
+4 QUIT
+5 ;
DELAG(BSDXY,BSDXGRP) ;EP
+1 ;Deletes entry having IEN BSDXGRP from BSDX ACCESS GROUP file
+2 ;Also deletes all entries in BSDX ACCESS GROUP TYPE that point to this group
+3 ;Return recordset containing error message or "" if no error
+4 ;Called by BSDX DELETE ACCESS GROUP
+5 ;Test Line:
+6 ;D DELAG^BSDX21(.RES,99)
+7 ;
+8 SET X="ERROR^BSDX21"
SET @^%ZOSF("TRAP")
+9 NEW BSDXI,DIK,DA,BSDXIEN,BSDXIEN1
+10 SET BSDXI=0
+11 SET BSDXY="^BSDXTMP("_$JOB_")"
+12 SET ^BSDXTMP($JOB,0)="I00020ACCESSGROUPID^T00030ERRORTEXT"_$CHAR(30)
+13 SET BSDXIEN=BSDXGRP
+14 ;I '$D(^BSDXAGP("B",BSDXGRP)) D ERR(BSDXI,0,0) Q
+15 ;S BSDXIEN=$O(^BSDXAGP("B",BSDXGRP,0))
+16 IF '+BSDXIEN
DO ERR(BSDXI,BSDXIEN,70)
QUIT
+17 IF '$DATA(^BSDXAGP(BSDXIEN,0))
DO ERR(0,"BSDX14: Invalid Access Group ID name.")
QUIT
+18 ;
+19 ;Delete BSDXACCESS GROUP TYPE entries
+20 ;
+21 SET BSDXIEN1=0
FOR
SET BSDXIEN1=$ORDER(^BSDXAGTP("B",BSDXIEN,BSDXIEN1))
IF 'BSDXIEN1
QUIT
Begin DoDot:1
+22 SET DIK="^BSDXAGTP("
+23 SET DA=BSDXIEN1
+24 DO ^DIK
+25 QUIT
End DoDot:1
+26 ;
+27 ;Delete entry BSDXIEN in BSDX ACCESS GROUP
+28 SET DIK="^BSDXAGP("
+29 SET DA=BSDXIEN
+30 DO ^DIK
+31 ;
+32 SET BSDXI=BSDXI+1
+33 SET ^BSDXTMP($JOB,BSDXI)=BSDXIEN_"^"_""_$CHAR(30)_$CHAR(31)
+34 QUIT
+35 ;
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,"BSDX21 M Error: <"_$GET(%ZTERROR)_">")
+5 QUIT
