source: FOIAVistA/trunk/r/CLINICAL_CASE_REGISTRIES-ROR/RORX015A.m

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

initial load of FOIAVistA 6/30/08 version

File size: 8.0 KB
Line 
1RORX015A ;HCIOFO/SG - OUTPATIENT PROCEDURES (QUERY & SORT) ; 6/21/06 4:36pm
2 ;;1.5;CLINICAL CASE REGISTRIES;**1**;Feb 17, 2006;Build 24
3 ;
4 ; This routine uses the following IAs:
5 ;
6 ; #1995 $$CODEN^ICPTCOD and $$CPT^ICPTCOD (supported)
7 ; #2548 SDQ routine (supported)
8 ; #3990 $$CODEN^ICDCODE and $$ICDOP^ICDCODE (supported)
9 ;
10 Q
11 ;
12 ;***** SEARCHES FOR INPATIENT PROCEDURES
13 ;
14 ; PTIEN Patient IEN (DFN)
15 ;
16 ; Return Values:
17 ; <0 Error code
18 ; 0 Ok
19 ; >0 Number of non-fatal errors
20 ;
21INPAT(PTIEN) ;
22 N DATE,ERRCNT,FLDLST,IEN,IEN45,IENS,NODE,RC,RORBUF,RORMSG,XREF
23 S (ERRCNT,RC)=0
24 S XREF=$$ROOT^DILFD(45,,1),XREF=$NA(@XREF@("B",PTIEN))
25 S IEN45=0
26 F S IEN45=$O(@XREF@(IEN45)) Q:IEN45'>0 D
27 . ;Q:$$GET1^DIQ(45,IEN45_",",6,"I",,"RORMSG")<1 ; Skip open records
28 . ;S IENS=IEN45_","
29 . ;S FLDLST="45.01;45.02;45.03;45.04;45.05"
30 . ;D GETS^DIQ(45,IENS,FLDLST,"I","RORBUF","RORMSG")
31 . ;I $G(DIERR) D S ERRCNT=ERRCNT+1
32 . ;. D DBS^RORERR("RORMSG",-99,,PTIEN,45,IENS)
33 . ;D INP(PTIEN,$NA(RORBUF(IENS)),FLDLST,???)
34 . ;--- Surgical procedures
35 . S NODE=$$ROOT^DILFD(45.01,","_IEN45_",",1)
36 . S IEN=0
37 . F S IEN=$O(@NODE@(IEN)) Q:IEN'>0 D
38 . . S IENS=IEN_","_IEN45_"," K RORBUF
39 . . S FLDLST="8;9;10;11;12"
40 . . ;--- Load the data
41 . . D GETS^DIQ(45.01,IENS,".01;"_FLDLST,"I","RORBUF","RORMSG")
42 . . I $G(DIERR) D S ERRCNT=ERRCNT+1
43 . . . D DBS^RORERR("RORMSG",-99,,PTIEN,45.01,IENS)
44 . . S DATE=$G(RORBUF(45.01,IENS,.01,"I"))
45 . . Q:(DATE<RORSDT)!(DATE'<ROREDT1)
46 . . ;--- Generate the output
47 . . D INP(PTIEN,$NA(RORBUF(45.01,IENS)),FLDLST,DATE)
48 . ;--- Other procedures
49 . S NODE=$$ROOT^DILFD(45.05,","_IEN45_",",1)
50 . S IEN=0
51 . F S IEN=$O(@NODE@(IEN)) Q:IEN'>0 D
52 . . S IENS=IEN_","_IEN45_"," K RORBUF
53 . . S FLDLST="4;5;6;7;8"
54 . . ;--- Load the data
55 . . D GETS^DIQ(45.05,IENS,".01;"_FLDLST,"I","RORBUF","RORMSG")
56 . . I $G(DIERR) D S ERRCNT=ERRCNT+1
57 . . . D DBS^RORERR("RORMSG",-99,,PTIEN,45.05,IENS)
58 . . S DATE=$G(RORBUF(45.05,IENS,.01,"I"))
59 . . Q:(DATE<RORSDT)!(DATE'<ROREDT1)
60 . . ;--- Generate the output
61 . . D INP(PTIEN,$NA(RORBUF(45.05,IENS)),FLDLST,DATE)
62 ;---
63 Q $S(RC<0:RC,1:ERRCNT)
64 ;
65 ;****
66INP(PTIEN,ROR8BUF,FLDLST,DATE) ;
67 N I,ICD9IEN,FLD
68 F I=1:1 S FLD=$P(FLDLST,";",I) Q:FLD="" D
69 . S ICD9IEN=+$G(@ROR8BUF@(FLD,"I"))
70 . D:ICD9IEN>0 PROCSET(PTIEN,"I",ICD9IEN,DATE)
71 Q
72 ;
73 ;***** CALL-BACK PROCEDURE FOR THE OUTPATIENT SEARCH
74 ;
75 ; PTIEN Patient IEN (DFN)
76 ;
77OPSCAN(PTIEN) ;
78 N CPTIEN,DATE,IEN,RORCPT,VDATE
79 D GETCPT^SDOE(Y,"RORCPT")
80 Q:$G(RORCPT)'>0
81 S VDATE=+$P(Y0,U)
82 ;---
83 S IEN=0
84 F S IEN=$O(RORCPT(IEN)) Q:IEN'>0 D
85 . S CPTIEN=+$P(RORCPT(IEN),U),DATE=+$P($G(RORCPT(IEN,12)),U)
86 . D:CPTIEN>0 PROCSET(PTIEN,"O",CPTIEN,$S(DATE>0:DATE,1:VDATE))
87 Q
88 ;
89 ;***** SEARCHES FOR OUTPATIENT PROCEDURES
90 ;
91 ; PTIEN Patient IEN (DFN)
92 ;
93 ; Return Values:
94 ; <0 Error code
95 ; 0 Ok
96 ; >0 Number of non-fatal errors
97 ;
98OUTPAT(PTIEN) ;
99 N QUERY
100 D OPEN^SDQ(.QUERY)
101 D INDEX^SDQ(.QUERY,"PATIENT/DATE","SET")
102 D PAT^SDQ(.QUERY,PTIEN,"SET")
103 D DATE^SDQ(.QUERY,RORSDT,ROREDT1,"SET")
104 D SCANCB^SDQ(.QUERY,"D OPSCAN^RORX015A("_PTIEN_")","SET")
105 D ACTIVE^SDQ(.QUERY,"TRUE","SET")
106 D SCAN^SDQ(.QUERY,"FORWARD")
107 D CLOSE^SDQ(.QUERY)
108 Q 0
109 ;
110 ;**** STORES THE PROCEDURE CODE
111 ;
112 ; PTIEN Patient IEN (DFN)
113 ; SOURCE CPT source code ("O" or "I")
114 ; [IEN] IEN of the procedure descriptor (file #81 or #80.1)
115 ; DATE Date when the code was entered
116 ; [CODE] Procedure code (CPT or ICD-9)
117 ;
118 ; Either the IEN or the CODE parameter must be provided.
119 ;
120PROCSET(PTIEN,SOURCE,IEN,DATE,CODE) ;
121 Q:DATE'>0
122 N TMP
123 S IEN=+$G(IEN)
124 ;---
125 I IEN'>0 Q:$G(CODE)="" D Q:IEN'>0
126 . I SOURCE="O" S IEN=+$$CODEN^ICPTCOD(CODE) Q
127 . I SOURCE="I" S IEN=+$$CODEN^ICDCODE(CODE,80.1) Q
128 ;---
129 I SOURCE="O",'$$PARAM^RORTSK01("CPTLST","ALL") D Q:'TMP
130 . S TMP=$D(RORTSK("PARAMS","CPTLST","C",IEN))
131 I SOURCE="I" Q:$$ICDGRCHK^RORXU008(.RORPTGRP,IEN,RORICDL)
132 ;---
133 S TMP=+$G(@RORTMP@("PAT",PTIEN,SOURCE,IEN))
134 S:'TMP!(DATE<TMP) @RORTMP@("PAT",PTIEN,SOURCE,IEN)=DATE
135 S ^("C")=$G(@RORTMP@("PAT",PTIEN,SOURCE,IEN,"C"))+1
136 Q
137 ;
138 ;***** QUERIES THE REGISTRY
139 ;
140 ; FLAGS Flags for the $$SKIP^RORXU005
141 ;
142 ; Return Values:
143 ; <0 Error code
144 ; 0 Ok
145 ; >0 Number of non-fatal errors
146 ;
147QUERY(FLAGS) ;
148 N ROREDT1 ; Day after the end date
149 N RORPTGRP ; Temporary list of ICD-9 groups
150 N RORPTN ; Number of patients in the registry
151 ;
152 N CNT,ECNT,IEN,IENS,MODE,PTIEN,RC,SKIP,SKIPEDT,SKIPSDT,TMP,UTEDT,UTSDT,XREFNODE
153 S XREFNODE=$NA(^RORDATA(798,"AC",+RORREG))
154 S ROREDT1=$$FMADD^XLFDT(ROREDT\1,1)
155 S (CNT,ECNT,RC)=0,SKIPEDT=ROREDT,SKIPSDT=RORSDT
156 S:$$PARAM^RORTSK01("PATIENTS","INPATIENT") MODE("I")=1
157 S:$$PARAM^RORTSK01("PATIENTS","OUTPATIENT") MODE("O")=1
158 ;--- Utilization date range
159 D:$$PARAM^RORTSK01("PATIENTS","CAREONLY")
160 . S UTSDT=$$PARAM^RORTSK01("DATE_RANGE_3","START")\1
161 . S UTEDT=$$PARAM^RORTSK01("DATE_RANGE_3","END")\1
162 . ;--- Combined date range
163 . S SKIPSDT=$$DTMIN^RORUTL18(SKIPSDT,UTSDT)
164 . S SKIPEDT=$$DTMAX^RORUTL18(SKIPEDT,UTEDT)
165 ;--- Number of patients in the registry
166 S RORPTN=$$REGSIZE^RORUTL02(+RORREG) S:RORPTN<0 RORPTN=0
167 ;
168 ;=== Browse through the registry records
169 S IEN=0
170 F S IEN=$O(@XREFNODE@(IEN)) Q:IEN'>0 D Q:RC<0
171 . S TMP=$S(RORPTN>0:CNT/RORPTN,1:"")
172 . S RC=$$LOOP^RORTSK01(TMP) Q:RC<0
173 . S IENS=IEN_",",CNT=CNT+1
174 . ;--- Check if the patient should be skipped
175 . Q:$$SKIP^RORXU005(IEN,FLAGS,SKIPSDT,SKIPEDT)
176 . ;
177 . ;--- Get the patient IEN (DFN)
178 . S PTIEN=$$PTIEN^RORUTL01(IEN) Q:PTIEN'>0
179 . M RORPTGRP=RORIGRP("C")
180 . ;
181 . ;--- Inpatient codes (ICD-9)
182 . I $G(MODE("I")) D I RC Q:RC<0 S ECNT=ECNT+RC
183 . . S RC=$$INPAT(PTIEN)
184 . ;--- Outpatient codes (CPT)
185 . I $G(MODE("O")) D I RC Q:RC<0 S ECNT=ECNT+RC
186 . . S RC=$$OUTPAT(PTIEN)
187 . ;
188 . ;--- If ICD-9 codes from some groups have not been found,
189 . ;--- then do not consider inpatient procedures at all
190 . K:$D(RORPTGRP)>1 @RORTMP@("PAT",PTIEN,"I")
191 . ;---
192 . S SKIP=($D(@RORTMP@("PAT",PTIEN))<10)
193 . S:RORPROC<0 SKIP='SKIP
194 . ;
195 . ;--- Check for any utilization in the corresponding date range
196 . I 'SKIP D:$$PARAM^RORTSK01("PATIENTS","CAREONLY")
197 . . K TMP S TMP("ALL")=1
198 . . S UTIL=+$$UTIL^RORXU003(UTSDT,UTEDT,PTIEN,.TMP)
199 . . S:'UTIL SKIP=1
200 . ;
201 . ;--- Skip the patient if not all search criteria have been met
202 . I SKIP K @RORTMP@("PAT",PTIEN) Q
203 . ;
204 . ;--- Calculate the patient's totals
205 . S RC=$$TOTALS(PTIEN)
206 . I RC Q:RC<0 S ECNT=ECNT+RC
207 ;---
208 Q $S(RC<0:RC,1:ECNT)
209 ;
210 ;***** SORTS THE RESULTS AND COMPILES THE TOTALS
211 ;
212 ; Return Values:
213 ; <0 Error code
214 ; 0 Ok
215 ; >0 Number of non-fatal errors
216 ;
217SORT() ;
218 N IEN,SRC,TMP,TNC,TNDC
219 ;---
220 S (TNC,TNDC)=0
221 F SRC="I","O" D
222 . S IEN=0
223 . F S IEN=$O(@RORTMP@("PROC",SRC,IEN)) Q:IEN'>0 D
224 . . S TMP=$P($G(@RORTMP@("PROC",SRC,IEN)),U,2)
225 . . S:TMP'="" @RORTMP@("PROC","B",TMP,SRC,IEN)=""
226 . . S TNC=TNC+$G(@RORTMP@("PROC",SRC,IEN,"C"))
227 . . S TNDC=TNDC+1
228 S @RORTMP@("PROC")=TNC_U_TNDC
229 ;---
230 Q 0
231 ;
232 ;***** CALCULATES INTERMEDIATE TOTALS
233 ;
234 ; PTIEN Patient IEN (DFN)
235 ;
236 ; Return Values:
237 ; <0 Error code
238 ; 0 Ok
239 ; >0 Number of non-fatal errors
240 ;
241TOTALS(PTIEN) ;
242 N CNT,CODE,IEN,NAME,PNODE,RC,SRC,TMP,VA,VADM
243 S PNODE=$NA(@RORTMP@("PAT",PTIEN))
244 ;--- Get and store the patient's data
245 D VADEM^RORUTL05(PTIEN,1)
246 S @PNODE=VA("BID")_U_VADM(1)_U_$$DATE^RORXU002(VADM(6)\1)
247 S ^("PAT")=$G(@RORTMP@("PAT"))+1
248 ;
249 F SRC="I","O" D
250 . S IEN=0
251 . F S IEN=$O(@PNODE@(SRC,IEN)) Q:IEN'>0 D
252 . . S CODE=$P($G(@RORTMP@("PROC",SRC,IEN)),U),NAME=""
253 . . D:CODE=""
254 . . . I SRC="O" D
255 . . . . S TMP=$$CPT^ICPTCOD(IEN)
256 . . . . S:TMP'<0 CODE=$P(TMP,U,2),NAME=$P(TMP,U,3)
257 . . . E D
258 . . . . S TMP=$$ICDOP^ICDCODE(IEN)
259 . . . . S:TMP'<0 CODE=$P(TMP,U,2),NAME=$P(TMP,U,5)
260 . . . S:CODE="" CODE="UNKN"
261 . . . S:NAME="" NAME="Unknown ("_IEN_")"
262 . . . S @RORTMP@("PROC",SRC,IEN)=CODE_U_NAME
263 . . ;---
264 . . S CNT=+$G(@PNODE@(SRC,IEN,"C"))
265 . . S ^("C")=$G(@RORTMP@("PROC",SRC,IEN,"C"))+CNT
266 . . S ^("P")=$G(@RORTMP@("PROC",SRC,IEN,"P"))+1
267 Q 0
Note: See TracBrowser for help on using the repository browser.