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

Last change on this file since 1581 was 1563, checked in by Tariq Hamkari, 12 years ago

updated the BSDX version to 1.7

  • fix "BSDX01.m" routine , it was take too long time to retrieve patient radiology exams.
File size: 2.4 KB
RevLine 
[1161]1BSDX19 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:21am
[1563]2 ;;1.6;BSDX;;Aug 31, 2011;Build 25
[1161]3 ; Licensed under LGPL
[614]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.