source: FOIAVistA/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAWFR3.m

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

initial load of FOIAVistA 6/30/08 version

File size: 3.4 KB
Line 
1RAWFR3 ;HISC/GJC-'Wasted Film Report' (3 of 4) ;4/15/96 07:12
2 ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
3 ;
4COMP ; Compilation for 'Non-Summary' data
5 N RACINE,RAF0,RAHDRFG,RATIO,RAUSED,X2,X3,X4,Y0,Y1,Y2,Y3
6 S RAHDRFG=0,X2="" ; 'X2' is the division
7 F S X2=$O(^TMP($J,"RA WFR","NS",X2)) Q:X2']""!(RAXIT) D
8 . S Y0=$G(^TMP($J,"RA WFR","NS",X2)) ; 'Y0' total # of all films
9 . S X3="" ; 'X3' is the imaging location
10 . F S X3=$O(^TMP($J,"RA WFR","NS",X2,"I",X3)) Q:X3']""!(RAXIT) D
11 .. Q:'$D(^TMP($J,"RA WFR","NS",X2,"I",X3,"WF"))
12 .. I RAHDRFG S RAXIT=$$EOS^RAUTL5 Q:RAXIT
13 .. S RADIV=X2,RAIMG=X3,(Y0,Y3)=0 D HDR
14 .. ; films for a particular imaging type
15 .. S X4="" ; wasted film type if 'X1' is "F", tech if 'X1' is "T"
16 .. F S X4=$O(^TMP($J,"RA WFR","NS",X2,"I",X3,"WF",X4)) Q:X4']""!(RAXIT) D
17 ... S RAUSED=+$O(^RA(78.4,"B",X4,0)) Q:'RAUSED
18 ... S RAUSED=+$P(^RA(78.4,RAUSED,0),U,5) Q:'RAUSED
19 ... S RAF0=$G(^RA(78.4,RAUSED,0))
20 ... S RAUSED=$P(RAF0,U),RACINE=$S($P(RAF0,U,2)="Y":1,1:0)
21 ... ;Q:'$D(^TMP($J,"RA WFR","NS",X2,"I",X3,"F",RAUSED))
22 ... S Y2=$G(^TMP($J,"RA WFR","NS",X2,"I",X3,"F",RAUSED))
23 ... S Y1=$G(^TMP($J,"RA WFR","NS",X2,"I",X3,"WF",X4))
24 ... I 'RACINE S Y0=Y0+Y1,Y3=Y3+Y2 ; add to subtotals if not cine type
25 ... ; 'Y3' is used for the division summary
26 ... S RATIO=$S((Y1+Y2)>0:$J((Y1/(Y1+Y2))*100,5,1),1:0)
27 ... W !,X4,?$S(IOM=132:60,1:35),Y2,?$S(IOM=132:75,1:45),Y1
28 ... W ?$S(IOM=132:100,1:60),RATIO
29 ... I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5 Q:RAXIT D HDR
30 ... Q
31 .. Q:RAXIT W !!?$S(IOM=132:10,1:5),"Subtotals:"
32 .. W ?$S(IOM=132:60,1:35),$S('Y3:"",1:Y3)
33 .. W ?$S(IOM=132:75,1:45),Y0
34 .. W ?$S(IOM=132:100,1:60),$S((Y0+Y3)>0:$J((Y0/(Y0+Y3))*100,5,1),1:0)
35 .. S RAHDRFG=1 W !,RALINE
36 .. I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5 Q:RAXIT D HDR
37 .. W !!?5,"* Cine data not included in totals."
38 .. Q
39 . Q:RAXIT
40 . I RATOT>1 D
41 .. N X S X=X2 N RASYN,RATIO,RAUSED,X1,X2,X3,X4,Y0,Y1,Y2,Y3
42 .. S RASYN=1 D SUMMARY^RAWFR2(X)
43 .. Q
44 . Q
45 Q
46KILL ; Kill and quit
47 K %,%CHK,%RET,%Z,DIROUT,DIRUT,DTOUT,DUOUT,I,RABGDTI,RABGDTX,RACCESS
48 K RADATE,RADFN,RADIV,RADT,RADTI,RAENDTI,RAENDTX,RAEXST,RAEX,RAEX0
49 K RAEXS,RAFLM0,RAFLMNUM,RAFLMS,RAHEAD,RAIBGDT,RAIENDT,RAIMG,RALINE
50 K RAMBGDT,RAMENDT,RAMES,RAPG,RAPOP,RAQUIT,RARP0,RASYN,RATAG,RATDAY
51 K RATECH,RATOT,RAWFR,RAXIT,X,Y,Z,ZTDESC,ZTRTN,ZTSAVE,POP
52 K ^TMP($J,"RA D-TYPE"),^TMP($J,"RA I-TYPE")
53 K ^TMP($J,"RA WFR") K:$D(RAPSTX) RACCESS,RAPSTX
54 Q
55HDR ; Display/Print the header for the report
56 W:$E(IOST,1,2)="C-" @IOF,!
57 W:$E(IOST,1,2)'="C-"&(+$G(RAPG)>0) @IOF,!
58 S RAPG=+$G(RAPG)+1
59 W !?(IOM-$L(RAHEAD)\2),RAHEAD,?$S(IOM=132:122,1:69),"Page: ",RAPG,!
60 I RASYN D
61 . W !?$S(IOM=132:10,1:5),"Division: ",$G(RADIV)
62 . W ?$S(IOM=132:85,1:50),"For Period: ",RABGDTX_" to"
63 . W !?$S(IOM=132:10,1:5),"Run Date: ",RATDAY
64 . W ?$S(IOM=132:97,1:62),RAENDTX_"."
65 E D
66 . W !?$S(IOM=132:10,1:5),"Division: ",$G(RADIV)
67 . W ?$S(IOM=132:85,1:50),"For Period: ",RABGDTX_" to"
68 . W !?$S(IOM=132:10,1:5),"Imaging Type: ",$G(RAIMG)
69 . W ?$S(IOM=132:97,1:62),RAENDTX_"."
70 . W !?$S(IOM=132:10,1:5),"Run Date: ",RATDAY
71 W !!?$S(IOM=132:60,1:35),"Units",?$S(IOM=132:75,1:45),"Units"
72 W ?$S(IOM=132:100,1:60),"Percentage"
73 W !?$S(IOM=132:60,1:35),"Of Used",?$S(IOM=132:75,1:45),"Of Wasted"
74 W ?$S(IOM=132:100,1:60),"Of Wasted"
75 W !,"Film Size",?$S(IOM=132:60,1:35),"Films"
76 W ?$S(IOM=132:75,1:45),"Films"
77 W ?$S(IOM=132:100,1:60),"Film"
78 W !,RALINE
79 W:RASYN !?$S(IOM=132:10,1:5),"(Division Summary)"
80 I $D(ZTQUEUED) D STOPCHK^RAUTL9 S:$G(ZTSTOP)=1 RAXIT=1
81 Q
Note: See TracBrowser for help on using the repository browser.