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

RAWRVUP.m

Go to the documentation of this file.
  1. RAWRVUP ;HISC/GJC-Display procedures with their wRVU values ;10/26/05 14:57
  1. ;;5.0;Radiology/Nuclear Medicine;**64,77**;Mar 16, 1998;Build 7
  1. ;09/25/06 KAM/BAY Remedy Call 154793 PATCH *77 RVU with 0 value
  1. ; and changed CPT calls from ^ICPTCOD to ^RACPTMSC
  1. ; eliminating the need for IA's 1995 amd 1996
  1. ;03/28/07 KAM/BAY Remedy Call 179232 Patch RA*5*77
  1. ; Add check to see if current RVU data is available and if
  1. ; not use previous year RVU data and added default scaling
  1. ; factors
  1. ;
  1. ;DBIA#:4799 ($$RVU^FBRVU) return wRVU value for CPT, CPT Mod, & exam
  1. ; date/time
  1. ;DBIA#:10060 EN1^RASELCT enacts 10060 which allows lookups on the NEW
  1. ; PERSON (#200) file
  1. ;DBIA#:10063 ($$S^%ZTLOAD)
  1. ;DBIA#:10103 ($$FMTE^XLFDT) & ($$NOW^XLFDT)
  1. ;DBIA#:10104 ($$CJ^XLFSTR)
  1. ;DBIA#:1519 ($$EN^XUTMDEVQ)
  1. ;DBIA#:4432 (LASTCY^FBAAFSR) return last calendar year file
  1. ; 162.99 was updated
  1. ;
  1. EN(RASCLD) ;entry point
  1. ;input: RASCLD=one if scaled, 0 if un-scaled
  1. K ^TMP($J,"RA PROCEDURES")
  1. ;
  1. PROC ;allow the user to select one/many/all Rad/Nuc Med procedures
  1. S RADIC="^RAMIS(71,",RADIC(0)="QEAMZ",RAUTIL="RA PROCEDURES"
  1. S RADIC("A")="Select Procedures: ",RADIC("B")="All",RAXIT=0
  1. ;screen: based on user selection of procedure activity and that the
  1. ;procedure must have a CPT code (only detailed and series procedures)
  1. S RADIC("S")="I $P(^(0),U,9)" ;must have a CPT code (detailed/series)
  1. W !! D EN1^RASELCT(.RADIC,RAUTIL)
  1. S RAXIT=RAQUIT K %W,%Y1,DIC,RADIC,RAQUIT,RAUTIL,X,Y
  1. ;did the user select physicians to compile data on? if not, quit
  1. I $O(^TMP($J,"RA PROCEDURES",""))="" D D XIT Q
  1. .W !!?3,$C(7),"Rad/Nuc Med Procedures were not selected."
  1. .Q
  1. ;
  1. F I="RASCLD","^TMP($J,""RA PROCEDURES""," S ZTSAVE(I)=""
  1. S I="RA print wRVUs for Rad/Nuc Med procedures"
  1. D EN^XUTMDEVQ("START^RAWRVUP",I,.ZTSAVE,,1)
  1. I +$G(ZTSK)>0 W !!,"Task Number: "_ZTSK,!
  1. K I,ZTSAVE,ZTSK
  1. Q
  1. ;
  1. START ;
  1. S:$D(ZTQUEUED)#2 ZTREQ="@"
  1. ; 03/29/07 KAM/BAY Patch RA*5*77/179232 Added RACYFLG to next line
  1. S $P(RALN,"-",IOM+1)="",(RACNT,RAPG,RAXIT,RACYFLG)=0
  1. ;03/29/07 KAM/BAY RA*5*77/179232 Added Fee Basis Data Check
  1. D CHKCY
  1. S RARUNDT=$$FMTE^XLFDT(DT,"1P")
  1. S RAHDR="PROCEDURE CPT CODE AND"_$S(RASCLD=1:" SCALED",1:"")_" WORK RELATIVE VALUE UNITS (wRVU)"
  1. S RAX="" D HDR
  1. F S RAX=$O(^TMP($J,"RA PROCEDURES",RAX)) Q:RAX="" D Q:RAXIT
  1. .S RAY=0
  1. .F S RAY=$O(^TMP($J,"RA PROCEDURES",RAX,RAY)) Q:'RAY D Q:RAXIT
  1. ..S RACNT=RACNT+1 S:RACNT#500=0 (RAXIT,ZTSTOP)=$$S^%ZTLOAD() Q:RAXIT
  1. ..S RAMIS(0)=$G(^RAMIS(71,RAY,0))
  1. ..S RAPROC=$E($P(RAMIS(0),U),1,35) ;truncate to thirty-five chars
  1. ..S RAPTYPE=$S($P(RAMIS(0),U,6)="D":"Detailed",1:"Series")
  1. ..S RAITYPE=$P($G(^RA(79.2,+$P(RAMIS(0),U,12),0)),U,3)
  1. ..;09/27/2006 KAM/BAY RA*5*77 Changed next line to use ^RACPTMSC
  1. ..S RACPT=$P(RAMIS(0),U,9),RACPT=$P($$NAMCODE^RACPTMSC(RACPT,DT),U,1)
  1. ..;determine if there are default CPT modifiers for this procedure; if
  1. ..;so, does one indicate 'bilateral'? If bilateral multiply wRVU by two.
  1. ..S RACPTMOD="",RABILAT=0
  1. ..I $O(^RAMIS(71,RAY,"DCM",0))>0 S RAI=0 D
  1. ...F S RAI=$O(^RAMIS(71,RAY,"DCM",RAI)) Q:'RAI D
  1. ....S RACPTMOD(0)=+$G(^RAMIS(71,RAY,"DCM",RAI,0))
  1. ....;09/27/2006 KAM/BAY RA*5*77 Changed next line to use ^RACPTMSC
  1. ....S RA813(0)=$$BASICMOD^RACPTMSC(RACPTMOD(0),DT)
  1. ....I 'RABILAT,$P(RA813(0),U,2)=50 S RABILAT=1 ;bilateral multiplier=2
  1. ....S RACPTMOD=RACPTMOD_$P(RA813(0),U,2)_","
  1. ....Q
  1. ...Q
  1. ..;get wRVU value from FEE BASIS; returns a string: status^value^message
  1. ..;where status'=1 means "in error"
  1. .. ;03/29/07 KAM/BAY RA*5*77/179232 Added $S to next line
  1. ..S RAWRVU=$$RVU^FBRVU(RACPT,RACPTMOD,$S(RACYFLG:DT-10000,1:DT))
  1. .. ; 09/25/2006 Remedy call 154793 Correct 0 RVUs
  1. .. I $P(RAWRVU,U,2)=0,RACPTMOD="" D
  1. ... ;03/29/07 KAM/BAY RA*5*77/179232 Added $S to next line
  1. ... S RAWRVU=$$RVU^FBRVU(RACPT,26,$S(RACYFLG:DT-10000,1:DT))
  1. .. ;
  1. ..I $P(RAWRVU,U)=1 D
  1. ...;apply bilateral multiplier if appropriate
  1. ...S:RABILAT RAWRVU=$P(RAWRVU,U,2)*2
  1. ...;or not...
  1. ...S:'RABILAT RAWRVU=$P(RAWRVU,U,2)
  1. ...Q
  1. ..E S RAWRVU=0 ;status some other value than 1; "in error"
  1. ..;
  1. ..S:RAWRVU>0 RAWRVU=$J(RAWRVU,1,2)
  1. ..;
  1. SCALED ..;when scaled find scaled wRVU value
  1. ..I RASCLD=1,(RAWRVU>0) D
  1. ...S RASFACTR=$$SFCTR(+$P(RAMIS(0),U,12)) ;pass i-type ptr
  1. ...S RASWRVU=$J((RAWRVU*RASFACTR),1,2)
  1. ...Q
  1. ..E S RASWRVU=0 ;mult by zero
  1. ..;
  1. ..W !,RAPROC,?37,RAPTYPE,?48,RAITYPE,?58,RACPT,?68,$S(RASCLD=1:$J(RASWRVU,7,2),1:$J(RAWRVU,7,2))
  1. ..I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5() D:'RAXIT HDR
  1. ..Q
  1. .Q
  1. I 'RAXIT,(RASCLD) S RASFACTR(0)="" 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 RA*5*77 Added $S to next line
  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. .S RAXIT=$$EOS^RAUTL5()
  1. .Q
  1. D XIT
  1. Q
  1. ;
  1. HDR ; Header for our report
  1. W:RAPG!($E(IOST,1,2)="C-") @IOF
  1. S RAPG=RAPG+1 W !?(IOM-$L(RAHDR)\2),RAHDR
  1. W !,"Run Date: ",RARUNDT,?68,"Page: ",RAPG
  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. W:'$D(RASFACTR(0))#2 !!,"Procedure",?37,"Proc Type",?48,"Img Type",?58,"CPT Code",?68,$S(RASCLD=1:" S",1:" ")_"wRVU"
  1. W:$D(RASFACTR(0))#2 !!,"Imaging Type",?34,"Abbreviation",?51,"wRVU scaling factor"
  1. W !,RALN
  1. Q
  1. ;
  1. XIT ;kill variables and exit
  1. I 'RAXIT W:'RACNT !,$$CJ^XLFSTR("No data found for this report",IOM)
  1. K DILN,DTOUT,DUOUT,I,POP,RA813,RABILAT,RACNT,RACPT,RACPTMOD,RAHDR,RAI
  1. K RAITYPE,RALN,RAMIS,RAPTYPE,RAPG,RAPROC,RARUNDT,RASCLD,RASFACTR
  1. K RASWRVU,RAWRVU,RAX,RAXIT,RAY,RAYEAR,X,Y,RACYFLG
  1. K ^TMP($J,"RA PROCEDURES")
  1. Q
  1. ;
  1. SFCTR(RAITYP,RAYEAR) ;return the calendar year specific scaling factor for a
  1. ;specific imaging type
  1. ;input: RAITYP=imaging type
  1. ; RAYEAR=internal FM date/time format; resolves to current year
  1. ;return: calendar year specific scaling factor
  1. N RASF,RAYR S RAYEAR=$G(RAYEAR,DT) ;default to DT (current year)
  1. S (RAYEAR,RAYR)=$E(RAYEAR,1,3)+1700
  1. S RASF=+$O(^RA(79.2,RAITYP,"CY","B",RAYEAR,0))
  1. ;if RASF=0 for the current year, check for the most recent year
  1. I RASF=0 D
  1. .S RAYEAR=+$O(^RA(79.2,1,"CY","B",RAYEAR),-1)
  1. .S RASF=+$O(^RA(79.2,RAITYP,"CY","B",RAYEAR,0))
  1. .Q
  1. S RASF=+$P($G(^RA(79.2,RAITYP,"CY",RASF,0)),U,2)
  1. S:RASF=0 RASF=1 ;defaults to one
  1. Q $J(RASF,$L(RASF),2)_$S(RAYEAR:" ("_RAYR_")",1:"")
  1. ;
  1. CHKCY ;03/28/2007 KAM/BAY RA*5*77 Remedy Call 179232 Check for latest RVU
  1. ;data from Fee Basis
  1. S RACYFLG=0,Y=$G(DT) D DD^%DT
  1. I $$LASTCY^FBAAFSR()<$P(Y," ",3) S RACYFLG=1
  1. Q