RAPMW ;HOIFO/SWM-Radiology Wait Time reports ;03/19/05 12:45
;;5.0;Radiology/Nuclear Medicine;**67,79,83,99**;Mar 16, 1998;Build 5
;RVD - 3/19/09 p99
;
; ___ set up RACESS array
I $D(DUZ),($O(RACCESS(DUZ,""))']"") D CHECK^RADLQ3(DUZ)
; ___ new/set/kill other variables
K ^TMP($J)
;**********************************************************
;* On Dec. 14, 2006, Dr. Anderson requested that the
;* RADIAION THERAPY procedure type be dropped from the
;* Wait Times Report but it may be included in the future.
;*
;* If RADIATION THERAPY will be included again, the only
;* coding that needs to be changed is the line below; it
;* should be removed. The rest of the coding that handles
;* exclusion of Procedure Types don't have to be changed
;* because it uses RAXCLUDE() to exclude procedure types.
;*
S RAXCLUDE("RADIATION THERAPY")=""
;*
;***********************************************************
D SETPTA
S (RATOTAL,RAXIT)=0
W @IOF
W !,"Radiology Outpatient Procedure Wait Time Report"
; __ get report type
D GETTYP I $D(DIRUT) G EXIT
; ___ get date range
W !! D GETDATE I $D(DIRUT) G EXIT
; ___ get division
S X=$$GETDIV() I X G EXIT
; ___ ask what to ask next, procedure or img typ
D ASKIP I RANX="" G EXIT
I RANX="P" D W "."
.W !!?5,"All PROCEDURE TYPES will be included"
.I $O(RAXCLUDE(""))]"" D
.W ", except "
.S I="" F S I=$O(RAXCLUDE(I)) Q:I="" W I W:$O(RAXCLUDE(I))]"" ", "
.Q
I RANX="C" D I RAQUIT G EXIT
. ; ___ get procedure/CPT CODE(s)
. D GETPROC
. Q
; *79, skip ask spec imaing type
I "B^D"[RATYP D I $D(DIRUT) G EXIT
. D ASKSORT I $D(DIRUT) Q
. D ASKDAYS
. Q
I "B^D"[RATYP D
.S RATXT="*** The detail report requires a 132 column output device ***"
.S RALINE="",$P(RALINE,"*",$L(RATXT)+1)=""
.W !!?(80-$L(RATXT)\2),RALINE,!?(80-$L(RATXT)\2),RATXT,!?(80-$L(RATXT)\2),RALINE,!
.Q
D GETDEV I RAPOP G EXIT
D START
Q
START ; taskman to del task after job, set Radiology IO
S:$D(ZTQUEUED) ZTREQ="@" S RAIO=$S(IO="":0,1:1) ;RAIO true/false
; get data
; remove: inpatient, cancelled
; keep: specific proc/CPT, imag types if entered
S RASAME=0 ; count # procedures cancelled and re-ordered same day
S RANEG=0 ; count # negative Days Wait
D GETDATA
U:RAIO IO
I "S^B"[RATYP D WRTSUM^RAPMW1 Q:$G(RAS99)!$G(RAL99) ; summary report
I RATYP="B",$E(IOST,1,2)'="C-" W @IOF
I "D^B"[RATYP D WRTDET^RAPMW2 ; detail report
D EXIT
Q
GETTYP ;
S DIR(0)="S^S:Summary;D:Detail;B:Both"
S DIR("A")="Select Report Type",DIR("B")="S"
S DIR("?")="Enter Summary report OR Detail report OR Both reports"
W !!,"Enter Report Type"
D ^DIR K DIR
Q:$D(DIRUT)
S RATYP=Y
Q
GETDATE ; start and end dates
S DIR(0)="D^:"_DT_":AEX"
W !?4,"The starting and ending dates are based upon what was entered at",!?4,"the ""Imaging Exam Date/Time"" prompt during Registration.",!
S DIR("A")="Enter starting date"
S DIR("?")="Enter date to begin searching Exam date from"
D ^DIR K DIR
Q:$D(DIRUT)
S RABDATE=Y
;
S RADD=91,X1=RABDATE,X2=RADD D C^%DTC S RAMAXDT=X
I RAMAXDT>DT S RAMAXDT=DT W !!?4,"** Ending Date cannot be later than today's date. **",!
S DIR(0)="D^"_RABDATE_":"_RAMAXDT_":AEX"
S DIR("A")="Enter ending date"
S DIR("?",1)="+91 days max. for Summary and Detail."
S DIR("?")="But the Ending Date cannot be later than today's date."
D ^DIR K DIR
Q:$D(DIRUT)
;
; RABDATE, RAEDATE original values
; RABEGDT, RAENDDT used in GETDATA
; Set to end of day
S RAEDATE=Y,RAENDDT=RAEDATE_.9999
; Set to include current day
S RABEGDT=(RABDATE-1)_.9999
Q
GETDIV() ;
N X S X=$$SETUPDI^RAUTL7() Q:X 1
D SELDIV^RAUTL7
I '$D(^TMP($J,"RA D-TYPE"))!(RAQUIT) D Q 1
.K RACCESS(DUZ,"DIV-IMG"),^TMP($J,"DIV-IMG")
.Q
Q 0
ASKIP ;
S RANX=""
S DIR(0)="S^C:CPT Code/Procedure Name;P:Procedure Type"
S DIR("?")=" "
S DIR("?",1)=" ""CPT Code/Procedure Name"" will include only the"
S DIR("?",2)=" user selected CPT Codes and Procedure names in this"
S DIR("?",3)=" date range, except for cases that are cancelled, have"
S DIR("?",4)=" no credit, and are inpatient."
S DIR("?",5)=" "
S DIR("?",6)=" ""Procedure Type"" will include all cases in this"
S DIR("?",7)=" date range, except for the 3 exclusions above and also"
S DIR("?",8)=" except if the case is part of a printset and it is not"
S DIR("?",9)=" the highest ranked modality in the printset."
S DIR("A")="What do you want to choose next",DIR("B")="P"
W !!,"Enter next item to select."
D ^DIR K DIR
Q:$D(DIRUT)
S RANX=Y
Q
; *79 removed GETIMG() section
GETPROC ;
S RADIC="^RAMIS(71,",RADIC(0)="QEAMZ"
S RADIC("A")="Select Procedure/CPT Code: "
S RAUTIL="RA WAIT"
D EN1^RASELCT(.RADIC,RAUTIL)
Q:RAQUIT
S RA1=""
F S RA1=$O(^TMP($J,"RA WAIT",RA1)) Q:RA1="" S RA2=0 D
.F S RA2=$O(^TMP($J,"RA WAIT",RA1,RA2)) Q:'RA2 S ^TMP($J,"RA WAIT2",RA2)="",^TMP($J,"RA WAIT1",RA1)=$P($$NAMCODE^RACPTMSC($P($G(^RAMIS(71,RA2,0)),U,9),DT),U) D
..;if parent was selected, then save iens of its descendents for FILTER2
..I $P(^RAMIS(71,RA2,0),U,6)="P" D
...S RA3=0 F S RA3=$O(^RAMIS(71,RA2,4,"B",RA3)) Q:'RA3 S ^TMP($J,"RA WAIT2",RA3)=""
...Q
..Q
.Q
Q
ASKSORT ;
S DIR(0)="S^CN:Case Number;CPT:CPT Code;DD:Date Desired;D:Days Wait;DO:Date of Order;DR:Date of Registration;I:Imaging Type;PN:Patient Name;PT:PROCEDURE TYPE;PROC:Procedure Name"
S DIR("?")="Select which item to use for sorting the Detail Report"
S DIR("A")="Sorted by",DIR("B")="D"
W !!,"Sort report by"
D ^DIR
I $D(DIRUT) K DIR Q
S RASORT=Y
S RASORTNM=Y(0)
S:RASORTNM["Regis" RASORTNM="Dt. Register"
K DIR
Q
ASKDAYS ;
S DIR(0)="N^0:120"
S DIR("A")="Print wait days greater than or equal to"
S DIR("B")="0"
S DIR("?",1)="Enter the minimum number of Days Wait between Date Desired and Registered Date."
S DIR("?",2)="Only cases with Days Wait greater than or equal to this value"
S DIR("?")="will be listed in the detail report."
D ^DIR K DIR Q:$D(DIRUT) S RASINCE=Y
Q
GETDEV ;
W:RATYP="B" !!,"Specify device for both summary and detail reports."
D TASK
D ZIS^RAUTL
Q
TASK ; set vars for taskman
S ZTRTN="START^RAPMW"
S ZTSAVE("RA*")=""
S ZTSAVE("^TMP($J,")=""
S ZTDESC="Radiology Outpatient Wait Time Report"
Q
GETDATA ;
S RABAD=0 ;=0 means nothing bad, so accept case; =1 means reject case
;loop thru exam date (RADTE)
S RADTE=RABEGDT
F S RADTE=$O(^RADPT("AR",RADTE)) Q:'RADTE Q:(RADTE>RAENDDT) D
.S RADFN="" F S RADFN=$O(^RADPT("AR",RADTE,RADFN)) Q:'RADFN S RABAD=0 D
..S RADTI="" F S RADTI=$O(^RADPT("AR",RADTE,RADFN,RADTI)) Q:'RADTI D FILTER1^RAPMW1 I 'RABAD D
...S RACNI=0 F S RACNI=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI)) Q:'RACNI D FILTER2^RAPMW1 I 'RABAD D CALC^RAPMW2
...Q
..Q
.Q
Q
EXIT ;
S:$G(RAS99)!$G(RAL99) RAP99=1
D:'$G(RAP99) CLOSE^RAUTL ;close dev. if it's not a mail wait and time
K I,J,POP,RA0,RA1,RA16,RA2,RA3,RA71REC,RA72,X,X1,X2,Y
K RABAD,RACHKDIV,RACN0,RACNI,RACNISAV,RACNL,RACOL,RACOL14
K RACPT,RADASH,RADD,RADFN,RADIC,RADIV,RADSDT,RADTE,RADTI,RADTORD
K RAH1,RAH3,RAH4,RAH5,RAH6,RAH7,RAH8,RAHD0,RAIMGTYP
K RAIT,RAITYP,RAKEY,RALINE,RAMAX,RAMAXDT,RANEG,RANOW,RANX
K RAOREC,RAORIEN,RAPATND,RAPATNM,RAPG,RAPOP,RAPROCNM,RAPSTX,RAQUIT
K RAR,RAREC,RASAME,RASAME2,RASELDIV,RASINCE,RASORT,RASORTNM
K RAAVG,RATOTAL,RATYP,RAUTIL,RAWAITD,RATXT,RAXDT,RAXIT,RAXMST
K RACPTC,RACPTI,RAHI,RAHIER,RAPCT,RAPCT14,RAPRC,RAPTA,RARY,RAXCLUDE,RAMES
K:'$G(RAP99) RAEDATE,RABDATE,RAENDDT,RABEGDT,^TMP($J),RAIO,RAIOM ;cln var if not mail
;
; ^TMP($J,"RA I-TYPE","CT SCAN",ienFile79.2)="" <--*79 not needed
; ^TMP($J,"RA D-TYPE","SUPPORT ISC",ienFile79)=""
; ^TMP($J,"RA WAIT",ProcNam,ienFile71)=""<--from EN1^RASELCT
; ^TMP($J,"RA WAIT1",ProcNam)=CPTcode<--hdr of rpt, SETHD^RAPMW1
; ^TMP($J,"RA WAIT2",ienFile71)=""<--screen cases, FILTER2^RAPMW1
;ex. ^TMP($J,"RA WAIT","TEETH",31)=
;ex. ^TMP($J,"RA WAIT1","TEETH")=70320
;ex. ^TMP($J,"RA WAIT2",31)=
; ^TMP($J,"RA WAIT NO ORD",RADFN,RADTI,RACNI)=ienFile75.1
; ^TMP($J,"RA WAIT NO DSR DT",RADFN,RADTI,RACNI)=ienFile75.1
; ^TMP($J,"RA WAIT3",RASORT,RADTE,RAPATNM,RACNI)=""<--detail display
Q
SETPTA ;Set up Proc Type Array, w Sherrill Snuggs' Xcel file
; also setup RATOTAL(), RACOL(,), RAHIER()
N I,J
S I=""
; RATOTAL(I) sub-total, each Proc Type
; RAWAITD(I) total wait days, each Proc Type
; RAAVG(I) average wait days, each Proc Type
; RACOL14(I) <14 days column
F S I=$O(^RA(73.2,"AC",I)) Q:I="" S RATOTAL(I)=0,RAWAITD(I)=0,RAAVG(I)=0,RACOL14(I,"FR")=0 F J=1:1:5 S RACOL(I,J)=0
S I="unknown",RATOTAL(I)=0,RAWAITD(I)=0,RAAVG(I)=0,RACOL14(I,"FR")=0 F J=1:1:5 S RACOL(I,J)=0
; Rank Proc Types, needed to pick case from printset
; 1=Interventional 2=MR 3=CT 4=Card. Stress Test 5=NM
; 6=US 7=Mammo 8=Plain Film (Gen Rad) 9=Other
S I=""
F S I=$O(RATOTAL(I)) Q:I="" D
.S J=$E(I,1,3)
.S RAHIER(I)=$S(J="CAR":4,J="COM":3,J="GEN":8,J="INT":1,J="MAG":2,J="MAM":7,J="NUC":5,J="ULT":6,1:9)
.Q
Q
;added in p#99
PWT(RABDATE,RAEDATE) ;entry point of EMAIL performance and wait time as part of a task job
S RAXCLUDE("RADIATION THERAPY")=""
D SETPTA S (RATOTAL,RAXIT)=0
K:$G(RAL99) RAS99
S RANX="P",RATYP="S"
D START
D EXIT
Q
RAPMW ;HOIFO/SWM-Radiology Wait Time reports ;03/19/05 12:45
+1 ;;5.0;Radiology/Nuclear Medicine;**67,79,83,99**;Mar 16, 1998;Build 5
+2 ;RVD - 3/19/09 p99
+3 ;
+4 ; ___ set up RACESS array
+5 IF $DATA(DUZ)
IF ($ORDER(RACCESS(DUZ,""))']"")
DO CHECK^RADLQ3(DUZ)
+6 ; ___ new/set/kill other variables
+7 KILL ^TMP($JOB)
+8 ;**********************************************************
+9 ;* On Dec. 14, 2006, Dr. Anderson requested that the
+10 ;* RADIAION THERAPY procedure type be dropped from the
+11 ;* Wait Times Report but it may be included in the future.
+12 ;*
+13 ;* If RADIATION THERAPY will be included again, the only
+14 ;* coding that needs to be changed is the line below; it
+15 ;* should be removed. The rest of the coding that handles
+16 ;* exclusion of Procedure Types don't have to be changed
+17 ;* because it uses RAXCLUDE() to exclude procedure types.
+18 ;*
+19 SET RAXCLUDE("RADIATION THERAPY")=""
+20 ;*
+21 ;***********************************************************
+22 DO SETPTA
+23 SET (RATOTAL,RAXIT)=0
+24 WRITE @IOF
+25 WRITE !,"Radiology Outpatient Procedure Wait Time Report"
+26 ; __ get report type
+27 DO GETTYP
IF $DATA(DIRUT)
GOTO EXIT
+28 ; ___ get date range
+29 WRITE !!
DO GETDATE
IF $DATA(DIRUT)
GOTO EXIT
+30 ; ___ get division
+31 SET X=$$GETDIV()
IF X
GOTO EXIT
+32 ; ___ ask what to ask next, procedure or img typ
+33 DO ASKIP
IF RANX=""
GOTO EXIT
+34 IF RANX="P"
Begin DoDot:1
+35 WRITE !!?5,"All PROCEDURE TYPES will be included"
+36 IF $ORDER(RAXCLUDE(""))]""
Begin DoDot:2
End DoDot:2
+37 WRITE ", except "
+38 SET I=""
FOR
SET I=$ORDER(RAXCLUDE(I))
IF I=""
QUIT
WRITE I
IF $ORDER(RAXCLUDE(I))]""
WRITE ", "
+39 QUIT
End DoDot:1
WRITE "."
+40 IF RANX="C"
Begin DoDot:1
+41 ; ___ get procedure/CPT CODE(s)
+42 DO GETPROC
+43 QUIT
End DoDot:1
IF RAQUIT
GOTO EXIT
+44 ; *79, skip ask spec imaing type
+45 IF "B^D"[RATYP
Begin DoDot:1
+46 DO ASKSORT
IF $DATA(DIRUT)
QUIT
+47 DO ASKDAYS
+48 QUIT
End DoDot:1
IF $DATA(DIRUT)
GOTO EXIT
+49 IF "B^D"[RATYP
Begin DoDot:1
+50 SET RATXT="*** The detail report requires a 132 column output device ***"
+51 SET RALINE=""
SET $PIECE(RALINE,"*",$LENGTH(RATXT)+1)=""
+52 WRITE !!?(80-$LENGTH(RATXT)\2),RALINE,!?(80-$LENGTH(RATXT)\2),RATXT,!?(80-$LENGTH(RATXT)\2),RALINE,!
+53 QUIT
End DoDot:1
+54 DO GETDEV
IF RAPOP
GOTO EXIT
+55 DO START
+56 QUIT
START ; taskman to del task after job, set Radiology IO
+1 ;RAIO true/false
IF $DATA(ZTQUEUED)
SET ZTREQ="@"
SET RAIO=$SELECT(IO="":0,1:1)
+2 ; get data
+3 ; remove: inpatient, cancelled
+4 ; keep: specific proc/CPT, imag types if entered
+5 ; count # procedures cancelled and re-ordered same day
SET RASAME=0
+6 ; count # negative Days Wait
SET RANEG=0
+7 DO GETDATA
+8 IF RAIO
USE IO
+9 ; summary report
IF "S^B"[RATYP
DO WRTSUM^RAPMW1
IF $GET(RAS99)!$GET(RAL99)
QUIT
+10 IF RATYP="B"
IF $EXTRACT(IOST,1,2)'="C-"
WRITE @IOF
+11 ; detail report
IF "D^B"[RATYP
DO WRTDET^RAPMW2
+12 DO EXIT
+13 QUIT
GETTYP ;
+1 SET DIR(0)="S^S:Summary;D:Detail;B:Both"
+2 SET DIR("A")="Select Report Type"
SET DIR("B")="S"
+3 SET DIR("?")="Enter Summary report OR Detail report OR Both reports"
+4 WRITE !!,"Enter Report Type"
+5 DO ^DIR
KILL DIR
+6 IF $DATA(DIRUT)
QUIT
+7 SET RATYP=Y
+8 QUIT
GETDATE ; start and end dates
+1 SET DIR(0)="D^:"_DT_":AEX"
+2 WRITE !?4,"The starting and ending dates are based upon what was entered at",!?4,"the ""Imaging Exam Date/Time"" prompt during Registration.",!
+3 SET DIR("A")="Enter starting date"
+4 SET DIR("?")="Enter date to begin searching Exam date from"
+5 DO ^DIR
KILL DIR
+6 IF $DATA(DIRUT)
QUIT
+7 SET RABDATE=Y
+8 ;
+9 SET RADD=91
SET X1=RABDATE
SET X2=RADD
DO C^%DTC
SET RAMAXDT=X
+10 IF RAMAXDT>DT
SET RAMAXDT=DT
WRITE !!?4,"** Ending Date cannot be later than today's date. **",!
+11 SET DIR(0)="D^"_RABDATE_":"_RAMAXDT_":AEX"
+12 SET DIR("A")="Enter ending date"
+13 SET DIR("?",1)="+91 days max. for Summary and Detail."
+14 SET DIR("?")="But the Ending Date cannot be later than today's date."
+15 DO ^DIR
KILL DIR
+16 IF $DATA(DIRUT)
QUIT
+17 ;
+18 ; RABDATE, RAEDATE original values
+19 ; RABEGDT, RAENDDT used in GETDATA
+20 ; Set to end of day
+21 SET RAEDATE=Y
SET RAENDDT=RAEDATE_.9999
+22 ; Set to include current day
+23 SET RABEGDT=(RABDATE-1)_.9999
+24 QUIT
GETDIV() ;
+1 NEW X
SET X=$$SETUPDI^RAUTL7()
IF X
QUIT 1
+2 DO SELDIV^RAUTL7
+3 IF '$DATA(^TMP($JOB,"RA D-TYPE"))!(RAQUIT)
Begin DoDot:1
+4 KILL RACCESS(DUZ,"DIV-IMG"),^TMP($JOB,"DIV-IMG")
+5 QUIT
End DoDot:1
QUIT 1
+6 QUIT 0
ASKIP ;
+1 SET RANX=""
+2 SET DIR(0)="S^C:CPT Code/Procedure Name;P:Procedure Type"
+3 SET DIR("?")=" "
+4 SET DIR("?",1)=" ""CPT Code/Procedure Name"" will include only the"
+5 SET DIR("?",2)=" user selected CPT Codes and Procedure names in this"
+6 SET DIR("?",3)=" date range, except for cases that are cancelled, have"
+7 SET DIR("?",4)=" no credit, and are inpatient."
+8 SET DIR("?",5)=" "
+9 SET DIR("?",6)=" ""Procedure Type"" will include all cases in this"
+10 SET DIR("?",7)=" date range, except for the 3 exclusions above and also"
+11 SET DIR("?",8)=" except if the case is part of a printset and it is not"
+12 SET DIR("?",9)=" the highest ranked modality in the printset."
+13 SET DIR("A")="What do you want to choose next"
SET DIR("B")="P"
+14 WRITE !!,"Enter next item to select."
+15 DO ^DIR
KILL DIR
+16 IF $DATA(DIRUT)
QUIT
+17 SET RANX=Y
+18 QUIT
+19 ; *79 removed GETIMG() section
GETPROC ;
+1 SET RADIC="^RAMIS(71,"
SET RADIC(0)="QEAMZ"
+2 SET RADIC("A")="Select Procedure/CPT Code: "
+3 SET RAUTIL="RA WAIT"
+4 DO EN1^RASELCT(.RADIC,RAUTIL)
+5 IF RAQUIT
QUIT
+6 SET RA1=""
+7 FOR
SET RA1=$ORDER(^TMP($JOB,"RA WAIT",RA1))
IF RA1=""
QUIT
SET RA2=0
Begin DoDot:1
+8 FOR
SET RA2=$ORDER(^TMP($JOB,"RA WAIT",RA1,RA2))
IF 'RA2
QUIT
SET ^TMP($JOB,"RA WAIT2",RA2)=""
SET ^TMP($JOB,"RA WAIT1",RA1)=$PIECE($$NAMCODE^RACPTMSC($PIECE($GET(^RAMIS(71,RA2,0)),U,9),DT),U)
Begin DoDot:2
+9 ;if parent was selected, then save iens of its descendents for FILTER2
+10 IF $PIECE(^RAMIS(71,RA2,0),U,6)="P"
Begin DoDot:3
+11 SET RA3=0
FOR
SET RA3=$ORDER(^RAMIS(71,RA2,4,"B",RA3))
IF 'RA3
QUIT
SET ^TMP($JOB,"RA WAIT2",RA3)=""
+12 QUIT
End DoDot:3
+13 QUIT
End DoDot:2
+14 QUIT
End DoDot:1
+15 QUIT
ASKSORT ;
+1 SET DIR(0)="S^CN:Case Number;CPT:CPT Code;DD:Date Desired;D:Days Wait;DO:Date of Order;DR:Date of Registration;I:Imaging Type;PN:Patient Name;PT:PROCEDURE TYPE;PROC:Procedure Name"
+2 SET DIR("?")="Select which item to use for sorting the Detail Report"
+3 SET DIR("A")="Sorted by"
SET DIR("B")="D"
+4 WRITE !!,"Sort report by"
+5 DO ^DIR
+6 IF $DATA(DIRUT)
KILL DIR
QUIT
+7 SET RASORT=Y
+8 SET RASORTNM=Y(0)
+9 IF RASORTNM["Regis"
SET RASORTNM="Dt. Register"
+10 KILL DIR
+11 QUIT
ASKDAYS ;
+1 SET DIR(0)="N^0:120"
+2 SET DIR("A")="Print wait days greater than or equal to"
+3 SET DIR("B")="0"
+4 SET DIR("?",1)="Enter the minimum number of Days Wait between Date Desired and Registered Date."
+5 SET DIR("?",2)="Only cases with Days Wait greater than or equal to this value"
+6 SET DIR("?")="will be listed in the detail report."
+7 DO ^DIR
KILL DIR
IF $DATA(DIRUT)
QUIT
SET RASINCE=Y
+8 QUIT
GETDEV ;
+1 IF RATYP="B"
WRITE !!,"Specify device for both summary and detail reports."
+2 DO TASK
+3 DO ZIS^RAUTL
+4 QUIT
TASK ; set vars for taskman
+1 SET ZTRTN="START^RAPMW"
+2 SET ZTSAVE("RA*")=""
+3 SET ZTSAVE("^TMP($J,")=""
+4 SET ZTDESC="Radiology Outpatient Wait Time Report"
+5 QUIT
GETDATA ;
+1 ;=0 means nothing bad, so accept case; =1 means reject case
SET RABAD=0
+2 ;loop thru exam date (RADTE)
+3 SET RADTE=RABEGDT
+4 FOR
SET RADTE=$ORDER(^RADPT("AR",RADTE))
IF 'RADTE
QUIT
IF (RADTE>RAENDDT)
QUIT
Begin DoDot:1
+5 SET RADFN=""
FOR
SET RADFN=$ORDER(^RADPT("AR",RADTE,RADFN))
IF 'RADFN
QUIT
SET RABAD=0
Begin DoDot:2
+6 SET RADTI=""
FOR
SET RADTI=$ORDER(^RADPT("AR",RADTE,RADFN,RADTI))
IF 'RADTI
QUIT
DO FILTER1^RAPMW1
IF 'RABAD
Begin DoDot:3
+7 SET RACNI=0
FOR
SET RACNI=$ORDER(^RADPT(RADFN,"DT",RADTI,"P",RACNI))
IF 'RACNI
QUIT
DO FILTER2^RAPMW1
IF 'RABAD
DO CALC^RAPMW2
+8 QUIT
End DoDot:3
+9 QUIT
End DoDot:2
+10 QUIT
End DoDot:1
+11 QUIT
EXIT ;
+1 IF $GET(RAS99)!$GET(RAL99)
SET RAP99=1
+2 ;close dev. if it's not a mail wait and time
IF '$GET(RAP99)
DO CLOSE^RAUTL
+3 KILL I,J,POP,RA0,RA1,RA16,RA2,RA3,RA71REC,RA72,X,X1,X2,Y
+4 KILL RABAD,RACHKDIV,RACN0,RACNI,RACNISAV,RACNL,RACOL,RACOL14
+5 KILL RACPT,RADASH,RADD,RADFN,RADIC,RADIV,RADSDT,RADTE,RADTI,RADTORD
+6 KILL RAH1,RAH3,RAH4,RAH5,RAH6,RAH7,RAH8,RAHD0,RAIMGTYP
+7 KILL RAIT,RAITYP,RAKEY,RALINE,RAMAX,RAMAXDT,RANEG,RANOW,RANX
+8 KILL RAOREC,RAORIEN,RAPATND,RAPATNM,RAPG,RAPOP,RAPROCNM,RAPSTX,RAQUIT
+9 KILL RAR,RAREC,RASAME,RASAME2,RASELDIV,RASINCE,RASORT,RASORTNM
+10 KILL RAAVG,RATOTAL,RATYP,RAUTIL,RAWAITD,RATXT,RAXDT,RAXIT,RAXMST
+11 KILL RACPTC,RACPTI,RAHI,RAHIER,RAPCT,RAPCT14,RAPRC,RAPTA,RARY,RAXCLUDE,RAMES
+12 ;cln var if not mail
IF '$GET(RAP99)
KILL RAEDATE,RABDATE,RAENDDT,RABEGDT,^TMP($JOB),RAIO,RAIOM
+13 ;
+14 ; ^TMP($J,"RA I-TYPE","CT SCAN",ienFile79.2)="" <--*79 not needed
+15 ; ^TMP($J,"RA D-TYPE","SUPPORT ISC",ienFile79)=""
+16 ; ^TMP($J,"RA WAIT",ProcNam,ienFile71)=""<--from EN1^RASELCT
+17 ; ^TMP($J,"RA WAIT1",ProcNam)=CPTcode<--hdr of rpt, SETHD^RAPMW1
+18 ; ^TMP($J,"RA WAIT2",ienFile71)=""<--screen cases, FILTER2^RAPMW1
+19 ;ex. ^TMP($J,"RA WAIT","TEETH",31)=
+20 ;ex. ^TMP($J,"RA WAIT1","TEETH")=70320
+21 ;ex. ^TMP($J,"RA WAIT2",31)=
+22 ; ^TMP($J,"RA WAIT NO ORD",RADFN,RADTI,RACNI)=ienFile75.1
+23 ; ^TMP($J,"RA WAIT NO DSR DT",RADFN,RADTI,RACNI)=ienFile75.1
+24 ; ^TMP($J,"RA WAIT3",RASORT,RADTE,RAPATNM,RACNI)=""<--detail display
+25 QUIT
SETPTA ;Set up Proc Type Array, w Sherrill Snuggs' Xcel file
+1 ; also setup RATOTAL(), RACOL(,), RAHIER()
+2 NEW I,J
+3 SET I=""
+4 ; RATOTAL(I) sub-total, each Proc Type
+5 ; RAWAITD(I) total wait days, each Proc Type
+6 ; RAAVG(I) average wait days, each Proc Type
+7 ; RACOL14(I) <14 days column
+8 FOR
SET I=$ORDER(^RA(73.2,"AC",I))
IF I=""
QUIT
SET RATOTAL(I)=0
SET RAWAITD(I)=0
SET RAAVG(I)=0
SET RACOL14(I,"FR")=0
FOR J=1:1:5
SET RACOL(I,J)=0
+9 SET I="unknown"
SET RATOTAL(I)=0
SET RAWAITD(I)=0
SET RAAVG(I)=0
SET RACOL14(I,"FR")=0
FOR J=1:1:5
SET RACOL(I,J)=0
+10 ; Rank Proc Types, needed to pick case from printset
+11 ; 1=Interventional 2=MR 3=CT 4=Card. Stress Test 5=NM
+12 ; 6=US 7=Mammo 8=Plain Film (Gen Rad) 9=Other
+13 SET I=""
+14 FOR
SET I=$ORDER(RATOTAL(I))
IF I=""
QUIT
Begin DoDot:1
+15 SET J=$EXTRACT(I,1,3)
+16 SET RAHIER(I)=$SELECT(J="CAR":4,J="COM":3,J="GEN":8,J="INT":1,J="MAG":2,J="MAM":7,J="NUC":5,J="ULT":6,1:9)
+17 QUIT
End DoDot:1
+18 QUIT
+19 ;added in p#99
PWT(RABDATE,RAEDATE) ;entry point of EMAIL performance and wait time as part of a task job
+1 SET RAXCLUDE("RADIATION THERAPY")=""
+2 DO SETPTA
SET (RATOTAL,RAXIT)=0
+3 IF $GET(RAL99)
KILL RAS99
+4 SET RANX="P"
SET RATYP="S"
+5 DO START
+6 DO EXIT
+7 QUIT
