Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RAPMW1

RAPMW1.m

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