Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RAWKLU1

RAWKLU1.m

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