source: FOIAVistA/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RALWKL4.m@ 1800

RALWKL4 ;HISC/FPT-Workload Reports By Functional Area ;4/11/96  09:33
 ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
EN1 ; This subroutine prints out only the Summary data as requested by the
 ; user.
 S RADIV=""
 F  S RADIV=$O(^TMP($J,"RA",RADIV)) Q:RAXIT!(RADIV="")  S RADIVNDE=$G(^(RADIV)) D IMGSUM,DIVSUM:'RAXIT
 K BEGDATE,ENDDATE,I,RADIFLG,RADIV,RADIVNDE,RADIVTOT,RADIVWWU,RAFL,RAFLD,RAFLDCNT,RAFLDNDE,RAFLDTOT,RAFLDWWU,RAIMG,RAIMGNDE,RAIMGSUM,RAIMGTOT,RAIMGWWU,RAINPUT,RAITCNT,RAITHLD,RALN,RAPG,RASUMNDE,RATDY,RATITLE,RAXIT
 Q
IMGSUM ; imaging summary
 S RAIMG="",RAIMGSUM="",RADIVTOT=0,RADIVWWU=$P(RADIVNDE,U,5)
 F I=1:1:4 S RADIVTOT=RADIVTOT+(+$P(RADIVNDE,U,I))
 F  S RAIMG=$O(^TMP($J,"RA",RADIV,RAIMG)) Q:RAXIT!(RAIMG="")   S RAIMGNDE=$G(^(RAIMG)) D HD^RALWKL1,IMGTOT,RAFLD,PIMGTOT:'RAXIT Q:RAXIT  I RADIFLG(RADIV)>1 S RAXIT=$$EOS^RAUTL5()
 Q
IMGTOT ; calculate imaging totals
 S RAIMGTOT=0,RAIMGWWU=$P(RAIMGNDE,U,5)
 F I=1:1:4 S RAIMGTOT=RAIMGTOT+(+$P(RAIMGNDE,U,I))
 Q
RAFLD ;
 S RAFLD=""
 F  S RAFLD=$O(^TMP($J,"RA",RADIV,RAIMG,RAFLD)) Q:RAXIT!(RAFLD="")  S RAFLDNDE=$G(^(RAFLD)) D PFLDTOT
 Q
PFLDTOT ; print rafld totals within imaging type
 S RAFLDTOT=0,RAFLDWWU=$P(RAFLDNDE,U,5)
 F I=1:1:4 S RAFLDTOT=RAFLDTOT+(+$P(RAFLDNDE,U,I))
 Q:'RAFLDTOT
 W !,$E(RAFLD,1,28),?30,$J(+$P(RAFLDNDE,U,1),5)
 W ?36,$J(+$P(RAFLDNDE,U,2),5)
 W ?42,$J(+$P(RAFLDNDE,U,3),5)
 W ?48,$J(+$P(RAFLDNDE,U,4),5)
 W ?55,$J(RAFLDTOT,5)
 W:$D(RAFL) ?62,$J($S(RAIMGTOT:(100*RAFLDTOT)/RAIMGTOT,1:0),5,1)
 W ?68,$J(RAFLDWWU,5)
 W:$D(RAFL) ?75,$J($S(RAIMGWWU:(100*RAFLDWWU)/RAIMGWWU,1:0),5,1)
 I ($Y+4)>IOSL S RAXIT=$$EOS^RAUTL5 Q:RAXIT  I $O(^TMP($J,"RA",RADIV,RAIMG,RAFLD))]"" D HD^RALWKL1
 Q
PIMGTOT ; print imaging type totals
 I ($Y+4)>IOSL S RAXIT=$$EOS^RAUTL5 Q:RAXIT  D HD^RALWKL1
 Q:RAXIT  W !,RALN
 W !!,"Imaging Type Total:",?30,$J(+$P(RAIMGNDE,U,1),5)
 W ?36,$J(+$P(RAIMGNDE,U,2),5)
 W ?42,$J(+$P(RAIMGNDE,U,3),5)
 W ?48,$J(+$P(RAIMGNDE,U,4),5)
 W ?55,$J(RAIMGTOT,5)
 W ?68,$J(RAIMGWWU,5)
 W !!?3,"# of "_RATITLE_"s selected: "_$S(RAINPUT=1:"ALL",1:$G(RAFLDCNT))
 Q
