Routine: RAFLM2

RAFLM2 ;HISC/FPT-Film Usage Rpt (cont.) ;4/17/96  09:30

 ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998

 ; print report

 S PAGE=0,RA80DASH=$$REPEAT^XLFSTR("-",80)

 S Y=BEGDATE D D^RAUTL S BEGDATE=Y

 S Y=ENDDATE D D^RAUTL S ENDDATE=Y

 S X="NOW",%DT="T" D ^%DT K %DT D D^RAUTL S RARUNDTE=Y

 F RADIV=0:0 S RADIV=$O(^TMP($J,"RA",RADIV)) Q:RAEOS!(RADIV'>0)  S RAITYPE="" F  S RAITYPE=$O(^TMP($J,"RA",RADIV,RAITYPE)) Q:RAEOS!(RAITYPE="")  D START

Q ; kill variables & close device

 K ^TMP($J,"RA"),^TMP($J,"RADIVFLD"),^TMP($J,"RAFILM"),^TMP($J,"RAFLM"),^TMP($J,"RA D-TYPE"),^TMP($J,"RA I-TYPE")

 K A,BEGDATE,ENDDATE,EXAM,FILM,I,J,PAGE,POP,RA80DASH,RABEG,RACNI,RACPT,RACRT,RAD0,RADEXAM,RADFILM,RADFN,RADIV,RADPCT,RADRATIO,RADTE,RADTI,RAEND,RAEOS,RAEXAM,RAFILM,RAFL1,RAFL2,RAFLDCNT

 K RAFLM,RAI,RAINPUT,RAITCNT,RAITEXAM,RAITFILM,RAITFLD,RAITHLD,RAITNDE,RAITNUM,RAITPCT,RAITRATO,RAITYPE,RALBL,RAMIS,RAMUL,RANUM,RAOR,RAP0,RAPCT,RAPIFN,RAPOP,RAPORT,RAPRC,RAPRI,RAQI,RAQUIT,RARATIO,RARUNDTE,RASTAT,RASUM,RASV

 K RATITLE,RATIO,RATMPNDE,RAXIT,RAY,RAZ,X,Y,Z,ZZ,ZZZ

 K DIROUT,DIRUT,DTOUT,DUOUT

 K:$D(RAPSTX) RACCESS,RAPSTX

 W ! D CLOSE^RAUTL

 K RAMES,ZTDESC,ZTRTN,ZTSAVE

START ;

 S (FILM,EXAM,RATIO)=0

 S RAZ=^TMP($J,"RA",RADIV,RAITYPE),RAY=$S($D(^DIC(4,RADIV,0)):$P(^(0),"^"),1:"UNKNOWN") D:$D(RAFL1) RAFLM Q:RAEOS  S RASUM="",Z=RAZ,ZZ=")",ZZZ="RAFLM" D HD Q:RAEOS  D PRT Q:RAEOS  D TOT K RASUM Q:RAEOS

 I $O(^TMP($J,"RA",RADIV,RAITYPE))="" D DIVTOT^RAFLM3

RAFLM S RAFLM="" F J=0:0 S RAFLM=$O(^TMP($J,"RA",RADIV,RAITYPE,RAFLM)) Q:RAEOS!(RAFLM="")  S Z=^(RAFLM) D HD Q:RAEOS  D RAMIS

RAMIS F RAMIS=0:0 S RAMIS=$O(^TMP($J,"RA",RADIV,RAITYPE,RAFLM,RAMIS)) D:RAMIS'>0 TOT Q:RAEOS!(RAMIS'>0)  S ZZ=",RAMIS,RAPRC)",ZZZ="RAPRC" D:RAMIS<25!(RAMIS=99)!(RAMIS=27) PRT

