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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRALWKL4 4259 printed Apr 09, 2024@21:40:46 Page 2
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
