RAFLM3 ;HISC/FPT-Film Usage Workload Rpt (cont.) ;4/17/96 09:32
;;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:RAEOS
S RATMPNDE=^TMP($J,"RA",RADIV),RADEXAM=$P(RATMPNDE,U,1),RADFILM=$P(RATMPNDE,U,2)
S RAITHLD=""
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 RAITEXAM=$P(^TMP($J,"RA",RADIV,RAITHLD,RAITFLD),U,1)
.S RAITFILM=$P(^TMP($J,"RA",RADIV,RAITHLD,RAITFLD),U,2)
.S:'$D(^TMP($J,"RADIVFLD",RAITFLD)) ^TMP($J,"RADIVFLD",RAITFLD)="0^0"
.I $P(^TMP($J,"RA",RADIV,RAITHLD,RAITFLD),U,4)=1 S $P(^TMP($J,"RADIVFLD",RAITFLD),U,4)=1
.S $P(^TMP($J,"RADIVFLD",RAITFLD),U,1)=$P(^TMP($J,"RADIVFLD",RAITFLD),U,1)+RAITEXAM
.S $P(^TMP($J,"RADIVFLD",RAITFLD),U,2)=$P(^TMP($J,"RADIVFLD",RAITFLD),U,2)+RAITFILM
S RAITFLD=""
F S RAITFLD=$O(^TMP($J,"RADIVFLD",RAITFLD)) Q:RAEOS!(RAITFLD="") D
.S RAITNDE=$G(^TMP($J,"RADIVFLD",RAITFLD))
.S RAITEXAM=$P(RAITNDE,U,1)
.S RAITFILM=$P(RAITNDE,U,2)
.S RAITPCT=$S(RADFILM:(100*RAITFILM)/RADFILM,1:0)
.S RAITRATO=$S(RAITEXAM:RAITFILM/RAITEXAM,1:0)
.W !?2,RAITFLD,?40,$J(RAITFILM,5),?50,$J(RAITEXAM,5),?60,$J(RAITRATO,5,1) Q:$P(RAITNDE,U,4) W ?70,$J(RAITPCT,5,1)
.I ($Y+6)>IOSL S RAEOS=$$EOS^RAUTL5() Q:RAEOS D DIVHDR
Q:RAEOS
S RADRATIO=$S(RADEXAM:RADFILM/RADEXAM,1:0)
W !,RA80DASH,!!?2,"Division Total",?40,$J(RADFILM,5),?50,$J(RADEXAM,5),?60,$J(RADRATIO,5,1)
W !!!,"* Cine data not included in division totals.",!?2,"Percentages calculated on film data only."
I ($Y+(RAITCNT(RADIV)\2)+3)>IOSL S RAEOS=$$EOS^RAUTL5 Q:RAEOS D DIVHDR Q:RAEOS
W !!?2,"Imaging Type(s): "
S RAITHLD=""
F S RAITHLD=$O(^TMP($J,"RA",RADIV,RAITHLD)) Q:RAEOS!(RAITHLD="") W:$X>(80-25) !?($X+$L("Imaging Type(s):")+3) D
.I ($Y+4)>IOSL S RAEOS=$$EOS^RAUTL5 Q:RAEOS D DIVHDR Q:RAEOS W !?19
.W $S($D(^RA(79.2,+$P(RAITHLD,"-",2),0)):$P(^(0),U,1),1:"UNKNOWN"),?($X+3)
Q:RAEOS
W !!?3,"# of Films selected: "_$S(RAINPUT=1:"ALL",1:$G(RAFLDCNT))
K ^TMP($J,"RADIVFLD"),RADEXAM,RADFILM,RADRATIO,RAITEXAM,RAITFILM,RAITFLD,RAITHLD,RAITNDE,RAITPCT,RAITRATO,RATMPNDE
I $O(^TMP($J,"RA",RADIV))]"" S RAEOS=$$EOS^RAUTL5()
Q
DIVHDR W:$Y>0 @IOF
W !?5,">>>>> Film Usage Report <<<<<"
S PAGE=PAGE+1 W ?70,"Page: ",PAGE
W !!?1,"Division: ",$S($D(^DIC(4,+RADIV,0)):$P(^(0),U,1),1:"UNKNOWN"),?52,"For period: ",?64,BEGDATE,?76,"to"
W !?1,"Run Date: ",RARUNDTE,?64,ENDDATE
W !!?40,"Number",?50,"Number",?60,"Films",?70,"Percentage"
W !?40," of ",?50," of ",?60," per ",?70," Films"
W !?2,"Film Size",?40,"Films*",?50,"Exams",?60," Exam",?70," Used"
W !,RA80DASH
W !?10,"(Division Summary)"
I $D(ZTQUEUED) D STOPCHK^RAUTL9 S:$G(ZTSTOP)=1 RAEOS=1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAFLM3 2864 printed Apr 09, 2024@21:40:50 Page 2
RAFLM3 ;HISC/FPT-Film Usage Workload Rpt (cont.) ;4/17/96 09:32
+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 RAEOS
QUIT
+4 SET RATMPNDE=^TMP($JOB,"RA",RADIV)
SET RADEXAM=$PIECE(RATMPNDE,U,1)
SET RADFILM=$PIECE(RATMPNDE,U,2)
+5 SET RAITHLD=""
+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 RAITEXAM=$PIECE(^TMP($JOB,"RA",RADIV,RAITHLD,RAITFLD),U,1)
+8 SET RAITFILM=$PIECE(^TMP($JOB,"RA",RADIV,RAITHLD,RAITFLD),U,2)
+9 if '$DATA(^TMP($JOB,"RADIVFLD",RAITFLD))
SET ^TMP($JOB,"RADIVFLD",RAITFLD)="0^0"
+10 IF $PIECE(^TMP($JOB,"RA",RADIV,RAITHLD,RAITFLD),U,4)=1
SET $PIECE(^TMP($JOB,"RADIVFLD",RAITFLD),U,4)=1
+11 SET $PIECE(^TMP($JOB,"RADIVFLD",RAITFLD),U,1)=$PIECE(^TMP($JOB,"RADIVFLD",RAITFLD),U,1)+RAITEXAM
+12 SET $PIECE(^TMP($JOB,"RADIVFLD",RAITFLD),U,2)=$PIECE(^TMP($JOB,"RADIVFLD",RAITFLD),U,2)+RAITFILM
End DoDot:1
+13 SET RAITFLD=""
+14 FOR
SET RAITFLD=$ORDER(^TMP($JOB,"RADIVFLD",RAITFLD))
if RAEOS!(RAITFLD="")
QUIT
Begin DoDot:1
+15 SET RAITNDE=$GET(^TMP($JOB,"RADIVFLD",RAITFLD))
+16 SET RAITEXAM=$PIECE(RAITNDE,U,1)
+17 SET RAITFILM=$PIECE(RAITNDE,U,2)
+18 SET RAITPCT=$SELECT(RADFILM:(100*RAITFILM)/RADFILM,1:0)
+19 SET RAITRATO=$SELECT(RAITEXAM:RAITFILM/RAITEXAM,1:0)
+20 WRITE !?2,RAITFLD,?40,$JUSTIFY(RAITFILM,5),?50,$JUSTIFY(RAITEXAM,5),?60,$JUSTIFY(RAITRATO,5,1)
if $PIECE(RAITNDE,U,4)
QUIT
WRITE ?70,$JUSTIFY(RAITPCT,5,1)
+21 IF ($Y+6)>IOSL
SET RAEOS=$$EOS^RAUTL5()
if RAEOS
QUIT
DO DIVHDR
End DoDot:1
+22 if RAEOS
QUIT
+23 SET RADRATIO=$SELECT(RADEXAM:RADFILM/RADEXAM,1:0)
+24 WRITE !,RA80DASH,!!?2,"Division Total",?40,$JUSTIFY(RADFILM,5),?50,$JUSTIFY(RADEXAM,5),?60,$JUSTIFY(RADRATIO,5,1)
+25 WRITE !!!,"* Cine data not included in division totals.",!?2,"Percentages calculated on film data only."
+26 IF ($Y+(RAITCNT(RADIV)\2)+3)>IOSL
SET RAEOS=$$EOS^RAUTL5
if RAEOS
QUIT
DO DIVHDR
if RAEOS
QUIT
+27 WRITE !!?2,"Imaging Type(s): "
+28 SET RAITHLD=""
+29 FOR
SET RAITHLD=$ORDER(^TMP($JOB,"RA",RADIV,RAITHLD))
if RAEOS!(RAITHLD="")
QUIT
if $X>(80-25)
WRITE !?($X+$LENGTH("Imaging Type(s):")+3)
Begin DoDot:1
+30 IF ($Y+4)>IOSL
SET RAEOS=$$EOS^RAUTL5
if RAEOS
QUIT
DO DIVHDR
if 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 RAEOS
QUIT
+33 WRITE !!?3,"# of Films selected: "_$SELECT(RAINPUT=1:"ALL",1:$GET(RAFLDCNT))
+34 KILL ^TMP($JOB,"RADIVFLD"),RADEXAM,RADFILM,RADRATIO,RAITEXAM,RAITFILM,RAITFLD,RAITHLD,RAITNDE,RAITPCT,RAITRATO,RATMPNDE
+35 IF $ORDER(^TMP($JOB,"RA",RADIV))]""
SET RAEOS=$$EOS^RAUTL5()
+36 QUIT
DIVHDR if $Y>0
WRITE @IOF
+1 WRITE !?5,">>>>> Film Usage Report <<<<<"
+2 SET PAGE=PAGE+1
WRITE ?70,"Page: ",PAGE
+3 WRITE !!?1,"Division: ",$SELECT($DATA(^DIC(4,+RADIV,0)):$PIECE(^(0),U,1),1:"UNKNOWN"),?52,"For period: ",?64,BEGDATE,?76,"to"
+4 WRITE !?1,"Run Date: ",RARUNDTE,?64,ENDDATE
+5 WRITE !!?40,"Number",?50,"Number",?60,"Films",?70,"Percentage"
+6 WRITE !?40," of ",?50," of ",?60," per ",?70," Films"
+7 WRITE !?2,"Film Size",?40,"Films*",?50,"Exams",?60," Exam",?70," Used"
+8 WRITE !,RA80DASH
+9 WRITE !?10,"(Division Summary)"
+10 IF $DATA(ZTQUEUED)
DO STOPCHK^RAUTL9
if $GET(ZTSTOP)=1
SET RAEOS=1
+11 QUIT
