source: FOIAVistA/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RASTRPT1.m@ 811

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

initial load of FOIAVistA 6/30/08 version

File size: 5.9 KB
Line 
1RASTRPT1 ;HISC/SS-Status Tracking Statistics Report ;4/28/00 10:00
2 ;;5.0;Radiology/Nuclear Medicine;**20**;Mar 16, 1998
3 ;Last Modifications by SS on MAY 15,2000 for patch P20
4RPTP20 ;P20, create report by requesting locations from ^TMP with proc details
5 N RARL ;requesting location
6 N RADV1 S RADV1=RADV,RARL=0
7 N RAZZSSFL S RAZZSSFL="DETAILS"
8 F S RARL=$O(^TMP($J,"RAST",RAIMAGE,RADV1,RARL)) Q:RARL=""!RAXIT D
9 .S RAFR=0 F S RAFR=$O(^TMP($J,"RAST",RAIMAGE,RADV1,RARL,"PROC",RAFR)) Q:RAFR'>0!RAXIT D
10 ..S RATO=0
11 ..F S RATO=$O(^TMP($J,"RAST",RAIMAGE,RADV1,RARL,"PROC",RAFR,RATO)) Q:RATO'>0!RAXIT D HDR3,PROC
12 ..Q
13 .Q
14 D RPTP20S
15 I +RA20RLOC>1 D PUTNOST(RAIMAGE,RADV1,$J)
16 Q
17RPTP20S ;P20, create report by requesting locations from ^TMP proc summary
18 N RARL ;requesting location
19 N RADV1 S RADV1=RADV,RARL=0
20 N I1,I2
21 N RAZZSSFL S RAZZSSFL="SUMMARY"
22 F S RARL=$O(^TMP($J,"RAST",RAIMAGE,RADV1,RARL)) Q:RARL=""!RAXIT D HDR3 Q:RAXIT D
23 .S RAFR=0 F S RAFR=$O(^TMP($J,"RAST",RAIMAGE,RADV1,RARL,"PROC",RAFR)) Q:RAFR'>0!RAXIT D
24 ..S RATO=0
25 ..F S RATO=$O(^TMP($J,"RAST",RAIMAGE,RADV1,RARL,"PROC",RAFR,RATO)) Q:RATO'>0!RAXIT S RASUM=^TMP($J,"RAST",RAIMAGE,RADV1,RARL,"SUM",RAFR,RATO) D SUM1
26 ..Q
27BP2 .D:'RAXIT SUM2
28 .Q
29 Q
30HDR3 ; Header for detailed report by requesting locations
31 S RAPG=RAPG+1 W:$E(IOST,1,2)="C-" @IOF
32 I $E(IOST,1,2)="P-",(RAPG>1) W @IOF
33 W !,?20,"** Status Tracking Statistics Report **",?71,"Page: ",$J(RAPG,3)
34 I RAZZSSFL="DETAILS" W !,?20,"Procedure Detail by Requesting Location"
35 E W !,?19,"Division Summary Requesting Location Details"
36 I +RA20RLOC=0 W !?14,"(Only requesting locations with data are included)"
37 W !!,?2,"Run Date: ",$E(DT,4,5),"/",$E(DT,6,7),"/",$E(DT,2,3)
38 W ?42,"For Period: ",$E(BEGDATE,4,5),"/",$E(BEGDATE,6,7),"/",$E(BEGDATE,2,3)," - ",$E(ENDDATE,4,5),"/",$E(ENDDATE,6,7),"/",$E(ENDDATE,2,3)
39 W !?2,"Division: ",$E($P($G(RACCESS(DUZ,"DIV",RADV,+$O(RACCESS(DUZ,"DIV",RADV,0)))),U,2),1,25),?40,"Imaging Type: ",$E(RAIMAGE(0),1,25)
40 Q:RAZZSSFL="NOSTAT"
41 W !?2,"Requesting Location: ",$E(RARL,1,76)
42 I RAZZSSFL="DETAILS" W !!,?10,"From: ",$S($D(^RA(72,+RAFR,0)):$P(^(0),"^"),1:"Unknown"),!,?10,"To : ",$S($D(^RA(72,+RATO,0)):$P(^(0),"^"),1:"Unknown")
43 W !,?33,"Minimum",?45,"Maximum",?57,"Average",!,?34,"Time",?46,"Time",?58,"Time",?67,"Number of",!
44 I RAZZSSFL="DETAILS" W ?4,"Procedure (CPT)"
45 W ?31,"(DD:HH:MM)",?43,"(DD:HH:MM)",?55,"(DD:HH:MM)",?67,"Procedures"
46 I RAZZSSFL="DETAILS" W !,?4,"---------------"
47 W !?31,"----------",?43,"----------",?55,"----------",?67,"----------",!
48 I RAZZSSFL="DETAILS" S RACTR=0
49 I $D(ZTQUEUED) D STOPCHK^RAUTL9 S:$G(ZTSTOP)=1 RAXIT=1
50 Q
51 ;
52PROC F RAPRC=0:0 S RAPRC=$O(^TMP($J,"RAST",RAIMAGE,RADV1,RARL,"PROC",RAFR,RATO,RAPRC)) Q:RAPRC'>0!RAXIT S RAPROC=^TMP($J,"RAST",RAIMAGE,RADV1,RARL,"PROC",RAFR,RATO,RAPRC) D DET1
53 Q:'$D(^TMP($J,"RAST",RAIMAGE,RADV1,RARL,"SUM",RAFR,RATO))!RAXIT
54 S RASUM=$G(^TMP($J,"RAST",RAIMAGE,RADV1,RARL,"SUM",RAFR,RATO)) D DET2
55 Q
56DET1 W !
57 I RAZZSSFL="DETAILS" D CPT W RACPT
58 W ?32,$P(RAPROC,"^",4),?44,$P(RAPROC,"^",2)
59 S X=$P(RAPROC,"^",6)\$P(RAPROC,"^",5) D MINUTS^RAUTL1 W ?56,Y,?70,$J($P(RAPROC,"^",5),5) S RACTR=RACTR+1
60 I $Y>(IOSL-4) S RAXIT=$S($E(IOST)="C":$$EOS^RAUTL5(),1:0) I 'RAXIT D HDR3
61 K RAPROC
62 Q
63 ;
64DET2 W !,?31,"----------",?43,"----------",?55,"----------",?67,"----------",!,?4,"Overall:" W ?32,$P(RASUM,"^",4),?44,$P(RASUM,"^",2)
65 S X=$P(RASUM,"^",6)\$P(RASUM,"^",5) D MINUTS^RAUTL1 W ?56,Y,?70,$J($P(RASUM,"^",5),5)
66 S RAXIT=$S($E(IOST)="C":$$EOS^RAUTL5(),1:0)
67 K RASUM
68 Q
69 ;
70CPT S RACPT=$G(^RAMIS(71,+RAPRC,0)) Q:RACPT=""
71 S RAZZZ=$P($$NAMCODE^RACPTMSC(+$P(RACPT,"^",9),DT),"^")
72 S RACPT=$E($P(RACPT,"^"),1,25)_"("_RAZZZ_")"
73 K RAZZZ
74 Q
75 ;
76GETLOC() ;P20 by SS
77 N RA20 S RA20="Requesting Location:"
78 I +RA20RLOC=0 Q RA20_"ALL"
79 I +RA20RLOC=1 Q RA20_$E($P(RA20RLOC,"^",2),1,16)
80 Q RA20_"ALL SELECTED"
81GETPROC() ;P20 by SS
82 N RA20 S RA20="Procedure:"
83 I +RAPROCED=0 S RA20=RA20_"ALL"
84 E S RA20=RA20_$E($P(RAPROCED,"^",2),1,25)
85 Q RA20
86 ;
87SUM1 W !,?4,"From: ",$S($D(^RA(72,RAFR,0)):$P(^(0),"^"),1:"Unknown"),!,?4,"To : ",$S($D(^RA(72,+RATO,0)):$P(^(0),"^"),1:"Unknown")
88 W ?32,$P(RASUM,"^",4),?44,$P(RASUM,"^",2)
89 S X=$P(RASUM,"^",6)\$P(RASUM,"^",5) D MINUTS^RAUTL1 W ?56,Y,?70,$J($P(RASUM,"^",5),5),! S RACTR=RACTR+3
90 I $Y>(IOSL-4) S RAXIT=$S($E(IOST)="C":$$EOS^RAUTL5(),1:0) I 'RAXIT D HDR3
91 K RASUM
92 Q
93SUM2 W !,?31,"----------",?43,"----------",?55,"----------",?67,"----------",!,?4,"From: ",$S($D(^RA(72,+RA(1),0)):$P(^(0),"^"),1:"Unknown"),!,?4,"To : ",$S($D(^RA(72,+RA,0)):$P(^(0),"^"),1:"Unknown")
94 Q:'$D(^TMP($J,"RAST",RAIMAGE,RADV1,RARL,"COMPLETE")) S RACOMP=^("COMPLETE") W ?32,$P(RACOMP,"^",4),?44,$P(RACOMP,"^",2)
95 N RAZZSS1 S RAZZSS1=^TMP($J,"RAST",RAIMAGE,RADV1,RARL,"COUNT")
96 S X=$P(RACOMP,"^",6)\$P(RACOMP,"^",5) D MINUTS^RAUTL1 W ?56,Y
97 I $Y>(IOSL-2) S RAXIT=$S($E(IOST)="C":$$EOS^RAUTL5(),1:0) I 'RAXIT D HDR3
98 W !!?4,"Total number of exams moved to a status of COMPLETE"
99 W !?4,"for period ",$E(BEGDATE,4,5),"/",$E(BEGDATE,6,7),"/",$E(BEGDATE,2,3)," - ",$E(ENDDATE,4,5),"/",$E(ENDDATE,6,7),"/",$E(ENDDATE,2,3),": ",?70,$J(RAZZSS1,5)
100 Q:$O(^TMP($J,"RASTAT",RADV1))'>0
101 S RAXIT=$S($E(IOST)="C":$$EOS^RAUTL5(),1:0)
102 Q
103 ;
104PUTNOST(RAIM1,RADV1,RA20J) ;P20 by SS Display all locations which have not exams
105 N RA20A,RA20B,RA20C,RA20PASS,RA20FL
106 S RAZZSSFL="NOSTAT"
107 S RA20PASS=0,RA20FL=0,RA20B="There are no statistics for following selected requesting locations:",$P(RA20C,"-",70)=""
108STRT I RA20PASS>0 D HDR3 W !?2,RA20B,!?2,RA20C
109 S RA20A=0
110 F S RA20A=$O(^TMP(RA20J,"RA REQ-LOC",RA20A)) G:RA20A="" LST I '$$ISTHERE(RAIM1,RADV1,RA20A) S RA20FL=1 Q:RA20PASS=0 W !?2,RA20A I $Y>(IOSL-4) S RAXIT=$S($E(IOST)="C":$$EOS^RAUTL5(),1:0) Q:RAXIT D HDR3 W !?2,RA20B,!?2,RA20C
111LST I RA20PASS>0 S RAXIT=$S($E(IOST)="C":$$EOS^RAUTL5(),1:0)
112 I RA20PASS=0,RA20FL=0 Q
113 I RA20PASS=0 S RA20PASS=1 G STRT
114 Q
115ISTHERE(RAIM,RADV,RALOC) ;Does this requesting location have exams is in ^TMP($J..)
116 N RA20A,RA20B,RA20C
117 S (RA20A,RA20B)=0
118 F S RA20A=$O(^TMP($J,"RAST",RAIM,RADV,RA20A)) Q:RA20A="" I RA20A=RALOC S RA20B=1 Q
119 Q RA20B
Note: See TracBrowser for help on using the repository browser.