source: WorldVistAEHR/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAPMW.m@ 724

Last change on this file since 724 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 8.5 KB
Line 
1RAPMW ;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
57START ; 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
71GETTYP ;
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
80GETDATE ; 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
105GETDIV() ;
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
112ASKIP ;
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
132GETPROC ;
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
148ASKSORT ;
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
160ASKDAYS ;
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
169GETDEV ;
170 W:RATYP="B" !!,"Specify device for both summary and detail reports."
171 D TASK
172 D ZIS^RAUTL
173 Q
174TASK ; 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
180GETDATA ;
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
192EXIT ;
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
216SETPTA ;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
Note: See TracBrowser for help on using the repository browser.