source: FOIAVistA/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RACDR1.m@ 1397

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

initial load of FOIAVistA 6/30/08 version
File size: 4.4 KB
Line 
1RACDR1 ;HISC/FPT-Continuation of routine RACDR, CDR report ;4/16/96 08:48
2 ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
3 ;Print CDR report
4 S (RADIV,X)=""
5 F S RADIV=$O(^TMP($J,"RACDR",RADIV)) Q:RAEOS!(RADIV="") D DIVNME,DIVTOT K RAFLG D Q:RAEOS I RAITCNT(RADIV)>1 D DIVSUM K RADIVSUM
6 .S RAIMAGE="" F S RAIMAGE=$O(^TMP($J,"RACDR",RADIV,RAIMAGE)) Q:RAEOS!(RAIMAGE="") K RAFLG D Q:RAEOS D IMGTOT,ITSUM K RAFLG
7 ..S RACDR="" F S RACDR=$O(^TMP($J,"RACDR",RADIV,RAIMAGE,RACDR)) Q:RAEOS!(RACDR']"") S RAT=^TMP($J,"RACDR",RADIV,RAIMAGE,RACDR),RATA=$P(RAT,"^")+$P(RAT,"^",2)+$P(RAT,"^",3)+$P(RAT,"^",4) D HED Q:RAEOS D Q:RAEOS
8 ...S RAPROCN="" F S RAPROCN=$O(^TMP($J,"RACDR",RADIV,RAIMAGE,RACDR,RAPROCN)) Q:RAEOS!(RAPROCN="") D Q:RAEOS
9 ....S RAPROC="" F S RAPROC=$O(^TMP($J,"RACDR",RADIV,RAIMAGE,RACDR,RAPROCN,RAPROC)) Q:RAEOS!(RAPROC']"") S RAX=^(RAPROC) D Q:RAEOS
10 .....I ($Y+5)>IOSL S RAEOS=$$EOS^RAUTL5() Q:RAEOS D HED Q:RAEOS
11 .....S RATP=0 W !,$E(RAPROCN,1,38),?41 F RAJ=1:1:4 W ?($X+1),$J($P(RAX,"^",RAJ),5) S RATP=RATP+$P(RAX,"^",RAJ)
12 .....W ?68,$J(RATP,4) S Y=$S(RATA=0:0,1:(RATP/RATA*100)) W ?74,$J(Y,5,1)
13 .....I $O(^TMP($J,"RACDR",RADIV,RAIMAGE,RACDR,RAPROCN))="" D W
14 Q
15W S RATP=0 W !!?32,"Total",?41
16 F RAJ=1:1:4 D
17 .W ?($X+1),$J($P(RAT,"^",RAJ),5)
18 .S RATP=RATP+$P(RAT,"^",RAJ)
19 .Q
20 W ?68,$J(RATP,4) S Y=$S(RATA=0:0,1:(RATP/RATA*100)) W ?74,$J(Y,5,1),!?30,"Percent",?41 F RAJ=1:1:4 W ?$X,$J($S(RATA=0:0,1:($P(RAT,"^",RAJ)/RATA*100)),6,1)
21 S RAEOS=$$EOS^RAUTL5()
22 Q
23ITSUM ; imaging type summary
24 S RAFLG="" D HED Q:RAEOS
25 W !?10,"(Imaging Type Summary)"
26 S RACDR=0 F S RACDR=$O(^TMP($J,"RACDR",RADIV,RAIMAGE,RACDR)) Q:RAEOS!(RACDR'>0) S RATP=0,RAT=^(RACDR) W !?2,$S(RACDR>0:RACDR,1:"")," ",$P(RAT,"^",5),?41 D
27 .F RAJ=1:1:4 W ?($X+1),$J($P(RAT,"^",RAJ),5) S RATP=RATP+$P(RAT,"^",RAJ)
28 .W ?68,$J(RATP,4) S Y=$S(RAIMGTOT=0:0,1:(RATP/RAIMGTOT*100)) W ?74,$J(Y,5,1)
29 .I ($Y+5)>IOSL S RAEOS=$$EOS^RAUTL5() Q:RAEOS D HED
30 .Q
31 Q:RAEOS
32 S RAIMGTOT(0)=0
33 W !!?32,"Total",?41
34 F RAJ=1:1:4 W ?($X+1),$J($P(RAIMGNDE,"^",RAJ),5) S RAIMGTOT(0)=RAIMGTOT(0)+$P(RAIMGNDE,U,RAJ)
35 W ?68,$J(RAIMGTOT,4) S Y=$S(RAIMGTOT=0:0,1:(RAIMGTOT(0)/RAIMGTOT*100))
36 W ?74,$J(Y,5,1),!?30,"Percent",?41
37 F RAJ=1:1:4 W ?$X,$J($S(RAIMGTOT=0:0,1:($P(RAIMGNDE,"^",RAJ)/RAIMGTOT*100)),6,1)
38 I $O(^TMP($J,"RACDR",RADIV))="",RAITCNT(RADIV)=1 Q
39 S RAEOS=$$EOS^RAUTL5()
40 Q
41HED ; header
42 W:$Y>0 @IOF S RAPG=RAPG+1
43 W !?20,">>>>> COST DISTRIBUTION REPORT <<<<<"
44 W ?71,"Page: ",RAPG
45 W !!,?4,"Division: ",RADIVNME
46 W:'$D(RADIVSUM) !,"Imaging Type: ",$S($D(^RA(79.2,+$P(RAIMAGE,"-",2),0)):$P(^(0),U,1),1:"Unknown")
47 W ?52,"For Period: ",?64,RABDT," to",!?4,"Run Date: ",RARDT,?64,RAEDT
48 W !!,?74,"% of",!,$S('$D(RAFLG):"Procedure",1:"Cost Distribution Center"),?43,"Inpt Opt Res Oth Total Exams",!,RAQ
49 W:'$D(RAFLG) !?10,"Cost Distribution Center: ",$S(RACDR=0:"",1:RACDR)," ",$P(RAT,"^",5),!
50 I $D(ZTQUEUED) D STOPCHK^RAUTL9 S:$G(ZTSTOP)=1 RAEOS=1
51 Q
52DIVSUM ; division summary
53 S (RADIVSUM,RAFLG)="" D HED Q:RAEOS
54 W !?10,"(Division Summary)"
55 S RACDR="" F S RACDR=$O(^TMP($J,"RA DIVTOT",RADIV,RACDR)) Q:RAEOS!(RACDR="") S RATP=0,RAT=^(RACDR) W !?2,$S(RACDR]"":RACDR,1:"")," ",$P(RAT,"^",5),?41 D
56 .F RAJ=1:1:4 W ?($X+1),$J($P(RAT,"^",RAJ),5) S RATP=RATP+$P(RAT,"^",RAJ)
57 .W ?68,$J(RATP,4) S Y=$S(RADIVTOT=0:0,1:(RATP/RADIVTOT*100)) W ?74,$J(Y,5,1)
58 .I ($Y+5)>IOSL S RAEOS=$$EOS^RAUTL5() Q:RAEOS D HED
59 .Q
60 Q:RAEOS
61 S RADIVTOT(0)=0
62 W !!?32,"Total",?41
63 F RAJ=1:1:4 W ?($X+1),$J($P(RADIVNDE,"^",RAJ),5) S RADIVTOT(0)=RADIVTOT(0)+$P(RADIVNDE,U,RAJ)
64 W ?68,$J(RADIVTOT,4) S Y=$S(RADIVTOT=0:0,1:(RADIVTOT(0)/RADIVTOT*100))
65 W ?74,$J(Y,5,1),!?30,"Percent",?41
66 F RAJ=1:1:4 W ?$X,$J($S(RADIVTOT=0:0,1:($P(RADIVNDE,"^",RAJ)/RADIVTOT*100)),6,1)
67 ; show imaging types
68 I ($Y+(RAITCNT(RADIV)\2)+3)>IOSL S RAEOS=$$EOS^RAUTL5 Q:RAEOS D HED Q:RAEOS
69 W !!?2,"Imaging Type(s): "
70 S RAITHLD=""
71 F S RAITHLD=$O(^TMP($J,"RACDR",RADIV,RAITHLD)) Q:RAEOS!(RAITHLD="") W:$X>(80-25) !?($X+$L("Imaging Type(s):")+3) D
72 .I ($Y+4)>IOSL S RAEOS=$$EOS^RAUTL5 Q:RAEOS D HED W !?19
73 .W $S($D(^RA(79.2,+$P(RAITHLD,"-",2),0)):$P(^(0),U,1),1:"UNKNOWN"),?($X+3)
74 I $O(^TMP($J,"RACDR",RADIV))]"" S RAEOS=$$EOS^RAUTL5()
75 Q
76DIVNME ;
77 S RADIVNME=$S($D(^DIC(4,+RADIV,0)):$P(^(0),"^"),1:"Unknown")
78 Q
79DIVTOT ;
80 S RADIVTOT=0,RADIVNDE=$G(^TMP($J,"RACDR",RADIV))
81 F RAJ=1:1:4 S RADIVTOT=RADIVTOT+$P(RADIVNDE,U,RAJ)
82 Q
83IMGTOT ;
84 S RAIMGTOT=0,RAIMGNDE=$G(^TMP($J,"RACDR",RADIV,RAIMAGE))
85 F RAJ=1:1:4 S RAIMGTOT=RAIMGTOT+$P(RAIMGNDE,U,RAJ)
86 Q
Note: See TracBrowser for help on using the repository browser.