Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RAWFR2

RAWFR2.m

Go to the documentation of this file.
  1. RAWFR2 ;HISC/GJC-'Wasted Film Report' (2 of 4) ;4/15/96 07:12
  1. ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
  1. ;
  1. ; *** Variable List ***
  1. ;^TMP($J,"RA WFR","NS",Division,"I",Imaging Type)=Subtotal
  1. ;^TMP($J,"RA WFR","NS",Division,"I",Imaging Type,"F",Used Film Size)=Subtotal
  1. ;^TMP($J,"RA WFR","NS",Division,"I",Imaging Type,"WF",Wasted Film Size)=Subtotal
  1. ;^TMP($J,"RA WFR","S",Division,"F",Used Film Size)=Subtotal
  1. ;^TMP($J,"RA WFR","S",Division,"WF",Wasted Film Size)=Subtotal
  1. ;
  1. SETUP ; Setup variables
  1. N RAIEN S RADIV=+$P($G(^RA(79,+$P($G(RARP0),U,3),0)),U)
  1. S RADIV=$P($G(^DIC(4,RADIV,0)),U),RAEXST=+$P($G(RAEX0),U,3)
  1. S RAEXST(0)=$G(^RA(72,+$P($G(RAEX0),U,3),0)),RAIMG=+$P(RAEXST(0),U,7)
  1. S RAIMG=$P($G(^RA(79.2,RAIMG,0)),U) ;derive i-type by xam status
  1. ; Check user access for division and imaging type
  1. Q:'$D(^TMP($J,"RA D-TYPE",RADIV))!('$D(^TMP($J,"RA I-TYPE",RAIMG)))
  1. S RAIEN=0,RADIV("X")=$G(RADIV)
  1. Q:RADIV("X")']""
  1. F S RAIEN=$O(^RADPT(RADFN,"DT",RADTI,"P",RAEX,"F",RAIEN)) Q:RAIEN'>0 D Q:RAXIT
  1. . Q:$G(^RADPT(RADFN,"DT",RADTI,"P",RAEX,"F",RAIEN,0))']""
  1. . S RAFLM0=$G(^RADPT(RADFN,"DT",RADTI,"P",RAEX,"F",RAIEN,0))
  1. . S RAFLMS=+$P(RAFLM0,U),RAFLMNUM=+$P(RAFLM0,U,2),RATECH=+$P(RAFLM0,U,3)
  1. . S RATAG=$S($D(^RA(78.4,"AW",1,RAFLMS)):"+",1:"")
  1. . D STORE ; Store off data
  1. . Q
  1. Q
  1. STORE ; Store data into '^TMP($J,"RA WFR")'
  1. I $D(ZTQUEUED) D STOPCHK^RAUTL9 S:$G(ZTSTOP)=1 RAXIT=1 Q:RAXIT
  1. S RAFLMS=$E($P($G(^RA(78.4,RAFLMS,0)),U),1,25)
  1. S RATECH=$E($P($G(^VA(200,RATECH,0)),U),1,25)
  1. Q:(RAFLMS']"")
  1. S:RAIMG']"" RAIMG="<<< Missing Data >>>"
  1. S:RATECH']"" RATECH="<<< Missing Data >>>"
  1. D STORE1 ; store off data
  1. Q
  1. STORE1 ; Store data in 'TMP' global [ non-summary "NS"/summary data only "S" ]
  1. I $D(ZTQUEUED) D STOPCHK^RAUTL9 S:$G(ZTSTOP)=1 RAXIT=1 Q:RAXIT
  1. S ^TMP($J,"RA WFR","S",RADIV("X"))=+$G(^TMP($J,"RA WFR","S",RADIV("X")))+RAFLMNUM
  1. S:RATAG="+" ^TMP($J,"RA WFR","S",RADIV("X"),"WF",RAFLMS)=+$G(^TMP($J,"RA WFR","S",RADIV("X"),"WF",RAFLMS))+RAFLMNUM
  1. S:RATAG'="+" ^TMP($J,"RA WFR","S",RADIV("X"),"F",RAFLMS)=+$G(^TMP($J,"RA WFR","S",RADIV("X"),"F",RAFLMS))+RAFLMNUM
  1. Q:RASYN ; Quit if summary data only
  1. S ^TMP($J,"RA WFR","NS",RADIV("X"))=+$G(^TMP($J,"RA WFR","NS",RADIV("X")))+RAFLMNUM
  1. S ^TMP($J,"RA WFR","NS",RADIV("X"),"I",RAIMG)=+$G(^TMP($J,"RA WFR","NS",RADIV("X"),"I",RAIMG))+RAFLMNUM
  1. 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
  1. 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
  1. Q
  1. COMPSUM ; Compile statistics and print for 'Summary' report
  1. N RAHDRFG,RATIO,RACINE,RAF0,RAUSED,X,X1,X2,Y0,Y1,Y2,Y3
  1. S RAHDRFG=0,X="" F S X=$O(^TMP($J,"RA WFR","S",X)) Q:X']""!(RAXIT) D
  1. . D SUMMARY(X)
  1. . Q
  1. Q
  1. SUMMARY(X) ; display data for summary report
  1. S Y0=+$G(^TMP($J,"RA WFR","S",X)) ; # of all films within time frame
  1. S RADIV=X,(Y1,Y3)=0,X1=""
  1. I RAHDRFG S RAXIT=$$EOS^RAUTL5 Q:RAXIT
  1. D HDR^RAWFR3
  1. F S X1=$O(^TMP($J,"RA WFR","S",X,"WF",X1)) Q:X1']""!(RAXIT) D
  1. . Q:'$D(^TMP($J,"RA WFR","S",X,"WF",X1))
  1. . S RAUSED=+$O(^RA(78.4,"B",X1,0)) Q:'RAUSED
  1. . S RAUSED=$P($G(^RA(78.4,RAUSED,0)),U,5)
  1. . S RAF0=$G(^RA(78.4,RAUSED,0))
  1. . S RAUSED=$P(RAF0,U),RACINE=$S($P(RAF0,U,2)="Y":1,1:0)
  1. . S Y2=+$G(^TMP($J,"RA WFR","S",X,"F",RAUSED))
  1. . S Y0=+$G(^TMP($J,"RA WFR","S",X,"WF",X1))
  1. . I 'RACINE S Y3=Y3+Y2,Y1=Y1+Y0
  1. . S RATIO=$S((Y0+Y2)>0:$J((Y0/(Y0+Y2))*100,5,1),1:0)
  1. . W !,X1,?$S(IOM=132:60,1:35),Y2
  1. . W ?$S(IOM=132:75,1:45),Y0,?$S(IOM=132:100,1:60),RATIO
  1. . I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5 Q:RAXIT D HDR^RAWFR3
  1. . Q
  1. Q:RAXIT
  1. W !!?$S(IOM=132:10,1:5),"Subtotals:"
  1. W ?$S(IOM=132:60,1:35),$S('Y3:"",1:Y3),?$S(IOM=132:75,1:45),Y1
  1. W ?$S(IOM=132:100,1:60),$S((Y1+Y3)>0:$J((Y1/(Y1+Y3))*100,5,1),1:0)
  1. S RAHDRFG=1 W !,RALINE
  1. D DISPLAY^RAWFR4(X) Q:RAXIT
  1. I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5 Q:RAXIT D HDR^RAWFR3
  1. W !!?5,"* Cine data not included in totals."
  1. Q