source: FOIAVistA/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAFLM2.m@ 1397

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
 Q
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
 Q
 ;
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
 Q
 ;
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
 Q
 ;
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
 Q
 ;
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()
 Q
 ;
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)
 Q
 ;
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
 Q