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

RAWKLU2.m

Go to the documentation of this file.
  1. RAWKLU2 ;HISC/GJC-physician wRVU (scaled too) by procedure ; Sep 09, 2021@08:05:17
  1. ;;5.0;Radiology/Nuclear Medicine;**64,77,91,184**;Mar 16, 1998;Build 2
  1. ;01/23/08 BAY/KAM Remedy Call 227583 Patch *91 Change RVU Reports to
  1. ; use Report End Date instead of Current date when setting
  1. ; the flag to determine if necessary to use last year's RVU
  1. ; data and retrieve RVU data by Verified date instead of
  1. ; Exam date
  1. ;
  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
  1. ;
  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 and 1996
  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) ;Identifies the option that the user wishes to execute.
  1. ;input: RASCLD=zero for non-scaled wRVU, & one for the scaled wRVU
  1. ; report.
  1. ;
  1. K ^TMP($J,"RA STFPHYS"),^TMP("RA STFPHYS-IEN",$J)
  1. ;
  1. PHYST ;allow the user to select one/many/all physicians
  1. ;(w/ staff classification) ;DBIA#: 10060
  1. S RADIC="^VA(200,",RADIC(0)="QEAMZ",RAUTIL="RA STFPHYS"
  1. S RADIC("A")="Select Physician: ",RADIC("B")="All"
  1. S RADIC("S")="I $D(^VA(200,""ARC"",""S"",+Y))\10"
  1. W !! D EN1^RASELCT(.RADIC,RAUTIL) K %W,%Y1,DIC,RADIC,RAUTIL,X,Y
  1. ;did the user select physicians to compile data on? if not, quit
  1. I $O(^TMP($J,"RA STFPHYS",""))="" D Q
  1. .W !!?3,$C(7),"Staff Physician data was not selected."
  1. .Q
  1. ;
  1. ;build a new staff physician array (the other array is subscripted by
  1. ;physician name then IEN) subscripting by staff physician IEN this
  1. ;allows us to check the IEN of the staff physician selected by the
  1. ;user against the IEN of the staff physician on the exam record
  1. S X="" F S X=$O(^TMP($J,"RA STFPHYS",X)) Q:X="" D
  1. .S Y=0
  1. .F S Y=$O(^TMP($J,"RA STFPHYS",X,Y)) Q:'Y S ^TMP("RA STFPHYS-IEN",$J,Y)=""
  1. .Q
  1. ;
  1. K ^TMP($J,"RA STFPHYS") S RADATE=$$FMTE^XLFDT($$NOW^XLFDT\1,1)
  1. ;
  1. STRTDT ;Prompt the user for the starting verified date
  1. S RASTART=$$STRTDT^RAWKLU1(RADATE,2110101)
  1. I RASTART=-1 D XIT Q
  1. S RABGDTI=$P(RASTART,U),RABGDTX=$P(RASTART,U,2),RAMBGDT=RABGDTI-.0001
  1. ;need inv. verified date to search ^RARPT("AA",
  1. S RAMBGDT=9999999.9999-RABGDTI
  1. K RASTART
  1. ;
  1. ENDDT ;Prompt the user for the ending verified date
  1. S RAEND=$$ENDDT^RAWKLU1(RABGDTI,RABGDTX)
  1. I RAEND=-1 D XIT Q
  1. S RAENDTI=$P(RAEND,U),RAENDTX=$P(RAEND,U,2),RAMENDT=RAENDTI+.9999
  1. ;need inv. verified date to search ^RARPT("AA",
  1. S RAMENDT=9999999.9999-RAMENDT
  1. K RAEND
  1. ;
  1. F I="^TMP(""RA STFPHYS-IEN"",$J,","RADATE","RAB*","RAM*","RAE*","RASCLD" S ZTSAVE(I)=""
  1. S I="RA print procedures, wRVUs, and their totals for a physician"
  1. D EN^XUTMDEVQ("START^RAWKLU2",I,.ZTSAVE,,1)
  1. I +$G(ZTSK)>0 W !!,"Task Number: "_ZTSK,!
  1. K I,ZTSAVE,ZTSK
  1. Q
  1. ;
  1. START ;check exams based on criteria input by user; physician & exam D/T
  1. ;eliminate the exam record is one of the following conditions is true:
  1. ;1-the status of the exam is 'Cancelled'
  1. ;2-the physician(s) selected are not the primary staff for the exam
  1. ;
  1. S:$D(ZTQUEUED)#2 ZTREQ="@"
  1. K ^TMP($J,"RA BY STFPHYS")
  1. ;03/28/07 KAM/BAY Remedy Call 179232 Added RACYFLG to next line
  1. S RARPTVDT=RAMBGDT,(RACNT,RAXIT,RACYFLG)=0
  1. ;03/28/07 KAM/BAY RA*5*77/179232 Added Fee Basis Data Check
  1. D CHKCY
  1. F S RARPTVDT=$O(^RARPT("AA",RARPTVDT),-1) Q:'RARPTVDT!(RARPTVDT<RAMENDT) D Q:RAXIT
  1. .S RARPTIEN=0
  1. .F S RARPTIEN=$O(^RARPT("AA",RARPTVDT,RARPTIEN)) Q:'RARPTIEN D Q:RAXIT
  1. ..S RARPT=$G(^RARPT(RARPTIEN,0)),RADFN=+$P(RARPT,U,2),RADTE=+$P(RARPT,U,3)
  1. ..S RADTI=9999999.9999-RADTE,RA7002=$G(^RADPT(RADFN,"DT",RADTI,0))
  1. ..S RAXAMDT=+$P(RA7002,U) Q:'RAXAMDT
  1. ..;must check every exam registered for this exam date/time; we might have a printset
  1. ..S RACNI=0 F S RACNI=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI)) Q:'RACNI D XAM
  1. ..Q
  1. .Q
  1. D EN^RAWKLU3 ;output the report
  1. D XIT
  1. Q
  1. ;
  1. XAM ; get exam information; procedure name, exam status order #, int. staff phys...
  1. S RA7003=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)) Q:'RA7003
  1. Q:$P(RA7003,U,17)'=RARPTIEN ;exam references a different report!
  1. S RAPRCIEN=+$P(RA7003,U,2) Q:'RAPRCIEN
  1. S RAPRCIEN(0)=$P($G(^RAMIS(71,RAPRCIEN,0)),U) Q:RAPRCIEN(0)=""
  1. S RACNT=RACNT+1
  1. ;
  1. ;did the user stop the task? Check every five hundred records...
  1. S:RACNT#500=0 (RAXIT,ZTSTOP)=$$S^%ZTLOAD() Q:RAXIT
  1. ;
  1. ;1-begin exam status check
  1. Q:$P($G(^RA(72,+$P(RA7003,U,3),0)),U,3)=0 ;cancelled...
  1. ;end exam status check
  1. ;
  1. ;2-begin physician check
  1. Q:'$P(RA7003,U,15) ;no physician, quit check
  1. Q:'$D(^TMP("RA STFPHYS-IEN",$J,$P(RA7003,U,15)))#2
  1. ;end physician check
  1. ;
  1. S RACPT=$P($G(^RAMIS(71,+$P(RA7003,U,2),0)),U,9) Q:'RACPT ;ptr to file #81
  1. ;
  1. ; 09/27/2006 KAM/BAY Patch RA*5*77 Changed next line to use ^RACPTMSC
  1. S RACPT=$P($$NAMCODE^RACPTMSC(RACPT,RAXAMDT),U,1) ;CPT code is 1st pc
  1. ;
  1. S RASTF=$$EXTERNAL^DILFD(70.03,15,,$P(RA7003,U,15))
  1. D SETARRY K RA7003,RACPT,RAPRCIEN,RASTF
  1. Q
  1. ;
  1. SETARRY ;find the wRVU value (either un-scaled or scaled) for a particular CPT
  1. ;or CPT code/CPT modifier combination. The case identifiers, CPT code
  1. ;(RACPT), & exam date (RAXAMDT) are known.
  1. ;
  1. ;get CPT code modifier string
  1. S RACPTMOD="",RABILAT=0
  1. I $O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"CMOD",0))>0 S RAI=0 D
  1. .F S RAI=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"CMOD",RAI)) Q:'RAI D
  1. ..S RACPTMOD(0)=+$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"CMOD",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),RAXAMDT)
  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". All exams prior to 1/1/1999 will use
  1. ;1999 wRVU values for their calculations.
  1. ;03/28/2007 KAM/BAY Rem Call 179232 Added RACYFLG to $S in next line
  1. ;01/23/2008 KAM/BAY RA*5*91 Remedy Call 227583 Changed the next line
  1. ; to use the Verified date instead of the exam date
  1. S RAWRVU=$$RVU^FBRVU(RACPT,RACPTMOD,$S((9999999.9999-RARPTVDT)<2990101:2990101,RACYFLG:(9999999.9999-RARPTVDT)-10000,1:(9999999.9999-RARPTVDT)))
  1. ;09/27/2006 KAM/BAY RA*5*77 Remedy Call 154793
  1. I $P(RAWRVU,U,2)=0,RACPTMOD="" D
  1. . ;01/23/2008 KAM/BAY RA*5*91 Remedy Call 227583 Changed next line
  1. . ; to use the Verified date instead of the exam date
  1. . S RAWRVU=$$RVU^FBRVU(RACPT,26,$S((9999999.9999-RARPTVDT)<2990101:2990101,RACYFLG:(9999999.9999-RARPTVDT)-10000,1:(9999999.9999-RARPTVDT)))
  1. I $P(RAWRVU,U)=1 D
  1. .;apply bilateral multiplier if appropriate
  1. .S:RABILAT RAWRVU=+$P(RAWRVU,U,2)*2 ;p184/KLM plus to convert NULL value to 0 (prevents error)
  1. .;or not...
  1. .S:'RABILAT RAWRVU=+$P(RAWRVU,U,2) ;p184
  1. .I RASCLD S RAWRVU=RAWRVU*$$SFCTR^RAWRVUP($P(RA7002,U,2),RAXAMDT)
  1. .Q
  1. ;
  1. E S RAWRVU=0 ;status some other value than 1; "in error"
  1. S:RAWRVU>0 RAWRVU=$J(RAWRVU,1,2) ;do not round the value...
  1. ;
  1. ;^TMP($J,"RA BY STFPHYS",RASTF)=total # procedures^wRVU total(all proc)
  1. ;^TMP($J,"RA BY STFPHYS",RASTF,RACPT,RAWRVU,RAPRCIEN(0))=^total # RACPT^
  1. ; total # RAWRVU
  1. ;
  1. S:'$D(^TMP($J,"RA BY STFPHYS",RASTF))#2 ^(RASTF)="0^0"
  1. S $P(^TMP($J,"RA BY STFPHYS",RASTF),U)=$P(^TMP($J,"RA BY STFPHYS",RASTF),U)+1
  1. S $P(^TMP($J,"RA BY STFPHYS",RASTF),U,2)=$P(^TMP($J,"RA BY STFPHYS",RASTF),U,2)+RAWRVU
  1. S:'$D(^TMP($J,"RA BY STFPHYS",RASTF,RACPT,RAWRVU,RAPRCIEN(0)))#2 ^(RAPRCIEN(0))="^0^0"
  1. S $P(^TMP($J,"RA BY STFPHYS",RASTF,RACPT,RAWRVU,RAPRCIEN(0)),U,2)=+$P($G(^TMP($J,"RA BY STFPHYS",RASTF,RACPT,RAWRVU,RAPRCIEN(0))),U,2)+1
  1. S $P(^TMP($J,"RA BY STFPHYS",RASTF,RACPT,RAWRVU,RAPRCIEN(0)),U,3)=RAWRVU*(+$P(^TMP($J,"RA BY STFPHYS",RASTF,RACPT,RAWRVU,RAPRCIEN(0)),U,2))
  1. ;
  1. K RA813,RABILAT,RACPTMOD,RAI,RAWRVU
  1. Q
  1. ;
  1. XIT ;kill variables and exit
  1. W:$G(ZTSTOP)=1 !,$$CJ^XLFSTR("USER STOPPED PROCESS THROUGH TASKMAN",IOM)
  1. K DIR,DIROUT,DIRUT,DTOUT,DUOUT,RA7002,RABGDTI,RABGDTX,RACNI,RACNT,RADATE
  1. K RADFN,RADTE,RADTI,RAENDTI,RAENDTX,RAMBGDT,RAMENDT,RAQUIT,RARPT,RARPTIEN
  1. K RARPTVDT,RAXAMDT,RAXIT,X,Y,RACYFLG
  1. K ^TMP("RA STFPHYS-IEN",$J),^TMP($J,"RA BY STFPHYS")
  1. Q
  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
  1. ;01/23/2008 BAY/KAM RA*5*91 Rem 227593 Changed next line to use the
  1. ; Report end date when setting variable RACYFLG
  1. I $$LASTCY^FBAAFSR()<+$P(RAENDTX,",",2) S RACYFLG=1
  1. Q