| 1 | RAPMW ;HOIFO/SWM-Radiology Wait Time reports ;11/07/05 12:53
|
|---|
| 2 | ;;5.0;Radiology/Nuclear Medicine;**67,79,83**;Mar 16, 1998;Build 4
|
|---|
| 3 | ;
|
|---|
| 4 | ; ___ set up RACESS array
|
|---|
| 5 | I $D(DUZ),($O(RACCESS(DUZ,""))']"") D CHECK^RADLQ3(DUZ)
|
|---|
| 6 | ; ___ new/set/kill other variables
|
|---|
| 7 | K ^TMP($J)
|
|---|
| 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 | S RAXCLUDE("RADIATION THERAPY")=""
|
|---|
| 20 | ;*
|
|---|
| 21 | ;***********************************************************
|
|---|
| 22 | D SETPTA
|
|---|
| 23 | S (RATOTAL,RAXIT)=0
|
|---|
| 24 | W @IOF
|
|---|
| 25 | W !,"Radiology Outpatient Procedure Wait Time Report"
|
|---|
| 26 | ; __ get report type
|
|---|
| 27 | D GETTYP I $D(DIRUT) G EXIT
|
|---|
| 28 | ; ___ get date range
|
|---|
| 29 | W !! D GETDATE I $D(DIRUT) G EXIT
|
|---|
| 30 | ; ___ get division
|
|---|
| 31 | S X=$$GETDIV() I X G EXIT
|
|---|
| 32 | ; ___ ask what to ask next, procedure or img typ
|
|---|
| 33 | D ASKIP I RANX="" G EXIT
|
|---|
| 34 | I RANX="P" D W "."
|
|---|
| 35 | .W !!?5,"All PROCEDURE TYPES will be included"
|
|---|
| 36 | .I $O(RAXCLUDE(""))]"" D
|
|---|
| 37 | .W ", except "
|
|---|
| 38 | .S I="" F S I=$O(RAXCLUDE(I)) Q:I="" W I W:$O(RAXCLUDE(I))]"" ", "
|
|---|
| 39 | .Q
|
|---|
| 40 | I RANX="C" D I RAQUIT G EXIT
|
|---|
| 41 | . ; ___ get procedure/CPT CODE(s)
|
|---|
| 42 | . D GETPROC
|
|---|
| 43 | . Q
|
|---|
| 44 | ; *79, skip ask spec imaing type
|
|---|
| 45 | I "B^D"[RATYP D I $D(DIRUT) G EXIT
|
|---|
| 46 | . D ASKSORT I $D(DIRUT) Q
|
|---|
| 47 | . D ASKDAYS
|
|---|
| 48 | . Q
|
|---|
| 49 | I "B^D"[RATYP D
|
|---|
| 50 | .S RATXT="*** The detail report requires a 132 column output device ***"
|
|---|
| 51 | .S RALINE="",$P(RALINE,"*",$L(RATXT)+1)=""
|
|---|
| 52 | .W !!?(80-$L(RATXT)\2),RALINE,!?(80-$L(RATXT)\2),RATXT,!?(80-$L(RATXT)\2),RALINE,!
|
|---|
| 53 | .Q
|
|---|
| 54 | D GETDEV I RAPOP G EXIT
|
|---|
| 55 | D START
|
|---|
| 56 | Q
|
|---|
| 57 | START ; taskman to del task after job, set Radiology IO
|
|---|
| 58 | S:$D(ZTQUEUED) ZTREQ="@" S RAIO=$S(IO="":0,1:1) ;RAIO true/false
|
|---|
| 59 | ; get data
|
|---|
| 60 | ; remove: inpatient, cancelled
|
|---|
| 61 | ; keep: specific proc/CPT, imag types if entered
|
|---|
| 62 | S RASAME=0 ; count # procedures cancelled and re-ordered same day
|
|---|
| 63 | S RANEG=0 ; count # negative Days Wait
|
|---|
| 64 | D GETDATA
|
|---|
| 65 | U:RAIO IO
|
|---|
| 66 | I "S^B"[RATYP D WRTSUM^RAPMW1 ; summary report
|
|---|
| 67 | I RATYP="B",$E(IOST,1,2)'="C-" W @IOF
|
|---|
| 68 | I "D^B"[RATYP D WRTDET^RAPMW2 ; detail report
|
|---|
| 69 | D EXIT
|
|---|
| 70 | Q
|
|---|
| 71 | GETTYP ;
|
|---|
| 72 | S DIR(0)="S^S:Summary;D:Detail;B:Both"
|
|---|
| 73 | S DIR("A")="Select Report Type",DIR("B")="S"
|
|---|
| 74 | S DIR("?")="Enter Summary report OR Detail report OR Both reports"
|
|---|
| 75 | W !!,"Enter Report Type"
|
|---|
| 76 | D ^DIR K DIR
|
|---|
| 77 | Q:$D(DIRUT)
|
|---|
| 78 | S RATYP=Y
|
|---|
| 79 | Q
|
|---|
| 80 | GETDATE ; start and end dates
|
|---|
| 81 | S DIR(0)="D^:"_DT_":AEX"
|
|---|
| 82 | W !?4,"The starting and ending dates are based upon what was entered at",!?4,"the ""Imaging Exam Date/Time"" prompt during Registration.",!
|
|---|
| 83 | S DIR("A")="Enter starting date"
|
|---|
| 84 | S DIR("?")="Enter date to begin searching Exam date from"
|
|---|
| 85 | D ^DIR K DIR
|
|---|
| 86 | Q:$D(DIRUT)
|
|---|
| 87 | S RABDATE=Y
|
|---|
| 88 | ;
|
|---|
| 89 | S RADD=$S(RATYP="S":91,1:31),X1=RABDATE,X2=RADD D C^%DTC S RAMAXDT=X
|
|---|
| 90 | I RAMAXDT>DT S RAMAXDT=DT W !!?4,"** Ending Date cannot be later than today's date. **",!
|
|---|
| 91 | S DIR(0)="D^"_RABDATE_":"_RAMAXDT_":AEX"
|
|---|
| 92 | S DIR("A")="Enter ending date"
|
|---|
| 93 | S DIR("?",1)="+91 days max. for Summary, +31 days max. for Detail."
|
|---|
| 94 | S DIR("?")="But the Ending Date cannot be later than today's date."
|
|---|
| 95 | D ^DIR K DIR
|
|---|
| 96 | Q:$D(DIRUT)
|
|---|
| 97 | ;
|
|---|
| 98 | ; RABDATE, RAEDATE original values
|
|---|
| 99 | ; RABEGDT, RAENDDT used in GETDATA
|
|---|
| 100 | ; Set to end of day
|
|---|
| 101 | S RAEDATE=Y,RAENDDT=RAEDATE_.9999
|
|---|
| 102 | ; Set to include current day
|
|---|
| 103 | S RABEGDT=(RABDATE-1)_.9999
|
|---|
| 104 | Q
|
|---|
| 105 | GETDIV() ;
|
|---|
| 106 | N X S X=$$SETUPDI^RAUTL7() Q:X 1
|
|---|
| 107 | D SELDIV^RAUTL7
|
|---|
| 108 | I '$D(^TMP($J,"RA D-TYPE"))!(RAQUIT) D Q 1
|
|---|
| 109 | .K RACCESS(DUZ,"DIV-IMG"),^TMP($J,"DIV-IMG")
|
|---|
| 110 | .Q
|
|---|
| 111 | Q 0
|
|---|
| 112 | ASKIP ;
|
|---|
| 113 | S RANX=""
|
|---|
| 114 | S DIR(0)="S^C:CPT Code/Procedure Name;P:Procedure Type"
|
|---|
| 115 | S DIR("?")=" "
|
|---|
| 116 | S DIR("?",1)=" ""CPT Code/Procedure Name"" will include only the"
|
|---|
| 117 | S DIR("?",2)=" user selected CPT Codes and Procedure names in this"
|
|---|
| 118 | S DIR("?",3)=" date range, except for cases that are cancelled, have"
|
|---|
| 119 | S DIR("?",4)=" no credit, and are inpatient."
|
|---|
| 120 | S DIR("?",5)=" "
|
|---|
| 121 | S DIR("?",6)=" ""Procedure Type"" will include all cases in this"
|
|---|
| 122 | S DIR("?",7)=" date range, except for the 3 exclusions above and also"
|
|---|
| 123 | S DIR("?",8)=" except if the case is part of a printset and it is not"
|
|---|
| 124 | S DIR("?",9)=" the highest ranked modality in the printset."
|
|---|
| 125 | S DIR("A")="What do you want to choose next",DIR("B")="P"
|
|---|
| 126 | W !!,"Enter next item to select."
|
|---|
| 127 | D ^DIR K DIR
|
|---|
| 128 | Q:$D(DIRUT)
|
|---|
| 129 | S RANX=Y
|
|---|
| 130 | Q
|
|---|
| 131 | ; *79 removed GETIMG() section
|
|---|
| 132 | GETPROC ;
|
|---|
| 133 | S RADIC="^RAMIS(71,",RADIC(0)="QEAMZ"
|
|---|
| 134 | S RADIC("A")="Select Procedure/CPT Code: "
|
|---|
| 135 | S RAUTIL="RA WAIT"
|
|---|
| 136 | D EN1^RASELCT(.RADIC,RAUTIL)
|
|---|
| 137 | Q:RAQUIT
|
|---|
| 138 | S RA1=""
|
|---|
| 139 | F S RA1=$O(^TMP($J,"RA WAIT",RA1)) Q:RA1="" S RA2=0 D
|
|---|
| 140 | .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
|
|---|
| 141 | ..;if parent was selected, then save iens of its descendents for FILTER2
|
|---|
| 142 | ..I $P(^RAMIS(71,RA2,0),U,6)="P" D
|
|---|
| 143 | ...S RA3=0 F S RA3=$O(^RAMIS(71,RA2,4,"B",RA3)) Q:'RA3 S ^TMP($J,"RA WAIT2",RA3)=""
|
|---|
| 144 | ...Q
|
|---|
| 145 | ..Q
|
|---|
| 146 | .Q
|
|---|
| 147 | Q
|
|---|
| 148 | ASKSORT ;
|
|---|
| 149 | 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"
|
|---|
| 150 | S DIR("?")="Select which item to use for sorting the Detail Report"
|
|---|
| 151 | S DIR("A")="Sorted by",DIR("B")="D"
|
|---|
| 152 | W !!,"Sort report by"
|
|---|
| 153 | D ^DIR
|
|---|
| 154 | I $D(DIRUT) K DIR Q
|
|---|
| 155 | S RASORT=Y
|
|---|
| 156 | S RASORTNM=Y(0)
|
|---|
| 157 | S:RASORTNM["Regis" RASORTNM="Dt. Register"
|
|---|
| 158 | K DIR
|
|---|
| 159 | Q
|
|---|
| 160 | ASKDAYS ;
|
|---|
| 161 | S DIR(0)="N^0:120"
|
|---|
| 162 | S DIR("A")="Print wait days greater than or equal to"
|
|---|
| 163 | S DIR("B")="0"
|
|---|
| 164 | S DIR("?",1)="Enter the minimum number of Days Wait between Date Desired and Registered Date."
|
|---|
| 165 | S DIR("?",2)="Only cases with Days Wait greater than or equal to this value"
|
|---|
| 166 | S DIR("?")="will be listed in the detail report."
|
|---|
| 167 | D ^DIR K DIR Q:$D(DIRUT) S RASINCE=Y
|
|---|
| 168 | Q
|
|---|
| 169 | GETDEV ;
|
|---|
| 170 | W:RATYP="B" !!,"Specify device for both summary and detail reports."
|
|---|
| 171 | D TASK
|
|---|
| 172 | D ZIS^RAUTL
|
|---|
| 173 | Q
|
|---|
| 174 | TASK ; set vars for taskman
|
|---|
| 175 | S ZTRTN="START^RAPMW"
|
|---|
| 176 | S ZTSAVE("RA*")=""
|
|---|
| 177 | S ZTSAVE("^TMP($J,")=""
|
|---|
| 178 | S ZTDESC="Radiology Outpatient Wait Time Report"
|
|---|
| 179 | Q
|
|---|
| 180 | GETDATA ;
|
|---|
| 181 | S RABAD=0 ;=0 means nothing bad, so accept case; =1 means reject case
|
|---|
| 182 | ;loop thru exam date (RADTE)
|
|---|
| 183 | S RADTE=RABEGDT
|
|---|
| 184 | F S RADTE=$O(^RADPT("AR",RADTE)) Q:'RADTE Q:(RADTE>RAENDDT) D
|
|---|
| 185 | .S RADFN="" F S RADFN=$O(^RADPT("AR",RADTE,RADFN)) Q:'RADFN S RABAD=0 D
|
|---|
| 186 | ..S RADTI="" F S RADTI=$O(^RADPT("AR",RADTE,RADFN,RADTI)) Q:'RADTI D FILTER1^RAPMW1 I 'RABAD D
|
|---|
| 187 | ...S RACNI=0 F S RACNI=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI)) Q:'RACNI D FILTER2^RAPMW1 I 'RABAD D CALC^RAPMW2
|
|---|
| 188 | ...Q
|
|---|
| 189 | ..Q
|
|---|
| 190 | .Q
|
|---|
| 191 | Q
|
|---|
| 192 | EXIT ;
|
|---|
| 193 | D CLOSE^RAUTL ;close dev
|
|---|
| 194 | K I,J,POP,RA0,RA1,RA16,RA2,RA3,RA71REC,RA72,X,X1,X2,Y,^TMP($J)
|
|---|
| 195 | K RABAD,RABDATE,RABEGDT,RACHKDIV,RACN0,RACNI,RACNISAV,RACNL,RACOL
|
|---|
| 196 | K RACPT,RADASH,RADD,RADFN,RADIC,RADIV,RADSDT,RADTE,RADTI,RADTORD
|
|---|
| 197 | K RAEDATE,RAENDDT,RAH1,RAH3,RAH4,RAH5,RAH6,RAH7,RAH8,RAHD0,RAIMGTYP
|
|---|
| 198 | K RAIO,RAIOM,RAIT,RAITYP,RAKEY,RALINE,RAMAX,RAMAXDT,RANEG,RANOW,RANX
|
|---|
| 199 | K RAOREC,RAORIEN,RAPATND,RAPATNM,RAPG,RAPOP,RAPROCNM,RAPSTX,RAQUIT
|
|---|
| 200 | K RAR,RAREC,RASAME,RASAME2,RASELDIV,RASINCE,RASORT,RASORTNM
|
|---|
| 201 | K RAAVG,RATOTAL,RATYP,RAUTIL,RAWAITD,RATXT,RAXDT,RAXIT,RAXMST
|
|---|
| 202 | K RACPTC,RACPTI,RAHI,RAHIER,RAPCT,RAPRC,RAPTA,RARY,RAXCLUDE,RAMES
|
|---|
| 203 | ;
|
|---|
| 204 | ; ^TMP($J,"RA I-TYPE","CT SCAN",ienFile79.2)="" <--*79 not needed
|
|---|
| 205 | ; ^TMP($J,"RA D-TYPE","SUPPORT ISC",ienFile79)=""
|
|---|
| 206 | ; ^TMP($J,"RA WAIT",ProcNam,ienFile71)=""<--from EN1^RASELCT
|
|---|
| 207 | ; ^TMP($J,"RA WAIT1",ProcNam)=CPTcode<--hdr of rpt, SETHD^RAPMW1
|
|---|
| 208 | ; ^TMP($J,"RA WAIT2",ienFile71)=""<--screen cases, FILTER2^RAPMW1
|
|---|
| 209 | ;ex. ^TMP($J,"RA WAIT","TEETH",31)=
|
|---|
| 210 | ;ex. ^TMP($J,"RA WAIT1","TEETH")=70320
|
|---|
| 211 | ;ex. ^TMP($J,"RA WAIT2",31)=
|
|---|
| 212 | ; ^TMP($J,"RA WAIT NO ORD",RADFN,RADTI,RACNI)=ienFile75.1
|
|---|
| 213 | ; ^TMP($J,"RA WAIT NO DSR DT",RADFN,RADTI,RACNI)=ienFile75.1
|
|---|
| 214 | ; ^TMP($J,"RA WAIT3",RASORT,RADTE,RAPATNM,RACNI)=""<--detail display
|
|---|
| 215 | Q
|
|---|
| 216 | SETPTA ;Set up Proc Type Array, w Sherrill Snuggs' Xcel file
|
|---|
| 217 | ; also setup RATOTAL(), RACOL(,), RAHIER()
|
|---|
| 218 | N I,J
|
|---|
| 219 | S I=""
|
|---|
| 220 | ; RATOTAL(I) sub-total, each Proc Type
|
|---|
| 221 | ; RAWAITD(I) total wait days, each Proc Type
|
|---|
| 222 | ; RAAVG(I) average wait days, each Proc Type
|
|---|
| 223 | F S I=$O(^RA(73.2,"AC",I)) Q:I="" S RATOTAL(I)=0,RAWAITD(I)=0,RAAVG(I)=0 F J=1:1:5 S RACOL(I,J)=0
|
|---|
| 224 | S I="unknown",RATOTAL(I)=0,RAWAITD(I)=0,RAAVG(I)=0 F J=1:1:5 S RACOL(I,J)=0
|
|---|
| 225 | ; Rank Proc Types, needed to pick case from printset
|
|---|
| 226 | ; 1=Interventional 2=MR 3=CT 4=Card. Stress Test 5=NM
|
|---|
| 227 | ; 6=US 7=Mammo 8=Plain Film (Gen Rad) 9=Other
|
|---|
| 228 | S I=""
|
|---|
| 229 | F S I=$O(RATOTAL(I)) Q:I="" D
|
|---|
| 230 | .S J=$E(I,1,3)
|
|---|
| 231 | .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)
|
|---|
| 232 | .Q
|
|---|
| 233 | Q
|
|---|