DIVSUM ; print division totals
 I RADIFLG(RADIV)=1,$O(RADIFLG(RADIV))]"" S RAXIT=$$EOS^RAUTL5 Q:RAXIT
 Q:RADIFLG(RADIV)=1  ;quit if only one imaging type selected for division
 D DIVHDR Q:RAXIT
 S RAFLD=""
 F  S RAFLD=$O(^TMP($J,"RA1",RADIV,RAFLD)) Q:RAXIT!(RAFLD="")  S RASUMNDE=$G(^(RAFLD)) D PDIVFLD
 D:'RAXIT PDIVTOT
 I $O(^TMP($J,"RA",RADIV))]"" S RAXIT=$$EOS^RAUTL5
 Q
PDIVFLD ;
 S RAFLDTOT=0
 F I=1:1:4 S RAFLDTOT=RAFLDTOT+(+$P(RASUMNDE,U,I))
 W !,$E(RAFLD,1,28),?30,$J(+$P(RASUMNDE,U,1),5),?36,$J(+$P(RASUMNDE,U,2),5),?42,$J(+$P(RASUMNDE,U,3),5),?48,$J(+$P(RASUMNDE,U,4),5),?55,$J(RAFLDTOT,5)
 W ?62,$J($S(RADIVTOT:(RAFLDTOT*100)/RADIVTOT,1:0),5,1)
 W ?68,$J(+$P(RASUMNDE,U,5),5)
 W:$D(RAFL) ?75,$J($S(RADIVWWU:($P(RASUMNDE,U,5)*100)/RADIVWWU,1:0),5,1)
 I ($Y+4)>IOSL S RAXIT=$$EOS^RAUTL5() D:'RAXIT DIVHDR
 Q
PDIVTOT ;
 I ($Y+4)>IOSL S RAXIT=$$EOS^RAUTL5() Q:RAXIT  D DIVHDR
 W !,RALN,!!,"Division Total",?30,$J(+$P(RADIVNDE,U,1),5),?36,$J(+$P(RADIVNDE,U,2),5),?42,$J(+$P(RADIVNDE,U,3),5),?48,$J(+$P(RADIVNDE,U,4),5),?55,$J(RADIVTOT,5)
 W ?68,$J(+$P(RADIVNDE,U,5),5)
 I ($Y+(RADIFLG(RADIV)\2)+3)>IOSL S RAXIT=$$EOS^RAUTL5() Q:RAXIT  D DIVHDR
 W !!?2,"Imaging Type(s): "
 S RAITHLD=""
 F  S RAITHLD=$O(^TMP($J,"RA",RADIV,RAITHLD)) Q:RAXIT!(RAITHLD="")  W:$X>(80-25) !?($X+$L("Imaging Type(s):")+3) D
 .I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5() D:'RAXIT DIVHDR Q:RAXIT 
 .W $S($D(^RA(79.2,+$P(RAITHLD,"-",2),0)):$P(^(0),U,1),1:"UNKNOWN"),?($X+3)
 Q:RAXIT
 W !!?3,"# of "_RATITLE_"s selected: "_$S(RAINPUT=1:"ALL",1:$G(RAFLDCNT))
 Q
DIVHDR ; division totals header
 W:$Y>0 @IOF W !?5,">>> ",RATITLE," Workload Report <<<" S RAPG=RAPG+1 W ?70,"Page: ",RAPG
 W !!,?4,"Division: ",$S($D(^DIC(4,+RADIV,0)):$P(^(0),U,1),1:"UNKNOWN"),?52,"For period: " W ?64,BEGDATE("X"),?76," to"
 W !?4,"Run Date: ",RATDY W ?64,ENDDATE("X")
 W !!?32,"-------Examinations------",!?62,"% of" W:$D(RAFL) ?75," % of"
 W !,RATITLE,?30," Inpt",?36,"  Opt",?42,"  Res",?48,"Other",?55,"Total",?62,"Exams"
 W:$D(RAFL) ?68,"  WWU",?75," WWU"
 W !,RALN
 W !?10,"(Division Summary)"
 I $D(ZTQUEUED) D STOPCHK^RAUTL9 S:$G(ZTSTOP)=1 RAXIT=1
 Q