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