source: FOIAVistA/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAPMW1.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 8.4 KB
Line 
1RAPMW1 ;HOIFO/SWM-Radiology Wait Time reports ;12/05/05 13:40
2 ;;5.0;Radiology/Nuclear Medicine;**67,79,83**;Mar 16, 1998;Build 4
3 ; IA 10090 allows Read w/Fileman for entire file 4
4 ; summary
5 Q
6FILTER1 ;
7 S RABAD=0
8 I '$D(^RADPT(RADFN,"DT",RADTI)) S RABAD=1 Q ;no exam data
9 ;division
10 S RASELDIV=$P($G(^RADPT(RADFN,"DT",RADTI,0)),U,3)
11 S RACHKDIV=$P($G(^DIC(4,+RASELDIV,0)),U)
12 I RACHKDIV'="",'$D(^TMP($J,"RA D-TYPE",RACHKDIV)) S RABAD=1 Q
13 ;imaging type
14 S RAITYP=$P($G(^RADPT(RADFN,"DT",RADTI,0)),U,2)
15 S RAIMGTYP=$P($G(^RA(79.2,+RAITYP,0)),U)
16 ; *79 removed check for imaging type
17 I RAIMGTYP="" S RAIMGTYP="(unk)"
18 Q
19FILTER2 ;
20 S RABAD=0
21 S RACN0=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))
22 I RACN0="" S RABAD=1 Q ;no case level data
23 I RANX="C",'$D(^TMP($J,"RA WAIT2",+$P(RACN0,U,2))) S RABAD=1 Q
24 S RACNISAV=RACNI ; save orig. before it's changed due printset
25 I RANX="P",$P(RACN0,U,25)>1 D G EXCL
26 .; If selecting by Proc Type, and case is from printset --
27 .; pick case with highest ranked Procedure Type
28 .; then skip remaining cases by setting a high RACNI
29 .S I=0
30 .K RARY ;array of cases and rank number
31 .F S I=$O(^RADPT(RADFN,"DT",RADTI,"P",I)) Q:'I S RACN0=$G(^(I,0)) D:RACN0'=""
32 ..S RABAD=0 D CHECK3 Q:RABAD ;skip case if it meets 1 of 3 exclusions
33 ..D PTA^RAPMW2
34 ..;eg. rary(6,racni)=racn0 for Ultrasound
35 ..S RARY(RAHIER(RAPTA),I)=RACN0
36 ..Q
37 .S RAHI=$O(RARY("")) ;highest rank number from prtset cases
38 .I RAHI="" D Q ; no case in prtset can be used
39 ..S RABAD=1,RACNI=99999
40 ..Q
41 .S RACNI=$O(RARY(RAHI,0))
42 .I RACNI="" D Q ;should not happen
43 ..S RABAD=1,RACNI=99999
44 ..Q
45 .S RACN0=RARY(RAHI,RACNI) ;reset racn0
46 .S RA72=^RA(72,+$P(RACN0,U,3),0) ;reset ra72
47 .S RACNISAV=RACNI ; save orig. before it's changed due printset
48 .S RACNI=99999 ;set to 99999 so GETDATA loop would skip rest of prtset
49 .Q
50 D CHECK3
51EXCL ; skip case if its proc isn't among user-selected procs
52 D PTA^RAPMW2 ; *79, Procedure Type via CPT Code & Sherrill's Xcel sheet
53 I $D(RAXCLUDE(RAPTA)) S RABAD=1 Q
54 Q
55CHECK3 ; check inpatient, no credit, cancelled exam
56 ; CATEGORY OF EXAM is inpatient
57 I $P(RACN0,U,4)="I" S RABAD=1 Q
58 ; exam's credit method is 2 (no credit)
59 I $P(RACN0,U,26)=2 S RABAD=1 Q
60 ; exam status is cancelled
61 I $P(RACN0,U,3)="" S RABAD=1 Q ;no exam status
62 S RA72=^RA(72,+$P(RACN0,U,3),0) ;file 72 node 0
63 I $P(RA72,U,3)=0 S RABAD=1 Q ;skip cancelled exam
64 Q
65STORSUM ;
66 S RACOL=$S(RAWAITD'>30:1,RAWAITD'>60:2,RAWAITD'>90:3,RAWAITD'>120:4,1:5)
67 S RACOL(RAPTA,RACOL)=RACOL(RAPTA,RACOL)+1
68 S RATOTAL(RAPTA)=RATOTAL(RAPTA)+1,RATOTAL=RATOTAL+1
69 ; count negative Wait Days as 0
70 S RAWAITD(RAPTA)=RAWAITD(RAPTA)+$S(RAWAITD<0:0,1:RAWAITD)
71 Q
72WRTSUM ;
73 S RAHD0="Summary",RAPG=1
74 D SETHD
75 D PRTS Q:RAXIT
76 D FOOTS
77 Q
78SETHD ; Set up header & dev vars for identical parts of summary and detail reports
79 S RAIOM=$S(RATYP="S":80,1:IOM),$P(RADASH,"-",46)=""
80 S RAH1=RAHD0_" Radiology Outpatient Procedure Wait Time Report"
81 ; Hdr Line 3 -- Facility, Station, VISN
82 D GETS^DIQ(4,DUZ(2),".01;14*;99","E","RAR","RAMSG")
83 K X
84 S X(1)=RAR(4,DUZ(2)_",",.01,"E") ; Name of facility
85 S X(2)=RAR(4,DUZ(2)_",",99,"E") ; Station Number
86 I $D(RAR(4.014)) D
87 . S X(3)=RAR(4.014,"1,"_DUZ(2)_",",.01,"E") ; Association
88 . S X(4)=RAR(4.014,"1,"_DUZ(2)_",",1,"E") ; Parent of Association
89 . S X(5)=$S(X(3)="VISN":X(4),1:"") ; should be VISN number
90 E S X(5)=""
91 ;
92 S $P(X(6)," ",79)=""
93 S $E(X(6),1,(10+$L(X(1))))="Facility: "_X(1)
94 S $E(X(6),41,(50+$L(X(2))))="Station: "_X(2)
95 S $E(X(6),60,(66+$L(X(5))))="VISN: "_X(5)
96 S RAH3=X(6) ;Facility, Station, VISN
97 ; Hdr Line 4 -- Division(s)
98 K RAH4
99 I '$D(^TMP($J,"RA D-TYPE")) S RAH4(1)="No division selected"
100 E D
101 .S RA1=1,RADIV="" S RAH4(1)="Division(s): "
102 .F S RADIV=$O(^TMP($J,"RA D-TYPE",RADIV)) Q:RADIV="" D
103 ..S:$L(RAH4(RA1))+$L(RADIV)>RAIOM RA1=RA1+1,$P(RAH4(RA1)," ",14)=""
104 ..S RAH4(RA1)=RAH4(RA1)_RADIV_$S($O(^TMP($J,"RA D-TYPE",RADIV))]"":", ",1:"")
105 ..Q
106 .Q
107 ; Hdr line 5 -- Exam Date Range
108 S RAH5="Exam Date Range: "_$$FMTE^XLFDT(RABDATE,"2D")_"-"_$$FMTE^XLFDT(RAEDATE,"2D")
109 ; Hdr line 6 -- Imaging Type(s) selected
110 K RAH6
111 I RANX="P" D
112 .S RAH6(1)="PROCEDURE TYPES: All" ;*79
113 .I $O(RAXCLUDE(""))]"" D
114 ..S RAH6(1)=RAH6(1)_", except "
115 ..S I="" F S I=$O(RAXCLUDE(I)) Q:I="" S RAH6(1)=RAH6(1)_I S:$O(RAXCLUDE(I))]"" RAH6(1)=RAH6(1)_", "
116 ..Q
117 .Q
118 ; Hdr line 7 -- CPT and Proc names
119 K RAH7 I RANX="C" D ; *79
120 .S RAH7(0)="CPT CODES and PROCEDURES: "
121 .S RA1=1,RA2="",RAH7(1)=RAH7(0)
122 .F S RA2=$O(^TMP($J,"RA WAIT1",RA2)) Q:RA2="" D
123 ..S RA1=RA1+1
124 ..S RAH7(RA1)=" "_^TMP($J,"RA WAIT1",RA2)_" "_RA2
125 ..Q
126 .Q
127 ;Hdr line 8 -- Run Date/Time
128 S RANOW=$$NOW^XLFDT,RANOW=$E(RANOW,1,12)
129 S RAH8="Run Date/Time: "_$$FMTE^XLFDT(RANOW,"2P")
130 Q
131HD ;
132 W:$E(IOST,1,2)="C-" @IOF W !?(RAIOM-$L(RAH1)\2),RAH1
133 W !,"Page: ",RAPG,!
134 W !,RAH3
135 S I=0 F S I=$O(RAH4(I)) Q:'I W !,RAH4(I)
136 W !,RAH5
137 S I=0 F S I=$O(RAH6(I)) Q:'I W !,RAH6(I)
138 S I=0 F S I=$O(RAH7(I)) Q:'I W !,RAH7(I) I ($Y+5)>IOSL D PRESS Q:RAXIT W:$E(IOST,1,2)="C-" @IOF
139 Q:RAXIT
140 W !,RAH8
141 Q
142HDSUM ;
143 W !!,"Total number of procedures registered during specified exam date range: ",RATOTAL,!
144 Q
145PRTS ;
146 I RAPG=1 D HD Q:RAXIT D HDSUM S RAPG=RAPG+1
147 S I="" F S I=$O(RACOL(I)) Q:I="" D
148 .F J=1:1:5 S RAPCT(I,J)=$S(RATOTAL(I)>0:$J(RACOL(I,J)/RATOTAL(I)*100,5,1),1:$J(0,5,1)),RACOL(I,J)=$J(RACOL(I,J),7)
149 .S RAAVG(I)=$S(RATOTAL(I)>0:$J(RAWAITD(I)/RATOTAL(I),7,0),1:"")
150 .I I="unknown",RATOTAL(I)=0 K RATOTAL(I),RACOL(I) Q ;remove "unknown" row if 0s
151 .I RANX="C",RATOTAL(I)=0 K RATOTAL(I),RACOL(I) Q ;remov 0 row if by CPT
152 .I $D(RAXCLUDE(I)) K RATOTAL(I),RACOL(I) Q ;remove excluded Proc Type
153 .S RATOTAL(I)=$J(RATOTAL(I),8)
154 .Q
155 W !?30,"DAYS WAIT -- PERCENTAGES",! D COLHDS^RAPMW2(1)
156 S I="" F S I=$O(RACOL(I)) Q:I="" D
157 .W !,$E($S(I="unknown":""""_I_"""",1:I),1,26),?30,RAPCT(I,1),?40,RAPCT(I,2),?50,RAPCT(I,3),?60,RAPCT(I,4),?70,RAPCT(I,5)
158 .Q
159 D PRESS Q:RAXIT
160 W !!!!?30,"DAYS WAIT -- COUNTS",! D COLHDS^RAPMW2(2)
161 S I="" F S I=$O(RACOL(I)) Q:I="" D
162 .W !,$E($S(I="unknown":""""_I_"""",1:I),1,26),?27,RACOL(I,1),?34,RACOL(I,2),?41,RACOL(I,3),?48,RACOL(I,4),?55,RACOL(I,5),?62,RATOTAL(I),?69,$S(RAAVG(I)="":" -",1:RAAVG(I))
163 .Q
164 W !!,"Number of procedures cancelled and re-ordered on the same day = ",RASAME
165 ; *79, deleted display of average wait days
166 Q
167FOOTS ;
168 I RANEG W !!?3,"(There ",$S(RANEG=1:"is",1:"are")," ",RANEG," case",$S(RANEG=1:"",1:"s")," with negative days wait included in the first column.)",!
169 D PRESS Q:RAXIT W:$E(IOST,1,2)="C-" @IOF
170 S RAMAX=$S($D(RATOTAL("unknown")):33,1:28)
171 F I=1:1:RAMAX Q:RAXIT W !?4,$P($T(FOOTS2+I),";;",2) I ($Y+5)>IOSL D PRESS Q:RAXIT W:$E(IOST,1,2)="C-" @IOF
172 Q
173PRESS ;
174 Q:$D(ZTQUEUED)
175 I IO=IO(0) D
176 .I $E(IOST,1,2)="C-" R !,"Press RETURN to continue, ""^"" to exit:",RAKEY:DTIME
177 .S:$G(RAKEY)="^" RAXIT=1
178 .Q
179 Q
180FOOTS2 ;
181 ;;
182 ;;1. Cancelled, "No Credit", inpatient cases, and not the highest modality
183 ;; of a printset are excluded from this report. (See 3. below.)
184 ;;
185 ;;2. Columns represent # of days wait from the Registered date (the date/
186 ;; time entered at the "Imaging Exam Date/Time:" prompt) backwards to the
187 ;; Date Desired for the ordered procedure. The calculation is based on
188 ;; the number of different days and not rounded off by hours. The "31-60"
189 ;; column represents those orders that were registered 31 days or more but
190 ;; less than 61 days after the Date Desired.
191 ;;
192 ;;3. If the user did not select a specific CPT Code or Procedure Name,
193 ;; then the cases from a printset (group of cases that share the same
194 ;; report) will have only the case with the highest modality printed.
195 ;; The modalities have this hierarchical order, where (1) is the highest:
196 ;; (1) Interventional, (2) MRI, (3) CT, (4) Cardiac Stress test,
197 ;; (5) Nuc Med, (6) US, (7) Mammo, (8) General Rad (9) Other
198 ;;
199 ;;4. "Procedure Types" are assigned by a national CPT code look-up table
200 ;; and may differ from locally defined "Imaging Types." Therefore the
201 ;; number of procedures in each category may not be the same as other
202 ;; radiology management reports.
203 ;;
204 ;;5. "Avg. Days" is the average days wait. It is calculated from the sum
205 ;; of the days wait for that Procedure Type, divided by the count of cases
206 ;; included in this report for that Procedure Type. Negative days wait
207 ;; is counted as 0. A "-" means an average cannot be calculated.
208 ;;
209 ;;6. Procedure Type of "unknown" refers to either cases that have no
210 ;; matching procedure type in the spreadsheet of CPT Codes provided
211 ;; by the Office of Patient Care Services, or cases that are missing
212 ;; data for the procedure.
213 ;;
Note: See TracBrowser for help on using the repository browser.