63 lines
3.4 KiB
Mathematica
63 lines
3.4 KiB
Mathematica
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
|