- 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 Dec 13, 2024@02:40:43 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