- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAPMW 9356 printed Jan 18, 2025@03:39:40 Page 2
- 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