- 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 Feb 19, 2025@00:07:01 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