source: Scheduling/trunk/m/BSDX15.m@ 1446

Last change on this file since 1446 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.3 KB
Line 
1BSDX15 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:19am
2 ;;1.6T2;BSDX;;May 16, 2011
3 ; Licensed under LGPL
4 ;
5 ;
6GRPTYP(BSDXY) ;EP
7 ;Called by BSDX GET ACCESS GROUP TYPES
8 ;Returns ADO recordset containing ACTIVE Access types ordered alphabetically
9 ;by Access Group
10 ;AccessGroupID, AccessGroup, AccessTypeID, AccessType
11 ;
12 ;Test Code:
13 ;D GRPTYP^BSDX15(.RES) ZW RES
14 ;
15 S BSDXY="^BSDXTMP("_$J_")"
16 N BSDX1
17 S BSDXI=0
18 S X="ETRAP^BSDX15",@^%ZOSF("TRAP")
19 S ^BSDXTMP($J,BSDXI)="I00020ACCESS_GROUP_TYPEID^I00020ACCESS_GROUP_ID^T00030ACCESS_GROUP^I00020ACCESS_TYPE_ID^T00030ACCESS_TYPE"_$C(30)
20 ;
21 ;N BSDX0,BSDX1,BSDXNOD,BSDXGPN,BSDXTN
22 ;$O Through "B" x-ref of BSDX ACCESS GROUP file
23 ;S BSDXGPN=0 F S BSDXGPN=$O(^BSDXAGP("B",BSDXGPN)) Q:BSDXGPN="" D
24 ;. S BSDX0=$O(^BSDXAGP("B",BSDXGPN,0))
25 ;. Q:'+BSDX0
26 ;. Q:'$D(^BSDXAGP(BSDX0,0)) ;INDEX VALIDITY CHECK
27 ;. Q:'$D(^BSDXAGTP("B",BSDX0))
28 ;. ;$O through "B" x-ref of BSDX ACCESS GROUP TYPE
29 ;. S BSDX1=0 F S BSDX1=$O(^BSDXAGTP("B",BSDX0,BSDX1)) Q:'+BSDX1 D
30 ;. . Q:'$D(^BSDXAGTP(BSDX1,0))
31 ;. . S BSDX2=$P(^BSDXAGTP(BSDX1,0),U,2)
32 ;. . Q:'+BSDX2
33 ;. . Q:'$D(^BSDXTYPE(BSDX2,0))
34 ;. . S BSDXNOD=^BSDXTYPE(BSDX2,0)
35 ;. . Q:$P(BSDXNOD,U,2)=1 ;INACTIVE
36 ;. . S BSDXTN=$P(BSDXNOD,U)
37 ;. . S BSDXI=BSDXI+1
38 ;. . S ^BSDXTMP($J,BSDXI)=BSDX1_U_BSDX0_U_BSDXGPN_U_BSDX2_U_BSDXTN_$C(30)
39 ;. . Q
40 ;. Q
41 ;
42 ;$O Through "AC" x-ref of BSDX ACCESS GROUP TYPE file
43 N BSDXAGID,BSDXAGN,BSDXATID,BSDXATN,BSDXAGTID
44 S BSDXAGID=0
45 F S BSDXAGID=$O(^BSDXAGTP("AC",BSDXAGID)) Q:'+BSDXAGID D
46 . I '$D(^BSDXAGP(BSDXAGID,0)) Q
47 . S BSDXAGN=$P(^BSDXAGP(BSDXAGID,0),U)
48 . S BSDXATID=0 F S BSDXATID=$O(^BSDXAGTP("AC",BSDXAGID,BSDXATID)) Q:'+BSDXATID D
49 . . S BSDXNOD=$G(^BSDXTYPE(BSDXATID,0))
50 . . I BSDXNOD="" Q
51 . . I $P(BSDXNOD,U,2)=1 Q ;Inactive
52 . . S BSDXATN=$P(BSDXNOD,U)
53 . . S BSDXAGTID=$O(^BSDXAGTP("AC",BSDXAGID,BSDXATID,0))
54 . . I '+BSDXAGTID Q
55 . . I '$D(^BSDXAGTP(BSDXAGTID,0)) Q
56 . . S BSDXI=BSDXI+1
57 . . S ^BSDXTMP($J,BSDXI)=BSDXAGTID_U_BSDXAGID_U_BSDXAGN_U_BSDXATID_U_BSDXATN_$C(30)
58 . . Q
59 . Q
60 ;
61 S BSDXI=BSDXI+1
62 S ^BSDXTMP($J,BSDXI)=$C(31)
63 Q
64 ;
65ERR(BSDXI,BSDXID,BSDXERR) ;Error processing
66 S BSDXI=BSDXI+1
67 S ^BSDXTMP($J,BSDXI)=BSDXERR_"^^^^"_$C(30)
68 S BSDXI=BSDXI+1
69 S ^BSDXTMP($J,BSDXI)=$C(31)
70 Q
71 ;
72ETRAP ;EP Error trap entry
73 I '$D(BSDXI) N BSDXI S BSDXI=999
74 S BSDXI=BSDXI+1
75 D ERR(BSDXI,99,70)
76 Q
Note: See TracBrowser for help on using the repository browser.