source: FOIAVistA/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAPM2.m

Last change on this file was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 9.0 KB
Line 
1RAPM2 ;HOIFO/TH-Radiology Performance Monitors/Indicator; ;2/26/04 12:41
2 ;;5.0;Radiology/Nuclear Medicine;**37,44,48,63,67**;Mar 16, 1998
3 ; IA 10090 allows Read w/Fileman for entire file 4
4 ; Print Detail report
5DETAIL ; Print Detail report
6 I ($Y+5)>IOSL!(RARPT="B") D
7 . I IO=IO(0),($E(IOST,1,2)="C-") D
8 . . R !,"Press RETURN to continue. ",X:DTIME
9 D HDR("D")
10 D PRTTOT
11 D DHDR
12 D DRPT Q:RAXIT
13 D DFOOT
14 Q
15 ;
16PRTTOT ; Print total number of reports
17 S RATOTCNT=+$G(^TMP($J,"RAPM","TOTAL"))
18 W !,"Total number of reports expected for procedures performed during specified date range: ",$J(RATOTCNT,$L(RATOTCNT))
19 Q
20 ;
21DHDR ; Header
22 I ($Y+5)>IOSL D
23 . S RAPG=RAPG+1,RAHD(0)="Detail Verification Timeliness Report"
24 . W @IOF,!?(RAIOM-$L(RAHD(0))\2),RAHD(0),?(RAIOM-10),"Page: ",$G(RAPG)
25 W !!,?32,"Date/Time",?48,"Date/Time",?68,"Date/Time",?102,"Cat"
26 W ?106,"Rpt",?110,"Img",?116,"Procedure"
27 W !,"Patient Name",?18,"Case #",?32,"Registered",?48,"Transcribed",?62,"Hrs"
28 W ?68,"Verified",?82,"Hrs",?87,"Radiologist",?102,"Exm",?106,"Sts"
29 W ?110,"Typ",?119,"Name",!
30 Q
31 ;
32DRPT ; Read records
33 S RAXIT=0
34 I '$D(^TMP($J,"RAPM2")) W !!?30,"No data to print...",!!!!! Q
35 S D1="" F S D1=$O(^TMP($J,"RAPM2",D1)) Q:D1="" Q:RAXIT D
36 . S D2="" F S D2=$O(^TMP($J,"RAPM2",D1,D2)) Q:D2="" Q:RAXIT D
37 . . S D3="" F S D3=$O(^TMP($J,"RAPM2",D1,D2,D3)) Q:D3="" Q:RAXIT D
38 . . . D SRT
39 Q
40 ;
41SRT ; Read records
42 I RASORT="C"!(RASORT="P") S RAREC=$G(^TMP($J,"RAPM2",D1,D2,D3)) D DET Q
43 S D4="" F S D4=$O(^TMP($J,"RAPM2",D1,D2,D3,D4)) Q:D4="" Q:RAXIT D
44 . S RAREC=$G(^TMP($J,"RAPM2",D1,D2,D3,D4)) D DET
45 Q
46 ;
47DET ; Print detail records
48 ; use Transcription elasped hr for all sorts, except if sort by Verif.
49 S RAVAL=$S(RASORT="V":$P(RAREC,U,13),1:$P(RAREC,U,12))
50 ; remove symbols before comparison
51 S:$E(RAVAL)="<" RAVAL=.5 S:$E(RAVAL)=">" RAVAL=999
52 ; include PENDING and those with hours > RASINCE
53 I RAVAL'="",RAVAL<RASINCE Q
54 I ($Y+5)>IOSL D
55 . I IO=IO(0) D
56 . . I $E(IOST,1,2)="C-" R !,"Press RETURN to continue or ""^"" to exit. ",X:DTIME S:X="^" RAXIT=1
57 . Q:RAXIT
58 . D DHDR
59 Q:RAXIT
60 W !,$E($P(RAREC,U,2),1,15)
61 W ?17,$P(RAREC,U,1)
62 W ?31,$P($$FMTE^XLFDT($P(RAREC,U,3),"2FS"),":",1,2)
63 W ?46,$P($$FMTE^XLFDT($P(RAREC,U,4),"2FS"),":",1,2),?61,$J($P(RAREC,U,12),4)
64 W ?66,$P($$FMTE^XLFDT($P(RAREC,U,5),"2FS"),":",1,2),?81,$J($P(RAREC,U,13),4)
65 I $P(RAREC,U,6)'="" W ?86,$E($P(RAREC,U,6),1,16)
66 W ?104,$P(RAREC,U,7),?107,$P(RAREC,U,8)
67 W ?110,$E($P(RAREC,U,9),1,3),?114,$E($P(RAREC,U,14),1,15)
68 W:$P(RAREC,U,11)="" ?130,"*D"
69 Q
70 ;
71DFOOT ; Footer for Detail report
72 I ($Y+5)>IOSL D
73 . I IO=IO(0) D
74 . . I $E(IOST,1,2)="C-" R !,"Press RETURN to continue. ",X:DTIME
75 . D DHDR
76 W !!,"Note: Category of Exam: 'I' for Inpatient; 'O' for Outpatient; "
77 W "'C' for Contract; 'S' for Sharing; 'E' for Employee; 'R' for Research"
78 W !," Report Status: 'V' for Verififed; 'R' for Released/Not "
79 W "Verified; 'PD' for Problem Draft; 'D' for Draft"
80 W:RANODIV !," *D = Division is missing"
81 W !!?5,"* A printset, i.e., a set of multiple exams that share the same report, will be expected to have 1 report."
82 W !!?5,"* Cancelled and ""No Credit"" cases are excluded from this report."
83 Q
84 ;
85STORE ; Store detail information
86 Q:RARPT="S"
87 ; for storage subscript: if no rpt dt, set to neg
88 S RADHT=$S(RARPTDT="":-1,1:RATDFHR)
89 S RADHV=$S(RAVERDT="":-1,1:RAVDFHR)
90 ; for display: truncate decimal portion of hours
91 S:RATDFHR'="" RATDFHR=RATDFHR\1
92 S:RAVDFHR'="" RAVDFHR=RAVDFHR\1
93 S RATDFHR=$S(RATDFHR="":"",RATDFHR<1:"<1",RATDFHR>999:">999",1:RATDFHR)
94 S RAVDFHR=$S(RAVDFHR="":"",RAVDFHR<1:"<1",RAVDFHR>999:">999",1:RAVDFHR)
95 ;
96 S RAREC1=RACN_U_RAPATNM_U_RADTE_U_RARPTDT_U
97 S RAREC1=RAREC1_RAVERDT_U_RAPRIMNM_U_RACAT_U_RARPTST_U_RAIMGTYP_U
98 S RAREC1=RAREC1_RADFN_U_RACHKDIV_U_RATDFHR_U_RAVDFHR_U_RAPRCN
99 ;
100 I RASORT="C" S ^TMP($J,"RAPM2",$P(RADTE,"."),RACN,RAPATNM)=RAREC1
101 I RASORT="P" S ^TMP($J,"RAPM2",RAPATNM,$P(RADTE,"."),RACN)=RAREC1
102 I RASORT="I" S ^TMP($J,"RAPM2",RAIMGTYP,$P(RADTE,"."),RACN,RAPATNM)=RAREC1
103 I RASORT="E" S ^TMP($J,"RAPM2",RACAT,$P(RADTE,"."),RACN,RAPATNM)=RAREC1
104 I RASORT="R" S ^TMP($J,"RAPM2",RAPRIMNM,$P(RADTE,"."),RACN,RAPATNM)=RAREC1
105 I RASORT="T" S ^TMP($J,"RAPM2",RADHT,RADTE,RACN,RAPATNM)=RAREC1
106 I RASORT="V" S ^TMP($J,"RAPM2",RADHV,RADTE,RACN,RAPATNM)=RAREC1
107 Q
108EMAIL ; Ask if ready to email the summary report
109 N RA1
110 W ! S DIR(0)="Y"
111 S DIR("A")="Send summary report to local mail group ""G.RAD PERFORMANCE INDICATOR"""
112 S DIR("B")="Yes"
113 D ^DIR
114 Q:$D(DIRUT)
115 S RAANS=Y
116 S RA1=$O(^RA(79,0)) Q:'RA1
117 I '$O(^RA(79,RA1,1,0)) D Q
118 . W !!,?5,"No OUTLOOK mail group(s) have been entered yet."
119 . Q
120 W ! S DIR(0)="Y"
121 S DIR("A")="Send summary report to OUTLOOK mail group(s)"
122 S DIR("B")="Yes"
123 D ^DIR
124 S RAANS2=Y
125 I RAANS2 D CKMONTH^RAPM4
126 Q
127SEND ; Send summary report to mail group
128 I RAANS=0,RAANS2=0 Q
129 N RA1,RA2,RASVSUB,RASVTEXT,RASTR
130 S XMSUB="Radiology Summary Verification Timeliness"
131 S XMDUZ=DUZ
132 S XMTEXT="^TMP($J,""RAPM"","
133 S RASVSUB=XMSUB,RASVTEXT=XMTEXT
134 I RAANS=1 D
135 . S XMY("G.RAD PERFORMANCE INDICATOR")=""
136 . D ^XMD
137 . K XMY
138 . Q
139 I RAANS2=1 D
140 . S RA1=$O(^RA(79,0)) Q:'RA1
141 . S XMSUB=RASVSUB,XMTEXT=RASVTEXT
142 . S RA2=0
143 .; Outlook mailgroup flagged for HQ should always get automatic mid-
144 .; mid-month rpt, but only get user-initiated rpt if user specifies so
145 .;
146 .; All non-HQ outlook mailgroups get all reports, including autom rpt
147 .;
148 . F S RA2=$O(^RA(79,RA1,1,RA2)) Q:'RA2 S RASTR=$G(^(RA2,0)) D
149 .. I $P(RASTR,U,2)="Y",$G(RAUTOM) S XMY($P(RASTR,U))=""
150 .. I $P(RASTR,U,2)'="Y" S XMY($P(RASTR,U))=""
151 .. Q
152 . Q:'$D(XMY)
153 . D ^XMD
154 . K XMY
155 . Q
156 K XMDUZ
157 Q
158HDR(RATYP) ; Print appropriate header
159 U:RAIO IO S RAPG=$G(RAPG)+1
160 I RAPG>1!($E(IOST,1,2)="C-") W:RAIO @IOF
161 I $E(IOST,1,2)="P-",(RAPG>1) W:RAIO @IOF
162 S RAHD(0)=$S(RATYP="S":"Summary",RATYP="D":"Detail",1:"")
163 S RAHD(0)=RAHD(0)_" Verification Timeliness Report"
164 S RAIOM=$S(RATYP="S":80,1:IOM)
165 W:RAIO !?(RAIOM-$L(RAHD(0))\2),RAHD(0),?(RAIOM-10),"Page: ",$G(RAPG),!
166 I RATYP="S" S RAN=1 D
167 . S ^TMP($J,"RAPM",RAN)=" Summary Verification Timeliness Report Page: "_$G(RAPG) S RAN=RAN+1
168 . S ^TMP($J,"RAPM",RAN)="",RAN=RAN+1
169 ;
170 D GETS^DIQ(4,DUZ(2),".01;14*;99","E","RAR","RAMSG")
171 K X
172 S X(1)=RAR(4,DUZ(2)_",",.01,"E") ; Name of facility
173 S X(2)=RAR(4,DUZ(2)_",",99,"E") ; Station Number
174 I $D(RAR(4.014)) D
175 . S X(3)=RAR(4.014,"1,"_DUZ(2)_",",.01,"E") ; Association
176 . S X(4)=RAR(4.014,"1,"_DUZ(2)_",",1,"E") ; Parent of Association
177 . S X(5)=$S(X(3)="VISN":X(4),1:"") ; should be VISN number
178 E S X(5)=""
179 ;
180 W:RAIO !,"Facility: ",X(1),?41,"Station: ",X(2),?60,"VISN: ",X(5)
181 I RATYP="S" D
182 . S $P(X(6)," ",79)=""
183 . S $E(X(6),1,(10+$L(X(1))))="Facility: "_X(1)
184 . S $E(X(6),41,(50+$L(X(2))))="Station: "_X(2)
185 . S $E(X(6),60,(66+$L(X(5))))="VISN: "_X(5)
186 . S ^TMP($J,"RAPM",RAN)=X(6)
187 . S RAN=RAN+1
188 . Q
189 W !,"Division: "
190 I RATYP="S" S ^TMP($J,"RAPM",RAN)="Division: "
191 D DIV
192 S:(RATYP="S") RAN=RAN+1
193 ;
194 W:RAIO !,"Exam Date Range: "
195 W:RAIO $$FMTE^XLFDT(RABDATE,"2D")," - ",$$FMTE^XLFDT(RAEDATE,"2D")
196 I RATYP="S" S ^TMP($J,"RAPM",RAN)="Exam Date Range: "_$$FMTE^XLFDT(RABDATE,"2D")_" - "_$$FMTE^XLFDT(RAEDATE,"2D") S RAN=RAN+1
197 ;
198 W:RAIO !,"Imaging Type(s): "
199 I RATYP="S" S ^TMP($J,"RAPM",RAN)="Imaging Type(s): "
200 D IMG
201 S:RATYP="S" RAN=RAN+1
202 ;
203 ; Run date and time
204 S NOW=$$NOW^XLFDT,NOW=$P(NOW,".",1)_"."_$E($P(NOW,".",2),1,4)
205 W:RAIO !,"Run Date/Time: ",$$FMTE^XLFDT(NOW,"2P"),!
206 I RATYP="S" S ^TMP($J,"RAPM",RAN)="Run Date/Time: "_$$FMTE^XLFDT(NOW,"2P"),RAN=RAN+1
207 I RARAD D
208 . W:RAIO !,"Primary Interpreting Staff Physician: ",$$GET1^DIQ(200,RARAD,.01),!
209 . I RATYP="S" D
210 .. S ^TMP($J,"RAPM",RAN)="",RAN=RAN+1
211 .. S ^TMP($J,"RAPM",RAN)="Primary Interpreting Staff Physician: "_$$GET1^DIQ(200,RARAD,.01),RAN=RAN+1
212 .. Q
213 . Q
214 I (RARPT="D"!(RARPT="B")),(RATYP'="S") D
215 . S RASRT=$S(RASORT="C":"Case Number",RASORT="E":"Category of Exam",RASORT="I":"Imaging Type",RASORT="P":"Patient Name",RASORT="R":"Radiologist",RASORT="T":"Hrs to Transcription",RASORT="V":"Hrs to Verification",1:"")
216 . W:RAIO !,"Sorted by: ",RASRT,?45,"Min. hours elasped to "_$S(RASORT="V":"Verification",1:"Transcription")_": "_RASINCE
217 Q
218DIV ; List selected Division
219 Q:'$D(^TMP($J,"RA D-TYPE"))
220 S RADIV="" F I=1:1 S RADIV=$O(^TMP($J,"RA D-TYPE",RADIV)) Q:RADIV="" D
221 . I $X'>(RAIOM-$L("Division(s): ")) D
222 . . W:RAIO RADIV_$S($O(^TMP($J,"RA D-TYPE",RADIV))]"":", ",1:"")
223 . . I RATYP="S" S ^TMP($J,"RAPM",RAN)=^TMP($J,"RAPM",RAN)_RADIV_$S($O(^TMP($J,"RA D-TYPE",RADIV))]"":", ",1:"")
224 . I $X>(RAIOM-$L("Division(s): ")) D
225 . . W:RAIO !?($X+$L("Division(s): "))
226 . . I RATYP="S" S RAN=RAN+1,^TMP($J,"RAPM",RAN)=" "
227 Q
228IMG ; List selected Imaging Type(s)
229 Q:'$D(^TMP($J,"RA I-TYPE"))
230 ;N RALMAX,RALUSED,RATAIL,RALDENT
231 S RALDENT=$L("Imaging Type(s): ")
232 S RALMAX=RAIOM-RALDENT
233 S RALUSED=0
234 S RAIMG="" F J=1:1 S RAIMG=$O(^TMP($J,"RA I-TYPE",RAIMG)) Q:RAIMG="" D
235 . S RATAIL=$S($O(^TMP($J,"RA I-TYPE",RAIMG))]"":", ",1:"")
236 . I (RALUSED+$L(RAIMG)+$L(RATAIL))>RALMAX D
237 .. W:RAIO !?RALDENT
238 .. I RATYP="S" S RAN=RAN+1,^TMP($J,"RAPM",RAN)=" "
239 .. S RALUSED=0
240 .. Q
241 . W:RAIO RAIMG_RATAIL
242 . I RATYP="S" S ^TMP($J,"RAPM",RAN)=^TMP($J,"RAPM",RAN)_RAIMG_RATAIL
243 . S RALUSED=RALUSED+$L(RAIMG)+$L(RATAIL)
244 Q
Note: See TracBrowser for help on using the repository browser.