source: FOIAVistA/trunk/r/CLINICAL_CASE_REGISTRIES-ROR/RORXU003.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: 7.2 KB
Line 
1RORXU003 ;HCIOFO/BH,SG - REPORT BUILDER UTILITIES ; 7/19/06 12:34pm
2 ;;1.5;CLINICAL CASE REGISTRIES;**1**;Feb 17, 2006;Build 24
3 ;
4 ; This routine uses the following IAs:
5 ;
6 ; #1894 ENCEVENT^PXKENC (controlled)
7 ;
8 Q
9 ;
10 ;***** SEARCHES FOR UTLIZATION
11 ;
12 ; STDT Start date for search (FileMan)
13 ; ENDT End date for search (FileMan)
14 ;
15 ; RORDFN Patient IEN in the PATIENT file (#2)
16 ;
17 ; CHK Reference to a local array that identifies the
18 ; packages files that need to be checked i.e. CHK("O"):
19 ; A Allergy
20 ; C Cytopathology
21 ; I Inpatients
22 ; IP Inpatient Pharmacy
23 ; IV IV Medications
24 ; L Laboratory
25 ; M Microbiology
26 ; O Outpatient
27 ; OP Outpatient Pharmacy
28 ; R Radiology
29 ; SP Surgical Pathology
30 ;
31 ; If set to "ALL", Outpatients, Inpatients, Radiology,
32 ; Allergy, Pharmacy, Microbiology, Surgical Pathology,
33 ; Cytopathology, and Lab data will be checked.
34 ;
35 ; Return Values:
36 ; 0 No utilization has been found
37 ; 1 The patient has had utilization. The subsequent "^"-pieces
38 ; will indicate the utilization areas (the same codes as
39 ; those for the CHK parameter)
40 ;
41 ; For example, if a patient had utilization for Inpatients,
42 ; Outpatient, Pharmacy, and Lab the string would look as
43 ; follows: 1^O^I^OP^L
44 ;
45UTIL(STDT,ENDT,RORDFN,CHK) ;
46 N IEN,LRDFN,RES,RORMSG,RORVAL
47 S RORVAL=""
48 ;
49 ;--- Outpatient data
50 I $D(CHK("ALL"))!$D(CHK("O")) D
51 . S RES=$$OUTPAT(STDT,ENDT,RORDFN)
52 . S:RES RORVAL=RORVAL_U_$P(RES,U,2,999)
53 ;
54 ;--- Inpatient data
55 I $D(CHK("ALL"))!$D(CHK("I")) D
56 . S RES=$$INPAT(STDT,ENDT,RORDFN)
57 . S:RES RORVAL=RORVAL_U_$P(RES,U,2,999)
58 ;
59 ;--- Radiology data
60 I $D(CHK("ALL"))!$D(CHK("R")) D
61 . S RES=$$RAD(STDT,ENDT,RORDFN)
62 . S:RES RORVAL=RORVAL_U_$P(RES,U,2,999)
63 ;
64 ;--- Allergy data
65 I $D(CHK("ALL"))!$D(CHK("A")) D
66 . S RES=$$ALLERGY(STDT,ENDT,RORDFN)
67 . S:RES RORVAL=RORVAL_U_$P(RES,U,2,999)
68 ;
69 ;--- Pharmacy data
70 I $D(CHK("ALL"))!$D(CHK("IP"))!$D(CHK("OP"))!$D(CHK("IV")) D
71 . S RES=$$PHARM(STDT,ENDT,RORDFN,.CHK)
72 . S:RES RORVAL=RORVAL_U_$P(RES,U,2,999)
73 ;
74 S LRDFN=+$$LABREF^RORUTL18(RORDFN)
75 ;
76 I LRDFN>0 D
77 . ;--- Microbiology
78 . I $D(CHK("ALL"))!$D(CHK("M")) D
79 . . S RES=$$MICRO(STDT,ENDT,LRDFN)
80 . . S:RES RORVAL=RORVAL_U_$P(RES,U,2,999)
81 . ;--- Surgical Pathology
82 . I $D(CHK("ALL"))!$D(CHK("SP")) D
83 . . S RES=$$SURGP(STDT,ENDT,LRDFN)
84 . . S:RES RORVAL=RORVAL_U_$P(RES,U,2,999)
85 . ;--- Cytopathology
86 . I $D(CHK("ALL"))!$D(CHK("C")) D
87 . . S RES=$$CYTO(STDT,ENDT,LRDFN)
88 . . S:RES RORVAL=RORVAL_U_$P(RES,U,2,999)
89 ;
90 ;--- Lab data
91 I $D(CHK("ALL"))!$D(CHK("L")) D
92 . S RES=$$LAB(STDT,ENDT,RORDFN)
93 . S:RES RORVAL=RORVAL_U_$P(RES,U,2,999)
94 ;
95 S $P(RORVAL,U)=(RORVAL'="")
96 Q RORVAL
97 ;
98 ;***** CHECKS ALLERGY DATA
99ALLERGY(STDT,ENDT,RORDFN) ;
100 N DTE,IEN,RC
101 S RC=0
102 S DTE=$O(^GMR(120.8,"AODT",STDT),-1)
103 S ENDT=ENDT_".999999"
104 F S DTE=$O(^GMR(120.8,"AODT",DTE)) Q:'DTE!(DTE'<ENDT) D Q:RC
105 . S IEN=0
106 . F S IEN=$O(^GMR(120.8,"AODT",DTE,IEN)) Q:'IEN D Q:RC
107 . . S:$D(^GMR(120.8,"B",RORDFN,IEN)) RC="1^A"
108 Q RC
109 ;
110 ;***** CHECKS CYTOPATHOLOGY DATA
111CYTO(STDT,ENDT,LRDFN) ;
112 N IDT
113 S IDT=$O(^LR(LRDFN,"CY",9999999-STDT))
114 S IDT=$O(^LR(LRDFN,"CY",IDT),-1)
115 Q $S(IDT&(IDT>(9999999-ENDT)):"1^C",1:0)
116 ;
117 ;***** CHECKS INPATIENT DATA
118INPAT(STDT,ENDT,DFN) ;
119 N ADMDT,DATE,DISDT,IEN,QUIT,RC,VAIP
120 S STDT=STDT\1
121 ;--- Check for an admission date inside the time frame
122 S QUIT=0,DATE=(ENDT\1)_".999999"
123 F S DATE=$O(^DGPT("AAD",DFN,DATE),-1) Q:'DATE!(DATE<STDT) D Q:QUIT
124 . S IEN=""
125 . F S IEN=$O(^DGPT("AAD",DFN,DATE,IEN),-1) Q:'IEN D Q:QUIT
126 . . S:'$$PTF^RORXU001(IEN,"FP") QUIT=1
127 Q:QUIT=1 "1^I"
128 ;--- Check for an earlier admission that overlaps the date range
129 S QUIT=0,VAIP("D")=STDT
130 F D Q:QUIT
131 . D IN5^VADPT
132 . S VAIP("D")=+$G(VAIP(13,1))
133 . I VAIP("D")'>0 S QUIT=2 Q
134 . S VAIP("D")=$$FMADD^XLFDT(VAIP("D"),,,,-1)
135 . S IEN=+$G(VAIP(12)) Q:IEN'>0
136 . S RC=$$PTF^RORXU001(IEN,"FP",,.DISDT)
137 . S QUIT=$S(RC:0,$G(DISDT)'>0:1,DISDT>STDT:1,1:2)
138 Q $S(QUIT=1:"1^I",1:0)
139 ;
140 ;***** CHECKS LAB DATA
141LAB(STDT,ENDT,RORDFN) ;
142 N PTID,RC,RORMSG,RORTMP
143 S PTID=$$PTID^RORUTL02(RORDFN) Q:PTID<0 0
144 S RORTMP=$$ALLOC^RORTMP()
145 ;--- Get the Lab data
146 S ENDT=(ENDT\1+1)_"^CD",STDT=STDT_"^CD"
147 S RC=$$GCPR^LA7QRY(PTID,STDT,ENDT,"CH","*",.RORMSG,RORTMP)
148 S RC=$S(($D(RORMSG)>1)&(RC=""):0,$D(@RORTMP)>1:"1^L",1:0)
149 ;--- Cleanup
150 D FREE^RORTMP(RORTMP)
151 Q RC
152 ;
153 ;***** CHECKS MICROBIOLOGY DATA
154MICRO(STDT,ENDT,LRDFN) ;
155 N RC,RORTMP
156 S RC=0,RORTMP=$$ALLOC^RORTMP()
157 D:$$GETDATA^LA7UTL1A(LRDFN,STDT,ENDT,"CD",RORTMP)'<0
158 . S:$D(@RORTMP@(LRDFN)) RC="1^M"
159 D FREE^RORTMP(RORTMP)
160 Q RC
161 ;
162 ;***** CHECKS OUTPATIENT DATA
163OUTPAT(STDT,ENDT,RORDFN) ;
164 S STDT=$P(STDT,".",1),STDT=STDT-1,STDT=STDT+.9999
165 S ENDT=$P(ENDT,".",1),ENDT=ENDT+1
166 N QUERY,RORDST,RORECNT
167 S RORECNT=0
168 S RORDST=$NA(^TMP("RORXU003",$J,"OUT"))
169 D OPEN^SDQ(.QUERY)
170 D INDEX^SDQ(.QUERY,"PATIENT/DATE","SET")
171 D PAT^SDQ(.QUERY,RORDFN,"SET")
172 D DATE^SDQ(.QUERY,STDT,ENDT,"SET")
173 D SCANCB^SDQ(.QUERY,"D SCAN^RORXU003()","SET")
174 D ACTIVE^SDQ(.QUERY,"TRUE","SET")
175 D SCAN^SDQ(.QUERY,"FORWARD")
176 D CLOSE^SDQ(.QUERY)
177 Q $S(RORECNT:"1^O",1:0)
178 ;
179 ;***** CHECKS PHARMACY DATA
180PHARM(STDT,ENDT,RORDFN,CHK) ;
181 N BUF,II,IP,IV,OP,ORD,RC,RORLST,SKIP,TMP,TYPE
182 S ENDT=$$FMADD^XLFDT(ENDT\1,1)
183 I '$D(CHK("ALL")) D
184 . S IP='$D(CHK("IP"))
185 . S IV='$D(CHK("IV"))
186 . S OP='$D(CHK("OP"))
187 E S (OP,IP,IV)=0
188 ;=== Get the list of orders
189 K ^TMP("PS",$J)
190 D OCL^PSOORRL(RORDFN,STDT,ENDT)
191 Q:$D(^TMP("PS",$J))<10 0
192 S RORLST=$$ALLOC^RORTMP()
193 ;=== Preselect the orders
194 S II=0
195 F S II=$O(^TMP("PS",$J,II)) Q:'II D
196 . S BUF=$G(^TMP("PS",$J,II,0)),ORD=$P(BUF,U) Q:ORD'>0
197 . S TMP=$L(ORD),TYPE=$E(ORD,TMP-2,TMP)
198 . S TYPE=$S(TYPE="R;O":"R",TYPE="U;I":"U",TYPE="V;I":"V",1:"")
199 . ;--- Check if this kind of orders should be processed
200 . Q:$S(TYPE="R":OP,TYPE="U":IP,TYPE="V":IV,1:1)
201 . ;--- Check the dates
202 . I "UV"[TYPE S TMP=$P(BUF,U,15) Q:(TMP<STDT)!(TMP'<ENDT)
203 . I TYPE="R" S TMP=$P(BUF,U,10) Q:TMP<STDT
204 . ;--- Add the order to the list
205 . S @RORLST@(II)=TYPE,@RORLST@(II,0)=BUF
206 ;=== Process the preselected orders
207 S II=0,RC=""
208 F S II=$O(@RORLST@(II)) Q:'II D Q:OP&IP&IV
209 . S TYPE=@RORLST@(II),ORD=$P(@RORLST@(II,0),U)
210 . ;--- Outpatient
211 . I TYPE="R" Q:OP D S:'SKIP OP=1,RC=RC_U_"OP" Q
212 . . ;--- Double-check the Rx date(s)
213 . . K ^TMP("PS",$J)
214 . . D OEL^PSOORRL(RORDFN,ORD)
215 . . I $D(^TMP("PS",$J))<10 S SKIP=1 Q
216 . . S SKIP=$$DTCHECK^RORUTL15(STDT,ENDT)
217 . ;--- Inpatient
218 . I TYPE="U" Q:IP S IP=1,RC=RC_U_"IP" Q
219 . ;--- IV
220 . I TYPE="V" Q:IV S IV=1,RC=RC_U_"IV" Q
221 ;===
222 D FREE^RORTMP(RORLST)
223 K ^TMP("PS",$J)
224 S $P(RC,U)=(RC'="")
225 Q RC
226 ;
227 ;***** CHECKS RADIOLOGY DATA
228RAD(STDT,ENDT,RORDFN) ;
229 N RC
230 K ^TMP($J,"RAE1")
231 D EN1^RAO7PC1(RORDFN,STDT,ENDT,999999999)
232 S RC=$S($D(^TMP($J,"RAE1",RORDFN))>1:"1^R",1:0)
233 K ^TMP($J,"RAE1")
234 Q RC
235 ;
236 ;*****
237SCAN() ;
238 S RORECNT=1
239 Q
240 ;
241 ;***** CHECKS SURGICAL PATHOLOGY DATA
242SURGP(STDT,ENDT,LRDFN) ;
243 N IDT
244 S IDT=$O(^LR(LRDFN,"SP",9999999-STDT))
245 S IDT=$O(^LR(LRDFN,"SP",IDT),-1)
246 Q $S(IDT&(IDT>(9999999-ENDT)):"1^SP",1:0)
Note: See TracBrowser for help on using the repository browser.