RAWKLU3 ;HISC/GJC-physician wRVU (scaled too) by procedure ;10/26/05 14:57 [3/15/06 12:30pm]
;;5.0;Radiology/Nuclear Medicine;**64,77**;Mar 16, 1998;Build 7
;
;03/28/07 KAM/BAY Remedy Call 179232 Patch RA*5*77
; Add note to header if current calendar year data was
; not used in the report creation and added default
; scaling factors
;
;DBIA#:2541 ($$KSP^XUPARAM) returns the DEFAULT INSTITUTION (#217)
; from the KERNEL SYSTEM PARAMETERS (#8989.3) file.
;DBIA#:2171 ($$NAME^XUAF4) resolves the DEFAULT INSTITUTION value into
; the name of the facility
;DBIA#:10063 ($$S^%ZTLOAD)
;DBIA#:10103 ($$FMTE^XLFDT) & ($$NOW^XLFDT)
;DBIA#:10104 ($$CJ^XLFSTR)
;
EN ;entry point; called from RAWKLU2...
S RAFAC=$$NAME^XUAF4(+$$KSP^XUPARAM("INST"))
S:RAFAC="" RAFAC="***undefined facility name***"
S $P(RALN,"-",IOM+1)="",(RACNT,RAPG,RAXIT)=0
S RAHDR="IMAGING PHYSICIAN "_$S(RASCLD=1:"SCALED",1:"UN-SCALED")_" wRVU SUMMARY BY CPT"
S RARDATE=$$FMTE^XLFDT($$NOW^XLFDT,"1D")
;
;get the data from the global array and print it...
D HDR S RASTF=""
F S RASTF=$O(^TMP($J,"RA BY STFPHYS",RASTF)) Q:RASTF="" D Q:RAXIT D PHYTTL
.S RADAT(0)=$G(^TMP($J,"RA BY STFPHYS",RASTF))
.S RATTLXP=$P(RADAT(0),U),RATLRVUP=$P(RADAT(0),U,2)
.W !,RASTF S RACPT=""
.F S RACPT=$O(^TMP($J,"RA BY STFPHYS",RASTF,RACPT)) Q:RACPT="" D Q:RAXIT
..S RAWRVU=""
..F S RAWRVU=$O(^TMP($J,"RA BY STFPHYS",RASTF,RACPT,RAWRVU)) Q:RAWRVU="" D Q:RAXIT
...S RAPRC=""
...F S RAPRC=$O(^TMP($J,"RA BY STFPHYS",RASTF,RACPT,RAWRVU,RAPRC)) Q:RAPRC="" D Q:RAXIT
....S RADAT(1)=$G(^TMP($J,"RA BY STFPHYS",RASTF,RACPT,RAWRVU,RAPRC))
....S RATTLX=$P(RADAT(1),U,2) ;total # of exams
....S RATTLRVU=$P(RADAT(1),U,3) ;total wRVU for a multiple occurances of the same CPT
....S RACNT=RACNT+1 S:RACNT#500=0 (RAXIT,ZTSTOP)=$$S^%ZTLOAD() Q:RAXIT
....I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5() Q:RAXIT D HDR
....W !?2,RACPT,?12,$E(RAPRC,1,35),?50,$J(RAWRVU,6,2),?58,$J(RATTLX,8,0),?70,$J(RATTLRVU,8,2)
....Q
...Q
..Q
.Q
;
I RAXIT D XIT Q
I 'RACNT W !,$$CJ^XLFSTR("No data found for this report",IOM) D XIT Q
;
DSPSFTR ;display CY i-type scaling factors if appropriate
;04/13/2007 KAM/BAY RA*5*77 added default scaling factors
I RASCLD=1 S RASFACTR="" D
.I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5() Q:RAXIT D HDR
.W !!,"For calendar year "_($E(DT,1,3)+1700)_" the following scaling factors apply:"
.S I=0
. ;04/13/07 KAM/BAY RA*5*77 Modified next line to loop thru all imaging types
.F S I=$O(^RA(79.2,I)) Q:'I D Q:RAXIT
..S I(0)=$G(^RA(79.2,I,0))
..I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5() Q:RAXIT D HDR
.. ;04/13/07 KAM/BAY Added $S to next line
.. W !,$P(I(0),U),?34,$P(I(0),U,3),?49,$S($O(^RA(79.2,I,"CY",0))>0:$$SFCTR^RAWRVUP(I,DT),1:"1.00 (default)")
..Q
.Q
XIT ;exit and kill variables
K I,RACNT,RACPT,RADAT,RAFAC,RAHDR,RAI,RALN,RAPG,RAPRC,RARDATE,RASFACTR
K RASTF,RATLRVUP,RATTLRVU,RATTLX,RATTLXP,RAWRVU
Q
;
HDR ; Header for our report
W:RAPG!($E(IOST,1,2)="C-") @IOF
S RAPG=RAPG+1
W !?(IOM-$L(RAHDR)\2),RAHDR
W !,"Run Date: ",RARDATE,?68,"Page: ",RAPG
W !,"Facility: ",RAFAC,?41,"Date Range: ",RABGDTX_" - "_RAENDTX
;header formatting logic for CPT scaled/un-scaled wRVU reports
;03/28/07 KAM/BAY RA*5*77/179232 Added next 2 lines
I $G(RACYFLG) D
. W !,?7,"***This report was prepared with "_$$LASTCY^FBAAFSR()_" Calendar Year RVU Data***"
W:'$D(RASFACTR)#2 !!,"Staff Physician",?58,"Total #",?73,"Total",!?2,"CPT Code",?12,"Procedure",?51,$S(RASCLD=1:"SwRVU",1:" wRVU"),?58,"of exams",?73,$S(RASCLD=1:"SwRVU",1:" wRVU")
W:$D(RASFACTR)#2 !,"Imaging Type",?34,"Abbreviation",?49,"wRVU scaling factor"
W !,RALN
Q
;
PHYTTL ;print the procedure & wRVU totals for the staff physician
I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5() Q:RAXIT D HDR
W !?59,"-------",?71,"-------",!?58,$J(RATTLXP,8,0),?70,$J(RATLRVUP,8,2)
Q
;
RAWKLU3 ;HISC/GJC-physician wRVU (scaled too) by procedure ;10/26/05 14:57 [3/15/06 12:30pm]
+1 ;;5.0;Radiology/Nuclear Medicine;**64,77**;Mar 16, 1998;Build 7
+2 ;
+3 ;03/28/07 KAM/BAY Remedy Call 179232 Patch RA*5*77
+4 ; Add note to header if current calendar year data was
+5 ; not used in the report creation and added default
+6 ; scaling factors
+7 ;
+8 ;DBIA#:2541 ($$KSP^XUPARAM) returns the DEFAULT INSTITUTION (#217)
+9 ; from the KERNEL SYSTEM PARAMETERS (#8989.3) file.
+10 ;DBIA#:2171 ($$NAME^XUAF4) resolves the DEFAULT INSTITUTION value into
+11 ; the name of the facility
+12 ;DBIA#:10063 ($$S^%ZTLOAD)
+13 ;DBIA#:10103 ($$FMTE^XLFDT) & ($$NOW^XLFDT)
+14 ;DBIA#:10104 ($$CJ^XLFSTR)
+15 ;
EN ;entry point; called from RAWKLU2...
+1 SET RAFAC=$$NAME^XUAF4(+$$KSP^XUPARAM("INST"))
+2 IF RAFAC=""
SET RAFAC="***undefined facility name***"
+3 SET $PIECE(RALN,"-",IOM+1)=""
SET (RACNT,RAPG,RAXIT)=0
+4 SET RAHDR="IMAGING PHYSICIAN "_$SELECT(RASCLD=1:"SCALED",1:"UN-SCALED")_" wRVU SUMMARY BY CPT"
+5 SET RARDATE=$$FMTE^XLFDT($$NOW^XLFDT,"1D")
+6 ;
+7 ;get the data from the global array and print it...
+8 DO HDR
SET RASTF=""
+9 FOR
SET RASTF=$ORDER(^TMP($JOB,"RA BY STFPHYS",RASTF))
IF RASTF=""
QUIT
Begin DoDot:1
+10 SET RADAT(0)=$GET(^TMP($JOB,"RA BY STFPHYS",RASTF))
+11 SET RATTLXP=$PIECE(RADAT(0),U)
SET RATLRVUP=$PIECE(RADAT(0),U,2)
+12 WRITE !,RASTF
SET RACPT=""
+13 FOR
SET RACPT=$ORDER(^TMP($JOB,"RA BY STFPHYS",RASTF,RACPT))
IF RACPT=""
QUIT
Begin DoDot:2
+14 SET RAWRVU=""
+15 FOR
SET RAWRVU=$ORDER(^TMP($JOB,"RA BY STFPHYS",RASTF,RACPT,RAWRVU))
IF RAWRVU=""
QUIT
Begin DoDot:3
+16 SET RAPRC=""
+17 FOR
SET RAPRC=$ORDER(^TMP($JOB,"RA BY STFPHYS",RASTF,RACPT,RAWRVU,RAPRC))
IF RAPRC=""
QUIT
Begin DoDot:4
+18 SET RADAT(1)=$GET(^TMP($JOB,"RA BY STFPHYS",RASTF,RACPT,RAWRVU,RAPRC))
+19 ;total # of exams
SET RATTLX=$PIECE(RADAT(1),U,2)
+20 ;total wRVU for a multiple occurances of the same CPT
SET RATTLRVU=$PIECE(RADAT(1),U,3)
+21 SET RACNT=RACNT+1
IF RACNT#500=0
SET (RAXIT,ZTSTOP)=$$S^%ZTLOAD()
IF RAXIT
QUIT
+22 IF $Y>(IOSL-4)
SET RAXIT=$$EOS^RAUTL5()
IF RAXIT
QUIT
DO HDR
+23 WRITE !?2,RACPT,?12,$EXTRACT(RAPRC,1,35),?50,$JUSTIFY(RAWRVU,6,2),?58,$JUSTIFY(RATTLX,8,0),?70,$JUSTIFY(RATTLRVU,8,2)
+24 QUIT
End DoDot:4
IF RAXIT
QUIT
+25 QUIT
End DoDot:3
IF RAXIT
QUIT
+26 QUIT
End DoDot:2
IF RAXIT
QUIT
+27 QUIT
End DoDot:1
IF RAXIT
QUIT
DO PHYTTL
+28 ;
+29 IF RAXIT
DO XIT
QUIT
+30 IF 'RACNT
WRITE !,$$CJ^XLFSTR("No data found for this report",IOM)
DO XIT
QUIT
+31 ;
DSPSFTR ;display CY i-type scaling factors if appropriate
+1 ;04/13/2007 KAM/BAY RA*5*77 added default scaling factors
+2 IF RASCLD=1
SET RASFACTR=""
Begin DoDot:1
+3 IF $Y>(IOSL-4)
SET RAXIT=$$EOS^RAUTL5()
IF RAXIT
QUIT
DO HDR
+4 WRITE !!,"For calendar year "_($EXTRACT(DT,1,3)+1700)_" the following scaling factors apply:"
+5 SET I=0
+6 ;04/13/07 KAM/BAY RA*5*77 Modified next line to loop thru all imaging types
+7 FOR
SET I=$ORDER(^RA(79.2,I))
IF 'I
QUIT
Begin DoDot:2
+8 SET I(0)=$GET(^RA(79.2,I,0))
+9 IF $Y>(IOSL-4)
SET RAXIT=$$EOS^RAUTL5()
IF RAXIT
QUIT
DO HDR
+10 ;04/13/07 KAM/BAY Added $S to next line
+11 WRITE !,$PIECE(I(0),U),?34,$PIECE(I(0),U,3),?49,$SELECT($ORDER(^RA(79.2,I,"CY",0))>0:$$SFCTR^RAWRVUP(I,DT),1:"1.00 (default)")
+12 QUIT
End DoDot:2
IF RAXIT
QUIT
+13 QUIT
End DoDot:1
XIT ;exit and kill variables
+1 KILL I,RACNT,RACPT,RADAT,RAFAC,RAHDR,RAI,RALN,RAPG,RAPRC,RARDATE,RASFACTR
+2 KILL RASTF,RATLRVUP,RATTLRVU,RATTLX,RATTLXP,RAWRVU
+3 QUIT
+4 ;
HDR ; Header for our report
+1 IF RAPG!($EXTRACT(IOST,1,2)="C-")
WRITE @IOF
+2 SET RAPG=RAPG+1
+3 WRITE !?(IOM-$LENGTH(RAHDR)\2),RAHDR
+4 WRITE !,"Run Date: ",RARDATE,?68,"Page: ",RAPG
+5 WRITE !,"Facility: ",RAFAC,?41,"Date Range: ",RABGDTX_" - "_RAENDTX
+6 ;header formatting logic for CPT scaled/un-scaled wRVU reports
+7 ;03/28/07 KAM/BAY RA*5*77/179232 Added next 2 lines
+8 IF $GET(RACYFLG)
Begin DoDot:1
+9 WRITE !,?7,"***This report was prepared with "_$$LASTCY^FBAAFSR()_" Calendar Year RVU Data***"
End DoDot:1
+10 IF '$DATA(RASFACTR)#2
WRITE !!,"Staff Physician",?58,"Total #",?73,"Total",!?2,"CPT Code",?12,"Procedure",?51,$SELECT(RASCLD=1:"SwRVU",1:" wRVU"),?58,"of exams",?73,$SELECT(RASCLD=1:"SwRVU",1:" wRVU")
+11 IF $DATA(RASFACTR)#2
WRITE !,"Imaging Type",?34,"Abbreviation",?49,"wRVU scaling factor"
+12 WRITE !,RALN
+13 QUIT
+14 ;
PHYTTL ;print the procedure & wRVU totals for the staff physician
+1 IF $Y>(IOSL-4)
SET RAXIT=$$EOS^RAUTL5()
IF RAXIT
QUIT
DO HDR
+2 WRITE !?59,"-------",?71,"-------",!?58,$JUSTIFY(RATTLXP,8,0),?70,$JUSTIFY(RATLRVUP,8,2)
+3 QUIT
+4 ;
