RAWFR2 ;HISC/GJC-'Wasted Film Report' (2 of 4) ;4/15/96 07:12
;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
;
; *** Variable List ***
;^TMP($J,"RA WFR","NS",Division,"I",Imaging Type)=Subtotal
;^TMP($J,"RA WFR","NS",Division,"I",Imaging Type,"F",Used Film Size)=Subtotal
;^TMP($J,"RA WFR","NS",Division,"I",Imaging Type,"WF",Wasted Film Size)=Subtotal
;^TMP($J,"RA WFR","S",Division,"F",Used Film Size)=Subtotal
;^TMP($J,"RA WFR","S",Division,"WF",Wasted Film Size)=Subtotal
;
SETUP ; Setup variables
N RAIEN S RADIV=+$P($G(^RA(79,+$P($G(RARP0),U,3),0)),U)
S RADIV=$P($G(^DIC(4,RADIV,0)),U),RAEXST=+$P($G(RAEX0),U,3)
S RAEXST(0)=$G(^RA(72,+$P($G(RAEX0),U,3),0)),RAIMG=+$P(RAEXST(0),U,7)
S RAIMG=$P($G(^RA(79.2,RAIMG,0)),U) ;derive i-type by xam status
; Check user access for division and imaging type
Q:'$D(^TMP($J,"RA D-TYPE",RADIV))!('$D(^TMP($J,"RA I-TYPE",RAIMG)))
S RAIEN=0,RADIV("X")=$G(RADIV)
Q:RADIV("X")']""
F S RAIEN=$O(^RADPT(RADFN,"DT",RADTI,"P",RAEX,"F",RAIEN)) Q:RAIEN'>0 D Q:RAXIT
. Q:$G(^RADPT(RADFN,"DT",RADTI,"P",RAEX,"F",RAIEN,0))']""
. S RAFLM0=$G(^RADPT(RADFN,"DT",RADTI,"P",RAEX,"F",RAIEN,0))
. S RAFLMS=+$P(RAFLM0,U),RAFLMNUM=+$P(RAFLM0,U,2),RATECH=+$P(RAFLM0,U,3)
. S RATAG=$S($D(^RA(78.4,"AW",1,RAFLMS)):"+",1:"")
. D STORE ; Store off data
. Q
Q
STORE ; Store data into '^TMP($J,"RA WFR")'
I $D(ZTQUEUED) D STOPCHK^RAUTL9 S:$G(ZTSTOP)=1 RAXIT=1 Q:RAXIT
S RAFLMS=$E($P($G(^RA(78.4,RAFLMS,0)),U),1,25)
S RATECH=$E($P($G(^VA(200,RATECH,0)),U),1,25)
Q:(RAFLMS']"")
S:RAIMG']"" RAIMG="<<< Missing Data >>>"
S:RATECH']"" RATECH="<<< Missing Data >>>"
D STORE1 ; store off data
Q
STORE1 ; Store data in 'TMP' global [ non-summary "NS"/summary data only "S" ]
I $D(ZTQUEUED) D STOPCHK^RAUTL9 S:$G(ZTSTOP)=1 RAXIT=1 Q:RAXIT
S ^TMP($J,"RA WFR","S",RADIV("X"))=+$G(^TMP($J,"RA WFR","S",RADIV("X")))+RAFLMNUM
S:RATAG="+" ^TMP($J,"RA WFR","S",RADIV("X"),"WF",RAFLMS)=+$G(^TMP($J,"RA WFR","S",RADIV("X"),"WF",RAFLMS))+RAFLMNUM
S:RATAG'="+" ^TMP($J,"RA WFR","S",RADIV("X"),"F",RAFLMS)=+$G(^TMP($J,"RA WFR","S",RADIV("X"),"F",RAFLMS))+RAFLMNUM
Q:RASYN ; Quit if summary data only
S ^TMP($J,"RA WFR","NS",RADIV("X"))=+$G(^TMP($J,"RA WFR","NS",RADIV("X")))+RAFLMNUM
S ^TMP($J,"RA WFR","NS",RADIV("X"),"I",RAIMG)=+$G(^TMP($J,"RA WFR","NS",RADIV("X"),"I",RAIMG))+RAFLMNUM
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
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
Q
COMPSUM ; Compile statistics and print for 'Summary' report
N RAHDRFG,RATIO,RACINE,RAF0,RAUSED,X,X1,X2,Y0,Y1,Y2,Y3
S RAHDRFG=0,X="" F S X=$O(^TMP($J,"RA WFR","S",X)) Q:X']""!(RAXIT) D
. D SUMMARY(X)
. Q
Q
SUMMARY(X) ; display data for summary report
S Y0=+$G(^TMP($J,"RA WFR","S",X)) ; # of all films within time frame
S RADIV=X,(Y1,Y3)=0,X1=""
I RAHDRFG S RAXIT=$$EOS^RAUTL5 Q:RAXIT
D HDR^RAWFR3
F S X1=$O(^TMP($J,"RA WFR","S",X,"WF",X1)) Q:X1']""!(RAXIT) D
. Q:'$D(^TMP($J,"RA WFR","S",X,"WF",X1))
. S RAUSED=+$O(^RA(78.4,"B",X1,0)) Q:'RAUSED
. S RAUSED=$P($G(^RA(78.4,RAUSED,0)),U,5)
. S RAF0=$G(^RA(78.4,RAUSED,0))
. S RAUSED=$P(RAF0,U),RACINE=$S($P(RAF0,U,2)="Y":1,1:0)
. S Y2=+$G(^TMP($J,"RA WFR","S",X,"F",RAUSED))
. S Y0=+$G(^TMP($J,"RA WFR","S",X,"WF",X1))
. I 'RACINE S Y3=Y3+Y2,Y1=Y1+Y0
. S RATIO=$S((Y0+Y2)>0:$J((Y0/(Y0+Y2))*100,5,1),1:0)
. W !,X1,?$S(IOM=132:60,1:35),Y2
. W ?$S(IOM=132:75,1:45),Y0,?$S(IOM=132:100,1:60),RATIO
. I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5 Q:RAXIT D HDR^RAWFR3
. Q
Q:RAXIT
W !!?$S(IOM=132:10,1:5),"Subtotals:"
W ?$S(IOM=132:60,1:35),$S('Y3:"",1:Y3),?$S(IOM=132:75,1:45),Y1
W ?$S(IOM=132:100,1:60),$S((Y1+Y3)>0:$J((Y1/(Y1+Y3))*100,5,1),1:0)
S RAHDRFG=1 W !,RALINE
D DISPLAY^RAWFR4(X) Q:RAXIT
I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5 Q:RAXIT D HDR^RAWFR3
W !!?5,"* Cine data not included in totals."
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAWFR2 4072 printed Dec 13, 2024@02:40:37 Page 2
RAWFR2 ;HISC/GJC-'Wasted Film Report' (2 of 4) ;4/15/96 07:12
+1 ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
+2 ;
+3 ; *** Variable List ***
+4 ;^TMP($J,"RA WFR","NS",Division,"I",Imaging Type)=Subtotal
+5 ;^TMP($J,"RA WFR","NS",Division,"I",Imaging Type,"F",Used Film Size)=Subtotal
+6 ;^TMP($J,"RA WFR","NS",Division,"I",Imaging Type,"WF",Wasted Film Size)=Subtotal
+7 ;^TMP($J,"RA WFR","S",Division,"F",Used Film Size)=Subtotal
+8 ;^TMP($J,"RA WFR","S",Division,"WF",Wasted Film Size)=Subtotal
+9 ;
SETUP ; Setup variables
+1 NEW RAIEN
SET RADIV=+$PIECE($GET(^RA(79,+$PIECE($GET(RARP0),U,3),0)),U)
+2 SET RADIV=$PIECE($GET(^DIC(4,RADIV,0)),U)
SET RAEXST=+$PIECE($GET(RAEX0),U,3)
+3 SET RAEXST(0)=$GET(^RA(72,+$PIECE($GET(RAEX0),U,3),0))
SET RAIMG=+$PIECE(RAEXST(0),U,7)
+4 ;derive i-type by xam status
SET RAIMG=$PIECE($GET(^RA(79.2,RAIMG,0)),U)
+5 ; Check user access for division and imaging type
+6 if '$DATA(^TMP($JOB,"RA D-TYPE",RADIV))!('$DATA(^TMP($JOB,"RA I-TYPE",RAIMG)))
QUIT
+7 SET RAIEN=0
SET RADIV("X")=$GET(RADIV)
+8 if RADIV("X")']""
QUIT
+9 FOR
SET RAIEN=$ORDER(^RADPT(RADFN,"DT",RADTI,"P",RAEX,"F",RAIEN))
if RAIEN'>0
QUIT
Begin DoDot:1
+10 if $GET(^RADPT(RADFN,"DT",RADTI,"P",RAEX,"F",RAIEN,0))']""
QUIT
+11 SET RAFLM0=$GET(^RADPT(RADFN,"DT",RADTI,"P",RAEX,"F",RAIEN,0))
+12 SET RAFLMS=+$PIECE(RAFLM0,U)
SET RAFLMNUM=+$PIECE(RAFLM0,U,2)
SET RATECH=+$PIECE(RAFLM0,U,3)
+13 SET RATAG=$SELECT($DATA(^RA(78.4,"AW",1,RAFLMS)):"+",1:"")
+14 ; Store off data
DO STORE
+15 QUIT
End DoDot:1
if RAXIT
QUIT
+16 QUIT
STORE ; Store data into '^TMP($J,"RA WFR")'
+1 IF $DATA(ZTQUEUED)
DO STOPCHK^RAUTL9
if $GET(ZTSTOP)=1
SET RAXIT=1
if RAXIT
QUIT
+2 SET RAFLMS=$EXTRACT($PIECE($GET(^RA(78.4,RAFLMS,0)),U),1,25)
+3 SET RATECH=$EXTRACT($PIECE($GET(^VA(200,RATECH,0)),U),1,25)
+4 if (RAFLMS']"")
QUIT
+5 if RAIMG']""
SET RAIMG="<<< Missing Data >>>"
+6 if RATECH']""
SET RATECH="<<< Missing Data >>>"
+7 ; store off data
DO STORE1
+8 QUIT
STORE1 ; Store data in 'TMP' global [ non-summary "NS"/summary data only "S" ]
+1 IF $DATA(ZTQUEUED)
DO STOPCHK^RAUTL9
if $GET(ZTSTOP)=1
SET RAXIT=1
if RAXIT
QUIT
+2 SET ^TMP($JOB,"RA WFR","S",RADIV("X"))=+$GET(^TMP($JOB,"RA WFR","S",RADIV("X")))+RAFLMNUM
+3 if RATAG="+"
SET ^TMP($JOB,"RA WFR","S",RADIV("X"),"WF",RAFLMS)=+$GET(^TMP($JOB,"RA WFR","S",RADIV("X"),"WF",RAFLMS))+RAFLMNUM
+4 if RATAG'="+"
SET ^TMP($JOB,"RA WFR","S",RADIV("X"),"F",RAFLMS)=+$GET(^TMP($JOB,"RA WFR","S",RADIV("X"),"F",RAFLMS))+RAFLMNUM
+5 ; Quit if summary data only
if RASYN
QUIT
+6 SET ^TMP($JOB,"RA WFR","NS",RADIV("X"))=+$GET(^TMP($JOB,"RA WFR","NS",RADIV("X")))+RAFLMNUM
+7 SET ^TMP($JOB,"RA WFR","NS",RADIV("X"),"I",RAIMG)=+$GET(^TMP($JOB,"RA WFR","NS",RADIV("X"),"I",RAIMG))+RAFLMNUM
+8 if RATAG="+"
SET ^TMP($JOB,"RA WFR","NS",RADIV("X"),"I",RAIMG,"WF",RAFLMS)=+$GET(^TMP($JOB,"RA WFR","NS",RADIV("X"),"I",RAIMG,"WF",RAFLMS))+RAFLMNUM
+9 if RATAG'="+"
SET ^TMP($JOB,"RA WFR","NS",RADIV("X"),"I",RAIMG,"F",RAFLMS)=+$GET(^TMP($JOB,"RA WFR","NS",RADIV("X"),"I",RAIMG,"F",RAFLMS))+RAFLMNUM
+10 QUIT
COMPSUM ; Compile statistics and print for 'Summary' report
+1 NEW RAHDRFG,RATIO,RACINE,RAF0,RAUSED,X,X1,X2,Y0,Y1,Y2,Y3
+2 SET RAHDRFG=0
SET X=""
FOR
SET X=$ORDER(^TMP($JOB,"RA WFR","S",X))
if X']""!(RAXIT)
QUIT
Begin DoDot:1
+3 DO SUMMARY(X)
+4 QUIT
End DoDot:1
+5 QUIT
SUMMARY(X) ; display data for summary report
+1 ; # of all films within time frame
SET Y0=+$GET(^TMP($JOB,"RA WFR","S",X))
+2 SET RADIV=X
SET (Y1,Y3)=0
SET X1=""
+3 IF RAHDRFG
SET RAXIT=$$EOS^RAUTL5
if RAXIT
QUIT
+4 DO HDR^RAWFR3
+5 FOR
SET X1=$ORDER(^TMP($JOB,"RA WFR","S",X,"WF",X1))
if X1']""!(RAXIT)
QUIT
Begin DoDot:1
+6 if '$DATA(^TMP($JOB,"RA WFR","S",X,"WF",X1))
QUIT
+7 SET RAUSED=+$ORDER(^RA(78.4,"B",X1,0))
if 'RAUSED
QUIT
+8 SET RAUSED=$PIECE($GET(^RA(78.4,RAUSED,0)),U,5)
+9 SET RAF0=$GET(^RA(78.4,RAUSED,0))
+10 SET RAUSED=$PIECE(RAF0,U)
SET RACINE=$SELECT($PIECE(RAF0,U,2)="Y":1,1:0)
+11 SET Y2=+$GET(^TMP($JOB,"RA WFR","S",X,"F",RAUSED))
+12 SET Y0=+$GET(^TMP($JOB,"RA WFR","S",X,"WF",X1))
+13 IF 'RACINE
SET Y3=Y3+Y2
SET Y1=Y1+Y0
+14 SET RATIO=$SELECT((Y0+Y2)>0:$JUSTIFY((Y0/(Y0+Y2))*100,5,1),1:0)
+15 WRITE !,X1,?$SELECT(IOM=132:60,1:35),Y2
+16 WRITE ?$SELECT(IOM=132:75,1:45),Y0,?$SELECT(IOM=132:100,1:60),RATIO
+17 IF $Y>(IOSL-4)
SET RAXIT=$$EOS^RAUTL5
if RAXIT
QUIT
DO HDR^RAWFR3
+18 QUIT
End DoDot:1
+19 if RAXIT
QUIT
+20 WRITE !!?$SELECT(IOM=132:10,1:5),"Subtotals:"
+21 WRITE ?$SELECT(IOM=132:60,1:35),$SELECT('Y3:"",1:Y3),?$SELECT(IOM=132:75,1:45),Y1
+22 WRITE ?$SELECT(IOM=132:100,1:60),$SELECT((Y1+Y3)>0:$JUSTIFY((Y1/(Y1+Y3))*100,5,1),1:0)
+23 SET RAHDRFG=1
WRITE !,RALINE
+24 DO DISPLAY^RAWFR4(X)
if RAXIT
QUIT
+25 IF $Y>(IOSL-4)
SET RAXIT=$$EOS^RAUTL5
if RAXIT
QUIT
DO HDR^RAWFR3
+26 WRITE !!?5,"* Cine data not included in totals."
+27 QUIT
