VistA-WorldVistAEHR/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RALWKL4.m

89 lines
4.1 KiB
Mathematica

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