RAWKL3 ;HISC/FPT-Workload Reports (cont.) ;9/23/96 08:44
;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
DIVTOT ; print division totals
Q:RAITCNT(RADIV)=1 ;quit if only one imaging type selected for division
K ^TMP($J,"RADIVFLD")
D DIVHDR Q:$D(RAEOS)
S RATMPNDE=^TMP($J,"RA",RADIV),RAITTEXM=$P(RATMPNDE,U,1)+$P(RATMPNDE,U,2),RAITTWWU=$P(RATMPNDE,U,3)
S RAITHLD="",(RADIN,RADOUT,RADTOT,RADWWU)=0
F S RAITHLD=$O(^TMP($J,"RA",RADIV,RAITHLD)) Q:RAITHLD="" S RAITFLD="" F S RAITFLD=$O(^TMP($J,"RA",RADIV,RAITHLD,RAITFLD)) Q:RAITFLD="" D
.S RAITIN=$P(^TMP($J,"RA",RADIV,RAITHLD,RAITFLD),U,1)
.S RAITOUT=$P(^TMP($J,"RA",RADIV,RAITHLD,RAITFLD),U,2)
.S RAITWWU=$P(^TMP($J,"RA",RADIV,RAITHLD,RAITFLD),U,3)
.S:'$D(^TMP($J,"RADIVFLD",RAITFLD)) ^TMP($J,"RADIVFLD",RAITFLD)="0^0^0"
.S $P(^TMP($J,"RADIVFLD",RAITFLD),U,1)=$P(^TMP($J,"RADIVFLD",RAITFLD),U,1)+RAITIN
.S $P(^TMP($J,"RADIVFLD",RAITFLD),U,2)=$P(^TMP($J,"RADIVFLD",RAITFLD),U,2)+RAITOUT
.S $P(^TMP($J,"RADIVFLD",RAITFLD),U,3)=$P(^TMP($J,"RADIVFLD",RAITFLD),U,3)+RAITWWU
.S RAITTOT=RAITIN+RAITOUT
.S RADIN=RADIN+RAITIN,RADOUT=RADOUT+RAITOUT,RADTOT=RADTOT+RAITTOT,RADWWU=RADWWU+RAITWWU
S RAITFLD=""
F S RAITFLD=$O(^TMP($J,"RADIVFLD",RAITFLD)) Q:RAITFLD=""!($D(RAEOS)) D
.S RAITIN=$P(^TMP($J,"RADIVFLD",RAITFLD),U,1)
.S RAITOUT=$P(^TMP($J,"RADIVFLD",RAITFLD),U,2)
.S RAITWWU=$P(^TMP($J,"RADIVFLD",RAITFLD),U,3)
.S RAITTOT=RAITIN+RAITOUT
.W !?2,RAITFLD,?40,$J(RAITIN,5),?47,$J(RAITOUT,5),?54,$J(RAITTOT,5),?61,$J($S(RAITTEXM:(RAITTOT*100)/RAITTEXM,1:0),5,1) W:$D(RAFL) ?68,$J(RAITWWU,5),?75,$J($S(RAITTWWU:(RAITWWU*100)/RAITTWWU,1:0),5,1)
.I ($Y+4)>IOSL D EOS^RAWKL2 Q:$D(RAEOS) D DIVHDR
Q:$D(RAEOS)
W !,RA80DASH,!!?2,"Division Total",?40,$J(RADIN,5),?47,$J(RADOUT,5),?54,$J(RADTOT,5) W:$D(RAFL) ?68,$J(RADWWU,5)
I ($Y+(RAITCNT(RADIV)\2)+3)>IOSL D EOS^RAWKL2 Q:$D(RAEOS) D DIVHDR
Q:$D(RAEOS) W !!?2,"Imaging Type(s): "
S RAITHLD=""
F S RAITHLD=$O(^TMP($J,"RA",RADIV,RAITHLD)) Q:RAITHLD=""!($D(RAEOS)) W:$X>(80-25) !?($X+$L("Imaging Type(s):")+3) D
.I ($Y+4)>IOSL D EOS^RAWKL2 Q:$D(RAEOS) D DIVHDR Q:$D(RAEOS) W !?19
.W $S($D(^RA(79.2,+$P(RAITHLD,"-",2),0)):$P(^(0),U,1),1:"UNKNOWN"),?($X+3)
Q:$D(RAEOS)
W !!?3,"# of "_RATITLE_"s selected: "_$S(RAINPUT=1:"ALL",1:$G(RAFLDCNT))
K ^TMP($J,"RADIVFLD"),RADIN,RADOUT,RADTOT,RADWWU,RAITFLD,RAITHLD,RAITIN,RAITOUT,RAITTEXM,RAITTOT,RAITWWU,RAITTWWU,RATMPNDE
I $O(^TMP($J,"RA",RADIV))]"" D EOS^RAWKL2
Q
DIVHDR ; division totals header
W:$Y>0 @IOF W !?10,">>> ",RATITLE," Workload Report <<<" S PAGE=PAGE+1 W ?70,"Page: ",PAGE
W !!,?4,"Division: ",$S($D(^DIC(4,+RADIV,0)):$P(^(0),U,1),1:"UNKNOWN"),?52,"For period: ",?64,BEGDATE,?76,"to"
W !?4,"Run Date: ",RARUNDTE,?64,ENDDATE
W !!?45,"Examinations",?61,"Percent" W:$D(RAFL) ?73,"Percent"
W !?2,RATITLE,?40," In",?47," Out",?54,"Total",?61," Exams" W:$D(RAFL) ?67," WWU",?73," WWU"
W !,RA80DASH
W !?10,"(Division Summary)"
I $D(ZTQUEUED) D STOPCHK^RAUTL9 S:$G(ZTSTOP)=1 RAEOS=""
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAWKL3 3028 printed Oct 16, 2024@18:41:17 Page 2
RAWKL3 ;HISC/FPT-Workload Reports (cont.) ;9/23/96 08:44
+1 ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
DIVTOT ; print division totals
+1 ;quit if only one imaging type selected for division
if RAITCNT(RADIV)=1
QUIT
+2 KILL ^TMP($JOB,"RADIVFLD")
+3 DO DIVHDR
if $DATA(RAEOS)
QUIT
+4 SET RATMPNDE=^TMP($JOB,"RA",RADIV)
SET RAITTEXM=$PIECE(RATMPNDE,U,1)+$PIECE(RATMPNDE,U,2)
SET RAITTWWU=$PIECE(RATMPNDE,U,3)
+5 SET RAITHLD=""
SET (RADIN,RADOUT,RADTOT,RADWWU)=0
+6 FOR
SET RAITHLD=$ORDER(^TMP($JOB,"RA",RADIV,RAITHLD))
if RAITHLD=""
QUIT
SET RAITFLD=""
FOR
SET RAITFLD=$ORDER(^TMP($JOB,"RA",RADIV,RAITHLD,RAITFLD))
if RAITFLD=""
QUIT
Begin DoDot:1
+7 SET RAITIN=$PIECE(^TMP($JOB,"RA",RADIV,RAITHLD,RAITFLD),U,1)
+8 SET RAITOUT=$PIECE(^TMP($JOB,"RA",RADIV,RAITHLD,RAITFLD),U,2)
+9 SET RAITWWU=$PIECE(^TMP($JOB,"RA",RADIV,RAITHLD,RAITFLD),U,3)
+10 if '$DATA(^TMP($JOB,"RADIVFLD",RAITFLD))
SET ^TMP($JOB,"RADIVFLD",RAITFLD)="0^0^0"
+11 SET $PIECE(^TMP($JOB,"RADIVFLD",RAITFLD),U,1)=$PIECE(^TMP($JOB,"RADIVFLD",RAITFLD),U,1)+RAITIN
+12 SET $PIECE(^TMP($JOB,"RADIVFLD",RAITFLD),U,2)=$PIECE(^TMP($JOB,"RADIVFLD",RAITFLD),U,2)+RAITOUT
+13 SET $PIECE(^TMP($JOB,"RADIVFLD",RAITFLD),U,3)=$PIECE(^TMP($JOB,"RADIVFLD",RAITFLD),U,3)+RAITWWU
+14 SET RAITTOT=RAITIN+RAITOUT
+15 SET RADIN=RADIN+RAITIN
SET RADOUT=RADOUT+RAITOUT
SET RADTOT=RADTOT+RAITTOT
SET RADWWU=RADWWU+RAITWWU
End DoDot:1
+16 SET RAITFLD=""
+17 FOR
SET RAITFLD=$ORDER(^TMP($JOB,"RADIVFLD",RAITFLD))
if RAITFLD=""!($DATA(RAEOS))
QUIT
Begin DoDot:1
+18 SET RAITIN=$PIECE(^TMP($JOB,"RADIVFLD",RAITFLD),U,1)
+19 SET RAITOUT=$PIECE(^TMP($JOB,"RADIVFLD",RAITFLD),U,2)
+20 SET RAITWWU=$PIECE(^TMP($JOB,"RADIVFLD",RAITFLD),U,3)
+21 SET RAITTOT=RAITIN+RAITOUT
+22 WRITE !?2,RAITFLD,?40,$JUSTIFY(RAITIN,5),?47,$JUSTIFY(RAITOUT,5),?54,$JUSTIFY(RAITTOT,5),?61,$JUSTIFY($SELECT(RAITTEXM:(RAITTOT*100)/RAITTEXM,1:0),5,1)
if $DATA(RAFL)
WRITE ?68,$JUSTIFY(RAITWWU,5),?75,$JUSTIFY($SELECT(RAITTWWU:(RAITWWU*100)/RAITTWWU,1:0),5,1)
+23 IF ($Y+4)>IOSL
DO EOS^RAWKL2
if $DATA(RAEOS)
QUIT
DO DIVHDR
End DoDot:1
+24 if $DATA(RAEOS)
QUIT
+25 WRITE !,RA80DASH,!!?2,"Division Total",?40,$JUSTIFY(RADIN,5),?47,$JUSTIFY(RADOUT,5),?54,$JUSTIFY(RADTOT,5)
if $DATA(RAFL)
WRITE ?68,$JUSTIFY(RADWWU,5)
+26 IF ($Y+(RAITCNT(RADIV)\2)+3)>IOSL
DO EOS^RAWKL2
if $DATA(RAEOS)
QUIT
DO DIVHDR
+27 if $DATA(RAEOS)
QUIT
WRITE !!?2,"Imaging Type(s): "
+28 SET RAITHLD=""
+29 FOR
SET RAITHLD=$ORDER(^TMP($JOB,"RA",RADIV,RAITHLD))
if RAITHLD=""!($DATA(RAEOS))
QUIT
if $X>(80-25)
WRITE !?($X+$LENGTH("Imaging Type(s):")+3)
Begin DoDot:1
+30 IF ($Y+4)>IOSL
DO EOS^RAWKL2
if $DATA(RAEOS)
QUIT
DO DIVHDR
if $DATA(RAEOS)
QUIT
WRITE !?19
+31 WRITE $SELECT($DATA(^RA(79.2,+$PIECE(RAITHLD,"-",2),0)):$PIECE(^(0),U,1),1:"UNKNOWN"),?($X+3)
End DoDot:1
+32 if $DATA(RAEOS)
QUIT
+33 WRITE !!?3,"# of "_RATITLE_"s selected: "_$SELECT(RAINPUT=1:"ALL",1:$GET(RAFLDCNT))
+34 KILL ^TMP($JOB,"RADIVFLD"),RADIN,RADOUT,RADTOT,RADWWU,RAITFLD,RAITHLD,RAITIN,RAITOUT,RAITTEXM,RAITTOT,RAITWWU,RAITTWWU,RATMPNDE
+35 IF $ORDER(^TMP($JOB,"RA",RADIV))]""
DO EOS^RAWKL2
+36 QUIT
DIVHDR ; division totals header
+1 if $Y>0
WRITE @IOF
WRITE !?10,">>> ",RATITLE," Workload Report <<<"
SET PAGE=PAGE+1
WRITE ?70,"Page: ",PAGE
+2 WRITE !!,?4,"Division: ",$SELECT($DATA(^DIC(4,+RADIV,0)):$PIECE(^(0),U,1),1:"UNKNOWN"),?52,"For period: ",?64,BEGDATE,?76,"to"
+3 WRITE !?4,"Run Date: ",RARUNDTE,?64,ENDDATE
+4 WRITE !!?45,"Examinations",?61,"Percent"
if $DATA(RAFL)
WRITE ?73,"Percent"
+5 WRITE !?2,RATITLE,?40," In",?47," Out",?54,"Total",?61," Exams"
if $DATA(RAFL)
WRITE ?67," WWU",?73," WWU"
+6 WRITE !,RA80DASH
+7 WRITE !?10,"(Division Summary)"
+8 IF $DATA(ZTQUEUED)
DO STOPCHK^RAUTL9
if $GET(ZTSTOP)=1
SET RAEOS=""
+9 QUIT