PRT I ($Y+6)>IOSL S RAEOS=$$EOS^RAUTL5() Q:RAEOS  D HD Q:RAEOS

 S EXAM=$P(Z,"^"),FILM=$P(Z,"^",2),RATIO=$S(EXAM:FILM/EXAM,1:0)

 S @ZZZ="" F I=0:0 S @ZZZ=$O(@("^TMP($J,""RA"",RADIV,RAITYPE,RAFLM"_ZZ)) Q:RAEOS!(@ZZZ="")  S Y=^(@ZZZ),RAEXAM=$P(Y,"^"),RAFILM=$P(Y,"^",2),RARATIO=$S(RAEXAM:RAFILM/RAEXAM,1:0),RAPCT=$S(FILM:(100*RAFILM)/FILM,1:0) D PRT1

TOT ;

 W !!?2,$S($D(RASUM):"Imaging Type",1:"Film Usage")," Total",?40,$J(FILM,5),?50,$J(EXAM,5),?60,$J(RATIO,5,1)

 W !,RA80DASH

 I ($Y+6)>IOSL S RAEOS=$$EOS^RAUTL5() Q:RAEOS  Q:'$D(RASUM)  D HD Q:RAEOS

 I $D(RASUM) D

 .W !!!,"* Cine data not included in imaging type totals.",!?2,"Percentages calculated on film data only."

 .W !!?3,"# of Films selected: ",$S(RAINPUT=1:"ALL",1:$G(RAFLDCNT))

 I $D(RASUM),$O(^TMP($J,"RA",RADIV))="",RAITCNT(RADIV)=1 Q

 S RAEOS=$$EOS^RAUTL5()

PRT1 I ($Y+6)>IOSL S RAEOS=$$EOS^RAUTL5() Q:RAEOS  D HD Q:RAEOS

 W !,@ZZZ,?40,$J(RAFILM,5),?50,$J(RAEXAM,5),?60,$J(RARATIO,5,1) Q:$D(RASUM)&($P(Y,"^",4))  W ?70,$J(RAPCT,5,1)

