source: Scheduling/trunk/m/BSDX21.m@ 1475

Last change on this file since 1475 was 1472, checked in by Sam Habiel, 12 years ago

Updated version number on all routines to be 1.7T1.
Minor fixes here and there for XINDEX errors.

File size: 2.7 KB
Line 
1BSDX21 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:22am
2 ;;1.7T1;BSDX;;Jul 06, 2012;Build 18
3 ; Licensed under LGPL
4 ;
5 ;
6ADDAGD(BSDXY,BSDXVAL) ;EP
7 ;Entry point for debugging
8 ;
9 ;D DEBUG^%Serenji("ADDAG^BSDX21(.BSDXY,BSDXVAL)")
10 Q
11 ;
12ADDAG(BSDXY,BSDXVAL) ;EP
13 ;Called by BSDX ADD/EDIT ACCESS GROUP
14 ;Add a new BSDX ACCESS GROUP entry
15 ;BSDXVAL is NAME of the entry
16 ;
17 S X="ERROR^BSDX21",@^%ZOSF("TRAP")
18 N BSDXIENS,BSDXFDA,BSDXMSG,BSDXIEN,BSDX,BSDXNAM
19 S BSDXY="^BSDXTMP("_$J_")"
20 S ^BSDXTMP($J,0)="I00020ACCESSGROUPID^T00030ERRORTEXT"_$C(30)
21 I BSDXVAL="" D ERR(0,"BSDX21: Invalid null input Parameter") Q
22 S BSDXIEN=$P(BSDXVAL,"|")
23 S BSDXNAM=$P(BSDXVAL,"|",2)
24 I +BSDXIEN D
25 . S BSDX="EDIT"
26 . S BSDXIENS=BSDXIEN_","
27 E D
28 . S BSDX="ADD"
29 . S BSDXIENS="+1,"
30 ;
31 S BSDXNAM=$P(BSDXVAL,"|",2)
32 I BSDXNAM="" D ERR(0,"BSDX14: Invalid null Access Type name.") Q
33 ;
34 ;Prevent adding entry with duplicate name
35 I $D(^BSDXAGP("B",BSDXNAM)),$O(^BSDXAGP("B",BSDXNAM,0))'=BSDXIEN D Q
36 . D ERR(0,"BSDX21: Cannot have two Access Groups with the same name.")
37 . Q
38 ;
39 S BSDXFDA(9002018.38,BSDXIENS,.01)=BSDXNAM ;NAME
40 I BSDX="ADD" D
41 . K BSDXIEN
42 . D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG")
43 . S BSDXIEN=+$G(BSDXIEN(1))
44 E D
45 . D FILE^DIE("","BSDXFDA","BSDXMSG")
46 S ^BSDXTMP($J,1)=$G(BSDXIEN)_"^"_$C(30)_$C(31)
47 Q
48 ;
49DELAGD(BSDXY,BSDXGRP) ;EP
50 ;Entry point for debugging
51 ;
52 ;D DEBUG^%Serenji("DELAG^BSDX21(.BSDXY,BSDXGRP)")
53 Q
54 ;
55DELAG(BSDXY,BSDXGRP) ;EP
56 ;Deletes entry having IEN BSDXGRP from BSDX ACCESS GROUP file
57 ;Also deletes all entries in BSDX ACCESS GROUP TYPE that point to this group
58 ;Return recordset containing error message or "" if no error
59 ;Called by BSDX DELETE ACCESS GROUP
60 ;Test Line:
61 ;D DELAG^BSDX21(.RES,99)
62 ;
63 S X="ERROR^BSDX21",@^%ZOSF("TRAP")
64 N BSDXI,DIK,DA,BSDXIEN,BSDXIEN1
65 S BSDXI=0
66 S BSDXY="^BSDXTMP("_$J_")"
67 S ^BSDXTMP($J,0)="I00020ACCESSGROUPID^T00030ERRORTEXT"_$C(30)
68 S BSDXIEN=BSDXGRP
69 ;I '$D(^BSDXAGP("B",BSDXGRP)) D ERR(BSDXI,0,0) Q
70 ;S BSDXIEN=$O(^BSDXAGP("B",BSDXGRP,0))
71 I '+BSDXIEN D ERR(BSDXI,BSDXIEN) Q
72 I '$D(^BSDXAGP(BSDXIEN,0)) D ERR(0,"BSDX14: Invalid Access Group ID name.") Q
73 ;
74 ;Delete BSDXACCESS GROUP TYPE entries
75 ;
76 S BSDXIEN1=0 F S BSDXIEN1=$O(^BSDXAGTP("B",BSDXIEN,BSDXIEN1)) Q:'BSDXIEN1 D
77 . S DIK="^BSDXAGTP("
78 . S DA=BSDXIEN1
79 . D ^DIK
80 . Q
81 ;
82 ;Delete entry BSDXIEN in BSDX ACCESS GROUP
83 S DIK="^BSDXAGP("
84 S DA=BSDXIEN
85 D ^DIK
86 ;
87 S BSDXI=BSDXI+1
88 S ^BSDXTMP($J,BSDXI)=BSDXIEN_"^"_""_$C(30)_$C(31)
89 Q
90 ;
91ERR(BSDXERID,ERRTXT) ;Error processing
92 S:'+$G(BSDXI) BSDXI=999999
93 S BSDXI=BSDXI+1
94 S ^BSDXTMP($J,BSDXI)=BSDXERID_"^"_ERRTXT_$C(30)
95 S BSDXI=BSDXI+1
96 S ^BSDXTMP($J,BSDXI)=$C(31)
97 Q
98 ;
99ERROR ;
100 D ^%ZTER
101 I '+$G(BSDXI) N BSDXI S BSDXI=999999
102 S BSDXI=BSDXI+1
103 D ERR(0,"BSDX21 M Error: <"_$G(%ZTERROR)_">")
104 Q
Note: See TracBrowser for help on using the repository browser.