source: Scheduling/trunk/m/BSDX19.m@ 1187

Last change on this file since 1187 was 1187, checked in by Sam Habiel, 13 years ago

Changes to BSDX01 to prevent Scheduled,dc'ed,completed radiology appointments from being cancelled. Updated files to T2.

File size: 2.4 KB
Line 
1BSDX19 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:21am
2 ;;1.6T2;BSDX;;May 16, 2011
3 ; Licensed under LGPL
4 ;
5 ;
6ADDRGD(BSDXY,BSDXVAL) ;EP
7 ;Entry point for debugging
8 ;
9 ;D DEBUG^%Serenji("ADDRG^BSDX19(.BSDXY,BSDXVAL)")
10 Q
11 ;
12ADDRG(BSDXY,BSDXVAL) ;EP
13 ;Called by BSDX ADD/EDIT RESOURCE GROUP
14 ;Add a new BSDX RESOURCE GROUP entry
15 ;BSDXVAL is IEN|NAME of the entry
16 ;Returns IEN of added/edited entry or 0 if error
17 ;
18 S X="ERROR^BSDX19",@^%ZOSF("TRAP")
19 N BSDXIENS,BSDXFDA,BSDXMSG,BSDXIEN,BSDX,BSDXNAM
20 S BSDXY="^BSDXTMP("_$J_")"
21 S ^BSDXTMP($J,0)="I00020RESOURCEGROUPID^T00030ERRORTEXT"_$C(30)
22 I BSDXVAL="" D ERR(0,"BSDX16: Invalid null input Parameter") Q
23 S BSDXIEN=$P(BSDXVAL,"|")
24 S BSDXNAM=$P(BSDXVAL,"|",2)
25 I +BSDXIEN D
26 . S BSDX="EDIT"
27 . S BSDXIENS=BSDXIEN_","
28 E D
29 . S BSDX="ADD"
30 . S BSDXIENS="+1,"
31 ;
32 ;Prevent adding entry with duplicate name
33 I $D(^BSDXDEPT("B",BSDXNAM)),$O(^BSDXDEPT("B",BSDXNAM,0))'=BSDXIEN D Q
34 . D ERR(0,"BSDX19: Cannot have two Resource Groups with the same name.")
35 . Q
36 ;
37 S BSDXFDA(9002018.2,BSDXIENS,.01)=BSDXNAM ;NAME
38 I BSDX="ADD" D
39 . K BSDXIEN
40 . D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG")
41 . S BSDXIEN=+$G(BSDXIEN(1))
42 E D
43 . D FILE^DIE("","BSDXFDA","BSDXMSG")
44 S ^BSDXTMP($J,1)=$G(BSDXIEN)_"^"_$C(30)_$C(31)
45 Q
46 ;
47DELRGD(BSDXY,BSDXGRP) ;EP
48 ;Entry point for debugging
49 ;
50 ;D DEBUG^%Serenji("DELRG^BSDX19(.BSDXY,BSDXGRP)")
51 Q
52 ;
53DELRG(BSDXY,BSDXGRP) ;EP
54 ;Deletes entry name BSDXGRP from BSDX RESOURCE GROUP file
55 ;Return recordset containing error message or "" if no error
56 ;Called by BSDX DELETE RESOURCE GROUP
57 ;Test Line:
58 ;D DELRU^BSDX18(.RES,99)
59 ;
60 N BSDXI,DIK,DA,BSDXIEN
61 S BSDXI=0
62 S BSDXY="^BSDXTMP("_$J_")"
63 S ^BSDXTMP($J,0)="I00020RESOURCEGROUPID^T00030ERRORTEXT"_$C(30)
64 I BSDXGRP="" D ERR(0,"DELRG~BSDX19: Invalid null Resource Group Name") Q
65 S BSDXIEN=$O(^BSDXDEPT("B",BSDXGRP,0))
66 I '+BSDXIEN D ERR(0,"DELRG~BSDX19: Invalid Resource Group Name") Q
67 I '$D(^BSDXDEPT(BSDXIEN,0)) D ERR(0,"DELRG~BSDX19: Invalid Resource Group IEN") Q
68 ;Delete entry BSDXIEN
69 S DIK="^BSDXDEPT("
70 S DA=BSDXIEN
71 D ^DIK
72 ;
73 S BSDXI=BSDXI+1
74 S ^BSDXTMP($J,BSDXI)=BSDXIEN_"^"_$C(30)_$C(31)
75 Q
76 ;
77ERR(BSDXERID,ERRTXT) ;Error processing
78 S:'+$G(BSDXI) BSDXI=999999
79 S BSDXI=BSDXI+1
80 S ^BSDXTMP($J,BSDXI)=BSDXERID_"^"_ERRTXT_$C(30)
81 S BSDXI=BSDXI+1
82 S ^BSDXTMP($J,BSDXI)=$C(31)
83 Q
84 ;
85ERROR ;
86 D ^%ZTER
87 I '+$G(BSDXI) N BSDXI S BSDXI=999999
88 S BSDXI=BSDXI+1
89 D ERR(0,"BSDX19 M Error: <"_$G(%ZTERROR)_">")
90 Q
Note: See TracBrowser for help on using the repository browser.