Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BSDX21

BSDX21.m

Go to the documentation of this file. 
  1. BSDX21 ; IHS/OIT/HMW/MSC/SAT - WINDOWS SCHEDULING RPCS ;
  1.  ;;3.0;IHS WINDOWS SCHEDULING;;DEC 09, 2010
  1.  ;
  1.  ;
  1. ADDAGD(BSDXY,BSDXVAL) ;EP
  1.  ;Entry point for debugging
  1.  ;
  1.  ;D DEBUG^%Serenji("ADDAG^BSDX21(.BSDXY,BSDXVAL)")
  1.  Q
  1.  ;
  1. ADDAG(BSDXY,BSDXVAL) ;EP
  1.  ;Called by BSDX ADD/EDIT ACCESS GROUP
  1.  ;Add a new BSDX ACCESS GROUP entry
  1.  ;BSDXVAL is NAME of the entry
  1.  ;
  1.  S X="ERROR^BSDX21",@^%ZOSF("TRAP")
  1.  N BSDXIENS,BSDXFDA,BSDXMSG,BSDXIEN,BSDX,BSDXNAM
  1.  S BSDXY="^BSDXTMP("_$J_")"
  1.  S ^BSDXTMP($J,0)="I00020ACCESSGROUPID^T00030ERRORTEXT"_$C(30)
  1.  I BSDXVAL="" D ERR(0,"BSDX21: Invalid null input Parameter") Q
  1.  S BSDXIEN=$P(BSDXVAL,"|")
  1.  S BSDXNAM=$P(BSDXVAL,"|",2)
  1.  I +BSDXIEN D
  1.  . S BSDX="EDIT"
  1.  . S BSDXIENS=BSDXIEN_","
  1.  E  D
  1.  . S BSDX="ADD"
  1.  . S BSDXIENS="+1,"
  1.  ;
  1.  S BSDXNAM=$P(BSDXVAL,"|",2)
  1.  I BSDXNAM="" D ERR(0,"BSDX14: Invalid null Access Type name.") Q
  1.  ;
  1.  ;Prevent adding entry with duplicate name
  1.  I $D(^BSDXAGP("B",BSDXNAM)),$O(^BSDXAGP("B",BSDXNAM,0))'=BSDXIEN D  Q
  1.  . D ERR(0,"BSDX21: Cannot have two Access Groups with the same name.")
  1.  . Q
  1.  ;
  1.  S BSDXFDA(9002018.38,BSDXIENS,.01)=BSDXNAM ;NAME
  1.  I BSDX="ADD" D
  1.  . K BSDXIEN
  1.  . D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG")
  1.  . S BSDXIEN=+$G(BSDXIEN(1))
  1.  E  D
  1.  . D FILE^DIE("","BSDXFDA","BSDXMSG")
  1.  S ^BSDXTMP($J,1)=$G(BSDXIEN)_"^"_$C(30)_$C(31)
  1.  Q
  1.  ;
  1. DELAGD(BSDXY,BSDXGRP) ;EP
  1.  ;Entry point for debugging
  1.  ;
  1.  ;D DEBUG^%Serenji("DELAG^BSDX21(.BSDXY,BSDXGRP)")
  1.  Q
  1.  ;
  1. DELAG(BSDXY,BSDXGRP) ;EP
  1.  ;Deletes entry having IEN BSDXGRP from BSDX ACCESS GROUP file
  1.  ;Also deletes all entries in BSDX ACCESS GROUP TYPE that point to this group
  1.  ;Return recordset containing error message or "" if no error
  1.  ;Called by BSDX DELETE ACCESS GROUP
  1.  ;Test Line:
  1.  ;D DELAG^BSDX21(.RES,99)
  1.  ;
  1.  S X="ERROR^BSDX21",@^%ZOSF("TRAP")
  1.  N BSDXI,DIK,DA,BSDXIEN,BSDXIEN1
  1.  S BSDXI=0
  1.  S BSDXY="^BSDXTMP("_$J_")"
  1.  S ^BSDXTMP($J,0)="I00020ACCESSGROUPID^T00030ERRORTEXT"_$C(30)
  1.  S BSDXIEN=BSDXGRP
  1.  ;I '$D(^BSDXAGP("B",BSDXGRP)) D ERR(BSDXI,0,0) Q
  1.  ;S BSDXIEN=$O(^BSDXAGP("B",BSDXGRP,0))
  1.  I '+BSDXIEN D ERR(BSDXI,BSDXIEN,70) Q
  1.  I '$D(^BSDXAGP(BSDXIEN,0)) D ERR(0,"BSDX14: Invalid Access Group ID name.") Q
  1.  ;
  1.  ;Delete BSDXACCESS GROUP TYPE entries
  1.  ;
  1.  S BSDXIEN1=0 F  S BSDXIEN1=$O(^BSDXAGTP("B",BSDXIEN,BSDXIEN1)) Q:'BSDXIEN1  D
  1.  . S DIK="^BSDXAGTP("
  1.  . S DA=BSDXIEN1
  1.  . D ^DIK
  1.  . Q
  1.  ;
  1.  ;Delete entry BSDXIEN in BSDX ACCESS GROUP
  1.  S DIK="^BSDXAGP("
  1.  S DA=BSDXIEN
  1.  D ^DIK
  1.  ;
  1.  S BSDXI=BSDXI+1
  1.  S ^BSDXTMP($J,BSDXI)=BSDXIEN_"^"_""_$C(30)_$C(31)
  1.  Q
  1.  ;
  1. ERR(BSDXERID,ERRTXT) ;Error processing
  1.  S:'+$G(BSDXI) BSDXI=999999
  1.  S BSDXI=BSDXI+1
  1.  S ^BSDXTMP($J,BSDXI)=BSDXERID_"^"_ERRTXT_$C(30)
  1.  S BSDXI=BSDXI+1
  1.  S ^BSDXTMP($J,BSDXI)=$C(31)
  1.  Q
  1.  ;
  1. ERROR ;
  1.  D ^%ZTER
  1.  I '+$G(BSDXI) N BSDXI S BSDXI=999999
  1.  S BSDXI=BSDXI+1
  1.  D ERR(0,"BSDX21 M Error: <"_$G(%ZTERROR)_">")
  1.  Q