| 1 | RAPMW1 ;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
|
|---|
| 6 | FILTER1 ;
|
|---|
| 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
|
|---|
| 19 | FILTER2 ;
|
|---|
| 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
|
|---|
| 51 | EXCL ; 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
|
|---|
| 55 | CHECK3 ; 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
|
|---|
| 65 | STORSUM ;
|
|---|
| 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
|
|---|
| 72 | WRTSUM ;
|
|---|
| 73 | S RAHD0="Summary",RAPG=1
|
|---|
| 74 | D SETHD
|
|---|
| 75 | D PRTS Q:RAXIT
|
|---|
| 76 | D FOOTS
|
|---|
| 77 | Q
|
|---|
| 78 | SETHD ; 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
|
|---|
| 131 | HD ;
|
|---|
| 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
|
|---|
| 142 | HDSUM ;
|
|---|
| 143 | W !!,"Total number of procedures registered during specified exam date range: ",RATOTAL,!
|
|---|
| 144 | Q
|
|---|
| 145 | PRTS ;
|
|---|
| 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
|
|---|
| 167 | FOOTS ;
|
|---|
| 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
|
|---|
| 173 | PRESS ;
|
|---|
| 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
|
|---|
| 180 | FOOTS2 ;
|
|---|
| 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 | ;;
|
|---|
