source: WorldVistAEHR/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAWKLU2.m@ 613

Last change on this file since 613 was 613, checked in by George Lilly, 14 years ago

initial load of WorldVistAEHR
File size: 8.6 KB
Line 
1RAWKLU2 ;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 ;
28EN(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 ;
34PHYST ;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 ;
56STRTDT ;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 ;
64ENDDT ;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 ;
79START ;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 ;
104XAM ; 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 ;
132SETARRY ;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 ;
184XIT ;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 ;
192CHKCY ;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
Note: See TracBrowser for help on using the repository browser.