- 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
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAWKLU3 3951 printed Feb 19, 2025@00:07:02 Page 2
- 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 ;