source: FOIAVistA/trunk/r/EVENT_CAPTURE-EC--ECT--ECX/ECUERPC1.m@ 1336

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

initial load of FOIAVistA 6/30/08 version
File size: 9.4 KB
Line 
1ECUERPC1 ;ALB/JAM;Event Capture Data Entry Broker Util ; 5/21/01 7:30pm
2 ;;2.0; EVENT CAPTURE ;**25,33,42,46,47,54,72**;8 May 96
3PATINF(RESULTS,ECARY) ;
4 ;Broker entry point to get various types of data from EVENT CAPTURE
5 ;PATIENT FILE #721
6 ; RPC: EC GETPATINFO
7 ;INPUTS ECARY - Contains the following subscripted elements
8 ; ECIEN - Event Capture Patient ien
9 ; ECTYP - Data type to return
10 ;
11 ;OUTPUTS RESULTS - Array of Event Capture Patient data
12 ;
13 N ECTYP,ECIEN
14 S ECARY=$G(ECARY),ECIEN=$P(ECARY,U),ECTYP=$P(ECARY,U,2) I ECIEN="" Q
15 I '$D(^ECH(ECIEN)) Q
16 D SETENV^ECUMRPC
17 I ECTYP="DXS" D PATDXS(ECIEN) Q
18 I ECTYP="MOD" D PATMOD(ECIEN) Q
19 I ECTYP="CLASS" D PATCLASS(ECIEN) Q
20 I ECTYP="OTH" D PATOTH(ECIEN) Q
21 I ECTYP="PRV" D PATPRV^ECUERPC2(ECIEN) Q
22 Q
23PATDXS(ECIEN) ;
24 ;Returns to broker a patient secondary DXs entries from EVENT
25 ;CAPTURE PATIENT FILE #721
26 ;INPUTS ECIEN - Event Capture Patient ien
27 ;
28 ;OUTPUTS RESULTS - Array of Event Capture Patient file contains
29 ; 721 IEN^secondary dx ien #80^secondary dx code^dx description
30 ;
31 N DXS,DXSIEN,DXSD,CNT
32 I '$D(^ECH(ECIEN,"DX")) Q
33 K ^TMP($J,"ECDXS")
34 S (CNT,DXS)=0 F S DXS=$O(^ECH(ECIEN,"DX",DXS)) Q:'DXS D
35 . S DXSIEN=$G(^ECH(ECIEN,"DX",DXS,0)) I DXSIEN="" Q
36 . S DXSD=$$ICDDX^ICDCODE(DXSIEN,$P($G(^ECH(ECIEN,0)),U,3))
37 . S DXSD=$P(DXSD,U,2)_" "_$P(DXSD,U,4)
38 . S CNT=CNT+1,^TMP($J,"ECDXS",CNT)=ECIEN_U_DXSIEN_U_DXSD
39 S RESULTS=$NA(^TMP($J,"ECDXS"))
40 Q
41PATMOD(ECIEN) ;
42 ;Returns to broker a patient procedure modifier from EVENT CAPTURE
43 ;PATIENT FILE #721
44 ;INPUTS ECIEN - Event Capture Patient ien
45 ;
46 ;OUTPUTS RESULTS - Array of procedure modifiers
47 ; 721 IEN^modifier ien #81.3^modifier^modifier name
48 ;
49 N MOD,MODIEN,CNT,MODS
50 I '$D(^ECH(ECIEN,"MOD")) Q
51 K ^TMP($J,"ECMOD")
52 S (CNT,MOD)=0 F S MOD=$O(^ECH(ECIEN,"MOD",MOD)) Q:'MOD D
53 . S MODIEN=$G(^ECH(ECIEN,"MOD",MOD,0)) I MODIEN="" Q
54 . S MODS=$$MOD^ICPTMOD(MODIEN,"I",$P($G(^ECH(ECIEN,0)),U,3)) I +MODS<0 Q
55 . S CNT=CNT+1
56 . S ^TMP($J,"ECMOD",CNT)=ECIEN_U_$P(MODS,U,1,2)_" "_$P(MODS,U,3)
57 S RESULTS=$NA(^TMP($J,"ECMOD"))
58 Q
59PATCLASS(ECIEN) ;
60 ;Returns to broker a patient classification & eligibility data from
61 ;EVENT CAPTURE PATIENT FILE #721
62 ; INPUTS ECIEN - Event Capture Patient ien
63 ; OUTPUTS RESULTS - Array of procedure modifiers
64 ; 721 IEN^agent orange^radiation exposure^service connect^environmental
65 ; contaminants^military sexual trauma^eligibility code #8^eligibility
66 ; description^head/neck cancer^combat veteran
67 ;
68 N CLA,ELIG,ELCOD,ECAO,ECIR,ECEC,ECSC,ECMST,STR,ECHNC,ECCV
69 I '$D(^ECH(ECIEN,"P")),'$D(^ECH(ECIEN,"PCE")) Q
70 K ^TMP($J,"ECLASS")
71 S ELIG=$P($G(^ECH(ECIEN,"PCE")),"~",17),ELCOD="",CLA=$G(^ECH(ECIEN,"P"))
72 S:ELIG'="" ELCOD=$P($G(^DIC(8,ELIG,0)),U)
73 S ECAO=$P(CLA,U,3),ECIR=$P(CLA,U,4),ECEC=$P(CLA,U,5),ECSC=$P(CLA,U,6)
74 S ECMST=$P(CLA,U,9),ECHNC=$P(CLA,U,10),ECCV=$P(CLA,U,11)
75 S STR=ECIEN_U_ECAO_U_ECIR_U_ECSC_U_ECEC_U_ECMST
76 S STR=STR_U_ELIG_U_ELCOD_U_ECHNC_U_ECCV,^TMP($J,"ECLASS",1)=STR
77 S RESULTS=$NA(^TMP($J,"ECLASS"))
78 Q
79PATOTH(ECIEN) ;
80 ;Returns to broker a patient remaining data from EVENT CAPTURE
81 ;PATIENT FILE #721
82 ;INPUTS ECIEN - Event Capture Patient ien
83 ;
84 ;OUTPUTS RESULTS -
85 ; 721 IEN^procedure reason
86 ;
87 N REAS,ECX
88 K ^TMP($J,"ECOTH")
89 S ECX=^ECH(ECIEN,0)
90 S REAS=$$GET1^DIQ(721,ECIEN,34,"E")
91 S ^TMP($J,"ECOTH",1)=REAS
92 S RESULTS=$NA(^TMP($J,"ECOTH"))
93 Q
94PATCLAST(RESULTS,ECARY) ;
95 ;Returns to broker a patient status (in/out) and classification
96 ; RPC: EC GETPATCLASTAT
97 ;INPUTS ECARY - Contains the following subscripted elements
98 ; ECDFN - Patient ien (#2)
99 ; ECD - DSS Unit ien (#724)
100 ; ECDT - Procedure date and time (fileman format)
101 ;OUTPUTS RESULTS - Patient status and classifications delimited by (^)
102 ; Patient Status: I for inpatient or O for outpatient
103 ; Classification: 2- Agent Orange, 3- Ionizing Radiation
104 ; 4- SC Condition, 5- Environmental Contaminants 6- Military
105 ; Sexual Trauma 7- Head/Neck Cancer 8- Combat Veteran
106 ; Data after the '~' refers to those class. that must be asked
107 ; by Delphi appl. when the answer to SC=No.
108 ; Data after "~" 1- Agent Orange 2- Ionizing Radi. 3- Env Cont
109 N ECDFN,ECDT,ECX,I,ECCLARY,SCDAT,PATSTAT
110 D SETENV^ECUMRPC
111 S ECDFN=$P(ECARY,U),ECD=$P(ECARY,U,2),ECDT=$P(ECARY,U,3) Q:ECDFN=""
112 I ECDT="" D NOW^%DTC S ECDT=%
113 S PATSTAT=$$INOUTPT^ECUTL0(ECDFN,ECDT),RESULTS="^^^^^^",SCDAT=";;;"
114 I PATSTAT="I" D Q ;added to be consistent w roll-n-scroll 11/25/03 JAM
115 .S RESULTS=PATSTAT_"^"_RESULTS_$S(SCDAT'="":"~"_SCDAT,1:"")
116 I '$$CHKDSS^ECUTL0(+$G(ECD),PATSTAT) D Q
117 .S RESULTS=PATSTAT_"^"_RESULTS_$S(SCDAT'="":"~"_SCDAT,1:"")
118 D CL^SDCO21(ECDFN,ECDT,"",.ECCLARY) F ECX=3,1,2,4,5,6,7 D
119 .I ECX=1,$P($G(^DPT(ECDFN,.321)),"^",2)'="Y" Q
120 .I ECX=2,$P($G(^DPT(ECDFN,.321)),"^",3)'="Y" Q
121 .I ECX=4,$P($G(^DPT(ECDFN,.322)),"^",13)'="Y",'$$EC^SDCO22(ECDFN,"") Q
122 .I ECX=3,$D(ECCLARY(ECX)) F I=1,2,4 S ECCLARY(I)="SC"
123 .I '$D(ECCLARY(ECX)) Q
124 .;Check SC, if answer to SC is NO then these questions will be asked
125 .I ECCLARY(ECX)="SC" S $P(SCDAT,";",ECX)="E"
126 .E S $P(RESULTS,"^",ECX)="E"
127 S RESULTS=PATSTAT_"^"_RESULTS_$S(SCDAT'="":"~"_SCDAT,1:"")
128 Q
129ENCDXS(RESULTS,ECARY) ;
130 ;Broker call returns a patient encounter primary & secondary dx (#721)
131 ; RPC: EC GETENCDXS
132 ;INPUTS ECDFN - Patient ien (#2)
133 ; ECDT - Procedure date and time (fileman format)
134 ; ECL - Location ien
135 ; EC4 - Clinic ien
136 ;
137 ;OUTPUTS RESULTS - array of patient encounter diagnosis
138 ; primary/secondary flag^DX ien^DX code DX description.
139 ;
140 N ECDFN,ECDT,ECL,EC4,ECPDX,ECDX,ECDXN,ECDXS,CNT,STR,ECPDX,SDXCNT
141 D SETENV^ECUMRPC
142 K ^TMP($J,"ECENCDXS")
143 S ECDFN=$P(ECARY,U),ECDT=+$P(ECARY,U,2),ECL=$P(ECARY,U,3)
144 S EC4=$P(ECARY,U,4) I ECDT="" D NOW^%DTC S ECDT=%
145 I ECDFN=""!(ECL="")!(EC4="") Q
146 S (ECDX,ECDXN)="",ECPDX=$$PDXCK^ECUTL2(ECDFN,ECDT,ECL,EC4) I ECDX="" Q
147 S IEN="",STR=1_U_ECDX_U_ECDXN_" "_$P($$ICDDX^ICDCODE(ECDX,ECDT),U,4)
148 S CNT=1,^TMP($J,"ECENCDXS",CNT)=STR
149 ;*ACS concat description to 2nd diag code, in the order entered by the user
150 F S IEN=$O(ECDXS(IEN)) Q:IEN="" D
151 . S CNT=CNT+1,^TMP($J,"ECENCDXS",CNT)=0_U_ECDXS(IEN)_U_IEN_" "_$P($$ICDDX^ICDCODE(ECDXS(IEN),ECDT),U,4)
152 S RESULTS=$NA(^TMP($J,"ECENCDXS"))
153 Q
154 ;
155PROCBAT(RESULTS,ECARY) ;
156 ;Broker call returns the entries from EVENT CAPTURE PATIENT FILE #721
157 ;for patients for a specific procedure
158 ; RPC: EC GETBATPROCS
159 ;INPUTS ECARY - Contains the following subscripted elements
160 ; ECLOC - Location ien
161 ; ECUNT - DSS unit ien
162 ; ECC - Category ien
163 ; ECP - Procedure ien
164 ; ECSD - Start Date
165 ; ECED - End Date
166 ;
167 ;OUTPUTS RESULTS - Array of Event Capture Patient data containing:-
168 ; 721 IEN^Patient name^Procedure Date/Time^Primary Dx
169 ; ^Ordering Section^Associated Clinic
170 ;^SSN^DOB^Procedure Date and Time
171 N IEN,CNT,ECLOC,ECUNT,NODE,DATA,PXDT,ECV,ECC,ECP,ECSD,ECED,DATE,DFN
172 N CAT,ECI,VADM,ORC,ASC,ECDX
173 S ECV="ECLOC^ECUNT^ECC^ECP^ECSD^ECED"
174 D PARSE^ECUERPC(ECV,ECARY)
175 I (ECLOC="")!(ECUNT="")!(ECC="")!(ECP="") Q
176 D SETENV^ECUMRPC K ^TMP($J,"ECBATPX") S CNT=0
177 S %DT="STX" F ECI="ECSD","ECED" S X=@ECI D ^%DT S @ECI=Y
178 S ECSD=$S(ECSD=-1:DT,1:ECSD)-.0001,ECED=$S(ECED=-1:DT,1:ECED)+.9999
179 Q:ECED'>ECSD S DATE=ECSD
180 F S DATE=$O(^ECH("AC1",ECLOC,DATE)) Q:'DATE!(DATE>ECED) S IEN=0 D
181 . F S IEN=$O(^ECH("AC1",ECLOC,DATE,IEN)) Q:'IEN D
182 . . S NODE=$G(^ECH(IEN,0)) Q:NODE="" Q:$P(NODE,U,7)'=ECUNT
183 . . Q:$P(NODE,U,8)'=ECC Q:$P(NODE,U,9)'=ECP
184 . . S ECDX=$P($G(^ECH(IEN,"P")),U,2) I ECDX'="" D
185 . . . S ECDX=$$ICDDX^ICDCODE(ECDX,DATE)
186 . . . S ECDX=$P(ECDX,U,2)_" "_$P(ECDX,U,4)
187 . . S ASC=$P(NODE,U,19) S:ASC'="" ASC=$$GET1^DIQ(44,ASC,.01,"I")
188 . . S ORC=$P(NODE,U,12) S:ORC'="" ORC=$$GET1^DIQ(723,ORC,.01,"I")
189 . . S Y=DATE X ^DD("DD") S PXDT=Y,DFN=$P(NODE,U,2) D DEM^VADPT
190 . . S DATA=$E(VADM(1),1,30)_U_PXDT_U_ECDX_U_ORC_U_ASC
191 . . S CNT=CNT+1,^TMP($J,"ECBATPX",CNT)=IEN_U_DATA
192 S RESULTS=$NA(^TMP($J,"ECBATPX"))
193 Q
194 ;
195CLHLP(RESULTS,ECARY) ;RPC Broker entry point for classification help
196 ; RPC: EC CLASHELP
197 ;INPUTS ECARY - Contains the following elements for report printing
198 ; ECDFN - Patient DFN from file (#2)
199 ; ECKY - Key to provide help on
200 ;
201 ;OUTPUTS RESULTS - Array of help text for classification
202 ;
203 N ECFILER,ECERR,ECDIRY,ECUFILE,ECDFN,ECKY,ECHNDL
204 D SETENV^ECUMRPC
205 K ^TMP("ECMSG",$J)
206 S ECERR=0,ECDFN=$P(ECARY,U),ECKY=$P(ECARY,U,2) D I ECERR D CLEND Q
207 .I ECDFN="" S ECERR=1,^TMP("ECMSG",$J,1)="0^Patient IEN not defined" Q
208 .I ECKY="" S ECERR=1,^TMP("ECMSG",$J,1)="0^Help Key not defined" Q
209 .S DIC=2,DIC(0)="NMZX",X=ECDFN D ^DIC I Y<0 D
210 ..S ECERR=1,^TMP("ECMSG",$J,1)="0^Patient IEN not found"
211 S ECHNDL="ECLASHLP" D HFSOPEN^ECRRPC(ECHNDL) I ECERR D CLEND Q
212 U IO
213 I ECKY="SC" D SC^SDCO23(ECDFN)
214 D HFSCLOSE^ECRRPC(ECFILER)
215CLEND ;
216 I $D(^TMP("ECMSG",$J)) S RESULTS=$NA(^TMP("ECMSG",$J)) Q
217 S RESULTS=$NA(^TMP($J))
218 Q
219ECDEF(RESULTS,ECARY) ;RPC Broker entry point to get a default for space bar
220 ; RPC: EC SPACEBAR
221 ;INPUTS ECARY - Contains the following elements for report printing
222 ; ECFILE - File to obtain value from
223 ;
224 ;OUTPUTS RESULTS - IEN^Description of Text
225 ;
226 N DIC,ECFILE,X,Y
227 D SETENV^ECUMRPC
228 S ECFILE=$P(ECARY,U)
229 I ECFILE="" S ECERR=1,RESULTS="0^File not defined" Q
230 S X=" ",DIC(0)="MZX",DIC=ECFILE D ^DIC I Y<0 D I ECERR Q
231 . S ECERR=1,RESULTS="0^Nothing found"
232 S RESULTS=Y
233 Q
Note: See TracBrowser for help on using the repository browser.