- 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 Feb 19, 2025@00:06:53 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