RAWKLU1 ;HISC/GJC-physician workload statistics by wRVU or CPT ;10/26/05 14:57
;;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 used in the report creation and add default
; scaling factors to print
;
;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)
;
EN ;entry point; called from RAWKLU...
S RAFAC=$$NAME^XUAF4(+$$KSP^XUPARAM("INST"))
S:RAFAC="" RAFAC="***undefined facility name***"
S $P(RALN,"-",IOM+1)="",(RACNT,RAPG)=0
S RAHDR="IMAGING PHYSICIAN WORKLOAD SUMMARY BY "
I RARPTYP="CPT" S RAHDR=RAHDR_"NUMBER OF CPT CODES"
I RARPTYP="RVU" S RAHDR=RAHDR_$S(RASCLD=1:"SCALED ",1:"")_"PROFESSIONAL COMPONENT CMS RVU"
S RARDATE=$$FMTE^XLFDT($$NOW^XLFDT,"1D")
;
;$O through physician names; print totals...
I RARPTYP="RVU" S RATMP="("_$S(RASCLD'=1:"un-s",1:"S")_"caled wRVU)"
S RAPCE=$S(RARPTYP="CPT":3,RARPTYP="RVU"&(IOM=132):5,1:7)
S RATRUNC=$S(RARPTYP="CPT":20,RARPTYP="RVU"&(IOM=80):23,1:27)
S RAWDTH=$S(RARPTYP="CPT":5,1:8),RADEC=$S(RARPTYP="RVU":2,1:0)
D HDR S RAX=""
F S RAX=$O(^TMP($J,"RA BY STFPHYS",RAX)) Q:RAX="" D Q:RAXIT
.S RACNT=RACNT+1,RAY=$G(^TMP($J,"RA BY STFPHYS",RAX)),RATOT=0
.;did the user stop the task? Check every five hundred records...
.S:RACNT#500=0 (RAXIT,ZTSTOP)=$$S^%ZTLOAD() Q:RAXIT
.W !,$E(RAX,1,RATRUNC) ;physician name
.D WRITE(RAPCE,0,RAY,RAWDTH,RADEC)
.S RAFMAT=$P($T(CFMAT+10),";;",2,99)
.;single physician total for all i-types - adj RAWDTH for totals
.W ?$P(RAFMAT,U,RAPCE),$J(RATOT,$S(RAWDTH=8:10,1:6),RADEC)
.I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5() Q:RAXIT D HDR
.Q
;print the imaging type and physician totals...
I RAXIT D XIT Q
I 'RACNT W !,$$CJ^XLFSTR("No data found for this report",IOM) D XIT Q
I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5() Q:RAXIT D HDR
S RAY=$G(^TMP($J,"RA BY I-TYPE")),RATOT=0
W !!,"Physician Total"
D WRITE(RAPCE,0,RAY,RAWDTH,RADEC)
S RAFMAT=$P($T(CFMAT+10),";;",2,99)
;total for all physicians for all i-types - adj RAWDTH for totals
W ?$P(RAFMAT,U,RAPCE),$J(RATOT,$S(RAWDTH=8:10,1:6),RADEC) ;physician total for all i-types
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 for default
.. 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,RADEC,RAFAC,RAFMAT,RAHDR,RAI,RALN,RAPCE,RAPG,RARDATE,RASFACTR,RATAB,RATMP,RATOT
K RATRUNC,RAWDTH,RAX,RAY
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: ",$E(RAFAC,1,40),?41,"Date Range: ",RABGDTX_" - "_RAENDTX
;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***"
;header formatting logic for CPT & RVU reports
W:RARPTYP="RVU" !,$$CJ^XLFSTR(RATMP,IOM)
W:RARPTYP="CPT" ! ;CPT report
N RAPCE S RAPCE=$S(RARPTYP="CPT":2,RARPTYP="RVU"&(IOM=132):4,1:6)
I '$D(RASFACTR)#2 D
.W !,"Physician" D WRITE(RAPCE,1)
W:$D(RASFACTR)#2 !,"Imaging Type",?34,"Abbreviation",?49,"wRVU scaling factor"
W !,RALN
Q
;
STRTDT(RADATE,RAEARLY) ;Prompt the user for the starting date report verified
;RADATE-Today's date; DT-implicitly defined as today's date(internal format)
;RAEARLY-Earliest conceivable starting date
W ! K DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y N RARSLT
S DIR(0)="DA^"_RAEARLY_":"_"DT:PEX"
S DIR("A",1)="Calculate physician workload over a date range; enter a start date"
S DIR("A")="of: "
S DIR("?",1)="Workload is assigned on the date the report is verified, not the date"
S DIR("?",2)="the report is dictated.",DIR("?",3)=""
S DIR("?",4)="This is the date from which our search will begin. The starting"
S DIR("?",5)="date must not precede: "_$$FMTE^XLFDT(RAEARLY,"1D")_" and must not come after: "_RADATE_"."
S DIR("?")="Dates associated with a time will not be accepted."
S DIR("B")=RADATE D ^DIR
S:$D(DIRUT) RARSLT=-1 S:'$D(DIRUT) RARSLT=Y_U_Y(0)
K DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
Q RARSLT
;
ENDDT(RABGDTI,RABGDTX) ;Prompt the user for the ending date report verified (no greater than a
;year after the start date input by the user)
;DT-implicitly defined as today's date(internal format)
;RABGDTI-The search start date (selected by the user; internal format)
;RABGDTX-The search start date (selected by the user; external format)
W ! K DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y N RAEND,RARSLT
;is today's date 365 days or more past the start date? If yes, calculate end date
;by adding a year to the start date selected by the user
I $$FMDIFF^XLFDT(DT,RABGDTI,1)'<365 S RAEND=$$FMADD^XLFDT(RABGDTI,365,0,0,0)
;if not, default using DT (today's date)
S:'$D(RAEND)#2 RAEND=DT
S DIR(0)="DA^"_RABGDTI_":"_RAEND_":PEX"
S DIR("A")="Enter an end date of: "
S DIR("?",1)="Workload is assigned on the date the report is verified, not the date"
S DIR("?",2)="the report is dictated.",DIR("?",3)=""
S DIR("?",4)="This is the date in which our search will end. The ending date"
S DIR("?",5)="must not precede: "_RABGDTX_" and must not exceed: "_$$FMTE^XLFDT(RAEND,"1D")_"."
S DIR("?")="Dates associated with a time will not be accepted."
S DIR("B")=$$FMTE^XLFDT(RAEND,"1D") D ^DIR K DIR
S:$D(DIRUT) RARSLT=-1 S:'$D(DIRUT) RARSLT=Y_U_Y(0)
K DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
Q RARSLT
;
WRITE(RAPCE,HDR,RAY,RAWDTH,RADEC) ;Write out the column headers and the data for our reports.
;input: RAPCE=the piece of data referenced from the format string defined in CFMAT (req'd)
; HDR=1 if called from the HDR subroutine, else HDR is 0 (req'd)
; RAY=data to be printed; not a label (optional)
; RAWDTH=field width; right justified (optional)
; RADEC=number of decimal places; either zero or two (optional)
S RANGE=$S(HDR=1:10,1:9)
F RAI=1:1:RANGE S RAFMAT=$P($T(CFMAT+RAI),";;",2,99) D
.S RATAB=$P(RAFMAT,U,RAPCE) S:HDR=0 RATOT=RATOT+$P(RAY,U,RAI)
.I $P(RAFMAT,U)="NUC",((RAPCE=6)!(RAPCE=7)) W ! ;RVU on 80
.W ?RATAB,$S(HDR=1:$P(RAFMAT,U),1:$J(+$P(RAY,U,RAI),RAWDTH,RADEC))
.Q
K RANGE
Q
;
CFMAT ;ImgTyp Abbr^colabbr-cpt80^col-data80^colabbr-rvu132^col-data132^colabbr-rvu80^col-data80
;;RAD^23^21^34^29^30^25
;;MRI^29^27^45^40^40^35
;;CT^36^33^56^50^51^45
;;US^42^39^66^60^61^55
;;NUC^47^45^75^70^14^9
;;VAS^53^51^85^80^25^20
;;ANI^59^57^95^91^36^31
;;CARD^64^63^104^100^46^42
;;MAM^70^67^115^110^58^53
;;Total^75^74^125^120^70^65
;;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAWKLU1 7321 printed Apr 09, 2024@21:41:03 Page 2
RAWKLU1 ;HISC/GJC-physician workload statistics by wRVU or CPT ;10/26/05 14:57
+1 ;;5.0;Radiology/Nuclear Medicine;**64,77**;Mar 16, 1998;Build 7
+2 ;03/28/07 KAM/BAY Remedy Call 179232 Patch RA*5*77
+3 ; Add note to header if current calendar year data was
+4 ; not used used in the report creation and add default
+5 ; scaling factors to print
+6 ;
+7 ;DBIA#:2541 ($$KSP^XUPARAM) returns the DEFAULT INSTITUTION (#217)
+8 ; from the KERNEL SYSTEM PARAMETERS (#8989.3) file.
+9 ;DBIA#:2171 ($$NAME^XUAF4) resolves the DEFAULT INSTITUTION value into
+10 ; the name of the facility
+11 ;DBIA#:10063 ($$S^%ZTLOAD)
+12 ;DBIA#:10103 ($$FMTE^XLFDT) & ($$NOW^XLFDT)
+13 ;
EN ;entry point; called from RAWKLU...
+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)=0
+4 SET RAHDR="IMAGING PHYSICIAN WORKLOAD SUMMARY BY "
+5 IF RARPTYP="CPT"
SET RAHDR=RAHDR_"NUMBER OF CPT CODES"
+6 IF RARPTYP="RVU"
SET RAHDR=RAHDR_$SELECT(RASCLD=1:"SCALED ",1:"")_"PROFESSIONAL COMPONENT CMS RVU"
+7 SET RARDATE=$$FMTE^XLFDT($$NOW^XLFDT,"1D")
+8 ;
+9 ;$O through physician names; print totals...
+10 IF RARPTYP="RVU"
SET RATMP="("_$SELECT(RASCLD'=1:"un-s",1:"S")_"caled wRVU)"
+11 SET RAPCE=$SELECT(RARPTYP="CPT":3,RARPTYP="RVU"&(IOM=132):5,1:7)
+12 SET RATRUNC=$SELECT(RARPTYP="CPT":20,RARPTYP="RVU"&(IOM=80):23,1:27)
+13 SET RAWDTH=$SELECT(RARPTYP="CPT":5,1:8)
SET RADEC=$SELECT(RARPTYP="RVU":2,1:0)
+14 DO HDR
SET RAX=""
+15 FOR
SET RAX=$ORDER(^TMP($JOB,"RA BY STFPHYS",RAX))
if RAX=""
QUIT
Begin DoDot:1
+16 SET RACNT=RACNT+1
SET RAY=$GET(^TMP($JOB,"RA BY STFPHYS",RAX))
SET RATOT=0
+17 ;did the user stop the task? Check every five hundred records...
+18 if RACNT#500=0
SET (RAXIT,ZTSTOP)=$$S^%ZTLOAD()
if RAXIT
QUIT
+19 ;physician name
WRITE !,$EXTRACT(RAX,1,RATRUNC)
+20 DO WRITE(RAPCE,0,RAY,RAWDTH,RADEC)
+21 SET RAFMAT=$PIECE($TEXT(CFMAT+10),";;",2,99)
+22 ;single physician total for all i-types - adj RAWDTH for totals
+23 WRITE ?$PIECE(RAFMAT,U,RAPCE),$JUSTIFY(RATOT,$SELECT(RAWDTH=8:10,1:6),RADEC)
+24 IF $Y>(IOSL-4)
SET RAXIT=$$EOS^RAUTL5()
if RAXIT
QUIT
DO HDR
+25 QUIT
End DoDot:1
if RAXIT
QUIT
+26 ;print the imaging type and physician totals...
+27 IF RAXIT
DO XIT
QUIT
+28 IF 'RACNT
WRITE !,$$CJ^XLFSTR("No data found for this report",IOM)
DO XIT
QUIT
+29 IF $Y>(IOSL-4)
SET RAXIT=$$EOS^RAUTL5()
if RAXIT
QUIT
DO HDR
+30 SET RAY=$GET(^TMP($JOB,"RA BY I-TYPE"))
SET RATOT=0
+31 WRITE !!,"Physician Total"
+32 DO WRITE(RAPCE,0,RAY,RAWDTH,RADEC)
+33 SET RAFMAT=$PIECE($TEXT(CFMAT+10),";;",2,99)
+34 ;total for all physicians for all i-types - adj RAWDTH for totals
+35 ;physician total for all i-types
WRITE ?$PIECE(RAFMAT,U,RAPCE),$JUSTIFY(RATOT,$SELECT(RAWDTH=8:10,1:6),RADEC)
+36 IF RASCLD=1
SET RASFACTR=""
Begin DoDot:1
+37 IF $Y>(IOSL-4)
SET RAXIT=$$EOS^RAUTL5()
if RAXIT
QUIT
DO HDR
+38 WRITE !!,"For calendar year "_($EXTRACT(DT,1,3)+1700)_" the following scaling factors apply:"
+39 SET I=0
+40 ;04/13/07 KAM/BAY RA*5*77 Modified next line to loop thru all imaging types
+41 FOR
SET I=$ORDER(^RA(79.2,I))
if 'I
QUIT
Begin DoDot:2
+42 SET I(0)=$GET(^RA(79.2,I,0))
+43 IF $Y>(IOSL-4)
SET RAXIT=$$EOS^RAUTL5()
if RAXIT
QUIT
DO HDR
+44 ;04/13/07 KAM/BAY Added $S to next line for default
+45 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)")
+46 QUIT
End DoDot:2
if RAXIT
QUIT
+47 QUIT
End DoDot:1
XIT ;exit and kill variables
+1 KILL I,RACNT,RADEC,RAFAC,RAFMAT,RAHDR,RAI,RALN,RAPCE,RAPG,RARDATE,RASFACTR,RATAB,RATMP,RATOT
+2 KILL RATRUNC,RAWDTH,RAX,RAY
+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: ",$EXTRACT(RAFAC,1,40),?41,"Date Range: ",RABGDTX_" - "_RAENDTX
+6 ;03/28/07 KAM/BAY RA*5*77/179232 Added next 2 lines
+7 IF $GET(RACYFLG)
Begin DoDot:1
+8 WRITE !,?7,"***This report was prepared with "_$$LASTCY^FBAAFSR()_" Calendar Year RVU Data***"
End DoDot:1
+9 ;header formatting logic for CPT & RVU reports
+10 if RARPTYP="RVU"
WRITE !,$$CJ^XLFSTR(RATMP,IOM)
+11 ;CPT report
if RARPTYP="CPT"
WRITE !
+12 NEW RAPCE
SET RAPCE=$SELECT(RARPTYP="CPT":2,RARPTYP="RVU"&(IOM=132):4,1:6)
+13 IF '$DATA(RASFACTR)#2
Begin DoDot:1
+14 WRITE !,"Physician"
DO WRITE(RAPCE,1)
End DoDot:1
+15 if $DATA(RASFACTR)#2
WRITE !,"Imaging Type",?34,"Abbreviation",?49,"wRVU scaling factor"
+16 WRITE !,RALN
+17 QUIT
+18 ;
STRTDT(RADATE,RAEARLY) ;Prompt the user for the starting date report verified
+1 ;RADATE-Today's date; DT-implicitly defined as today's date(internal format)
+2 ;RAEARLY-Earliest conceivable starting date
+3 WRITE !
KILL DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
NEW RARSLT
+4 SET DIR(0)="DA^"_RAEARLY_":"_"DT:PEX"
+5 SET DIR("A",1)="Calculate physician workload over a date range; enter a start date"
+6 SET DIR("A")="of: "
+7 SET DIR("?",1)="Workload is assigned on the date the report is verified, not the date"
+8 SET DIR("?",2)="the report is dictated."
SET DIR("?",3)=""
+9 SET DIR("?",4)="This is the date from which our search will begin. The starting"
+10 SET DIR("?",5)="date must not precede: "_$$FMTE^XLFDT(RAEARLY,"1D")_" and must not come after: "_RADATE_"."
+11 SET DIR("?")="Dates associated with a time will not be accepted."
+12 SET DIR("B")=RADATE
DO ^DIR
+13 if $DATA(DIRUT)
SET RARSLT=-1
if '$DATA(DIRUT)
SET RARSLT=Y_U_Y(0)
+14 KILL DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+15 QUIT RARSLT
+16 ;
ENDDT(RABGDTI,RABGDTX) ;Prompt the user for the ending date report verified (no greater than a
+1 ;year after the start date input by the user)
+2 ;DT-implicitly defined as today's date(internal format)
+3 ;RABGDTI-The search start date (selected by the user; internal format)
+4 ;RABGDTX-The search start date (selected by the user; external format)
+5 WRITE !
KILL DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
NEW RAEND,RARSLT
+6 ;is today's date 365 days or more past the start date? If yes, calculate end date
+7 ;by adding a year to the start date selected by the user
+8 IF $$FMDIFF^XLFDT(DT,RABGDTI,1)'<365
SET RAEND=$$FMADD^XLFDT(RABGDTI,365,0,0,0)
+9 ;if not, default using DT (today's date)
+10 if '$DATA(RAEND)#2
SET RAEND=DT
+11 SET DIR(0)="DA^"_RABGDTI_":"_RAEND_":PEX"
+12 SET DIR("A")="Enter an end date of: "
+13 SET DIR("?",1)="Workload is assigned on the date the report is verified, not the date"
+14 SET DIR("?",2)="the report is dictated."
SET DIR("?",3)=""
+15 SET DIR("?",4)="This is the date in which our search will end. The ending date"
+16 SET DIR("?",5)="must not precede: "_RABGDTX_" and must not exceed: "_$$FMTE^XLFDT(RAEND,"1D")_"."
+17 SET DIR("?")="Dates associated with a time will not be accepted."
+18 SET DIR("B")=$$FMTE^XLFDT(RAEND,"1D")
DO ^DIR
KILL DIR
+19 if $DATA(DIRUT)
SET RARSLT=-1
if '$DATA(DIRUT)
SET RARSLT=Y_U_Y(0)
+20 KILL DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+21 QUIT RARSLT
+22 ;
WRITE(RAPCE,HDR,RAY,RAWDTH,RADEC) ;Write out the column headers and the data for our reports.
+1 ;input: RAPCE=the piece of data referenced from the format string defined in CFMAT (req'd)
+2 ; HDR=1 if called from the HDR subroutine, else HDR is 0 (req'd)
+3 ; RAY=data to be printed; not a label (optional)
+4 ; RAWDTH=field width; right justified (optional)
+5 ; RADEC=number of decimal places; either zero or two (optional)
+6 SET RANGE=$SELECT(HDR=1:10,1:9)
+7 FOR RAI=1:1:RANGE
SET RAFMAT=$PIECE($TEXT(CFMAT+RAI),";;",2,99)
Begin DoDot:1
+8 SET RATAB=$PIECE(RAFMAT,U,RAPCE)
if HDR=0
SET RATOT=RATOT+$PIECE(RAY,U,RAI)
+9 ;RVU on 80
IF $PIECE(RAFMAT,U)="NUC"
IF ((RAPCE=6)!(RAPCE=7))
WRITE !
+10 WRITE ?RATAB,$SELECT(HDR=1:$PIECE(RAFMAT,U),1:$JUSTIFY(+$PIECE(RAY,U,RAI),RAWDTH,RADEC))
+11 QUIT
End DoDot:1
+12 KILL RANGE
+13 QUIT
+14 ;
CFMAT ;ImgTyp Abbr^colabbr-cpt80^col-data80^colabbr-rvu132^col-data132^colabbr-rvu80^col-data80
+1 ;;RAD^23^21^34^29^30^25
+2 ;;MRI^29^27^45^40^40^35
+3 ;;CT^36^33^56^50^51^45
+4 ;;US^42^39^66^60^61^55
+5 ;;NUC^47^45^75^70^14^9
+6 ;;VAS^53^51^85^80^25^20
+7 ;;ANI^59^57^95^91^36^31
+8 ;;CARD^64^63^104^100^46^42
+9 ;;MAM^70^67^115^110^58^53
+10 ;;Total^75^74^125^120^70^65
+11 ;;
