source: FOIAVistA/trunk/r/CLINICAL_CASE_REGISTRIES-ROR/RORX007.m@ 1754

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

initial load of FOIAVistA 6/30/08 version
File size: 6.6 KB
Line 
1RORX007 ;HCIOFO/BH,SG - RADIOLOGY UTILIZATION ; 10/14/05 1:37pm
2 ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
3 ;
4 ; This routine uses the following IAs:
5 ;
6 ; #10061 DEM^VADPT (supported)
7 ;
8 Q
9 ;
10 ;***** COMPILES THE "RADIOLOGY UTILIZATION" REPORT
11 ; REPORT CODE: 007
12 ;
13 ; .RORTSK Task number and task parameters
14 ;
15 ; The ^TMP("RORX007",$J) and ^TMP($J,"RAE1") global nodes are
16 ; used by this function.
17 ;
18 ; ^TMP("RORX007",$J,
19 ;
20 ; "PAT",
21 ; DFN,
22 ; ProcName) Number of procedures
23 ;
24 ; "PATSORT",
25 ; ProcQnty,
26 ; Name,
27 ; Last4) Patient data
28 ; ^01: Number of different procedures
29 ; ^02: Date of death
30 ;
31 ; "PROC",
32 ; ProcName,
33 ; DFN) Number of procedures
34 ;
35 ; "PROCSORT",
36 ; ProcQnty,
37 ; ProcName,
38 ; CPT) Number of individual patients
39 ;
40 ; "TOTAL") Category Totals
41 ; ^01: Total number of procedures
42 ; ^02: Number of different procedures
43 ; ^03: Total number of patients
44 ; ^04: Number of individual patients
45 ;
46 ; Return Values:
47 ; <0 Error code
48 ; 0 Ok
49 ;
50RADUTL(RORTSK) ;
51 N ROREDT ; End date
52 N RORREG ; Registry IEN
53 N RORSDT ; Start date
54 ;
55 N CNT,ECNT,RC,REPORT,RORPTN,SFLAGS,TMP
56 ;--- Root node of the report
57 S REPORT=$$ADDVAL^RORTSK11(RORTSK,"REPORT")
58 Q:REPORT<0 REPORT
59 ;
60 ;--- Get and prepare the report parameters
61 S RORREG=$$PARAM^RORTSK01("REGIEN")
62 S RC=$$PARAMS^RORX007A(REPORT,.RORSDT,.ROREDT,.SFLAGS)
63 Q:RC<0 RC
64 ;
65 ;--- Initialize constants and variables
66 S RORPTN=$$REGSIZE^RORUTL02(+RORREG) S:RORPTN<0 RORPTN=0
67 S ECNT=0 K ^TMP("RORX007",$J)
68 ;
69 ;--- Report header
70 S RC=$$HEADER^RORX007A(REPORT) Q:RC<0 RC
71 ;
72 D
73 . ;--- Query the registry
74 . D TPPSETUP^RORTSK01(75)
75 . S RC=$$QUERY^RORX007A(SFLAGS)
76 . I RC Q:RC<0 S ECNT=ECNT+RC
77 . ;--- Sort the data
78 . D TPPSETUP^RORTSK01(10)
79 . S RC=$$SORT()
80 . I RC Q:RC<0 S ECNT=ECNT+RC
81 . ;--- Store the results
82 . D TPPSETUP^RORTSK01(15)
83 . S RC=$$STORE(REPORT)
84 . I RC Q:RC<0 S ECNT=ECNT+RC
85 ;
86 ;--- Cleanup
87 K ^TMP("RORX007",$J),^TMP($J,"RAE1")
88 Q $S(RC<0:RC,ECNT>0:-43,1:0)
89 ;
90 ;***** SORTS THE RESULTS AND COMPILES THE TOTALS
91 ;
92 ; SPCNT Number of patients selected for the report
93 ;
94 ; Return Values:
95 ; <0 Error code
96 ; 0 Ok
97 ; >0 Number of non-fatal errors
98 ;
99SORT(SPCNT) ;
100 N DFN,DOD,DPCNT,ECNT,NAME,NODE,PRCNT,PQ,PRN,RC,TMP,TOTAL,VA,VADM,VAHOW,VAROOT
101 S (ECNT,RC)=0
102 S NODE=$NA(^TMP("RORX007",$J))
103 Q:$D(@NODE)<10 0
104 ;--- Procedures
105 S RC=$$LOOP^RORTSK01(0) Q:RC<0 RC
106 S PRN=""
107 F S PRN=$O(@NODE@("PROC",PRN)) Q:PRN="" D
108 . S (DPCNT,PRCNT)=0
109 . S DFN=""
110 . F S DFN=$O(@NODE@("PROC",PRN,DFN)) Q:DFN="" D
111 . . S PQ=$G(@NODE@("PROC",PRN,DFN))
112 . . S DPCNT=DPCNT+1,PRCNT=PRCNT+PQ
113 . ;---
114 . S @NODE@("PROCSORT",PRCNT,$P(PRN,U),$P(PRN,U,2))=DPCNT
115 . S TOTAL("DPR")=$G(TOTAL("DPR"))+1 ; Different procedures
116 . S TOTAL("TPT")=$G(TOTAL("TPT"))+DPCNT ; Number of patients
117 K @NODE@("PROC")
118 ;--- Patients
119 S RC=$$LOOP^RORTSK01(0.5) Q:RC<0 RC
120 S DFN=""
121 F S DFN=$O(@NODE@("PAT",DFN)) Q:DFN="" D
122 . S (DPCNT,PRCNT)=0
123 . D DEM^VADPT
124 . S NAME=$G(VADM(1)) Q:NAME=""
125 . S LAST4=$G(VA("BID")) S:LAST4="" LAST4=" "
126 . S DOD=$$DATE^RORXU002($P(VADM(6),U)\1)
127 . S PRN=""
128 . F S PRN=$O(@NODE@("PAT",DFN,PRN)) Q:PRN="" D
129 . . S PQ=$G(@NODE@("PAT",DFN,PRN))
130 . . S DPCNT=DPCNT+1,PRCNT=PRCNT+PQ
131 . ;---
132 . S @NODE@("PATSORT",PRCNT,NAME,LAST4)=DPCNT_U_DOD
133 . S TOTAL("TPR")=$G(TOTAL("TPR"))+PRCNT ; Number of procedures
134 . S TOTAL("DPT")=$G(TOTAL("DPT"))+1 ; Different patients
135 K @NODE@("PAT")
136 ;--- Totals
137 S TMP=$G(TOTAL("TPR"))_U_$G(TOTAL("DPR"))
138 S @NODE@("TOTAL")=TMP_U_$G(TOTAL("TPT"))_U_$G(TOTAL("DPT"))
139 ;---
140 Q $S(RC<0:RC,1:ECNT)
141 ;
142 ;***** STORES THE RESULTS
143 ;
144 ; Return Values:
145 ; <0 Error code
146 ; 0 Ok
147 ; >0 Number of non-fatal errors
148 ;
149STORE(PARTAG) ;
150 N RORSONLY ; Output summary only
151 ;
152 N RC,TMP
153 S RORSONLY=$$SMRYONLY^RORXU006()
154 S RC=0
155 ;--- Tables
156 Q:$D(^TMP("RORX007",$J))<10 0
157 ;--- Procedures
158 S RC=$$LOOP^RORTSK01(0) Q:RC<0 RC
159 S RC=$$TBLPROC(PARTAG) Q:RC<0 RC
160 ;--- Patients
161 S RC=$$LOOP^RORTSK01(0.5) Q:RC<0 RC
162 S RC=$$TBLPAT(PARTAG) Q:RC<0 RC
163 ;--- Totals
164 S TMP=$G(^TMP("RORX007",$J,"TOTAL"))
165 D ADDVAL^RORTSK11(RORTSK,"NPR",$P(TMP,U,1),PARTAG)
166 D ADDVAL^RORTSK11(RORTSK,"NDP",$P(TMP,U,2),PARTAG)
167 D ADDVAL^RORTSK11(RORTSK,"NP",$P(TMP,U,4),PARTAG)
168 ;---
169 Q $S(RC<0:RC,1:0)
170 ;
171 ;***** STORES THE TABLE OF PATIENTS
172 ;
173 ; PRNTELMT IEN of the parent tag
174 ;
175 ; Return Values:
176 ; <0 Error code
177 ; 0 Ok
178 ;
179TBLPAT(PRNTELMT) ;
180 N BUF,ITEM,LAST4,MAXUTNUM,NAME,NODE,PRCNT,RC,TABLE,TMP,UTNUM
181 S MAXUTNUM=$$PARAM^RORTSK01("MAXUTNUM")
182 Q:MAXUTNUM'>0 0
183 S TABLE=$$ADDVAL^RORTSK11(RORTSK,"PATIENTS",,PRNTELMT)
184 Q:TABLE<0 TABLE
185 D ADDATTR^RORTSK11(RORTSK,TABLE,"TABLE","PATIENTS")
186 S NODE=$NA(^TMP("RORX007",$J,"PATSORT"))
187 ;--- Table
188 S PRCNT="",(RC,UTNUM)=0
189 F S PRCNT=$O(@NODE@(PRCNT),-1) Q:PRCNT="" D Q:RC
190 . S NAME=""
191 . F S NAME=$O(@NODE@(PRCNT,NAME)) Q:NAME="" D Q:RC
192 . . S LAST4=""
193 . . F S LAST4=$O(@NODE@(PRCNT,NAME,LAST4)) Q:LAST4="" D Q:RC
194 . . . S ITEM=$$ADDVAL^RORTSK11(RORTSK,"PATIENT",,TABLE)
195 . . . D ADDVAL^RORTSK11(RORTSK,"NAME",NAME,ITEM,1)
196 . . . D ADDVAL^RORTSK11(RORTSK,"LAST4",LAST4,ITEM,1)
197 . . . S BUF=@NODE@(PRCNT,NAME,LAST4)
198 . . . D ADDVAL^RORTSK11(RORTSK,"DOD",$P(BUF,U,2),ITEM,1)
199 . . . D ADDVAL^RORTSK11(RORTSK,"TOTAL",PRCNT,ITEM,1)
200 . . . D ADDVAL^RORTSK11(RORTSK,"UNIQUE",+BUF,ITEM,1)
201 . . . S UTNUM=UTNUM+1 S:UTNUM'<MAXUTNUM RC=1
202 Q:RC<0 RC
203 ;---
204 Q $S(RC<0:RC,1:0)
205 ;
206 ;***** STORES THE TABLE OF PROCEDURES
207 ;
208 ; PRNTELMT IEN of the parent tag
209 ;
210 ; Return Values:
211 ; <0 Error code
212 ; 0 Ok
213 ;
214TBLPROC(PRNTELMT) ;
215 N CPT,ITEM,MINRPNUM,NODE,PRCNT,PRN,TABLE,TMP
216 S MINRPNUM=$$PARAM^RORTSK01("MINRPNUM")
217 Q:MINRPNUM'>0 0
218 S TABLE=$$ADDVAL^RORTSK11(RORTSK,"PROCEDURES",,PRNTELMT)
219 Q:TABLE<0 TABLE
220 D ADDATTR^RORTSK11(RORTSK,TABLE,"TABLE","PROCEDURES")
221 S NODE=$NA(^TMP("RORX007",$J,"PROCSORT"))
222 ;--- Table
223 S PRCNT="",RC=0
224 F S PRCNT=$O(@NODE@(PRCNT),-1) Q:PRCNT<MINRPNUM D Q:RC
225 . S PRN=""
226 . F S PRN=$O(@NODE@(PRCNT,PRN)) Q:PRN="" D Q:RC
227 . . S CPT=""
228 . . F S CPT=$O(@NODE@(PRCNT,PRN,CPT)) Q:CPT="" D Q:RC
229 . . . S ITEM=$$ADDVAL^RORTSK11(RORTSK,"PROCEDURE",,TABLE)
230 . . . D ADDVAL^RORTSK11(RORTSK,"NAME",PRN,ITEM,1)
231 . . . D ADDVAL^RORTSK11(RORTSK,"CPT",CPT,ITEM,2)
232 . . . S TMP=+@NODE@(PRCNT,PRN,CPT)
233 . . . D ADDVAL^RORTSK11(RORTSK,"PATIENTS",TMP,ITEM,1)
234 . . . D ADDVAL^RORTSK11(RORTSK,"TOTAL",PRCNT,ITEM,1)
235 Q:RC<0 RC
236 ;---
237 Q $S(RC<0:RC,1:0)
Note: See TracBrowser for help on using the repository browser.