source: FOIAVistA/trunk/r/EVENT_CAPTURE-EC--ECT--ECX/ECUMRPC.m@ 1203

Last change on this file since 1203 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 6.9 KB
Line 
1ECUMRPC ;ALB/JAM;Event Capture Management Broker Utilities ; 10/4/00 4:58pm
2 ;;2.0; EVENT CAPTURE ;**25,32,33**;8 May 96
3ECUSR(RESULTS,ECARY) ;
4 ;
5 ;This broker entry point returns an array of users with access to a
6 ;DSS unit in file 200.
7 ; RPC: EC GETDSSUNITUSRS
8 ;INPUTS ECARY - Contains the following subscripted elements
9 ; UNT - DSS unit IEN
10 ;
11 ;OUTPUTS RESULTS - The array of users. Data pieces as follows:-
12 ; PIECE - Description
13 ; 1 NAME of user
14 ; 2 DUZ or IEN of file 200
15 ;
16 N UNT,EDUZ,CNT
17 D SETENV
18 S UNT=$P(ECARY,U) Q:UNT=""
19 K ^TMP($J,"ECUSR") S (EDUZ,CNT)=0
20 F S EDUZ=$O(^VA(200,EDUZ)) Q:'EDUZ I $D(^VA(200,EDUZ,"EC",UNT,0)) D
21 . S CNT=CNT+1,^TMP($J,"ECUSR",CNT)=$P(^VA(200,EDUZ,0),U)_U_EDUZ
22 S RESULTS=$NA(^TMP($J,"ECUSR"))
23 Q
24 ;
25ECLOC(RESULTS) ;
26 ;
27 ;This broker entry point returns all active Event Capture locations
28 ; RPC: EC GETECLOC
29 ;
30 ;OUTPUTS RESULTS - The array of active Event Capture locations.
31 ; PIECE - Description
32 ; 1 Location description
33 ; 2 LOC IEN
34 N LOC
35 D SETENV
36 K ^TMP($J,"ECLOC")
37 D GETLOC^ECL(.LOC) M ^TMP($J,"ECLOC")=LOC
38 S RESULTS=$NA(^TMP($J,"ECLOC"))
39 Q
40ECSCN(RESULTS,ECARY) ;
41 ;
42 ;Broker call returns the entries from EC EVENT CODE SCREENS FILE #720.3
43 ; RPC: GETECSCREEN
44 ;INPUTS ECARY - Contains the following subscripted elements
45 ; STAT - Active or inactive Event Code Screens
46 ; A-ctive (default), I-nactive, B-oth
47 ; LOCIEN - Location IEN (optional)
48 ; DSSIEN - DSS IEN (optional)
49 ;
50 ;OUTPUTS RESULTS - Array of EC screens, contains
51 ; 720.3 ien^location description^DSS Unit description^Category
52 ; desription^Procedure 5 digit code and description
53 ;
54 N STAT,IEN,CNT,ACT,FL,V,EI,ECSCR,CLN,LOC,UNT,CAT,PX,NODE,LOCIEN,DSSIEN
55 D SETENV K ^TMP($J,"ECSCN")
56 S STAT=$P($G(ECARY,"A"),U),LOCIEN=$P($G(ECARY),U,2),FL="4,724,726"
57 S V="LOC,UNT,CAT",(IEN,CNT)=0,DSSIEN=$P(ECARY,U,3)
58 F S IEN=$O(^ECJ(IEN)) Q:'IEN S NODE=$G(^ECJ(IEN,0)) I NODE'="" D
59 .S ACT=$P(NODE,U,2),ECSCR=$TR($P(NODE,U),"-;,","^^")
60 .I $S(STAT="A"&(ACT'=""):1,STAT="I"&(ACT=""):1,1:0) Q
61 .I LOCIEN'="",LOCIEN'=$P(ECSCR,U) Q
62 .I DSSIEN'="",DSSIEN'=$P(ECSCR,U,2) Q
63 .F EI=1:1:3 D
64 ..S @$P(V,",",EI)=$$GET1^DIQ($P(FL,",",EI),$P(ECSCR,U,EI),.01,"E"),PX=""
65 .I $P(ECSCR,U,5)["EC" D
66 ..S PRO=$G(^EC(725,$P(ECSCR,U,4),0)),PX=$P(PRO,U,2)_" "_$P(PRO,U)
67 .E S PRO=$$CPT^ICPTCOD($P(ECSCR,U,4)) S PX=$P(PRO,U,2)_" "_$P(PRO,U,3)
68 .S CNT=CNT+1,^TMP($J,"ECSCN",CNT)=IEN_U_LOC_U_UNT_U_CAT_U_PX
69 S RESULTS=$NA(^TMP($J,"ECSCN"))
70 Q
71ECSDTLS(RESULTS,ECARY) ;
72 ;
73 ;Broker call returns details on an Event Code Screen from EC EVENT
74 ;CODE SCREENS FILE #720.3
75 ; RPC: GETECSDETAIL
76 ;INPUTS ECARY - Contains the following data
77 ; Event code screen IEN
78 ;
79 ;OUTPUTS RESULTS - Details of EC screen, contains
80 ; 720.3 ien^event code screen key^synonym^volume^associated
81 ; clinic^Procedure reason indicator^event code screen status
82 ; flag (y-active,n-inactive)^Send To PCE
83 ;
84 N NODE,PRO,CLN,STAT,STR,SPCE
85 Q:$G(ECARY)="" Q:'$D(^ECJ(ECARY,0))
86 D SETENV
87 S NODE=^ECJ(ECARY,0),PRO=$G(^ECJ(ECARY,"PRO")),SPCE=$P(NODE,"-",2)
88 S SPCE=$P($G(^ECD(SPCE,0)),U,14),SPCE=$S(SPCE="O":1,SPCE="A":1,1:0)
89 S STAT=$S($P(NODE,U,2)="":"Y",1:"N")
90 S:$P(PRO,U,4)'="" CLN=$$GET1^DIQ(44,$P(PRO,U,4),.01,"E")
91 S STR=ECARY_U_$P(NODE,U)_U_$P(PRO,U,2,3)_U_$G(CLN)_U_$P(PRO,U,5)_U_STAT
92 S RESULTS=STR_U_SPCE
93 Q
94 ;
95DSSECS(RESULTS,ECARY) ;
96 ;
97 ;Broker call returns a list of Event Code Screen from EC EVENT CODE
98 ;SCREENS FILE #720.3 based on a DSS Unit
99 ; RPC: EC GETDSSECS
100 ;INPUTS ECARY - Contains the following data
101 ; ECD - DSS Unit IEN
102 ; ECL - Location
103 ;
104 ;OUTPUTS RESULTS - Data on EC screen, contains
105 ; 720.3 ien^Procedure 5 digit code and description^Location^
106 ; status(Y-active, N-inactive)^Category description^synonym
107 ;
108 N NODE,PRO,STAT,CNT,ECD,LOC,CAT,IEN,PX,PN,CATD,LOCDS,ECL,ECSYN
109 S ECD=$P(ECARY,U),ECL=$P(ECARY,U,2) I ECD="",ECL="" Q
110 D SETENV K ^TMP($J,"ECDSSECS")
111 S (CNT,LOC)=0 I ECL'="" S LOC=ECL-1
112 F S LOC=$O(^ECJ("AP",LOC)) Q:'LOC S CAT="" Q:ECL&(ECL'=LOC) D
113 .I ECD'="" D:$D(^ECJ("AP",LOC,ECD)) GETSCN Q
114 .S ECD=0 F S ECD=$O(^ECJ("AP",LOC,ECD)) Q:'ECD D GETSCN
115 S RESULTS=$NA(^TMP($J,"ECDSSECS"))
116 Q
117GETSCN F S CAT=$O(^ECJ("AP",LOC,ECD,CAT)) Q:CAT="" S PX="" D
118 .F S PX=$O(^ECJ("AP",LOC,ECD,CAT,PX)) Q:PX="" S IEN=0 D
119 ..F S IEN=$O(^ECJ("AP",LOC,ECD,CAT,PX,IEN)) Q:'IEN D
120 ...S NODE=$G(^ECJ(IEN,0)) I NODE="" Q
121 ...S PRO=$G(^ECJ(IEN,"PRO")),ECSYN=$P(PRO,U,2),PN=$P($P(PRO,U),";")
122 ...I PN="" Q
123 ...I $P(PRO,U)["EC" S PN=$G(^EC(725,PN,0)),PRO=$P(PN,U,2)_" "_$P(PN,U)
124 ...E S PN=$$CPT^ICPTCOD(PN) S PRO=$P(PN,U,2)_" "_$P(PN,U,3)
125 ...S STAT=$S($P(NODE,U,2)'="":"No",1:"Yes")
126 ...S CATD=$S('CAT:"None",1:$P($G(^EC(726,CAT,0)),U))
127 ...S LOCDS=$$GET1^DIQ(4,LOC,.01,"I"),CNT=CNT+1
128 ...S ^TMP($J,"ECDSSECS",CNT)=IEN_U_PRO_U_LOCDS_U_STAT_U_CATD_U_ECSYN
129 Q
130 ;
131ECPXRS(RESULTS,ECARY) ;
132 ;
133 ;Broker call returns entries for Procedure reasons linked to EC screen.
134 ; RPC: EC GETPXREASON
135 ;INPUTS ECARY - Contains the following subscripted elements
136 ; ECSCR - Event code screen ien (file #720.3)
137 ;
138 ;OUTPUTS RESULTS - Array of procedure reasons for EC screen
139 ; Procedure reason^procedure reason ien #720.4^Event Code
140 ; screens/procedure reason link ien #720.5
141 ;
142 N RSN,IEN,CNT,RIEN
143 S ECSCR=$G(ECARY,"") I ECSCR="" Q
144 D SETENV
145 K ^TMP($J,"ECPXREAS") S (IEN,CNT)=0
146 F S IEN=$O(^ECL("AD",ECSCR,IEN)) Q:'IEN D
147 . S RSN=$G(^ECR(IEN,0)),RIEN=$O(^ECL("AD",ECSCR,IEN,0)) Q:'$P(RSN,U,2)
148 . S CNT=CNT+1,^TMP($J,"ECPXREAS",CNT)=$P(RSN,U)_U_IEN_U_RIEN
149 S RESULTS=$NA(^TMP($J,"ECPXREAS"))
150 Q
151 ;
152ECNATPX(RESULTS,ECARY) ;
153 ;
154 ;Broker call returns EC national & local Procedures from file #725.
155 ; RPC: EC GETNATPX
156 ;INPUTS ECARY - Contains the following subscripted elements
157 ; ECPX - Procedures to output, L- local, N- National, B- Both
158 ; STAT - Active or inactive EC Nat Codes
159 ; A-ctive (default), I-nactive, B-oth
160 ;
161 ;OUTPUTS RESULTS - Array of EC local procedures
162 ; ien #725^Procedure name^national number^inactive date^
163 ; synonym^CPT ien^CPT code^CPT Short Name
164 ;
165 N STAT,IEN,STR,CNT,ACT,CPT,CPTDAT,ECPX
166 D SETENV
167 S ECPX=$P(ECARY,U),STAT=$P(ECARY,U,2)
168 S:ECPX="" ECPX="L" S:STAT="" STAT="A"
169 K ^TMP($J,"ECLOCPX")
170 S IEN=$S(ECPX="L":90000,1:0),CNT=0
171 F S IEN=$O(^EC(725,IEN)) Q:'IEN!((ECPX="N")&(IEN>90000)) D
172 . S STR=$G(^EC(725,IEN,0)) I STR="" Q
173 . S ACT=$P(STR,U,3),CPT=$P(STR,U,5)
174 . I $S(STAT="A"&(ACT'=""):1,STAT="I"&(ACT=""):1,1:0) Q
175 . S CPTDAT=$S(CPT="":"",1:$$CPT^ICPTCOD(CPT))
176 . S CNT=CNT+1,^TMP($J,"ECLOCPX",CNT)=IEN_U_STR_U_$P(CPTDAT,U,2,3)
177 S RESULTS=$NA(^TMP($J,"ECLOCPX"))
178 Q
179SETENV ;set environment variables for RPC broker
180 I '$G(DUZ) D
181 . S DUZ=.5,DUZ(0)="@",U="^",DTIME=300
182 . D NOW^%DTC S DT=X
183 Q
Note: See TracBrowser for help on using the repository browser.