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

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

Changes to BSDX01 to prevent Scheduled,dc'ed,completed radiology appointments from being cancelled. Updated files to T2.
File size: 2.8 KB
Line 
1BSDX22 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:22am
2 ;;1.6T2;BSDX;;May 16, 2011
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.