source: Scheduling/trunk/m/BSDX22.m@ 1572

Last change on this file since 1572 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.8 KB
Line 
1BSDX22 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:22am
2 ;;1.6;BSDX;;Aug 31, 2011;Build 25
3 ; Licensed under LGPL
4 ;
5 ;
6DELAGID(BSDXY,BSDXIEN,BSDXIEN1) ;EP
7 ;Entry point for debugging
8 ;
9 ;D DEBUG^%Serenji("DELAGI^BSDX22(.BSDXY,BSDXIEN,BSDXIEN1)")
10 Q
11 ;
12DELAGI(BSDXY,BSDXIEN,BSDXIEN1) ;EP
13 ;Deletes entry having Access Group BSDXIEN and Access Type BSDXIEN1 the ACCESS GROUP TYPE file
14 ;Return recordset containing error message or "" if no error
15 ;Called by BSDX DELETE ACCESS GROUP ITEM
16 ;Test Line:
17 ;D DELAGI^BSDX22(.RES,99)
18 ;
19 S X="ERROR^BSDX22",@^%ZOSF("TRAP")
20 N BSDXI,DIK,DA,BSDXIEN2
21 S BSDXI=0
22 S BSDXY="^BSDXTMP("_$J_")"
23 S ^BSDXTMP($J,0)="I00020ACCESSGROUPTYPEID^T00030ERRORTEXT"_$C(30)
24 I '+BSDXIEN D ERR(0,"BSDX22: Invalid null Access Group ID") Q
25 I '+BSDXIEN1 D ERR(0,"BSDX22: Invalid null Access Type ID") Q
26 I '$D(^BSDXAGTP("AC",BSDXIEN,BSDXIEN1)) D Q
27 . D ERR(0,"BSDX22: Invalid null Access Group Type ID")
28 . Q
29 S BSDXIEN2=$O(^BSDXAGTP("AC",BSDXIEN,BSDXIEN1,0))
30 I '+BSDXIEN2 D ERR(0,"BSDX22: Invalid null Access Group Type ID") Q
31 ;
32 ;Delete entry
33 S DIK="^BSDXAGTP("
34 S DA=BSDXIEN2
35 D ^DIK
36 ;
37 S BSDXI=BSDXI+1
38 S ^BSDXTMP($J,BSDXI)=BSDXIEN2_"^"_"-1"_$C(30)_$C(31)
39 Q
40 ;
41ADDAGID(BSDXY,BSDXIEN,BSDXIEN1) ;EP
42 ;Entry point for debugging
43 ;
44 ;D DEBUG^%Serenji("ADDAGI^BSDX22(.BSDXY,BSDXIEN,BSDXIEN1)")
45 Q
46 ;
47ADDAGI(BSDXY,BSDXIEN,BSDXIEN1) ;EP
48 ;Adds ACCESS GROUP TYPE file entry having access group BSDXIEN and access type BSDXIEN1
49 ;Return recordset containing added entry number error message or "" if no error
50 ;Called by BSDX ADD ACCESS GROUP ITEM
51 ;Test Line:
52 ;D ADDAGI^BSDX22(.RES,1,1)
53 ;
54 S X="ERROR^BSDX22",@^%ZOSF("TRAP")
55 N BSDXI,BSDXIENS,BSDXMSG,BSDXFDA
56 S BSDXI=0
57 S BSDXY="^BSDXTMP("_$J_")"
58 ;S ^BSDXTMP($J,0)="I00020ACCESSGROUPTYPEID^I00020ERRORID"_$C(30)
59 S ^BSDXTMP($J,0)="I00020ACCESSGROUPTYPEID^T00030ERRORTEXT"_$C(30)
60 I '+BSDXIEN D ERR(0,"BSDX22: Invalid null Access Group ID") Q
61 I '+BSDXIEN1 D ERR(0,"BSDX22: Invalid null Access Type ID") Q
62 I '$D(^BSDXAGP(BSDXIEN,0)) D ERR(0,"BSDX22: Invalid Access Group ID") Q
63 I '$D(^BSDXTYPE(BSDXIEN1,0)) D ERR(0,"BSDX22: Invalid Access Type ID") Q
64 I $D(^BSDXAGTP("AC",BSDXIEN,BSDXIEN1)) D Q
65 . S BSDXIENS=$O(^BSDXAGTP("AC",BSDXIEN,BSDXIEN1,0))
66 . S ^BSDXTMP($J,BSDXI+1)=+BSDXIENS_"^"_$C(30)_$C(31)
67 . Q
68 ;
69 S BSDXIENS="+1,"
70 S BSDXFDA(9002018.39,BSDXIENS,.01)=BSDXIEN ;ACCESS GROUP ID
71 S BSDXFDA(9002018.39,BSDXIENS,.02)=BSDXIEN1 ;ACCESS TYPE ID
72 K BSDXIEN
73 D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG")
74 S BSDXI=BSDXI+1
75 S ^BSDXTMP($J,BSDXI)=+$G(BSDXIEN(1))_"^"_$C(30)_$C(31)
76 Q
77 ;
78ERR(BSDXERID,ERRTXT) ;Error processing
79 S:'+$G(BSDXI) BSDXI=999999
80 S BSDXI=BSDXI+1
81 S ^BSDXTMP($J,BSDXI)=BSDXERID_"^"_ERRTXT_$C(30)
82 S BSDXI=BSDXI+1
83 S ^BSDXTMP($J,BSDXI)=$C(31)
84 Q
85 ;
86ERROR ;
87 D ^%ZTER
88 I '+$G(BSDXI) N BSDXI S BSDXI=999999
89 S BSDXI=BSDXI+1
90 D ERR(0,"BSDX22 M Error: <"_$G(%ZTERROR)_">")
91 Q
Note: See TracBrowser for help on using the repository browser.