- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAWKLU2.m
r613 r623 1 RAWKLU2 ;HISC/GJC-physician wRVU (scaled too) by procedure ;10/26/05 14:57 2 ;;5.0;Radiology/Nuclear Medicine;**64,77,91**;Mar 16, 1998;Build 1 3 ;01/23/08 BAY/KAM Remedy Call 227583 Patch *91 Change RVU Reports to 4 ; use Report End Date instead of Current date when setting 5 ; the flag to determine if necessary to use last year's RVU 6 ; data and retrieve RVU data by Verified date instead of 7 ; Exam date 8 ; 9 ;03/28/07 KAM/BAY Remedy Call 179232 Patch RA*5*77 10 ; Add check to see if current RVU data is available and if 11 ; not use previous year RVU data 12 ; 13 ;09/25/06 KAM/BAY Remedy Call 154793 PATCH *77 RVU with 0 value 14 ; and changed CPT calls from ^ICPTCOD to ^RACPTMSC 15 ; eliminating the need for IA's 1995 and 1996 16 ; 17 ;DBIA#:4799 ($$RVU^FBRVU) return wRVU value for CPT, CPT Mod, & exam 18 ; date/time 19 ;DBIA#:10060 EN1^RASELCT enacts 10060 which allows lookups on the NEW 20 ; PERSON (#200) file 21 ;DBIA#:10063 ($$S^%ZTLOAD) 22 ;DBIA#:10103 ($$FMTE^XLFDT) & ($$NOW^XLFDT) 23 ;DBIA#:10104 ($$CJ^XLFSTR) 24 ;DBIA#:1519 ($$EN^XUTMDEVQ) 25 ;DBIA#:4432 (LASTCY^FBAAFSR) return last calendar year file 26 ; 162.99 was updated 27 ; 28 EN(RASCLD) ;Identifies the option that the user wishes to execute. 29 ;input: RASCLD=zero for non-scaled wRVU, & one for the scaled wRVU 30 ; report. 31 ; 32 K ^TMP($J,"RA STFPHYS"),^TMP("RA STFPHYS-IEN",$J) 33 ; 34 PHYST ;allow the user to select one/many/all physicians 35 ;(w/ staff classification) ;DBIA#: 10060 36 S RADIC="^VA(200,",RADIC(0)="QEAMZ",RAUTIL="RA STFPHYS" 37 S RADIC("A")="Select Physician: ",RADIC("B")="All" 38 S RADIC("S")="I $D(^VA(200,""ARC"",""S"",+Y))\10" 39 W !! D EN1^RASELCT(.RADIC,RAUTIL) K %W,%Y1,DIC,RADIC,RAUTIL,X,Y 40 ;did the user select physicians to compile data on? if not, quit 41 I $O(^TMP($J,"RA STFPHYS",""))="" D Q 42 .W !!?3,$C(7),"Staff Physician data was not selected." 43 .Q 44 ; 45 ;build a new staff physician array (the other array is subscripted by 46 ;physician name then IEN) subscripting by staff physician IEN this 47 ;allows us to check the IEN of the staff physician selected by the 48 ;user against the IEN of the staff physician on the exam record 49 S X="" F S X=$O(^TMP($J,"RA STFPHYS",X)) Q:X="" D 50 .S Y=0 51 .F S Y=$O(^TMP($J,"RA STFPHYS",X,Y)) Q:'Y S ^TMP("RA STFPHYS-IEN",$J,Y)="" 52 .Q 53 ; 54 K ^TMP($J,"RA STFPHYS") S RADATE=$$FMTE^XLFDT($$NOW^XLFDT\1,1) 55 ; 56 STRTDT ;Prompt the user for the starting verified date 57 S RASTART=$$STRTDT^RAWKLU1(RADATE,2110101) 58 I RASTART=-1 D XIT Q 59 S RABGDTI=$P(RASTART,U),RABGDTX=$P(RASTART,U,2),RAMBGDT=RABGDTI-.0001 60 ;need inv. verified date to search ^RARPT("AA", 61 S RAMBGDT=9999999.9999-RABGDTI 62 K RASTART 63 ; 64 ENDDT ;Prompt the user for the ending verified date 65 S RAEND=$$ENDDT^RAWKLU1(RABGDTI,RABGDTX) 66 I RAEND=-1 D XIT Q 67 S RAENDTI=$P(RAEND,U),RAENDTX=$P(RAEND,U,2),RAMENDT=RAENDTI+.9999 68 ;need inv. verified date to search ^RARPT("AA", 69 S RAMENDT=9999999.9999-RAMENDT 70 K RAEND 71 ; 72 F I="^TMP(""RA STFPHYS-IEN"",$J,","RADATE","RAB*","RAM*","RAE*","RASCLD" S ZTSAVE(I)="" 73 S I="RA print procedures, wRVUs, and their totals for a physician" 74 D EN^XUTMDEVQ("START^RAWKLU2",I,.ZTSAVE,,1) 75 I +$G(ZTSK)>0 W !!,"Task Number: "_ZTSK,! 76 K I,ZTSAVE,ZTSK 77 Q 78 ; 79 START ;check exams based on criteria input by user; physician & exam D/T 80 ;eliminate the exam record is one of the following conditions is true: 81 ;1-the status of the exam is 'Cancelled' 82 ;2-the physician(s) selected are not the primary staff for the exam 83 ; 84 S:$D(ZTQUEUED)#2 ZTREQ="@" 85 K ^TMP($J,"RA BY STFPHYS") 86 ;03/28/07 KAM/BAY Remedy Call 179232 Added RACYFLG to next line 87 S RARPTVDT=RAMBGDT,(RACNT,RAXIT,RACYFLG)=0 88 ;03/28/07 KAM/BAY RA*5*77/179232 Added Fee Basis Data Check 89 D CHKCY 90 F S RARPTVDT=$O(^RARPT("AA",RARPTVDT),-1) Q:'RARPTVDT!(RARPTVDT<RAMENDT) D Q:RAXIT 91 .S RARPTIEN=0 92 .F S RARPTIEN=$O(^RARPT("AA",RARPTVDT,RARPTIEN)) Q:'RARPTIEN D Q:RAXIT 93 ..S RARPT=$G(^RARPT(RARPTIEN,0)),RADFN=+$P(RARPT,U,2),RADTE=+$P(RARPT,U,3) 94 ..S RADTI=9999999.9999-RADTE,RA7002=$G(^RADPT(RADFN,"DT",RADTI,0)) 95 ..S RAXAMDT=+$P(RA7002,U) Q:'RAXAMDT 96 ..;must check every exam registered for this exam date/time; we might have a printset 97 ..S RACNI=0 F S RACNI=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI)) Q:'RACNI D XAM 98 ..Q 99 .Q 100 D EN^RAWKLU3 ;output the report 101 D XIT 102 Q 103 ; 104 XAM ; get exam information; procedure name, exam status order #, int. staff phys... 105 S RA7003=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)) Q:'RA7003 106 Q:$P(RA7003,U,17)'=RARPTIEN ;exam references a different report! 107 S RAPRCIEN=+$P(RA7003,U,2) Q:'RAPRCIEN 108 S RAPRCIEN(0)=$P($G(^RAMIS(71,RAPRCIEN,0)),U) Q:RAPRCIEN(0)="" 109 S RACNT=RACNT+1 110 ; 111 ;did the user stop the task? Check every five hundred records... 112 S:RACNT#500=0 (RAXIT,ZTSTOP)=$$S^%ZTLOAD() Q:RAXIT 113 ; 114 ;1-begin exam status check 115 Q:$P($G(^RA(72,+$P(RA7003,U,3),0)),U,3)=0 ;cancelled... 116 ;end exam status check 117 ; 118 ;2-begin physician check 119 Q:'$P(RA7003,U,15) ;no physician, quit check 120 Q:'$D(^TMP("RA STFPHYS-IEN",$J,$P(RA7003,U,15)))#2 121 ;end physician check 122 ; 123 S RACPT=$P($G(^RAMIS(71,+$P(RA7003,U,2),0)),U,9) Q:'RACPT ;ptr to file #81 124 ; 125 ; 09/27/2006 KAM/BAY Patch RA*5*77 Changed next line to use ^RACPTMSC 126 S RACPT=$P($$NAMCODE^RACPTMSC(RACPT,RAXAMDT),U,1) ;CPT code is 1st pc 127 ; 128 S RASTF=$$EXTERNAL^DILFD(70.03,15,,$P(RA7003,U,15)) 129 D SETARRY K RA7003,RACPT,RAPRCIEN,RASTF 130 Q 131 ; 132 SETARRY ;find the wRVU value (either un-scaled or scaled) for a particular CPT 133 ;or CPT code/CPT modifier combination. The case identifiers, CPT code 134 ;(RACPT), & exam date (RAXAMDT) are known. 135 ; 136 ;get CPT code modifier string 137 S RACPTMOD="",RABILAT=0 138 I $O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"CMOD",0))>0 S RAI=0 D 139 .F S RAI=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"CMOD",RAI)) Q:'RAI D 140 ..S RACPTMOD(0)=+$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"CMOD",RAI,0)) 141 ..;09/27/2006 KAM/BAY RA*5*77 Changed next line to use ^RACPTMSC 142 ..S RA813(0)=$$BASICMOD^RACPTMSC(RACPTMOD(0),RAXAMDT) 143 ..I 'RABILAT,$P(RA813(0),U,2)=50 S RABILAT=1 ;bilateral multiplier=2 144 ..S RACPTMOD=RACPTMOD_$P(RA813(0),U,2)_"," 145 ..Q 146 .Q 147 ;get wRVU value from FEE BASIS; returns a string: status^value^message 148 ;where status'=1 means "in error". All exams prior to 1/1/1999 will use 149 ;1999 wRVU values for their calculations. 150 ;03/28/2007 KAM/BAY Rem Call 179232 Added RACYFLG to $S in next line 151 ;01/23/2008 KAM/BAY RA*5*91 Remedy Call 227583 Changed the next line 152 ; to use the Verified date instead of the exam date 153 S RAWRVU=$$RVU^FBRVU(RACPT,RACPTMOD,$S((9999999.9999-RARPTVDT)<2990101:2990101,RACYFLG:(9999999.9999-RARPTVDT)-10000,1:(9999999.9999-RARPTVDT))) 154 ;09/27/2006 KAM/BAY RA*5*77 Remedy Call 154793 155 I $P(RAWRVU,U,2)=0,RACPTMOD="" D 156 . ;01/23/2008 KAM/BAY RA*5*91 Remedy Call 227583 Changed next line 157 . ; to use the Verified date instead of the exam date 158 . S RAWRVU=$$RVU^FBRVU(RACPT,26,$S((9999999.9999-RARPTVDT)<2990101:2990101,RACYFLG:(9999999.9999-RARPTVDT)-10000,1:(9999999.9999-RARPTVDT))) 159 I $P(RAWRVU,U)=1 D 160 .;apply bilateral multiplier if appropriate 161 .S:RABILAT RAWRVU=$P(RAWRVU,U,2)*2 162 .;or not... 163 .S:'RABILAT RAWRVU=$P(RAWRVU,U,2) 164 .I RASCLD S RAWRVU=RAWRVU*$$SFCTR^RAWRVUP($P(RA7002,U,2),RAXAMDT) 165 .Q 166 ; 167 E S RAWRVU=0 ;status some other value than 1; "in error" 168 S:RAWRVU>0 RAWRVU=$J(RAWRVU,1,2) ;do not round the value... 169 ; 170 ;^TMP($J,"RA BY STFPHYS",RASTF)=total # procedures^wRVU total(all proc) 171 ;^TMP($J,"RA BY STFPHYS",RASTF,RACPT,RAWRVU,RAPRCIEN(0))=^total # RACPT^ 172 ; total # RAWRVU 173 ; 174 S:'$D(^TMP($J,"RA BY STFPHYS",RASTF))#2 ^(RASTF)="0^0" 175 S $P(^TMP($J,"RA BY STFPHYS",RASTF),U)=$P(^TMP($J,"RA BY STFPHYS",RASTF),U)+1 176 S $P(^TMP($J,"RA BY STFPHYS",RASTF),U,2)=$P(^TMP($J,"RA BY STFPHYS",RASTF),U,2)+RAWRVU 177 S:'$D(^TMP($J,"RA BY STFPHYS",RASTF,RACPT,RAWRVU,RAPRCIEN(0)))#2 ^(RAPRCIEN(0))="^0^0" 178 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 179 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)) 180 ; 181 K RA813,RABILAT,RACPTMOD,RAI,RAWRVU 182 Q 183 ; 184 XIT ;kill variables and exit 185 W:$G(ZTSTOP)=1 !,$$CJ^XLFSTR("USER STOPPED PROCESS THROUGH TASKMAN",IOM) 186 K DIR,DIROUT,DIRUT,DTOUT,DUOUT,RA7002,RABGDTI,RABGDTX,RACNI,RACNT,RADATE 187 K RADFN,RADTE,RADTI,RAENDTI,RAENDTX,RAMBGDT,RAMENDT,RAQUIT,RARPT,RARPTIEN 188 K RARPTVDT,RAXAMDT,RAXIT,X,Y,RACYFLG 189 K ^TMP("RA STFPHYS-IEN",$J),^TMP($J,"RA BY STFPHYS") 190 Q 191 ; 192 CHKCY ;03/28/2007 KAM/BAY RA*5*77 Remedy Call 179232 Check for latest RVU 193 ; data from Fee Basis 194 S RACYFLG=0 195 ;01/23/2008 BAY/KAM RA*5*91 Rem 227593 Changed next line to use the 196 ; Report end date when setting variable RACYFLG 197 I $$LASTCY^FBAAFSR()<+$P(RAENDTX,",",2) S RACYFLG=1 198 Q 1 RAWKLU2 ;HISC/GJC-physician wRVU (scaled too) by procedure ;10/26/05 14:57 2 ;;5.0;Radiology/Nuclear Medicine;**64,77**;Mar 16, 1998;Build 7 3 ;09/25/06 KAM/BAY Remedy Call 154793 PATCH *77 RVU with 0 value 4 ; and changed CPT calls from ^ICPTCOD to ^RACPTMSC 5 ; eliminating the need for IA's 1995 amd 1996 6 ;03/28/07 KAM/BAY Remedy Call 179232 Patch RA*5*77 7 ; Add check to see if current RVU data is available and if 8 ; not use previous year RVU data 9 ; 10 ;DBIA#:4799 ($$RVU^FBRVU) return wRVU value for CPT, CPT Mod, & exam 11 ; date/time 12 ;DBIA#:10060 EN1^RASELCT enacts 10060 which allows lookups on the NEW 13 ; PERSON (#200) file 14 ;DBIA#:10063 ($$S^%ZTLOAD) 15 ;DBIA#:10103 ($$FMTE^XLFDT) & ($$NOW^XLFDT) 16 ;DBIA#:10104 ($$CJ^XLFSTR) 17 ;DBIA#:1519 ($$EN^XUTMDEVQ) 18 ;DBIA#:4432 (LASTCY^FBAAFSR) return last calendar year file 19 ; 162.99 was updated 20 ; 21 EN(RASCLD) ;Identifies the option that the user wishes to execute. 22 ;input: RASCLD=zero for non-scaled wRVU, & one for the scaled wRVU 23 ; report. 24 ; 25 K ^TMP($J,"RA STFPHYS"),^TMP("RA STFPHYS-IEN",$J) 26 ; 27 PHYST ;allow the user to select one/many/all physicians 28 ;(w/ staff classification) ;DBIA#: 10060 29 S RADIC="^VA(200,",RADIC(0)="QEAMZ",RAUTIL="RA STFPHYS" 30 S RADIC("A")="Select Physician: ",RADIC("B")="All" 31 S RADIC("S")="I $D(^VA(200,""ARC"",""S"",+Y))\10" 32 W !! D EN1^RASELCT(.RADIC,RAUTIL) K %W,%Y1,DIC,RADIC,RAUTIL,X,Y 33 ;did the user select physicians to compile data on? if not, quit 34 I $O(^TMP($J,"RA STFPHYS",""))="" D Q 35 .W !!?3,$C(7),"Staff Physician data was not selected." 36 .Q 37 ; 38 ;build a new staff physician array (the other array is subscripted by 39 ;physician name then IEN) subscripting by staff physician IEN this 40 ;allows us to check the IEN of the staff physician selected by the 41 ;user against the IEN of the staff physician on the exam record 42 S X="" F S X=$O(^TMP($J,"RA STFPHYS",X)) Q:X="" D 43 .S Y=0 44 .F S Y=$O(^TMP($J,"RA STFPHYS",X,Y)) Q:'Y S ^TMP("RA STFPHYS-IEN",$J,Y)="" 45 .Q 46 ; 47 K ^TMP($J,"RA STFPHYS") S RADATE=$$FMTE^XLFDT($$NOW^XLFDT\1,1) 48 ; 49 STRTDT ;Prompt the user for the starting verified date 50 S RASTART=$$STRTDT^RAWKLU1(RADATE,2110101) 51 I RASTART=-1 D XIT Q 52 S RABGDTI=$P(RASTART,U),RABGDTX=$P(RASTART,U,2),RAMBGDT=RABGDTI-.0001 53 ;need inv. verified date to search ^RARPT("AA", 54 S RAMBGDT=9999999.9999-RABGDTI 55 K RASTART 56 ; 57 ENDDT ;Prompt the user for the ending verified date 58 S RAEND=$$ENDDT^RAWKLU1(RABGDTI,RABGDTX) 59 I RAEND=-1 D XIT Q 60 S RAENDTI=$P(RAEND,U),RAENDTX=$P(RAEND,U,2),RAMENDT=RAENDTI+.9999 61 ;need inv. verified date to search ^RARPT("AA", 62 S RAMENDT=9999999.9999-RAMENDT 63 K RAEND 64 ; 65 F I="^TMP(""RA STFPHYS-IEN"",$J,","RADATE","RAB*","RAM*","RAE*","RASCLD" S ZTSAVE(I)="" 66 S I="RA print procedures, wRVUs, and their totals for a physician" 67 D EN^XUTMDEVQ("START^RAWKLU2",I,.ZTSAVE,,1) 68 I +$G(ZTSK)>0 W !!,"Task Number: "_ZTSK,! 69 K I,ZTSAVE,ZTSK 70 Q 71 ; 72 START ;check exams based on criteria input by user; physician & exam D/T 73 ;eliminate the exam record is one of the following conditions is true: 74 ;1-the status of the exam is 'Cancelled' 75 ;2-the physician(s) selected are not the primary staff for the exam 76 ; 77 S:$D(ZTQUEUED)#2 ZTREQ="@" 78 K ^TMP($J,"RA BY STFPHYS") 79 ;03/28/07 KAM/BAY Remedy Call 179232 Added RACYFLG to next line 80 S RARPTVDT=RAMBGDT,(RACNT,RAXIT,RACYFLG)=0 81 ;03/28/07 KAM/BAY RA*5*77/179232 Added Fee Basis Data Check 82 D CHKCY 83 F S RARPTVDT=$O(^RARPT("AA",RARPTVDT),-1) Q:'RARPTVDT!(RARPTVDT<RAMENDT) D Q:RAXIT 84 .S RARPTIEN=0 85 .F S RARPTIEN=$O(^RARPT("AA",RARPTVDT,RARPTIEN)) Q:'RARPTIEN D Q:RAXIT 86 ..S RARPT=$G(^RARPT(RARPTIEN,0)),RADFN=+$P(RARPT,U,2),RADTE=+$P(RARPT,U,3) 87 ..S RADTI=9999999.9999-RADTE,RA7002=$G(^RADPT(RADFN,"DT",RADTI,0)) 88 ..S RAXAMDT=+$P(RA7002,U) Q:'RAXAMDT 89 ..;must check every exam registered for this exam date/time; we might have a printset 90 ..S RACNI=0 F S RACNI=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI)) Q:'RACNI D XAM 91 ..Q 92 .Q 93 D EN^RAWKLU3 ;output the report 94 D XIT 95 Q 96 ; 97 XAM ; get exam information; procedure name, exam status order #, int. staff phys... 98 S RA7003=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)) Q:'RA7003 99 Q:$P(RA7003,U,17)'=RARPTIEN ;exam references a different report! 100 S RAPRCIEN=+$P(RA7003,U,2) Q:'RAPRCIEN 101 S RAPRCIEN(0)=$P($G(^RAMIS(71,RAPRCIEN,0)),U) Q:RAPRCIEN(0)="" 102 S RACNT=RACNT+1 103 ; 104 ;did the user stop the task? Check every five hundred records... 105 S:RACNT#500=0 (RAXIT,ZTSTOP)=$$S^%ZTLOAD() Q:RAXIT 106 ; 107 ;1-begin exam status check 108 Q:$P($G(^RA(72,+$P(RA7003,U,3),0)),U,3)=0 ;cancelled... 109 ;end exam status check 110 ; 111 ;2-begin physician check 112 Q:'$P(RA7003,U,15) ;no physician, quit check 113 Q:'$D(^TMP("RA STFPHYS-IEN",$J,$P(RA7003,U,15)))#2 114 ;end physician check 115 ; 116 S RACPT=$P($G(^RAMIS(71,+$P(RA7003,U,2),0)),U,9) Q:'RACPT ;ptr to file #81 117 ; 118 ; 09/27/2006 KAM/BAY Patch RA*5*77 Changed next line to use ^RACPTMSC 119 S RACPT=$P($$NAMCODE^RACPTMSC(RACPT,RAXAMDT),U,1) ;CPT code is 1st pc 120 ; 121 S RASTF=$$EXTERNAL^DILFD(70.03,15,,$P(RA7003,U,15)) 122 D SETARRY K RA7003,RACPT,RAPRCIEN,RASTF 123 Q 124 ; 125 SETARRY ;find the wRVU value (either un-scaled or scaled) for a particular CPT 126 ;or CPT code/CPT modifier combination. The case identifiers, CPT code 127 ;(RACPT), & exam date (RAXAMDT) are known. 128 ; 129 ;get CPT code modifier string 130 S RACPTMOD="",RABILAT=0 131 I $O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"CMOD",0))>0 S RAI=0 D 132 .F S RAI=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"CMOD",RAI)) Q:'RAI D 133 ..S RACPTMOD(0)=+$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"CMOD",RAI,0)) 134 ..;09/27/2006 KAM/BAY RA*5*77 Changed next line to use ^RACPTMSC 135 ..S RA813(0)=$$BASICMOD^RACPTMSC(RACPTMOD(0),RAXAMDT) 136 ..I 'RABILAT,$P(RA813(0),U,2)=50 S RABILAT=1 ;bilateral multiplier=2 137 ..S RACPTMOD=RACPTMOD_$P(RA813(0),U,2)_"," 138 ..Q 139 .Q 140 ;get wRVU value from FEE BASIS; returns a string: status^value^message 141 ;where status'=1 means "in error". All exams prior to 1/1/1999 will use 142 ;1999 wRVU values for their calculations. 143 ;03/28/2007 KAM/BAY Rem Call 179232 Added RACYFLG to $S in next line 144 S RAWRVU=$$RVU^FBRVU(RACPT,RACPTMOD,$S(RAXAMDT<2990101:2990101,RACYFLG:RAXAMDT-10000,1:RAXAMDT)) 145 ;09/27/2006 KAM/BAY RA*5*77 Remedy Call 154793 146 I $P(RAWRVU,U,2)=0,RACPTMOD="" D 147 . S RAWRVU=$$RVU^FBRVU(RACPT,26,$S(RAXAMDT<2990101:2990101,RACYFLG:RAXAMDT-10000,1:RAXAMDT)) 148 I $P(RAWRVU,U)=1 D 149 .;apply bilateral multiplier if appropriate 150 .S:RABILAT RAWRVU=$P(RAWRVU,U,2)*2 151 .;or not... 152 .S:'RABILAT RAWRVU=$P(RAWRVU,U,2) 153 .I RASCLD S RAWRVU=RAWRVU*$$SFCTR^RAWRVUP($P(RA7002,U,2),RAXAMDT) 154 .Q 155 ; 156 E S RAWRVU=0 ;status some other value than 1; "in error" 157 S:RAWRVU>0 RAWRVU=$J(RAWRVU,1,2) ;do not round the value... 158 ; 159 ;^TMP($J,"RA BY STFPHYS",RASTF)=total # procedures^wRVU total(all proc) 160 ;^TMP($J,"RA BY STFPHYS",RASTF,RACPT,RAWRVU,RAPRCIEN(0))=^total # RACPT^ 161 ; total # RAWRVU 162 ; 163 S:'$D(^TMP($J,"RA BY STFPHYS",RASTF))#2 ^(RASTF)="0^0" 164 S $P(^TMP($J,"RA BY STFPHYS",RASTF),U)=$P(^TMP($J,"RA BY STFPHYS",RASTF),U)+1 165 S $P(^TMP($J,"RA BY STFPHYS",RASTF),U,2)=$P(^TMP($J,"RA BY STFPHYS",RASTF),U,2)+RAWRVU 166 S:'$D(^TMP($J,"RA BY STFPHYS",RASTF,RACPT,RAWRVU,RAPRCIEN(0)))#2 ^(RAPRCIEN(0))="^0^0" 167 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 168 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)) 169 ; 170 K RA813,RABILAT,RACPTMOD,RAI,RAWRVU 171 Q 172 ; 173 XIT ;kill variables and exit 174 W:$G(ZTSTOP)=1 !,$$CJ^XLFSTR("USER STOPPED PROCESS THROUGH TASKMAN",IOM) 175 K DIR,DIROUT,DIRUT,DTOUT,DUOUT,RA7002,RABGDTI,RABGDTX,RACNI,RACNT,RADATE 176 K RADFN,RADTE,RADTI,RAENDTI,RAENDTX,RAMBGDT,RAMENDT,RAQUIT,RARPT,RARPTIEN 177 K RARPTVDT,RAXAMDT,RAXIT,X,Y,RACYFLG 178 K ^TMP("RA STFPHYS-IEN",$J),^TMP($J,"RA BY STFPHYS") 179 Q 180 ; 181 CHKCY ;03/28/2007 KAM/BAY RA*5*77 Remedy Call 179232 Check for latest RVU 182 ;data from Fee Basis 183 ; 184 S RACYFLG=0,Y=$G(DT) D DD^%DT 185 I $$LASTCY^FBAAFSR()<$P(Y," ",3) S RACYFLG=1 186 Q
Note:
See TracChangeset
for help on using the changeset viewer.
