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

Last change on this file since 614 was 614, checked in by Sam Habiel, 14 years ago

Initial committ of scheduling package

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