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

Last change on this file since 811 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 3.4 KB
Line 
1RAFLM2 ;HISC/FPT-Film Usage Rpt (cont.) ;4/17/96 09:30
2 ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
3 ; print report
4 S PAGE=0,RA80DASH=$$REPEAT^XLFSTR("-",80)
5 S Y=BEGDATE D D^RAUTL S BEGDATE=Y
6 S Y=ENDDATE D D^RAUTL S ENDDATE=Y
7 S X="NOW",%DT="T" D ^%DT K %DT D D^RAUTL S RARUNDTE=Y
8 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
9Q ; kill variables & close device
10 K ^TMP($J,"RA"),^TMP($J,"RADIVFLD"),^TMP($J,"RAFILM"),^TMP($J,"RAFLM"),^TMP($J,"RA D-TYPE"),^TMP($J,"RA I-TYPE")
11 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
12 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
13 K RATITLE,RATIO,RATMPNDE,RAXIT,RAY,RAZ,X,Y,Z,ZZ,ZZZ
14 K DIROUT,DIRUT,DTOUT,DUOUT
15 K:$D(RAPSTX) RACCESS,RAPSTX
16 W ! D CLOSE^RAUTL
17 K RAMES,ZTDESC,ZTRTN,ZTSAVE
18 Q
19START ;
20 S (FILM,EXAM,RATIO)=0
21 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
22 I $O(^TMP($J,"RA",RADIV,RAITYPE))="" D DIVTOT^RAFLM3
23 Q
24 ;
25RAFLM 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
26 Q
27 ;
28RAMIS 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
29 Q
30 ;
31PRT I ($Y+6)>IOSL S RAEOS=$$EOS^RAUTL5() Q:RAEOS D HD Q:RAEOS
32 S EXAM=$P(Z,"^"),FILM=$P(Z,"^",2),RATIO=$S(EXAM:FILM/EXAM,1:0)
33 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
34 Q
35 ;
36TOT ;
37 W !!?2,$S($D(RASUM):"Imaging Type",1:"Film Usage")," Total",?40,$J(FILM,5),?50,$J(EXAM,5),?60,$J(RATIO,5,1)
38 W !,RA80DASH
39 I ($Y+6)>IOSL S RAEOS=$$EOS^RAUTL5() Q:RAEOS Q:'$D(RASUM) D HD Q:RAEOS
40 I $D(RASUM) D
41 .W !!!,"* Cine data not included in imaging type totals.",!?2,"Percentages calculated on film data only."
42 .W !!?3,"# of Films selected: ",$S(RAINPUT=1:"ALL",1:$G(RAFLDCNT))
43 I $D(RASUM),$O(^TMP($J,"RA",RADIV))="",RAITCNT(RADIV)=1 Q
44 S RAEOS=$$EOS^RAUTL5()
45 Q
46 ;
47PRT1 I ($Y+6)>IOSL S RAEOS=$$EOS^RAUTL5() Q:RAEOS D HD Q:RAEOS
48 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)
49 Q
50 ;
51HD S RALBL=$S($P(Z,"^",4):"Cine Ft",1:"Films") W:$Y>0 @IOF
52 W !?8,">>>>> Film Usage Report <<<<<"
53 S PAGE=PAGE+1 W ?70,"Page: ",PAGE
54 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"
55 W !?4,"Run Date: ",RARUNDTE,?64,ENDDATE
56 W !!?40,"Number",?50,"Number",?60,RALBL,?70,"Percentage"
57 W !?40," of ",?50," of ",?60," per ",?70," ",RALBL
58 W !?2,$S('$D(RASUM):"Procedure(CPT)",1:"Film Size"),?40,RALBL,$S($D(RASUM):"*",1:""),?50,"Exams",?60," Exam",?70," Used"
59 W !,RA80DASH
60 W:$D(RASUM) !?10,"(Imaging Type Summary)" W:'$D(RASUM) !?10,"Film Size: ",RAFLM
61 I $D(ZTQUEUED) D STOPCHK^RAUTL9 S:$G(ZTSTOP)=1 RAEOS=1
62 Q
Note: See TracBrowser for help on using the repository browser.