source: WorldVistAEHR/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RACDR1.m@ 1450

RACDR1 ;HISC/FPT-Continuation of routine RACDR, CDR report ;4/16/96  08:48
 ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
 ;Print CDR report
 S (RADIV,X)=""
 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
 .S RAIMAGE="" F  S RAIMAGE=$O(^TMP($J,"RACDR",RADIV,RAIMAGE)) Q:RAEOS!(RAIMAGE="")  K RAFLG D  Q:RAEOS  D IMGTOT,ITSUM K RAFLG
 ..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
 ...S RAPROCN="" F  S RAPROCN=$O(^TMP($J,"RACDR",RADIV,RAIMAGE,RACDR,RAPROCN)) Q:RAEOS!(RAPROCN="")  D  Q:RAEOS
 ....S RAPROC="" F  S RAPROC=$O(^TMP($J,"RACDR",RADIV,RAIMAGE,RACDR,RAPROCN,RAPROC)) Q:RAEOS!(RAPROC']"")  S RAX=^(RAPROC) D  Q:RAEOS
 .....I ($Y+5)>IOSL S RAEOS=$$EOS^RAUTL5() Q:RAEOS  D HED Q:RAEOS
 .....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)
 .....W ?68,$J(RATP,4) S Y=$S(RATA=0:0,1:(RATP/RATA*100)) W ?74,$J(Y,5,1)
 .....I $O(^TMP($J,"RACDR",RADIV,RAIMAGE,RACDR,RAPROCN))="" D W
 Q
W S RATP=0 W !!?32,"Total",?41
 F RAJ=1:1:4 D
 .W ?($X+1),$J($P(RAT,"^",RAJ),5)
 .S RATP=RATP+$P(RAT,"^",RAJ)
 .Q
 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)
 S RAEOS=$$EOS^RAUTL5()
 Q
ITSUM ; imaging type summary
 S RAFLG="" D HED Q:RAEOS
 W !?10,"(Imaging Type Summary)"
 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
 .F RAJ=1:1:4 W ?($X+1),$J($P(RAT,"^",RAJ),5) S RATP=RATP+$P(RAT,"^",RAJ)
 .W ?68,$J(RATP,4) S Y=$S(RAIMGTOT=0:0,1:(RATP/RAIMGTOT*100)) W ?74,$J(Y,5,1)
 .I ($Y+5)>IOSL S RAEOS=$$EOS^RAUTL5() Q:RAEOS  D HED
 .Q
 Q:RAEOS
 S RAIMGTOT(0)=0
 W !!?32,"Total",?41
 F RAJ=1:1:4 W ?($X+1),$J($P(RAIMGNDE,"^",RAJ),5) S RAIMGTOT(0)=RAIMGTOT(0)+$P(RAIMGNDE,U,RAJ)
 W ?68,$J(RAIMGTOT,4) S Y=$S(RAIMGTOT=0:0,1:(RAIMGTOT(0)/RAIMGTOT*100))
 W ?74,$J(Y,5,1),!?30,"Percent",?41
 F RAJ=1:1:4 W ?$X,$J($S(RAIMGTOT=0:0,1:($P(RAIMGNDE,"^",RAJ)/RAIMGTOT*100)),6,1)
 I $O(^TMP($J,"RACDR",RADIV))="",RAITCNT(RADIV)=1 Q
 S RAEOS=$$EOS^RAUTL5()
 Q
HED ; header
 W:$Y>0 @IOF S RAPG=RAPG+1
 W !?20,">>>>> COST DISTRIBUTION REPORT <<<<<"
 W ?71,"Page: ",RAPG
 W !!,?4,"Division: ",RADIVNME
 W:'$D(RADIVSUM) !,"Imaging Type: ",$S($D(^RA(79.2,+$P(RAIMAGE,"-",2),0)):$P(^(0),U,1),1:"Unknown")
 W ?52,"For Period: ",?64,RABDT," to",!?4,"Run Date: ",RARDT,?64,RAEDT
 W !!,?74,"% of",!,$S('$D(RAFLG):"Procedure",1:"Cost Distribution Center"),?43,"Inpt   Opt   Res   Oth  Total  Exams",!,RAQ
 W:'$D(RAFLG) !?10,"Cost Distribution Center: ",$S(RACDR=0:"",1:RACDR),"  ",$P(RAT,"^",5),!
 I $D(ZTQUEUED) D STOPCHK^RAUTL9 S:$G(ZTSTOP)=1 RAEOS=1
 Q
DIVSUM ; division summary
 S (RADIVSUM,RAFLG)="" D HED Q:RAEOS
 W !?10,"(Division Summary)"
 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
 .F RAJ=1:1:4 W ?($X+1),$J($P(RAT,"^",RAJ),5) S RATP=RATP+$P(RAT,"^",RAJ)
 .W ?68,$J(RATP,4) S Y=$S(RADIVTOT=0:0,1:(RATP/RADIVTOT*100)) W ?74,$J(Y,5,1)
 .I ($Y+5)>IOSL S RAEOS=$$EOS^RAUTL5() Q:RAEOS  D HED
 .Q
 Q:RAEOS
 S RADIVTOT(0)=0
 W !!?32,"Total",?41
 F RAJ=1:1:4 W ?($X+1),$J($P(RADIVNDE,"^",RAJ),5) S RADIVTOT(0)=RADIVTOT(0)+$P(RADIVNDE,U,RAJ)
 W ?68,$J(RADIVTOT,4) S Y=$S(RADIVTOT=0:0,1:(RADIVTOT(0)/RADIVTOT*100))
 W ?74,$J(Y,5,1),!?30,"Percent",?41
 F RAJ=1:1:4 W ?$X,$J($S(RADIVTOT=0:0,1:($P(RADIVNDE,"^",RAJ)/RADIVTOT*100)),6,1)
 ; show imaging types
 I ($Y+(RAITCNT(RADIV)\2)+3)>IOSL S RAEOS=$$EOS^RAUTL5 Q:RAEOS   D HED Q:RAEOS
 W !!?2,"Imaging Type(s): "
 S RAITHLD=""
 F  S RAITHLD=$O(^TMP($J,"RACDR",RADIV,RAITHLD)) Q:RAEOS!(RAITHLD="")  W:$X>(80-25) !?($X+$L("Imaging Type(s):")+3) D
 .I ($Y+4)>IOSL S RAEOS=$$EOS^RAUTL5 Q:RAEOS  D HED W !?19
 .W $S($D(^RA(79.2,+$P(RAITHLD,"-",2),0)):$P(^(0),U,1),1:"UNKNOWN"),?($X+3)
 I $O(^TMP($J,"RACDR",RADIV))]"" S RAEOS=$$EOS^RAUTL5()
 Q
DIVNME ;
 S RADIVNME=$S($D(^DIC(4,+RADIV,0)):$P(^(0),"^"),1:"Unknown")
 Q
DIVTOT ;
 S RADIVTOT=0,RADIVNDE=$G(^TMP($J,"RACDR",RADIV))
 F RAJ=1:1:4 S RADIVTOT=RADIVTOT+$P(RADIVNDE,U,RAJ)
 Q
IMGTOT ;
 S RAIMGTOT=0,RAIMGNDE=$G(^TMP($J,"RACDR",RADIV,RAIMAGE))
 F RAJ=1:1:4 S RAIMGTOT=RAIMGTOT+$P(RAIMGNDE,U,RAJ)
 Q