HD S RALBL=$S($P(Z,"^",4):"Cine Ft",1:"Films") W:$Y>0 @IOF

 W !?8,">>>>> Film Usage Report <<<<<"

 S PAGE=PAGE+1 W ?70,"Page: ",PAGE

 W !!?4,"Division: ",RAY,!,"Imaging Type: ",$S($D(^RA(79.2,+$P(RAITYPE,"-",2),0)):$P(^(0),U,1),1:"UNKNOWN"),?52,"For period: ",?64,BEGDATE,?76,"to"

 W !?4,"Run Date: ",RARUNDTE,?64,ENDDATE

 W !!?40,"Number",?50,"Number",?60,RALBL,?70,"Percentage"

 W !?40,"  of  ",?50,"  of  ",?60,"  per ",?70," ",RALBL

 W !?2,$S('$D(RASUM):"Procedure(CPT)",1:"Film Size"),?40,RALBL,$S($D(RASUM):"*",1:""),?50,"Exams",?60," Exam",?70," Used"

 W !,RA80DASH

 W:$D(RASUM) !?10,"(Imaging Type Summary)" W:'$D(RASUM) !?10,"Film Size: ",RAFLM

 I $D(ZTQUEUED) D STOPCHK^RAUTL9 S:$G(ZTSTOP)=1 RAEOS=1

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAFLM2   3556     printed  Mar 13, 2025@21:39:56                                                                                                                                                                                                      Page 2

RAFLM2    ;HISC/FPT-Film Usage Rpt (cont.) ;4/17/96  09:30

 +1       ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998

 +2       ; print report

 +3        SET PAGE=0

           SET RA80DASH=$$REPEAT^XLFSTR("-",80)

 +4        SET Y=BEGDATE

           DO D^RAUTL

           SET BEGDATE=Y

 +5        SET Y=ENDDATE

           DO D^RAUTL

           SET ENDDATE=Y

 +6        SET X="NOW"

           SET %DT="T"

           DO ^%DT

           KILL %DT

           DO D^RAUTL

           SET RARUNDTE=Y

 +7        FOR RADIV=0:0

               SET RADIV=$ORDER(^TMP($JOB,"RA",RADIV))

               if RAEOS!(RADIV'>0)

                   QUIT

               SET RAITYPE=""

FOR

                   SET RAITYPE=$ORDER(^TMP($JOB,"RA",RADIV,RAITYPE))

                   if RAEOS!(RAITYPE="")

                       QUIT

                   DO START

Q         ; kill variables & close device

 +1        KILL ^TMP($JOB,"RA"),^TMP($JOB,"RADIVFLD"),^TMP($JOB,"RAFILM"),^TMP($JOB,"RAFLM"),^TMP($JOB,"RA D-TYPE"),^TMP($JOB,"RA I-TYPE")

 +2        KILL A,BEGDATE,ENDDATE,EXAM,FILM,I,J,PAGE,POP,RA80DASH,RABEG,RACNI,RACPT,RACRT,RAD0,RADEXAM,RADFILM,RADFN,RADIV,RADPCT,RADRATIO,RADTE,RADTI,RAEND,RAEOS,RAEXAM,RAFILM,RAFL1,RAFL2,RAFLDCNT

 +3        KILL RAFLM,RAI,RAINPUT,RAITCNT,RAITEXAM,RAITFILM,RAITFLD,RAITHLD,RAITNDE,RAITNUM,RAITPCT,RAITRATO,RAITYPE,RALBL,RAMIS,RAMUL,RANUM,RAOR,RAP0,RAPCT,RAPIFN,RAPOP,RAPORT,RAPRC,RAPRI,RAQI,RAQUIT,RARATIO,RARUNDTE,RASTAT,RASUM,RASV

 +4        KILL RATITLE,RATIO,RATMPNDE,RAXIT,RAY,RAZ,X,Y,Z,ZZ,ZZZ

 +5        KILL DIROUT,DIRUT,DTOUT,DUOUT

 +6        if $DATA(RAPSTX)

               KILL RACCESS,RAPSTX

 +7        WRITE !

           DO CLOSE^RAUTL

 +8        KILL RAMES,ZTDESC,ZTRTN,ZTSAVE

 +9        QUIT

START     ;

 +1        SET (FILM,EXAM,RATIO)=0

 +2        SET RAZ=^TMP($JOB,"RA",RADIV,RAITYPE)

           SET RAY=$SELECT($DATA(^DIC(4,RADIV,0)):$PIECE(^(0),"^"),1:"UNKNOWN")

           if $DATA(RAFL1)

               DO RAFLM

           if RAEOS

               QUIT

           SET RASUM=""

           SET Z=RAZ

           SET ZZ=")"

           SET ZZZ="RAFLM"

           DO HD

           if RAEOS

               QUIT

           DO PRT

           if RAEOS

               QUIT

           DO TOT

           KILL RASUM

           if RAEOS

               QUIT

 +3        IF $ORDER(^TMP($JOB,"RA",RADIV,RAITYPE))=""

               DO DIVTOT^RAFLM3

 +4        QUIT

 +5       ;

RAFLM      SET RAFLM=""

           FOR J=0:0

               SET RAFLM=$ORDER(^TMP($JOB,"RA",RADIV,RAITYPE,RAFLM))

               if RAEOS!(RAFLM="")

                   QUIT

               SET Z=^(RAFLM)

               DO HD

               if RAEOS

                   QUIT

               DO RAMIS

 +1        QUIT

 +2       ;

RAMIS      FOR RAMIS=0:0

               SET RAMIS=$ORDER(^TMP($JOB,"RA",RADIV,RAITYPE,RAFLM,RAMIS))

               if RAMIS'>0

                   DO TOT

               if RAEOS!(RAMIS'>0)

                   QUIT

               SET ZZ=",RAMIS,RAPRC)"

               SET ZZZ="RAPRC"

               if RAMIS<25!(RAMIS=99)!(RAMIS=27)

                   DO PRT

 +1        QUIT

 +2       ;

PRT        IF ($Y+6)>IOSL

               SET RAEOS=$$EOS^RAUTL5()

               if RAEOS

                   QUIT

               DO HD

               if RAEOS

                   QUIT

 +1        SET EXAM=$PIECE(Z,"^")

           SET FILM=$PIECE(Z,"^",2)

           SET RATIO=$SELECT(EXAM:FILM/EXAM,1:0)

 +2        SET @ZZZ=""

           FOR I=0:0

               SET @ZZZ=$ORDER(@("^TMP($J,""RA"",RADIV,RAITYPE,RAFLM"_ZZ))

               if RAEOS!(@ZZZ="")

                   QUIT

               SET Y=^(@ZZZ)

               SET RAEXAM=$PIECE(Y,"^")

               SET RAFILM=$PIECE(Y,"^",2)

               SET RARATIO=$SELECT(RAEXAM:RAFILM/RAEXAM,1:0)

               SET RAPCT=$SELECT(FILM:(100*RAFILM)/FILM,1:0)

               DO PRT1

 +3        QUIT

 +4       ;

TOT       ;

 +1        WRITE !!?2,$SELECT($DATA(RASUM):"Imaging Type",1:"Film Usage")," Total",?40,$JUSTIFY(FILM,5),?50,$JUSTIFY(EXAM,5),?60,$JUSTIFY(RATIO,5,1)

 +2        WRITE !,RA80DASH

 +3        IF ($Y+6)>IOSL

               SET RAEOS=$$EOS^RAUTL5()

               if RAEOS

                   QUIT

               if '$DATA(RASUM)

                   QUIT

               DO HD

               if RAEOS

                   QUIT

 +4        IF $DATA(RASUM)

               Begin DoDot:1

 +5                WRITE !!!,"* Cine data not included in imaging type totals.",!?2,"Percentages calculated on film data only."

 +6                WRITE !!?3,"# of Films selected: ",$SELECT(RAINPUT=1:"ALL",1:$GET(RAFLDCNT))

               End DoDot:1

 +7        IF $DATA(RASUM)

               IF $ORDER(^TMP($JOB,"RA",RADIV))=""

                   IF RAITCNT(RADIV)=1

                       QUIT

 +8        SET RAEOS=$$EOS^RAUTL5()

 +9        QUIT

 +10      ;

PRT1       IF ($Y+6)>IOSL

               SET RAEOS=$$EOS^RAUTL5()

               if RAEOS

                   QUIT

               DO HD

               if RAEOS

                   QUIT

 +1        WRITE !,@ZZZ,?40,$JUSTIFY(RAFILM,5),?50,$JUSTIFY(RAEXAM,5),?60,$JUSTIFY(RARATIO,5,1)

           if $DATA(RASUM)&($PIECE(Y,"^",4))

               QUIT

           WRITE ?70,$JUSTIFY(RAPCT,5,1)

 +2        QUIT

 +3       ;

HD         SET RALBL=$SELECT($PIECE(Z,"^",4):"Cine Ft",1:"Films")

           if $Y>0

               WRITE @IOF

 +1        WRITE !?8,">>>>> Film Usage Report <<<<<"

 +2        SET PAGE=PAGE+1

           WRITE ?70,"Page: ",PAGE

 +3        WRITE !!?4,"Division: ",RAY,!,"Imaging Type: ",$SELECT($DATA(^RA(79.2,+$PIECE(RAITYPE,"-",2),0)):$PIECE(^(0),U,1),1:"UNKNOWN"),?52,"For period: ",?64,BEGDATE,?76,"to"

 +4        WRITE !?4,"Run Date: ",RARUNDTE,?64,ENDDATE

 +5        WRITE !!?40,"Number",?50,"Number",?60,RALBL,?70,"Percentage"

 +6        WRITE !?40,"  of  ",?50,"  of  ",?60,"  per ",?70," ",RALBL

 +7        WRITE !?2,$SELECT('$DATA(RASUM):"Procedure(CPT)",1:"Film Size"),?40,RALBL,$SELECT($DATA(RASUM):"*",1:""),?50,"Exams",?60," Exam",?70," Used"

 +8        WRITE !,RA80DASH

 +9        if $DATA(RASUM)

               WRITE !?10,"(Imaging Type Summary)"

           if '$DATA(RASUM)

               WRITE !?10,"Film Size: ",RAFLM

 +10       IF $DATA(ZTQUEUED)

               DO STOPCHK^RAUTL9

               if $GET(ZTSTOP)=1

                   SET RAEOS=1

 +11       QUIT

RAFLM2.m