source: FOIAVistA/trunk/r/CLINICAL_CASE_REGISTRIES-ROR/RORX013A.m@ 870

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

initial load of FOIAVistA 6/30/08 version
File size: 7.0 KB
Line 
1RORX013A ;HCIOFO/SG - DIAGNOSIS CODES (QUERY & SORT) ; 6/21/06 2:24pm
2 ;;1.5;CLINICAL CASE REGISTRIES;**1**;Feb 17, 2006;Build 24
3 ;
4 ; This routine uses the following IAs:
5 ;
6 ; #928 ACTIVE^GMPLUTL
7 ; #1554 POV^PXAPIIB (controlled)
8 ; #1900-F SELECTED^VSIT (controlled)
9 ; #2977 GETFLDS^GMPLEDT3
10 ; #3157 RPC^DGPTFAPI (supported)
11 ; #3545 Access to the "AAD" cross-reference and the field 80
12 ; #3990 $$CODEN^ICDCODE and $$ICDDX^ICDCODE (supported)
13 ; #10082 Read access to the file #80 (supported)
14 ;
15 Q
16 ;
17 ;**** STORES THE ICD-9 CODE
18 ;
19 ; PATIEN Patient IEN (DFN)
20 ; SOURCE ICD-9 source code ("I", "O", "PB")
21 ; [ICD9IEN] IEN of the ICD-9 descriptor in file #80
22 ; DATE Date when the code was entered
23 ; [ICD9] ICD-9 code
24 ;
25 ; Either the ICD9IEN or the ICD9 parameter must be provided.
26 ;
27ICD9SET(PATIEN,SOURCE,ICD9IEN,DATE,ICD9) ;
28 Q:DATE'>0
29 N TMP
30 S ICD9IEN=+$G(ICD9IEN)
31 I ICD9IEN'>0 Q:$G(ICD9)="" D Q:ICD9IEN'>0
32 . S ICD9IEN=+$$CODEN^ICDCODE(ICD9,80)
33 ;---
34 Q:$$ICDGRCHK^RORXU008(.RORPTGRP,ICD9IEN,RORICDL)
35 ;---
36 S TMP=+$G(@RORTMP@("PAT",PATIEN,ICD9IEN))
37 S:'TMP!(DATE<TMP) @RORTMP@("PAT",PATIEN,ICD9IEN)=DATE_U_SOURCE
38 S ^(SOURCE)=$G(@RORTMP@("PAT",PATIEN,ICD9IEN,SOURCE))+1
39 Q
40 ;
41 ;***** SEARCHES FOR INPATIENT DIAGNOSES
42 ;
43 ; PATIEN Patient IEN (DFN)
44 ;
45 ; Return Values:
46 ; <0 Error code
47 ; 0 Ok
48 ; >0 Number of non-fatal errors
49 ;
50INPAT(PATIEN) ;
51 N ADMDT,DISDT,I,IEN,NODE,RC,RORBUF,RORMSG,TMP
52 S NODE=$NA(^DGPT("AAD",+PATIEN))
53 S RC=0
54 ;--- Browse through the admissions
55 S ADMDT=ROREDT1
56 F S ADMDT=$O(@NODE@(ADMDT),-1) Q:ADMDT'>0 D Q:RC
57 . S IEN=""
58 . F S IEN=$O(@NODE@(ADMDT,IEN),-1) Q:IEN'>0 D Q:RC
59 . . Q:+$G(^DGPT(IEN,0))'=PATIEN
60 . . Q:$$PTF^RORXU001(IEN,"FP",,.DISDT)
61 . . ;--- Skip invalid and/or incomplete admissions
62 . . I DISDT'>0 D Q:TMP!(DISDT'>0)
63 . . . S TMP=$$CHKADM^RORXU001(PATIEN,ADMDT,.DISDT)
64 . . ;--- Check if any appropriate admissions are left
65 . . I DISDT<RORSDT S RC=1 Q
66 . . Q:DISDT'<ROREDT1
67 . . ;--- Load and process the admission data
68 . . K RORBUF D RPC^DGPTFAPI(.RORBUF,IEN)
69 . . I $G(RORBUF(0))<0 D Q
70 . . . D ERROR^RORERR(-57,,,,RORBUF(0),"RPC^DGPTFAPI")
71 . . S TMP=$P($G(RORBUF(1)),U,3)
72 . . D:TMP'="" ICD9SET(PATIEN,"I",,DISDT,TMP) ; ICD1
73 . . D:$G(RORBUF(2))'="" ; ICD2 - ICD10
74 . . . F I=1:1:9 S TMP=$P(RORBUF(2),U,I) D:TMP'=""
75 . . . . D ICD9SET(PATIEN,"I",,DISDT,TMP)
76 . . S TMP=+$$GET1^DIQ(45,IEN,80,"I",,"RORMSG")
77 . . D:$G(DIERR) DBS^RORERR("RORMSG",-9,,,45,IEN)
78 . . D:TMP>0 ICD9SET(PATIEN,"I",TMP,DISDT) ; PRINCIPAL DIAGNOSIS
79 ;---
80 Q $S(RC<0:RC,1:0)
81 ;
82 ;***** SEARCHES FOR OUTPATIENT DIAGNOSES
83 ;
84 ; PATIEN Patient IEN (DFN)
85 ;
86 ; Return Values:
87 ; <0 Error code
88 ; 0 Ok
89 ; >0 Number of non-fatal errors
90 ;
91OUTPAT(PATIEN) ;
92 N DATE,ICDIEN,RC,RORMSG,RORVPLST,TMP,VPIEN,VSIEN,VSIT
93 D SELECTED^VSIT(PATIEN,RORSDT,ROREDT)
94 ;--- Browse through the visits
95 S (VSIEN,RC)=0
96 F S VSIEN=$O(^TMP("VSIT",$J,VSIEN)) Q:VSIEN="" D Q:RC<0
97 . S TMP=+$O(^TMP("VSIT",$J,VSIEN,"")) Q:TMP'>0
98 . S DATE=$P($G(^TMP("VSIT",$J,VSIEN,TMP)),U) Q:DATE'>0
99 . ;--- Get a list of V POV records
100 . D POV^PXAPIIB(VSIEN,.RORVPLST)
101 . ;--- Process the records
102 . S (VPIEN,RC)=0
103 . F S VPIEN=$O(RORVPLST(VPIEN)) Q:VPIEN'>0 D Q:RC
104 . . S ICDIEN=+$P(RORVPLST(VPIEN),U)
105 . . D:ICDIEN>0 ICD9SET(PATIEN,"O",ICDIEN,DATE)
106 Q $S(RC<0:RC,1:0)
107 ;
108 ;***** SEARCHES FOR PROBLEMS
109 ;
110 ; PATIEN Patient IEN (DFN)
111 ;
112 ; Return Values:
113 ; <0 Error code
114 ; 0 Ok
115 ; >0 Number of non-fatal errors
116 ;
117PROBLEM(PATIEN) ;
118 N DATE,GMPFLD,GMPORIG,GMPROV,GMVAMC,ICDIEN,IEN,RC,RORPLST,TMP
119 ;--- Load a list of active problems
120 D ACTIVE^GMPLUTL(PATIEN,.RORPLST)
121 ;--- Browse through the problems
122 S (GMPVAMC,GMPROV)=0
123 S (IS,RC)=0
124 F S IS=$O(RORPLST(IS)) Q:IS="" D Q:RC
125 . S IEN=+$G(RORPLST(IS,0)) Q:IEN'>0
126 . K GMPFLD,GMPORIG D GETFLDS^GMPLEDT3(IEN)
127 . S ICDIEN=+$G(GMPFLD(.01)) Q:ICDIEN'>0
128 . S DATE=$P($G(GMPFLD(.08)),U)
129 . D:(DATE'<RORSDT)&(DATE<ROREDT1) ICD9SET(PATIEN,"PB",ICDIEN,DATE)
130 Q 0
131 ;
132 ;***** QUERIES THE REGISTRY
133 ;
134 ; FLAGS Flags for the $$SKIP^RORXU005
135 ;
136 ; Return Values:
137 ; <0 Error code
138 ; 0 Ok
139 ; >0 Number of non-fatal errors
140 ;
141QUERY(FLAGS) ;
142 N RORDOD ; Date of death
143 N ROREDT1 ; Day after the end date
144 N RORLAST4 ; Last 4 digits of the current patient's SSN
145 N RORPNAME ; Name of the current patient
146 N RORPTGRP ; Temporary list of ICD-9 groups
147 N RORPTN ; Number of patients in the registry
148 ;
149 N CNT,ECNT,IEN,IENS,PATIEN,RC,TMP,VA,VADM,XREFNODE
150 S XREFNODE=$NA(^RORDATA(798,"AC",+RORREG))
151 S RORPTN=$$REGSIZE^RORUTL02(+RORREG) S:RORPTN<0 RORPTN=0
152 S ROREDT1=$$FMADD^XLFDT(ROREDT\1,1)
153 S (CNT,ECNT,RC)=0
154 ;
155 ;--- Browse through the registry records
156 S IEN=0
157 F S IEN=$O(@XREFNODE@(IEN)) Q:IEN'>0 D Q:RC<0
158 . S TMP=$S(RORPTN>0:CNT/RORPTN,1:"")
159 . S RC=$$LOOP^RORTSK01(TMP) Q:RC<0
160 . S IENS=IEN_",",CNT=CNT+1
161 . ;--- Check if the patient should be skipped
162 . Q:$$SKIP^RORXU005(IEN,FLAGS,RORSDT,ROREDT)
163 . ;
164 . ;--- Get the patient IEN (DFN)
165 . S PATIEN=$$PTIEN^RORUTL01(IEN) Q:PATIEN'>0
166 . M RORPTGRP=RORIGRP("C")
167 . ;
168 . ;--- Inpatient codes
169 . S RC=$$INPAT(PATIEN)
170 . I RC Q:RC<0 S ECNT=ECNT+RC
171 . ;
172 . ;--- Outpatient codes
173 . S RC=$$OUTPAT(PATIEN)
174 . I RC Q:RC<0 S ECNT=ECNT+RC
175 . ;
176 . ;--- Problem list
177 . S RC=$$PROBLEM(PATIEN)
178 . I RC Q:RC<0 S ECNT=ECNT+RC
179 . ;
180 . ;--- Skip the patient if no data has been found
181 . Q:$D(@RORTMP@("PAT",PATIEN))<10
182 . ;--- No ICD-9 from some groups
183 . I $D(RORPTGRP)>1 K @RORTMP@("PAT",PATIEN) Q
184 . ;
185 . ;--- Get the patient's data
186 . D VADEM^RORUTL05(PATIEN,1)
187 . S RORPNAME=VADM(1),RORDOD=$P(VADM(6),U),RORLAST4=VA("BID")
188 . ;
189 . ;--- Calculate the patient's totals
190 . S RC=$$TOTALS(PATIEN)
191 . I RC Q:RC<0 S ECNT=ECNT+RC
192 ;---
193 Q $S(RC<0:RC,1:ECNT)
194 ;
195 ;***** SORTS THE RESULTS AND COMPILES THE TOTALS
196 ;
197 ; Return Values:
198 ; <0 Error code
199 ; 0 Ok
200 ; >0 Number of non-fatal errors
201 ;
202SORT() ;
203 N ICDIEN,TMP,TNC,TNDC
204 ;---
205 S ICDIEN=0,(TNC,TNDC)=0
206 F S ICDIEN=$O(@RORTMP@("ICD",ICDIEN)) Q:ICDIEN'>0 D
207 . S TNC=TNC+$G(@RORTMP@("ICD",ICDIEN,"C"))
208 . S TNDC=TNDC+1
209 S @RORTMP@("ICD")=TNC_U_TNDC
210 ;---
211 Q 0
212 ;
213 ;***** CALCULATES INTERMEDIATE TOTALS
214 ;
215 ; PATIEN Patient IEN (DFN)
216 ;
217 ; Return Values:
218 ; <0 Error code
219 ; 0 Ok
220 ; >0 Number of non-fatal errors
221 ;
222TOTALS(PATIEN) ;
223 N CNT,ICD9,ICDIEN,PNODE,RC,TMP
224 S PNODE=$NA(@RORTMP@("PAT",PATIEN))
225 S @PNODE=RORLAST4_U_RORPNAME_U_RORDOD
226 S ^("PAT")=$G(@RORTMP@("PAT"))+1
227 ;
228 S ICDIEN=0
229 F S ICDIEN=$O(@PNODE@(ICDIEN)) Q:ICDIEN'>0 D
230 . S ICD9=$P($G(@RORTMP@("ICD",ICDIEN)),U)
231 . I ICD9="" D
232 . . S TMP=$$ICDDX^ICDCODE(ICDIEN)
233 . . I TMP'<0 S ICD9=$P(TMP,U,2),TMP=$P(TMP,U,4)
234 . . E S TMP=""
235 . . S:ICD9="" ICD9="UNKN"
236 . . S:TMP="" TMP="Unknown ("_ICDIEN_")"
237 . . S @RORTMP@("ICD",ICDIEN)=ICD9_U_TMP
238 . ;---
239 . S CNT=0
240 . F TMP="I","O","PB" S CNT=CNT+$G(@PNODE@(ICDIEN,TMP))
241 . S @PNODE@(ICDIEN,"C")=CNT
242 . S ^("C")=$G(@RORTMP@("ICD",ICDIEN,"C"))+CNT
243 . S ^("P")=$G(@RORTMP@("ICD",ICDIEN,"P"))+1
244 Q 0
Note: See TracBrowser for help on using the repository browser.