source: FOIAVistA/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAWFR2.m@ 1764

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

initial load of FOIAVistA 6/30/08 version

File size: 3.9 KB
Line 
1RAWFR2 ;HISC/GJC-'Wasted Film Report' (2 of 4) ;4/15/96 07:12
2 ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
3 ;
4 ; *** Variable List ***
5 ;^TMP($J,"RA WFR","NS",Division,"I",Imaging Type)=Subtotal
6 ;^TMP($J,"RA WFR","NS",Division,"I",Imaging Type,"F",Used Film Size)=Subtotal
7 ;^TMP($J,"RA WFR","NS",Division,"I",Imaging Type,"WF",Wasted Film Size)=Subtotal
8 ;^TMP($J,"RA WFR","S",Division,"F",Used Film Size)=Subtotal
9 ;^TMP($J,"RA WFR","S",Division,"WF",Wasted Film Size)=Subtotal
10 ;
11SETUP ; Setup variables
12 N RAIEN S RADIV=+$P($G(^RA(79,+$P($G(RARP0),U,3),0)),U)
13 S RADIV=$P($G(^DIC(4,RADIV,0)),U),RAEXST=+$P($G(RAEX0),U,3)
14 S RAEXST(0)=$G(^RA(72,+$P($G(RAEX0),U,3),0)),RAIMG=+$P(RAEXST(0),U,7)
15 S RAIMG=$P($G(^RA(79.2,RAIMG,0)),U) ;derive i-type by xam status
16 ; Check user access for division and imaging type
17 Q:'$D(^TMP($J,"RA D-TYPE",RADIV))!('$D(^TMP($J,"RA I-TYPE",RAIMG)))
18 S RAIEN=0,RADIV("X")=$G(RADIV)
19 Q:RADIV("X")']""
20 F S RAIEN=$O(^RADPT(RADFN,"DT",RADTI,"P",RAEX,"F",RAIEN)) Q:RAIEN'>0 D Q:RAXIT
21 . Q:$G(^RADPT(RADFN,"DT",RADTI,"P",RAEX,"F",RAIEN,0))']""
22 . S RAFLM0=$G(^RADPT(RADFN,"DT",RADTI,"P",RAEX,"F",RAIEN,0))
23 . S RAFLMS=+$P(RAFLM0,U),RAFLMNUM=+$P(RAFLM0,U,2),RATECH=+$P(RAFLM0,U,3)
24 . S RATAG=$S($D(^RA(78.4,"AW",1,RAFLMS)):"+",1:"")
25 . D STORE ; Store off data
26 . Q
27 Q
28STORE ; Store data into '^TMP($J,"RA WFR")'
29 I $D(ZTQUEUED) D STOPCHK^RAUTL9 S:$G(ZTSTOP)=1 RAXIT=1 Q:RAXIT
30 S RAFLMS=$E($P($G(^RA(78.4,RAFLMS,0)),U),1,25)
31 S RATECH=$E($P($G(^VA(200,RATECH,0)),U),1,25)
32 Q:(RAFLMS']"")
33 S:RAIMG']"" RAIMG="<<< Missing Data >>>"
34 S:RATECH']"" RATECH="<<< Missing Data >>>"
35 D STORE1 ; store off data
36 Q
37STORE1 ; Store data in 'TMP' global [ non-summary "NS"/summary data only "S" ]
38 I $D(ZTQUEUED) D STOPCHK^RAUTL9 S:$G(ZTSTOP)=1 RAXIT=1 Q:RAXIT
39 S ^TMP($J,"RA WFR","S",RADIV("X"))=+$G(^TMP($J,"RA WFR","S",RADIV("X")))+RAFLMNUM
40 S:RATAG="+" ^TMP($J,"RA WFR","S",RADIV("X"),"WF",RAFLMS)=+$G(^TMP($J,"RA WFR","S",RADIV("X"),"WF",RAFLMS))+RAFLMNUM
41 S:RATAG'="+" ^TMP($J,"RA WFR","S",RADIV("X"),"F",RAFLMS)=+$G(^TMP($J,"RA WFR","S",RADIV("X"),"F",RAFLMS))+RAFLMNUM
42 Q:RASYN ; Quit if summary data only
43 S ^TMP($J,"RA WFR","NS",RADIV("X"))=+$G(^TMP($J,"RA WFR","NS",RADIV("X")))+RAFLMNUM
44 S ^TMP($J,"RA WFR","NS",RADIV("X"),"I",RAIMG)=+$G(^TMP($J,"RA WFR","NS",RADIV("X"),"I",RAIMG))+RAFLMNUM
45 S:RATAG="+" ^TMP($J,"RA WFR","NS",RADIV("X"),"I",RAIMG,"WF",RAFLMS)=+$G(^TMP($J,"RA WFR","NS",RADIV("X"),"I",RAIMG,"WF",RAFLMS))+RAFLMNUM
46 S:RATAG'="+" ^TMP($J,"RA WFR","NS",RADIV("X"),"I",RAIMG,"F",RAFLMS)=+$G(^TMP($J,"RA WFR","NS",RADIV("X"),"I",RAIMG,"F",RAFLMS))+RAFLMNUM
47 Q
48COMPSUM ; Compile statistics and print for 'Summary' report
49 N RAHDRFG,RATIO,RACINE,RAF0,RAUSED,X,X1,X2,Y0,Y1,Y2,Y3
50 S RAHDRFG=0,X="" F S X=$O(^TMP($J,"RA WFR","S",X)) Q:X']""!(RAXIT) D
51 . D SUMMARY(X)
52 . Q
53 Q
54SUMMARY(X) ; display data for summary report
55 S Y0=+$G(^TMP($J,"RA WFR","S",X)) ; # of all films within time frame
56 S RADIV=X,(Y1,Y3)=0,X1=""
57 I RAHDRFG S RAXIT=$$EOS^RAUTL5 Q:RAXIT
58 D HDR^RAWFR3
59 F S X1=$O(^TMP($J,"RA WFR","S",X,"WF",X1)) Q:X1']""!(RAXIT) D
60 . Q:'$D(^TMP($J,"RA WFR","S",X,"WF",X1))
61 . S RAUSED=+$O(^RA(78.4,"B",X1,0)) Q:'RAUSED
62 . S RAUSED=$P($G(^RA(78.4,RAUSED,0)),U,5)
63 . S RAF0=$G(^RA(78.4,RAUSED,0))
64 . S RAUSED=$P(RAF0,U),RACINE=$S($P(RAF0,U,2)="Y":1,1:0)
65 . S Y2=+$G(^TMP($J,"RA WFR","S",X,"F",RAUSED))
66 . S Y0=+$G(^TMP($J,"RA WFR","S",X,"WF",X1))
67 . I 'RACINE S Y3=Y3+Y2,Y1=Y1+Y0
68 . S RATIO=$S((Y0+Y2)>0:$J((Y0/(Y0+Y2))*100,5,1),1:0)
69 . W !,X1,?$S(IOM=132:60,1:35),Y2
70 . W ?$S(IOM=132:75,1:45),Y0,?$S(IOM=132:100,1:60),RATIO
71 . I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5 Q:RAXIT D HDR^RAWFR3
72 . Q
73 Q:RAXIT
74 W !!?$S(IOM=132:10,1:5),"Subtotals:"
75 W ?$S(IOM=132:60,1:35),$S('Y3:"",1:Y3),?$S(IOM=132:75,1:45),Y1
76 W ?$S(IOM=132:100,1:60),$S((Y1+Y3)>0:$J((Y1/(Y1+Y3))*100,5,1),1:0)
77 S RAHDRFG=1 W !,RALINE
78 D DISPLAY^RAWFR4(X) Q:RAXIT
79 I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5 Q:RAXIT D HDR^RAWFR3
80 W !!?5,"* Cine data not included in totals."
81 Q
Note: See TracBrowser for help on using the repository browser.