RAPMW1 ;HOIFO/SWM-Radiology Wait Time reports ;3/20/09 13:40
;;5.0;Radiology/Nuclear Medicine;**67,79,83,99**;Mar 16, 1998;Build 5
; IA 10090 allows Read w/Fileman for entire file 4
; IA #2541 = KSP^XUPARAM
; Supported IA #10103 reference to ^XLFDT
; Supported IA #2056 reference to ^DIQ
; RVD - 3/20/99 p99
; summary
Q
FILTER1 ;
S RABAD=0
I '$D(^RADPT(RADFN,"DT",RADTI)) S RABAD=1 Q ;no exam data
;division
S RASELDIV=$P($G(^RADPT(RADFN,"DT",RADTI,0)),U,3)
S RACHKDIV=$P($G(^DIC(4,+RASELDIV,0)),U)
I RACHKDIV'="",'$D(^TMP($J,"RA D-TYPE",RACHKDIV)) S RABAD=1 Q
;imaging type
S RAITYP=$P($G(^RADPT(RADFN,"DT",RADTI,0)),U,2)
S RAIMGTYP=$P($G(^RA(79.2,+RAITYP,0)),U)
; *79 removed check for imaging type
I RAIMGTYP="" S RAIMGTYP="(unk)"
Q
FILTER2 ;
S RABAD=0
S RACN0=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))
I RACN0="" S RABAD=1 Q ;no case level data
I RANX="C",'$D(^TMP($J,"RA WAIT2",+$P(RACN0,U,2))) S RABAD=1 Q
S RACNISAV=RACNI ; save orig. before it's changed due printset
I RANX="P",$P(RACN0,U,25)>1 D G EXCL
.; If selecting by Proc Type, and case is from printset --
.; pick case with highest ranked Procedure Type
.; then skip remaining cases by setting a high RACNI
.S I=0
.K RARY ;array of cases and rank number
.F S I=$O(^RADPT(RADFN,"DT",RADTI,"P",I)) Q:'I S RACN0=$G(^(I,0)) D:RACN0'=""
..S RABAD=0 D CHECK3 Q:RABAD ;skip case if it meets 1 of 3 exclusions
..D PTA^RAPMW2
..;eg. rary(6,racni)=racn0 for Ultrasound
..S RARY(RAHIER(RAPTA),I)=RACN0
..Q
.S RAHI=$O(RARY("")) ;highest rank number from prtset cases
.I RAHI="" D Q ; no case in prtset can be used
..S RABAD=1,RACNI=99999
..Q
.S RACNI=$O(RARY(RAHI,0))
.I RACNI="" D Q ;should not happen
..S RABAD=1,RACNI=99999
..Q
.S RACN0=RARY(RAHI,RACNI) ;reset racn0
.S RA72=^RA(72,+$P(RACN0,U,3),0) ;reset ra72
.S RACNISAV=RACNI ; save orig. before it's changed due printset
.S RACNI=99999 ;set to 99999 so GETDATA loop would skip rest of prtset
.Q
D CHECK3
EXCL ; skip case if its proc isn't among user-selected procs
D PTA^RAPMW2 ; *79, Procedure Type via CPT Code & Sherrill's Xcel sheet
I $D(RAXCLUDE(RAPTA)) S RABAD=1 Q
Q
CHECK3 ; check inpatient, no credit, cancelled exam
; CATEGORY OF EXAM is inpatient
I $P(RACN0,U,4)="I" S RABAD=1 Q
; exam's credit method is 2 (no credit)
I $P(RACN0,U,26)=2 S RABAD=1 Q
; exam status is cancelled
I $P(RACN0,U,3)="" S RABAD=1 Q ;no exam status
S RA72=^RA(72,+$P(RACN0,U,3),0) ;file 72 node 0
I $P(RA72,U,3)=0 S RABAD=1 Q ;skip cancelled exam
Q
STORSUM ;
S RACOL=$S(RAWAITD'>30:1,RAWAITD'>60:2,RAWAITD'>90:3,RAWAITD'>120:4,1:5)
S:RAWAITD<15 RACOL14(RAPTA,"FR")=RACOL14(RAPTA,"FR")+1
S RACOL(RAPTA,RACOL)=RACOL(RAPTA,RACOL)+1
S RATOTAL(RAPTA)=RATOTAL(RAPTA)+1,RATOTAL=RATOTAL+1
; count negative Wait Days as 0
S RAWAITD(RAPTA)=RAWAITD(RAPTA)+$S(RAWAITD<0:0,1:RAWAITD)
Q
WRTSUM ;
S RAHD0="Summary",RAPG=1
D SETHD
I $G(RAS99) D RAJOB^RAPMW3 Q ;if this is an email wait and time performance report
I $G(RAL99) D RAJOB1^RAPMW3 Q ;if email W&T performance report, process all.
D PRTS Q:RAXIT
D FOOTS
Q
SETHD ; Set up header & dev vars for identical parts of summary and detail reports
S RAIOM=$S(RATYP="S":80,1:IOM),$P(RADASH,"-",46)=""
S RAH1=RAHD0_" Radiology Outpatient Procedure Wait Time Report"
; Hdr Line 3 -- Facility, Station, VISN
S:'$G(DUZ(2)) DUZ(2)=$$KSP^XUPARAM("INST") ;if NULL, use the default institution
;
D GETS^DIQ(4,DUZ(2),".01;14*;99","E","RAR","RAMSG")
K X
S X(1)=RAR(4,DUZ(2)_",",.01,"E") ; Name of facility
S X(2)=RAR(4,DUZ(2)_",",99,"E") ; Station Number
I $D(RAR(4.014)) D
. S X(3)=RAR(4.014,"1,"_DUZ(2)_",",.01,"E") ; Association
. S X(4)=RAR(4.014,"1,"_DUZ(2)_",",1,"E") ; Parent of Association
. S X(5)=$S(X(3)="VISN":X(4),1:"") ; should be VISN number
E S X(5)=""
;
S $P(X(6)," ",79)=""
S $E(X(6),1,(10+$L(X(1))))="Facility: "_X(1)
S $E(X(6),41,(50+$L(X(2))))="Station: "_X(2)
S $E(X(6),60,(66+$L(X(5))))="VISN: "_X(5)
S RAH3=X(6) ;Facility, Station, VISN
; Hdr Line 4 -- Division(s)
K RAH4
I '$D(^TMP($J,"RA D-TYPE")) S RAH4(1)="No division selected"
E D
.S RA1=1,RADIV="" S RAH4(1)="Division(s): "
.F S RADIV=$O(^TMP($J,"RA D-TYPE",RADIV)) Q:RADIV="" D
..S:$L(RAH4(RA1))+$L(RADIV)>RAIOM RA1=RA1+1,$P(RAH4(RA1)," ",14)=""
..S RAH4(RA1)=RAH4(RA1)_RADIV_$S($O(^TMP($J,"RA D-TYPE",RADIV))]"":", ",1:"")
..Q
.Q
; Hdr line 5 -- Exam Date Range
S RAH5="Exam Date Range: "_$$FMTE^XLFDT(RABDATE,"2D")_"-"_$$FMTE^XLFDT(RAEDATE,"2D")
; Hdr line 6 -- Imaging Type(s) selected
K RAH6
I RANX="P" D
.S RAH6(1)="PROCEDURE TYPES: All" ;*79
.I $O(RAXCLUDE(""))]"" D
..S RAH6(1)=RAH6(1)_", except "
..S I="" F S I=$O(RAXCLUDE(I)) Q:I="" S RAH6(1)=RAH6(1)_I S:$O(RAXCLUDE(I))]"" RAH6(1)=RAH6(1)_", "
..Q
.Q
; Hdr line 7 -- CPT and Proc names
K RAH7 I RANX="C" D ; *79
.S RAH7(0)="CPT CODES and PROCEDURES: "
.S RA1=1,RA2="",RAH7(1)=RAH7(0)
.F S RA2=$O(^TMP($J,"RA WAIT1",RA2)) Q:RA2="" D
..S RA1=RA1+1
..S RAH7(RA1)=" "_^TMP($J,"RA WAIT1",RA2)_" "_RA2
..Q
.Q
;Hdr line 8 -- Run Date/Time
S RANOW=$$NOW^XLFDT,RANOW=$E(RANOW,1,12)
S RAH8="Run Date/Time: "_$$FMTE^XLFDT(RANOW,"2P")
Q
HD ;
W:$E(IOST,1,2)="C-" @IOF W !?(RAIOM-$L(RAH1)\2),RAH1
W !,"Page: ",RAPG,!
W !,RAH3
S I=0 F S I=$O(RAH4(I)) Q:'I W !,RAH4(I)
W !,RAH5
S I=0 F S I=$O(RAH6(I)) Q:'I W !,RAH6(I)
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
Q:RAXIT
W !,RAH8
Q
HDSUM ;
W !!,"Total number of procedures registered during specified exam date range: ",RATOTAL,!
Q
DAY14 ;
W !!,"The ""<=14 Days"" column contains data that is also in the ""<=30 Days"" column."
W !,"The reason that performance is calculated for both <=14 days and <=30 days is"
W !,"so that facilities can track their performance to a 14 day performance standard"
W !,"rather than a 30 day standard if they choose to do so."
Q
PRTS ;
I RAPG=1 D HD Q:RAXIT D HDSUM S RAPG=RAPG+1
S I="" F S I=$O(RACOL(I)) Q:I="" D
.F J=1:1:5 D
..S RAPCT(I,J)=$S(RATOTAL(I)>0:$J(RACOL(I,J)/RATOTAL(I)*100,5,1),1:$J(0,5,1))
..S RACOL(I,J)=$J(RACOL(I,J),7)
..S RAPCT14(I,"FR")=$S(RATOTAL(I)>0:$J(RACOL14(I,"FR")/RATOTAL(I)*100,5,1),1:$J(0,5,1))
..Q
.S RAAVG(I)=$S(RATOTAL(I)>0:$J(RAWAITD(I)/RATOTAL(I),7,0),1:"")
.I I="unknown",RATOTAL(I)=0 K RATOTAL(I),RACOL(I) Q ;remove "unknown" row if 0s
.I RANX="C",RATOTAL(I)=0 K RATOTAL(I),RACOL(I) Q ;remov 0 row if by CPT
.I $D(RAXCLUDE(I)) K RATOTAL(I),RACOL(I) Q ;remove excluded Proc Type
.S RATOTAL(I)=$J(RATOTAL(I),8)
.Q
W !?30,"DAYS WAIT -- PERCENTAGES",! D COLHDS^RAPMW2(1)
S I="" F S I=$O(RACOL(I)) Q:I="" D
.W !,$E($S(I="unknown":""""_I_"""",1:I),1,24),?28,RAPCT14(I,"FR"),?36,RAPCT(I,1),?45,RAPCT(I,2),?54,RAPCT(I,3),?64,RAPCT(I,4),?72,RAPCT(I,5)
.Q
D PRESS Q:RAXIT
W !!!!?30,"DAYS WAIT -- COUNTS",! D COLHDS^RAPMW2(2)
S I="" F S I=$O(RACOL(I)) Q:I="" D
.W !,$E($S(I="unknown":""""_I_"""",1:I),1,15),?16,$J(RACOL14(I,"FR"),7),?24,RACOL(I,1),?32,RACOL(I,2),?40,RACOL(I,3),?48,RACOL(I,4),?56,RACOL(I,5),?63,RATOTAL(I),?72,$S(RAAVG(I)="":" -",1:RAAVG(I))
.Q
D DAY14 W !!,"Number of procedures cancelled and re-ordered on the same day = ",RASAME
; *79, deleted display of average wait days
Q
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.)",!
D PRESS Q:RAXIT W:$E(IOST,1,2)="C-" @IOF
S RAMAX=$S($D(RATOTAL("unknown")):33,1:28)
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
Q
PRESS ;
Q:$D(ZTQUEUED)
I IO=IO(0) D
.I $E(IOST,1,2)="C-" R !,"Press RETURN to continue, ""^"" to exit:",RAKEY:DTIME
.S:$G(RAKEY)="^" RAXIT=1
.Q
Q
;;
;;1. Cancelled, "No Credit", inpatient cases, and not the highest modality
;; of a printset are excluded from this report. (See 3. below.)
;;
;;2. Columns represent # of days wait from the Registered date (the date/
;; time entered at the "Imaging Exam Date/Time:" prompt) backwards to the
;; Date Desired for the ordered procedure. The calculation is based on
;; the number of different days and not rounded off by hours. The "31-60"
;; column represents those orders that were registered 31 days or more but
;; less than 61 days after the Date Desired.
;;
;;3. If the user did not select a specific CPT Code or Procedure Name,
;; then the cases from a printset (group of cases that share the same
;; report) will have only the case with the highest modality printed.
;; The modalities have this hierarchical order, where (1) is the highest:
;; (1) Interventional, (2) MRI, (3) CT, (4) Cardiac Stress test,
;; (5) Nuc Med, (6) US, (7) Mammo, (8) General Rad (9) Other
;;
;;4. "Procedure Types" are assigned by a national CPT code look-up table
;; and may differ from locally defined "Imaging Types." Therefore the
;; number of procedures in each category may not be the same as other
;; radiology management reports.
;;
;;5. "Avg. Days" is the average days wait. It is calculated from the sum
;; of the days wait for that Procedure Type, divided by the count of cases
;; included in this report for that Procedure Type. Negative days wait
;; is counted as 0. A "-" means an average cannot be calculated.
;;
;;6. Procedure Type of "unknown" refers to either cases that have no
;; matching procedure type in the spreadsheet of CPT Codes provided
;; by the Office of Patient Care Services, or cases that are missing
;; data for the procedure.
;;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAPMW1 9811 printed Dec 13, 2024@02:38:41 Page 2
RAPMW1 ;HOIFO/SWM-Radiology Wait Time reports ;3/20/09 13:40
+1 ;;5.0;Radiology/Nuclear Medicine;**67,79,83,99**;Mar 16, 1998;Build 5
+2 ; IA 10090 allows Read w/Fileman for entire file 4
+3 ; IA #2541 = KSP^XUPARAM
+4 ; Supported IA #10103 reference to ^XLFDT
+5 ; Supported IA #2056 reference to ^DIQ
+6 ; RVD - 3/20/99 p99
+7 ; summary
+8 QUIT
FILTER1 ;
+1 SET RABAD=0
+2 ;no exam data
IF '$DATA(^RADPT(RADFN,"DT",RADTI))
SET RABAD=1
QUIT
+3 ;division
+4 SET RASELDIV=$PIECE($GET(^RADPT(RADFN,"DT",RADTI,0)),U,3)
+5 SET RACHKDIV=$PIECE($GET(^DIC(4,+RASELDIV,0)),U)
+6 IF RACHKDIV'=""
IF '$DATA(^TMP($JOB,"RA D-TYPE",RACHKDIV))
SET RABAD=1
QUIT
+7 ;imaging type
+8 SET RAITYP=$PIECE($GET(^RADPT(RADFN,"DT",RADTI,0)),U,2)
+9 SET RAIMGTYP=$PIECE($GET(^RA(79.2,+RAITYP,0)),U)
+10 ; *79 removed check for imaging type
+11 IF RAIMGTYP=""
SET RAIMGTYP="(unk)"
+12 QUIT
FILTER2 ;
+1 SET RABAD=0
+2 SET RACN0=$GET(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))
+3 ;no case level data
IF RACN0=""
SET RABAD=1
QUIT
+4 IF RANX="C"
IF '$DATA(^TMP($JOB,"RA WAIT2",+$PIECE(RACN0,U,2)))
SET RABAD=1
QUIT
+5 ; save orig. before it's changed due printset
SET RACNISAV=RACNI
+6 IF RANX="P"
IF $PIECE(RACN0,U,25)>1
Begin DoDot:1
+7 ; If selecting by Proc Type, and case is from printset --
+8 ; pick case with highest ranked Procedure Type
+9 ; then skip remaining cases by setting a high RACNI
+10 SET I=0
+11 ;array of cases and rank number
KILL RARY
+12 FOR
SET I=$ORDER(^RADPT(RADFN,"DT",RADTI,"P",I))
if 'I
QUIT
SET RACN0=$GET(^(I,0))
if RACN0'=""
Begin DoDot:2
+13 ;skip case if it meets 1 of 3 exclusions
SET RABAD=0
DO CHECK3
if RABAD
QUIT
+14 DO PTA^RAPMW2
+15 ;eg. rary(6,racni)=racn0 for Ultrasound
+16 SET RARY(RAHIER(RAPTA),I)=RACN0
+17 QUIT
End DoDot:2
+18 ;highest rank number from prtset cases
SET RAHI=$ORDER(RARY(""))
+19 ; no case in prtset can be used
IF RAHI=""
Begin DoDot:2
+20 SET RABAD=1
SET RACNI=99999
+21 QUIT
End DoDot:2
QUIT
+22 SET RACNI=$ORDER(RARY(RAHI,0))
+23 ;should not happen
IF RACNI=""
Begin DoDot:2
+24 SET RABAD=1
SET RACNI=99999
+25 QUIT
End DoDot:2
QUIT
+26 ;reset racn0
SET RACN0=RARY(RAHI,RACNI)
+27 ;reset ra72
SET RA72=^RA(72,+$PIECE(RACN0,U,3),0)
+28 ; save orig. before it's changed due printset
SET RACNISAV=RACNI
+29 ;set to 99999 so GETDATA loop would skip rest of prtset
SET RACNI=99999
+30 QUIT
End DoDot:1
GOTO EXCL
+31 DO CHECK3
EXCL ; skip case if its proc isn't among user-selected procs
+1 ; *79, Procedure Type via CPT Code & Sherrill's Xcel sheet
DO PTA^RAPMW2
+2 IF $DATA(RAXCLUDE(RAPTA))
SET RABAD=1
QUIT
+3 QUIT
CHECK3 ; check inpatient, no credit, cancelled exam
+1 ; CATEGORY OF EXAM is inpatient
+2 IF $PIECE(RACN0,U,4)="I"
SET RABAD=1
QUIT
+3 ; exam's credit method is 2 (no credit)
+4 IF $PIECE(RACN0,U,26)=2
SET RABAD=1
QUIT
+5 ; exam status is cancelled
+6 ;no exam status
IF $PIECE(RACN0,U,3)=""
SET RABAD=1
QUIT
+7 ;file 72 node 0
SET RA72=^RA(72,+$PIECE(RACN0,U,3),0)
+8 ;skip cancelled exam
IF $PIECE(RA72,U,3)=0
SET RABAD=1
QUIT
+9 QUIT
STORSUM ;
+1 SET RACOL=$SELECT(RAWAITD'>30:1,RAWAITD'>60:2,RAWAITD'>90:3,RAWAITD'>120:4,1:5)
+2 if RAWAITD<15
SET RACOL14(RAPTA,"FR")=RACOL14(RAPTA,"FR")+1
+3 SET RACOL(RAPTA,RACOL)=RACOL(RAPTA,RACOL)+1
+4 SET RATOTAL(RAPTA)=RATOTAL(RAPTA)+1
SET RATOTAL=RATOTAL+1
+5 ; count negative Wait Days as 0
+6 SET RAWAITD(RAPTA)=RAWAITD(RAPTA)+$SELECT(RAWAITD<0:0,1:RAWAITD)
+7 QUIT
WRTSUM ;
+1 SET RAHD0="Summary"
SET RAPG=1
+2 DO SETHD
+3 ;if this is an email wait and time performance report
IF $GET(RAS99)
DO RAJOB^RAPMW3
QUIT
+4 ;if email W&T performance report, process all.
IF $GET(RAL99)
DO RAJOB1^RAPMW3
QUIT
+5 DO PRTS
if RAXIT
QUIT
+6 DO FOOTS
+7 QUIT
SETHD ; Set up header & dev vars for identical parts of summary and detail reports
+1 SET RAIOM=$SELECT(RATYP="S":80,1:IOM)
SET $PIECE(RADASH,"-",46)=""
+2 SET RAH1=RAHD0_" Radiology Outpatient Procedure Wait Time Report"
+3 ; Hdr Line 3 -- Facility, Station, VISN
+4 ;if NULL, use the default institution
if '$GET(DUZ(2))
SET DUZ(2)=$$KSP^XUPARAM("INST")
+5 ;
+6 DO GETS^DIQ(4,DUZ(2),".01;14*;99","E","RAR","RAMSG")
+7 KILL X
+8 ; Name of facility
SET X(1)=RAR(4,DUZ(2)_",",.01,"E")
+9 ; Station Number
SET X(2)=RAR(4,DUZ(2)_",",99,"E")
+10 IF $DATA(RAR(4.014))
Begin DoDot:1
+11 ; Association
SET X(3)=RAR(4.014,"1,"_DUZ(2)_",",.01,"E")
+12 ; Parent of Association
SET X(4)=RAR(4.014,"1,"_DUZ(2)_",",1,"E")
+13 ; should be VISN number
SET X(5)=$SELECT(X(3)="VISN":X(4),1:"")
End DoDot:1
+14 IF '$TEST
SET X(5)=""
+15 ;
+16 SET $PIECE(X(6)," ",79)=""
+17 SET $EXTRACT(X(6),1,(10+$LENGTH(X(1))))="Facility: "_X(1)
+18 SET $EXTRACT(X(6),41,(50+$LENGTH(X(2))))="Station: "_X(2)
+19 SET $EXTRACT(X(6),60,(66+$LENGTH(X(5))))="VISN: "_X(5)
+20 ;Facility, Station, VISN
SET RAH3=X(6)
+21 ; Hdr Line 4 -- Division(s)
+22 KILL RAH4
+23 IF '$DATA(^TMP($JOB,"RA D-TYPE"))
SET RAH4(1)="No division selected"
+24 IF '$TEST
Begin DoDot:1
+25 SET RA1=1
SET RADIV=""
SET RAH4(1)="Division(s): "
+26 FOR
SET RADIV=$ORDER(^TMP($JOB,"RA D-TYPE",RADIV))
if RADIV=""
QUIT
Begin DoDot:2
+27 if $LENGTH(RAH4(RA1))+$LENGTH(RADIV)>RAIOM
SET RA1=RA1+1
SET $PIECE(RAH4(RA1)," ",14)=""
+28 SET RAH4(RA1)=RAH4(RA1)_RADIV_$SELECT($ORDER(^TMP($JOB,"RA D-TYPE",RADIV))]"":", ",1:"")
+29 QUIT
End DoDot:2
+30 QUIT
End DoDot:1
+31 ; Hdr line 5 -- Exam Date Range
+32 SET RAH5="Exam Date Range: "_$$FMTE^XLFDT(RABDATE,"2D")_"-"_$$FMTE^XLFDT(RAEDATE,"2D")
+33 ; Hdr line 6 -- Imaging Type(s) selected
+34 KILL RAH6
+35 IF RANX="P"
Begin DoDot:1
+36 ;*79
SET RAH6(1)="PROCEDURE TYPES: All"
+37 IF $ORDER(RAXCLUDE(""))]""
Begin DoDot:2
+38 SET RAH6(1)=RAH6(1)_", except "
+39 SET I=""
FOR
SET I=$ORDER(RAXCLUDE(I))
if I=""
QUIT
SET RAH6(1)=RAH6(1)_I
if $ORDER(RAXCLUDE(I))]""
SET RAH6(1)=RAH6(1)_", "
+40 QUIT
End DoDot:2
+41 QUIT
End DoDot:1
+42 ; Hdr line 7 -- CPT and Proc names
+43 ; *79
KILL RAH7
IF RANX="C"
Begin DoDot:1
+44 SET RAH7(0)="CPT CODES and PROCEDURES: "
+45 SET RA1=1
SET RA2=""
SET RAH7(1)=RAH7(0)
+46 FOR
SET RA2=$ORDER(^TMP($JOB,"RA WAIT1",RA2))
if RA2=""
QUIT
Begin DoDot:2
+47 SET RA1=RA1+1
+48 SET RAH7(RA1)=" "_^TMP($JOB,"RA WAIT1",RA2)_" "_RA2
+49 QUIT
End DoDot:2
+50 QUIT
End DoDot:1
+51 ;Hdr line 8 -- Run Date/Time
+52 SET RANOW=$$NOW^XLFDT
SET RANOW=$EXTRACT(RANOW,1,12)
+53 SET RAH8="Run Date/Time: "_$$FMTE^XLFDT(RANOW,"2P")
+54 QUIT
HD ;
+1 if $EXTRACT(IOST,1,2)="C-"
WRITE @IOF
WRITE !?(RAIOM-$LENGTH(RAH1)\2),RAH1
+2 WRITE !,"Page: ",RAPG,!
+3 WRITE !,RAH3
+4 SET I=0
FOR
SET I=$ORDER(RAH4(I))
if 'I
QUIT
WRITE !,RAH4(I)
+5 WRITE !,RAH5
+6 SET I=0
FOR
SET I=$ORDER(RAH6(I))
if 'I
QUIT
WRITE !,RAH6(I)
+7 SET I=0
FOR
SET I=$ORDER(RAH7(I))
if 'I
QUIT
WRITE !,RAH7(I)
IF ($Y+5)>IOSL
DO PRESS
if RAXIT
QUIT
if $EXTRACT(IOST,1,2)="C-"
WRITE @IOF
+8 if RAXIT
QUIT
+9 WRITE !,RAH8
+10 QUIT
HDSUM ;
+1 WRITE !!,"Total number of procedures registered during specified exam date range: ",RATOTAL,!
+2 QUIT
DAY14 ;
+1 WRITE !!,"The ""<=14 Days"" column contains data that is also in the ""<=30 Days"" column."
+2 WRITE !,"The reason that performance is calculated for both <=14 days and <=30 days is"
+3 WRITE !,"so that facilities can track their performance to a 14 day performance standard"
+4 WRITE !,"rather than a 30 day standard if they choose to do so."
+5 QUIT
PRTS ;
+1 IF RAPG=1
DO HD
if RAXIT
QUIT
DO HDSUM
SET RAPG=RAPG+1
+2 SET I=""
FOR
SET I=$ORDER(RACOL(I))
if I=""
QUIT
Begin DoDot:1
+3 FOR J=1:1:5
Begin DoDot:2
+4 SET RAPCT(I,J)=$SELECT(RATOTAL(I)>0:$JUSTIFY(RACOL(I,J)/RATOTAL(I)*100,5,1),1:$JUSTIFY(0,5,1))
+5 SET RACOL(I,J)=$JUSTIFY(RACOL(I,J),7)
+6 SET RAPCT14(I,"FR")=$SELECT(RATOTAL(I)>0:$JUSTIFY(RACOL14(I,"FR")/RATOTAL(I)*100,5,1),1:$JUSTIFY(0,5,1))
+7 QUIT
End DoDot:2
+8 SET RAAVG(I)=$SELECT(RATOTAL(I)>0:$JUSTIFY(RAWAITD(I)/RATOTAL(I),7,0),1:"")
+9 ;remove "unknown" row if 0s
IF I="unknown"
IF RATOTAL(I)=0
KILL RATOTAL(I),RACOL(I)
QUIT
+10 ;remov 0 row if by CPT
IF RANX="C"
IF RATOTAL(I)=0
KILL RATOTAL(I),RACOL(I)
QUIT
+11 ;remove excluded Proc Type
IF $DATA(RAXCLUDE(I))
KILL RATOTAL(I),RACOL(I)
QUIT
+12 SET RATOTAL(I)=$JUSTIFY(RATOTAL(I),8)
+13 QUIT
End DoDot:1
+14 WRITE !?30,"DAYS WAIT -- PERCENTAGES",!
DO COLHDS^RAPMW2(1)
+15 SET I=""
FOR
SET I=$ORDER(RACOL(I))
if I=""
QUIT
Begin DoDot:1
+16 WRITE !,$EXTRACT($SELECT(I="unknown":""""_I_"""",1:I),1,24),?28,RAPCT14(I,"FR"),?36,RAPCT(I,1),?45,RAPCT(I,2),?54,RAPCT(I,3),?64,RAPCT(I,4),?72,RAPCT(I,5)
+17 QUIT
End DoDot:1
+18 DO PRESS
if RAXIT
QUIT
+19 WRITE !!!!?30,"DAYS WAIT -- COUNTS",!
DO COLHDS^RAPMW2(2)
+20 SET I=""
FOR
SET I=$ORDER(RACOL(I))
if I=""
QUIT
Begin DoDot:1
+21 WRITE !,$EXTRACT($SELECT(I="unknown":""""_I_"""",1:I),1,15),?16,$JUSTIFY(RACOL14(I,"FR"),7),?24,RACOL(I,1),?32,RACOL(I,2),?40,RACOL(I,3),?48,RACOL(I,4),?56,RACOL(I,5),?63,RATOTAL(I),?72,$SELECT(RAAVG(I)="":" -",1:RAAVG(I))
+22 QUIT
End DoDot:1
+23 DO DAY14
WRITE !!,"Number of procedures cancelled and re-ordered on the same day = ",RASAME
+24 ; *79, deleted display of average wait days
+25 QUIT
+1 IF RANEG
WRITE !!?3,"(There ",$SELECT(RANEG=1:"is",1:"are")," ",RANEG," case",$SELECT(RANEG=1:"",1:"s")," with negative days wait included in the first column.)",!
+2 DO PRESS
if RAXIT
QUIT
if $EXTRACT(IOST,1,2)="C-"
WRITE @IOF
+3 SET RAMAX=$SELECT($DATA(RATOTAL("unknown")):33,1:28)
+4 FOR I=1:1:RAMAX
if RAXIT
QUIT
WRITE !?4,$PIECE($TEXT(FOOTS2+I),";;",2)
IF ($Y+5)>IOSL
DO PRESS
if RAXIT
QUIT
if $EXTRACT(IOST,1,2)="C-"
WRITE @IOF
+5 QUIT
PRESS ;
+1 if $DATA(ZTQUEUED)
QUIT
+2 IF IO=IO(0)
Begin DoDot:1
+3 IF $EXTRACT(IOST,1,2)="C-"
READ !,"Press RETURN to continue, ""^"" to exit:",RAKEY:DTIME
+4 if $GET(RAKEY)="^"
SET RAXIT=1
+5 QUIT
End DoDot:1
+6 QUIT
+1 ;;
+2 ;;1. Cancelled, "No Credit", inpatient cases, and not the highest modality
+3 ;; of a printset are excluded from this report. (See 3. below.)
+4 ;;
+5 ;;2. Columns represent # of days wait from the Registered date (the date/
+6 ;; time entered at the "Imaging Exam Date/Time:" prompt) backwards to the
+7 ;; Date Desired for the ordered procedure. The calculation is based on
+8 ;; the number of different days and not rounded off by hours. The "31-60"
+9 ;; column represents those orders that were registered 31 days or more but
+10 ;; less than 61 days after the Date Desired.
+11 ;;
+12 ;;3. If the user did not select a specific CPT Code or Procedure Name,
+13 ;; then the cases from a printset (group of cases that share the same
+14 ;; report) will have only the case with the highest modality printed.
+15 ;; The modalities have this hierarchical order, where (1) is the highest:
+16 ;; (1) Interventional, (2) MRI, (3) CT, (4) Cardiac Stress test,
+17 ;; (5) Nuc Med, (6) US, (7) Mammo, (8) General Rad (9) Other
+18 ;;
+19 ;;4. "Procedure Types" are assigned by a national CPT code look-up table
+20 ;; and may differ from locally defined "Imaging Types." Therefore the
+21 ;; number of procedures in each category may not be the same as other
+22 ;; radiology management reports.
+23 ;;
+24 ;;5. "Avg. Days" is the average days wait. It is calculated from the sum
+25 ;; of the days wait for that Procedure Type, divided by the count of cases
+26 ;; included in this report for that Procedure Type. Negative days wait
+27 ;; is counted as 0. A "-" means an average cannot be calculated.
+28 ;;
+29 ;;6. Procedure Type of "unknown" refers to either cases that have no
+30 ;; matching procedure type in the spreadsheet of CPT Codes provided
+31 ;; by the Office of Patient Care Services, or cases that are missing
+32 ;; data for the procedure.
+33 ;;
