RAWKLU2 ;HISC/GJC-physician wRVU (scaled too) by procedure ; Sep 09, 2021@08:05:17
;;5.0;Radiology/Nuclear Medicine;**64,77,91,184**;Mar 16, 1998;Build 2
;01/23/08 BAY/KAM Remedy Call 227583 Patch *91 Change RVU Reports to
; use Report End Date instead of Current date when setting
; the flag to determine if necessary to use last year's RVU
; data and retrieve RVU data by Verified date instead of
; Exam date
;
;03/28/07 KAM/BAY Remedy Call 179232 Patch RA*5*77
; Add check to see if current RVU data is available and if
; not use previous year RVU data
;
;09/25/06 KAM/BAY Remedy Call 154793 PATCH *77 RVU with 0 value
; and changed CPT calls from ^ICPTCOD to ^RACPTMSC
; eliminating the need for IA's 1995 and 1996
;
;DBIA#:4799 ($$RVU^FBRVU) return wRVU value for CPT, CPT Mod, & exam
; date/time
;DBIA#:10060 EN1^RASELCT enacts 10060 which allows lookups on the NEW
; PERSON (#200) file
;DBIA#:10063 ($$S^%ZTLOAD)
;DBIA#:10103 ($$FMTE^XLFDT) & ($$NOW^XLFDT)
;DBIA#:10104 ($$CJ^XLFSTR)
;DBIA#:1519 ($$EN^XUTMDEVQ)
;DBIA#:4432 (LASTCY^FBAAFSR) return last calendar year file
; 162.99 was updated
;
EN(RASCLD) ;Identifies the option that the user wishes to execute.
;input: RASCLD=zero for non-scaled wRVU, & one for the scaled wRVU
; report.
;
K ^TMP($J,"RA STFPHYS"),^TMP("RA STFPHYS-IEN",$J)
;
PHYST ;allow the user to select one/many/all physicians
;(w/ staff classification) ;DBIA#: 10060
S RADIC="^VA(200,",RADIC(0)="QEAMZ",RAUTIL="RA STFPHYS"
S RADIC("A")="Select Physician: ",RADIC("B")="All"
S RADIC("S")="I $D(^VA(200,""ARC"",""S"",+Y))\10"
W !! D EN1^RASELCT(.RADIC,RAUTIL) K %W,%Y1,DIC,RADIC,RAUTIL,X,Y
;did the user select physicians to compile data on? if not, quit
I $O(^TMP($J,"RA STFPHYS",""))="" D Q
.W !!?3,$C(7),"Staff Physician data was not selected."
.Q
;
;build a new staff physician array (the other array is subscripted by
;physician name then IEN) subscripting by staff physician IEN this
;allows us to check the IEN of the staff physician selected by the
;user against the IEN of the staff physician on the exam record
S X="" F S X=$O(^TMP($J,"RA STFPHYS",X)) Q:X="" D
.S Y=0
.F S Y=$O(^TMP($J,"RA STFPHYS",X,Y)) Q:'Y S ^TMP("RA STFPHYS-IEN",$J,Y)=""
.Q
;
K ^TMP($J,"RA STFPHYS") S RADATE=$$FMTE^XLFDT($$NOW^XLFDT\1,1)
;
STRTDT ;Prompt the user for the starting verified date
S RASTART=$$STRTDT^RAWKLU1(RADATE,2110101)
I RASTART=-1 D XIT Q
S RABGDTI=$P(RASTART,U),RABGDTX=$P(RASTART,U,2),RAMBGDT=RABGDTI-.0001
;need inv. verified date to search ^RARPT("AA",
S RAMBGDT=9999999.9999-RABGDTI
K RASTART
;
ENDDT ;Prompt the user for the ending verified date
S RAEND=$$ENDDT^RAWKLU1(RABGDTI,RABGDTX)
I RAEND=-1 D XIT Q
S RAENDTI=$P(RAEND,U),RAENDTX=$P(RAEND,U,2),RAMENDT=RAENDTI+.9999
;need inv. verified date to search ^RARPT("AA",
S RAMENDT=9999999.9999-RAMENDT
K RAEND
;
F I="^TMP(""RA STFPHYS-IEN"",$J,","RADATE","RAB*","RAM*","RAE*","RASCLD" S ZTSAVE(I)=""
S I="RA print procedures, wRVUs, and their totals for a physician"
D EN^XUTMDEVQ("START^RAWKLU2",I,.ZTSAVE,,1)
I +$G(ZTSK)>0 W !!,"Task Number: "_ZTSK,!
K I,ZTSAVE,ZTSK
Q
;
START ;check exams based on criteria input by user; physician & exam D/T
;eliminate the exam record is one of the following conditions is true:
;1-the status of the exam is 'Cancelled'
;2-the physician(s) selected are not the primary staff for the exam
;
S:$D(ZTQUEUED)#2 ZTREQ="@"
K ^TMP($J,"RA BY STFPHYS")
;03/28/07 KAM/BAY Remedy Call 179232 Added RACYFLG to next line
S RARPTVDT=RAMBGDT,(RACNT,RAXIT,RACYFLG)=0
;03/28/07 KAM/BAY RA*5*77/179232 Added Fee Basis Data Check
D CHKCY
F S RARPTVDT=$O(^RARPT("AA",RARPTVDT),-1) Q:'RARPTVDT!(RARPTVDT<RAMENDT) D Q:RAXIT
.S RARPTIEN=0
.F S RARPTIEN=$O(^RARPT("AA",RARPTVDT,RARPTIEN)) Q:'RARPTIEN D Q:RAXIT
..S RARPT=$G(^RARPT(RARPTIEN,0)),RADFN=+$P(RARPT,U,2),RADTE=+$P(RARPT,U,3)
..S RADTI=9999999.9999-RADTE,RA7002=$G(^RADPT(RADFN,"DT",RADTI,0))
..S RAXAMDT=+$P(RA7002,U) Q:'RAXAMDT
..;must check every exam registered for this exam date/time; we might have a printset
..S RACNI=0 F S RACNI=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI)) Q:'RACNI D XAM
..Q
.Q
D EN^RAWKLU3 ;output the report
D XIT
Q
;
XAM ; get exam information; procedure name, exam status order #, int. staff phys...
S RA7003=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)) Q:'RA7003
Q:$P(RA7003,U,17)'=RARPTIEN ;exam references a different report!
S RAPRCIEN=+$P(RA7003,U,2) Q:'RAPRCIEN
S RAPRCIEN(0)=$P($G(^RAMIS(71,RAPRCIEN,0)),U) Q:RAPRCIEN(0)=""
S RACNT=RACNT+1
;
;did the user stop the task? Check every five hundred records...
S:RACNT#500=0 (RAXIT,ZTSTOP)=$$S^%ZTLOAD() Q:RAXIT
;
;1-begin exam status check
Q:$P($G(^RA(72,+$P(RA7003,U,3),0)),U,3)=0 ;cancelled...
;end exam status check
;
;2-begin physician check
Q:'$P(RA7003,U,15) ;no physician, quit check
Q:'$D(^TMP("RA STFPHYS-IEN",$J,$P(RA7003,U,15)))#2
;end physician check
;
S RACPT=$P($G(^RAMIS(71,+$P(RA7003,U,2),0)),U,9) Q:'RACPT ;ptr to file #81
;
; 09/27/2006 KAM/BAY Patch RA*5*77 Changed next line to use ^RACPTMSC
S RACPT=$P($$NAMCODE^RACPTMSC(RACPT,RAXAMDT),U,1) ;CPT code is 1st pc
;
S RASTF=$$EXTERNAL^DILFD(70.03,15,,$P(RA7003,U,15))
D SETARRY K RA7003,RACPT,RAPRCIEN,RASTF
Q
;
SETARRY ;find the wRVU value (either un-scaled or scaled) for a particular CPT
;or CPT code/CPT modifier combination. The case identifiers, CPT code
;(RACPT), & exam date (RAXAMDT) are known.
;
;get CPT code modifier string
S RACPTMOD="",RABILAT=0
I $O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"CMOD",0))>0 S RAI=0 D
.F S RAI=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"CMOD",RAI)) Q:'RAI D
..S RACPTMOD(0)=+$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"CMOD",RAI,0))
..;09/27/2006 KAM/BAY RA*5*77 Changed next line to use ^RACPTMSC
..S RA813(0)=$$BASICMOD^RACPTMSC(RACPTMOD(0),RAXAMDT)
..I 'RABILAT,$P(RA813(0),U,2)=50 S RABILAT=1 ;bilateral multiplier=2
..S RACPTMOD=RACPTMOD_$P(RA813(0),U,2)_","
..Q
.Q
;get wRVU value from FEE BASIS; returns a string: status^value^message
;where status'=1 means "in error". All exams prior to 1/1/1999 will use
;1999 wRVU values for their calculations.
;03/28/2007 KAM/BAY Rem Call 179232 Added RACYFLG to $S in next line
;01/23/2008 KAM/BAY RA*5*91 Remedy Call 227583 Changed the next line
; to use the Verified date instead of the exam date
S RAWRVU=$$RVU^FBRVU(RACPT,RACPTMOD,$S((9999999.9999-RARPTVDT)<2990101:2990101,RACYFLG:(9999999.9999-RARPTVDT)-10000,1:(9999999.9999-RARPTVDT)))
;09/27/2006 KAM/BAY RA*5*77 Remedy Call 154793
I $P(RAWRVU,U,2)=0,RACPTMOD="" D
. ;01/23/2008 KAM/BAY RA*5*91 Remedy Call 227583 Changed next line
. ; to use the Verified date instead of the exam date
. S RAWRVU=$$RVU^FBRVU(RACPT,26,$S((9999999.9999-RARPTVDT)<2990101:2990101,RACYFLG:(9999999.9999-RARPTVDT)-10000,1:(9999999.9999-RARPTVDT)))
I $P(RAWRVU,U)=1 D
.;apply bilateral multiplier if appropriate
.S:RABILAT RAWRVU=+$P(RAWRVU,U,2)*2 ;p184/KLM plus to convert NULL value to 0 (prevents error)
.;or not...
.S:'RABILAT RAWRVU=+$P(RAWRVU,U,2) ;p184
.I RASCLD S RAWRVU=RAWRVU*$$SFCTR^RAWRVUP($P(RA7002,U,2),RAXAMDT)
.Q
;
E S RAWRVU=0 ;status some other value than 1; "in error"
S:RAWRVU>0 RAWRVU=$J(RAWRVU,1,2) ;do not round the value...
;
;^TMP($J,"RA BY STFPHYS",RASTF)=total # procedures^wRVU total(all proc)
;^TMP($J,"RA BY STFPHYS",RASTF,RACPT,RAWRVU,RAPRCIEN(0))=^total # RACPT^
; total # RAWRVU
;
S:'$D(^TMP($J,"RA BY STFPHYS",RASTF))#2 ^(RASTF)="0^0"
S $P(^TMP($J,"RA BY STFPHYS",RASTF),U)=$P(^TMP($J,"RA BY STFPHYS",RASTF),U)+1
S $P(^TMP($J,"RA BY STFPHYS",RASTF),U,2)=$P(^TMP($J,"RA BY STFPHYS",RASTF),U,2)+RAWRVU
S:'$D(^TMP($J,"RA BY STFPHYS",RASTF,RACPT,RAWRVU,RAPRCIEN(0)))#2 ^(RAPRCIEN(0))="^0^0"
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
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))
;
K RA813,RABILAT,RACPTMOD,RAI,RAWRVU
Q
;
XIT ;kill variables and exit
W:$G(ZTSTOP)=1 !,$$CJ^XLFSTR("USER STOPPED PROCESS THROUGH TASKMAN",IOM)
K DIR,DIROUT,DIRUT,DTOUT,DUOUT,RA7002,RABGDTI,RABGDTX,RACNI,RACNT,RADATE
K RADFN,RADTE,RADTI,RAENDTI,RAENDTX,RAMBGDT,RAMENDT,RAQUIT,RARPT,RARPTIEN
K RARPTVDT,RAXAMDT,RAXIT,X,Y,RACYFLG
K ^TMP("RA STFPHYS-IEN",$J),^TMP($J,"RA BY STFPHYS")
Q
;
CHKCY ;03/28/2007 KAM/BAY RA*5*77 Remedy Call 179232 Check for latest RVU
; data from Fee Basis
S RACYFLG=0
;01/23/2008 BAY/KAM RA*5*91 Rem 227593 Changed next line to use the
; Report end date when setting variable RACYFLG
I $$LASTCY^FBAAFSR()<+$P(RAENDTX,",",2) S RACYFLG=1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAWKLU2 9099 printed Apr 09, 2024@21:37:09 Page 2
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
+2 ;01/23/08 BAY/KAM Remedy Call 227583 Patch *91 Change RVU Reports to
+3 ; use Report End Date instead of Current date when setting
+4 ; the flag to determine if necessary to use last year's RVU
+5 ; data and retrieve RVU data by Verified date instead of
+6 ; Exam date
+7 ;
+8 ;03/28/07 KAM/BAY Remedy Call 179232 Patch RA*5*77
+9 ; Add check to see if current RVU data is available and if
+10 ; not use previous year RVU data
+11 ;
+12 ;09/25/06 KAM/BAY Remedy Call 154793 PATCH *77 RVU with 0 value
+13 ; and changed CPT calls from ^ICPTCOD to ^RACPTMSC
+14 ; eliminating the need for IA's 1995 and 1996
+15 ;
+16 ;DBIA#:4799 ($$RVU^FBRVU) return wRVU value for CPT, CPT Mod, & exam
+17 ; date/time
+18 ;DBIA#:10060 EN1^RASELCT enacts 10060 which allows lookups on the NEW
+19 ; PERSON (#200) file
+20 ;DBIA#:10063 ($$S^%ZTLOAD)
+21 ;DBIA#:10103 ($$FMTE^XLFDT) & ($$NOW^XLFDT)
+22 ;DBIA#:10104 ($$CJ^XLFSTR)
+23 ;DBIA#:1519 ($$EN^XUTMDEVQ)
+24 ;DBIA#:4432 (LASTCY^FBAAFSR) return last calendar year file
+25 ; 162.99 was updated
+26 ;
EN(RASCLD) ;Identifies the option that the user wishes to execute.
+1 ;input: RASCLD=zero for non-scaled wRVU, & one for the scaled wRVU
+2 ; report.
+3 ;
+4 KILL ^TMP($JOB,"RA STFPHYS"),^TMP("RA STFPHYS-IEN",$JOB)
+5 ;
PHYST ;allow the user to select one/many/all physicians
+1 ;(w/ staff classification) ;DBIA#: 10060
+2 SET RADIC="^VA(200,"
SET RADIC(0)="QEAMZ"
SET RAUTIL="RA STFPHYS"
+3 SET RADIC("A")="Select Physician: "
SET RADIC("B")="All"
+4 SET RADIC("S")="I $D(^VA(200,""ARC"",""S"",+Y))\10"
+5 WRITE !!
DO EN1^RASELCT(.RADIC,RAUTIL)
KILL %W,%Y1,DIC,RADIC,RAUTIL,X,Y
+6 ;did the user select physicians to compile data on? if not, quit
+7 IF $ORDER(^TMP($JOB,"RA STFPHYS",""))=""
Begin DoDot:1
+8 WRITE !!?3,$CHAR(7),"Staff Physician data was not selected."
+9 QUIT
End DoDot:1
QUIT
+10 ;
+11 ;build a new staff physician array (the other array is subscripted by
+12 ;physician name then IEN) subscripting by staff physician IEN this
+13 ;allows us to check the IEN of the staff physician selected by the
+14 ;user against the IEN of the staff physician on the exam record
+15 SET X=""
FOR
SET X=$ORDER(^TMP($JOB,"RA STFPHYS",X))
if X=""
QUIT
Begin DoDot:1
+16 SET Y=0
+17 FOR
SET Y=$ORDER(^TMP($JOB,"RA STFPHYS",X,Y))
if 'Y
QUIT
SET ^TMP("RA STFPHYS-IEN",$JOB,Y)=""
+18 QUIT
End DoDot:1
+19 ;
+20 KILL ^TMP($JOB,"RA STFPHYS")
SET RADATE=$$FMTE^XLFDT($$NOW^XLFDT\1,1)
+21 ;
STRTDT ;Prompt the user for the starting verified date
+1 SET RASTART=$$STRTDT^RAWKLU1(RADATE,2110101)
+2 IF RASTART=-1
DO XIT
QUIT
+3 SET RABGDTI=$PIECE(RASTART,U)
SET RABGDTX=$PIECE(RASTART,U,2)
SET RAMBGDT=RABGDTI-.0001
+4 ;need inv. verified date to search ^RARPT("AA",
+5 SET RAMBGDT=9999999.9999-RABGDTI
+6 KILL RASTART
+7 ;
ENDDT ;Prompt the user for the ending verified date
+1 SET RAEND=$$ENDDT^RAWKLU1(RABGDTI,RABGDTX)
+2 IF RAEND=-1
DO XIT
QUIT
+3 SET RAENDTI=$PIECE(RAEND,U)
SET RAENDTX=$PIECE(RAEND,U,2)
SET RAMENDT=RAENDTI+.9999
+4 ;need inv. verified date to search ^RARPT("AA",
+5 SET RAMENDT=9999999.9999-RAMENDT
+6 KILL RAEND
+7 ;
+8 FOR I="^TMP(""RA STFPHYS-IEN"",$J,","RADATE","RAB*","RAM*","RAE*","RASCLD"
SET ZTSAVE(I)=""
+9 SET I="RA print procedures, wRVUs, and their totals for a physician"
+10 DO EN^XUTMDEVQ("START^RAWKLU2",I,.ZTSAVE,,1)
+11 IF +$GET(ZTSK)>0
WRITE !!,"Task Number: "_ZTSK,!
+12 KILL I,ZTSAVE,ZTSK
+13 QUIT
+14 ;
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:
+2 ;1-the status of the exam is 'Cancelled'
+3 ;2-the physician(s) selected are not the primary staff for the exam
+4 ;
+5 if $DATA(ZTQUEUED)#2
SET ZTREQ="@"
+6 KILL ^TMP($JOB,"RA BY STFPHYS")
+7 ;03/28/07 KAM/BAY Remedy Call 179232 Added RACYFLG to next line
+8 SET RARPTVDT=RAMBGDT
SET (RACNT,RAXIT,RACYFLG)=0
+9 ;03/28/07 KAM/BAY RA*5*77/179232 Added Fee Basis Data Check
+10 DO CHKCY
+11 FOR
SET RARPTVDT=$ORDER(^RARPT("AA",RARPTVDT),-1)
if 'RARPTVDT!(RARPTVDT<RAMENDT)
QUIT
Begin DoDot:1
+12 SET RARPTIEN=0
+13 FOR
SET RARPTIEN=$ORDER(^RARPT("AA",RARPTVDT,RARPTIEN))
if 'RARPTIEN
QUIT
Begin DoDot:2
+14 SET RARPT=$GET(^RARPT(RARPTIEN,0))
SET RADFN=+$PIECE(RARPT,U,2)
SET RADTE=+$PIECE(RARPT,U,3)
+15 SET RADTI=9999999.9999-RADTE
SET RA7002=$GET(^RADPT(RADFN,"DT",RADTI,0))
+16 SET RAXAMDT=+$PIECE(RA7002,U)
if 'RAXAMDT
QUIT
+17 ;must check every exam registered for this exam date/time; we might have a printset
+18 SET RACNI=0
FOR
SET RACNI=$ORDER(^RADPT(RADFN,"DT",RADTI,"P",RACNI))
if 'RACNI
QUIT
DO XAM
+19 QUIT
End DoDot:2
if RAXIT
QUIT
+20 QUIT
End DoDot:1
if RAXIT
QUIT
+21 ;output the report
DO EN^RAWKLU3
+22 DO XIT
+23 QUIT
+24 ;
XAM ; get exam information; procedure name, exam status order #, int. staff phys...
+1 SET RA7003=$GET(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))
if 'RA7003
QUIT
+2 ;exam references a different report!
if $PIECE(RA7003,U,17)'=RARPTIEN
QUIT
+3 SET RAPRCIEN=+$PIECE(RA7003,U,2)
if 'RAPRCIEN
QUIT
+4 SET RAPRCIEN(0)=$PIECE($GET(^RAMIS(71,RAPRCIEN,0)),U)
if RAPRCIEN(0)=""
QUIT
+5 SET RACNT=RACNT+1
+6 ;
+7 ;did the user stop the task? Check every five hundred records...
+8 if RACNT#500=0
SET (RAXIT,ZTSTOP)=$$S^%ZTLOAD()
if RAXIT
QUIT
+9 ;
+10 ;1-begin exam status check
+11 ;cancelled...
if $PIECE($GET(^RA(72,+$PIECE(RA7003,U,3),0)),U,3)=0
QUIT
+12 ;end exam status check
+13 ;
+14 ;2-begin physician check
+15 ;no physician, quit check
if '$PIECE(RA7003,U,15)
QUIT
+16 if '$DATA(^TMP("RA STFPHYS-IEN",$JOB,$PIECE(RA7003,U,15)))#2
QUIT
+17 ;end physician check
+18 ;
+19 ;ptr to file #81
SET RACPT=$PIECE($GET(^RAMIS(71,+$PIECE(RA7003,U,2),0)),U,9)
if 'RACPT
QUIT
+20 ;
+21 ; 09/27/2006 KAM/BAY Patch RA*5*77 Changed next line to use ^RACPTMSC
+22 ;CPT code is 1st pc
SET RACPT=$PIECE($$NAMCODE^RACPTMSC(RACPT,RAXAMDT),U,1)
+23 ;
+24 SET RASTF=$$EXTERNAL^DILFD(70.03,15,,$PIECE(RA7003,U,15))
+25 DO SETARRY
KILL RA7003,RACPT,RAPRCIEN,RASTF
+26 QUIT
+27 ;
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
+2 ;(RACPT), & exam date (RAXAMDT) are known.
+3 ;
+4 ;get CPT code modifier string
+5 SET RACPTMOD=""
SET RABILAT=0
+6 IF $ORDER(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"CMOD",0))>0
SET RAI=0
Begin DoDot:1
+7 FOR
SET RAI=$ORDER(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"CMOD",RAI))
if 'RAI
QUIT
Begin DoDot:2
+8 SET RACPTMOD(0)=+$GET(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"CMOD",RAI,0))
+9 ;09/27/2006 KAM/BAY RA*5*77 Changed next line to use ^RACPTMSC
+10 SET RA813(0)=$$BASICMOD^RACPTMSC(RACPTMOD(0),RAXAMDT)
+11 ;bilateral multiplier=2
IF 'RABILAT
IF $PIECE(RA813(0),U,2)=50
SET RABILAT=1
+12 SET RACPTMOD=RACPTMOD_$PIECE(RA813(0),U,2)_","
+13 QUIT
End DoDot:2
+14 QUIT
End DoDot:1
+15 ;get wRVU value from FEE BASIS; returns a string: status^value^message
+16 ;where status'=1 means "in error". All exams prior to 1/1/1999 will use
+17 ;1999 wRVU values for their calculations.
+18 ;03/28/2007 KAM/BAY Rem Call 179232 Added RACYFLG to $S in next line
+19 ;01/23/2008 KAM/BAY RA*5*91 Remedy Call 227583 Changed the next line
+20 ; to use the Verified date instead of the exam date
+21 SET RAWRVU=$$RVU^FBRVU(RACPT,RACPTMOD,$SELECT((9999999.9999-RARPTVDT)<2990101:2990101,RACYFLG:(9999999.9999-RARPTVDT)-10000,1:(9999999.9999-RARPTVDT)))
+22 ;09/27/2006 KAM/BAY RA*5*77 Remedy Call 154793
+23 IF $PIECE(RAWRVU,U,2)=0
IF RACPTMOD=""
Begin DoDot:1
+24 ;01/23/2008 KAM/BAY RA*5*91 Remedy Call 227583 Changed next line
+25 ; to use the Verified date instead of the exam date
+26 SET RAWRVU=$$RVU^FBRVU(RACPT,26,$SELECT((9999999.9999-RARPTVDT)<2990101:2990101,RACYFLG:(9999999.9999-RARPTVDT)-10000,1:(9999999.9999-RARPTVDT)))
End DoDot:1
+27 IF $PIECE(RAWRVU,U)=1
Begin DoDot:1
+28 ;apply bilateral multiplier if appropriate
+29 ;p184/KLM plus to convert NULL value to 0 (prevents error)
if RABILAT
SET RAWRVU=+$PIECE(RAWRVU,U,2)*2
+30 ;or not...
+31 ;p184
if 'RABILAT
SET RAWRVU=+$PIECE(RAWRVU,U,2)
+32 IF RASCLD
SET RAWRVU=RAWRVU*$$SFCTR^RAWRVUP($PIECE(RA7002,U,2),RAXAMDT)
+33 QUIT
End DoDot:1
+34 ;
+35 ;status some other value than 1; "in error"
IF '$TEST
SET RAWRVU=0
+36 ;do not round the value...
if RAWRVU>0
SET RAWRVU=$JUSTIFY(RAWRVU,1,2)
+37 ;
+38 ;^TMP($J,"RA BY STFPHYS",RASTF)=total # procedures^wRVU total(all proc)
+39 ;^TMP($J,"RA BY STFPHYS",RASTF,RACPT,RAWRVU,RAPRCIEN(0))=^total # RACPT^
+40 ; total # RAWRVU
+41 ;
+42 if '$DATA(^TMP($JOB,"RA BY STFPHYS",RASTF))#2
SET ^(RASTF)="0^0"
+43 SET $PIECE(^TMP($JOB,"RA BY STFPHYS",RASTF),U)=$PIECE(^TMP($JOB,"RA BY STFPHYS",RASTF),U)+1
+44 SET $PIECE(^TMP($JOB,"RA BY STFPHYS",RASTF),U,2)=$PIECE(^TMP($JOB,"RA BY STFPHYS",RASTF),U,2)+RAWRVU
+45 if '$DATA(^TMP($JOB,"RA BY STFPHYS",RASTF,RACPT,RAWRVU,RAPRCIEN(0)))#2
SET ^(RAPRCIEN(0))="^0^0"
+46 SET $PIECE(^TMP($JOB,"RA BY STFPHYS",RASTF,RACPT,RAWRVU,RAPRCIEN(0)),U,2)=+$PIECE($GET(^TMP($JOB,"RA BY STFPHYS",RASTF,RACPT,RAWRVU,RAPRCIEN(0))),U,2)+1
+47 SET $PIECE(^TMP($JOB,"RA BY STFPHYS",RASTF,RACPT,RAWRVU,RAPRCIEN(0)),U,3)=RAWRVU*(+$PIECE(^TMP($JOB,"RA BY STFPHYS",RASTF,RACPT,RAWRVU,RAPRCIEN(0)),U,2))
+48 ;
+49 KILL RA813,RABILAT,RACPTMOD,RAI,RAWRVU
+50 QUIT
+51 ;
XIT ;kill variables and exit
+1 if $GET(ZTSTOP)=1
WRITE !,$$CJ^XLFSTR("USER STOPPED PROCESS THROUGH TASKMAN",IOM)
+2 KILL DIR,DIROUT,DIRUT,DTOUT,DUOUT,RA7002,RABGDTI,RABGDTX,RACNI,RACNT,RADATE
+3 KILL RADFN,RADTE,RADTI,RAENDTI,RAENDTX,RAMBGDT,RAMENDT,RAQUIT,RARPT,RARPTIEN
+4 KILL RARPTVDT,RAXAMDT,RAXIT,X,Y,RACYFLG
+5 KILL ^TMP("RA STFPHYS-IEN",$JOB),^TMP($JOB,"RA BY STFPHYS")
+6 QUIT
+7 ;
CHKCY ;03/28/2007 KAM/BAY RA*5*77 Remedy Call 179232 Check for latest RVU
+1 ; data from Fee Basis
+2 SET RACYFLG=0
+3 ;01/23/2008 BAY/KAM RA*5*91 Rem 227593 Changed next line to use the
+4 ; Report end date when setting variable RACYFLG
+5 IF $$LASTCY^FBAAFSR()<+$PIECE(RAENDTX,",",2)
SET RACYFLG=1
+6 QUIT
