source: Scheduling/trunk/m/BSDX15.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.3 KB
RevLine 
[1161]1BSDX15 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:19am
[1563]2 ;;1.6;BSDX;;Aug 31, 2011;Build 25
[1161]3 ; Licensed under LGPL
[614]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.