source: FOIAVistA/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAWKLU.m@ 1757

Last change on this file since 1757 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 8.3 KB
Line 
1RAWKLU ;HISC/GJC-physician workload statistics by wRVU or CPT ;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 ;
19EN(RARPTYP,RASCLD) ;Identifies the option that the user wishes to execute.
20 ;input: RARPTYP="CPT" for the CPT workload report -or- "RVU" for
21 ; wRVU workload report. Exit if the value is neither 'CPT'
22 ; or 'RVU'.
23 ; RASCLD=null for the CPT report, zero for non-scaled wRVU, & one
24 ; for the scaled wRVU report.
25 ;
26 I RARPTYP'="CPT",(RARPTYP'="RVU") Q
27 I RARPTYP="CPT",(RASCLD'="") Q
28 K ^TMP($J,"RA STFPHYS"),^TMP("RA STFPHYS-IEN",$J)
29 I RARPTYP="RVU" W !!,"Please note that this report is best suited for display on a 132 column device."
30 ;
31PHYST ;allow the user to select one/many/all physicians
32 ;(w/ staff classification) ;DBIA#: 10060
33 S RADIC="^VA(200,",RADIC(0)="QEAMZ",RAUTIL="RA STFPHYS"
34 S RADIC("A")="Select Physician: ",RADIC("B")="All"
35 S RADIC("S")="I $D(^VA(200,""ARC"",""S"",+Y))\10"
36 W !! D EN1^RASELCT(.RADIC,RAUTIL) K %W,%Y1,DIC,RADIC,RAQUIT,RAUTIL,X,Y
37 ;did the user select physicians to compile data on? if not, quit
38 I $O(^TMP($J,"RA STFPHYS",""))="" D Q
39 .W !!?3,$C(7),"Staff Physician data was not selected."
40 .Q
41 ;
42 ;build a new staff physician array (the other array is subscripted by
43 ;physician name then IEN) subscripting by staff physician IEN this
44 ;allows us to check the IEN of the staff physician selected by the
45 ;user against the IEN of the staff physician on the exam record
46 S X="" F S X=$O(^TMP($J,"RA STFPHYS",X)) Q:X="" D
47 .S Y=0
48 .F S Y=$O(^TMP($J,"RA STFPHYS",X,Y)) Q:'Y S ^TMP("RA STFPHYS-IEN",$J,Y)=""
49 .Q
50 ;
51 K ^TMP($J,"RA STFPHYS") S RADATE=$$FMTE^XLFDT($$NOW^XLFDT\1,1)
52 ;
53STRTDT ;Prompt the user for a starting date (VERIFIED DATE)
54 S RASTART=$$STRTDT^RAWKLU1(RADATE,2110101)
55 I RASTART=-1 D XIT Q
56 S RABGDTI=$P(RASTART,U),RABGDTX=$P(RASTART,U,2),RAMBGDT=RABGDTI-.0001
57 ;need inv. verified date to search ^RARPT("AA",
58 S RAMBGDT=9999999.9999-RAMBGDT
59 K RASTART
60 ;
61ENDDT ;Prompt the user for an ending date (VERIFIED DATE)
62 S RAEND=$$ENDDT^RAWKLU1(RABGDTI,RABGDTX)
63 I RAEND=-1 D XIT Q
64 S RAENDTI=$P(RAEND,U),RAENDTX=$P(RAEND,U,2),RAMENDT=RAENDTI+.9999
65 ;need inv. verified date to search ^RARPT("AA",
66 S RAMENDT=9999999.9999-RAMENDT
67 K RAEND
68 ;
69 F I="RARPTYP","^TMP(""RA STFPHYS-IEN"",$J,","RADATE","RAB*","RAM*","RAE*","RASCLD" S ZTSAVE(I)=""
70 S I="RA print "_$S(RARPTYP="CPT":"CPTs",1:"wRVUs")_" totals for physicians within imaging type"
71 D EN^XUTMDEVQ("START^RAWKLU",I,.ZTSAVE,,1)
72 I +$G(ZTSK)>0 W !!,"Task Number: "_ZTSK,!
73 K I,ZTSAVE,ZTSK
74 Q
75 ;
76START ;check exams based on criteria input by user; physician & exam D/T
77 ;eliminate the exam record is one of the following conditions is true:
78 ;1-the status of the exam is 'Cancelled'
79 ;2-the physician(s) selected are not the primary staff for the exam
80 ;
81 ;03/28/07 KAM/BAY Remedy Call 179232 Added next line
82 S RACYFLG=0
83 ;03/28/07 KAM/BAY RA*5*77/179232 Added Fee Basis Data Check
84 D CHKCY^RAWKLU2
85 S:$D(ZTQUEUED)#2 ZTREQ="@"
86 K ^TMP($J,"RA BY STFPHYS"),^TMP($J,"RA BY I-TYPE")
87 S ^TMP($J,"RA BY I-TYPE")="0^0^0^0^0^0^0^0^0",CNT=0
88 ;define where the totals for imaging type will reside on the globals
89 F RAI="RAD","MRI","CT","US","NM","VAS","ANI","CARD","MAM" S CNT=CNT+1,RAIAB(RAI)=CNT
90 K RAI,CNT S RARPTVDT=RAMBGDT,(RACNT,RAXIT)=0
91 F S RARPTVDT=$O(^RARPT("AA",RARPTVDT),-1) Q:'RARPTVDT!(RARPTVDT<RAMENDT) D Q:RAXIT
92 .S RARPTIEN=0
93 .F S RARPTIEN=$O(^RARPT("AA",RARPTVDT,RARPTIEN)) Q:'RARPTIEN D Q:RAXIT
94 ..S RARPT=$G(^RARPT(RARPTIEN,0)),RADFN=+$P(RARPT,U,2),RADTE=+$P(RARPT,U,3)
95 ..S RADTI=9999999.9999-RADTE,RA7002=$G(^RADPT(RADFN,"DT",RADTI,0))
96 ..Q:$P(RA7002,U,2)="" ;no imaging type defined
97 ..S RAITYP=$P($G(^RA(79.2,$P(RA7002,U,2),0)),U,3) ;abbreviation
98 ..Q:'($D(RAIAB(RAITYP))#2)
99 ..S RACNI=0
100 ..F S RACNI=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI)) Q:'RACNI D Q:RAXIT
101 ...S RA7003=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)) Q:RA7003="" ;missing exam node
102 ...Q:$P(RA7003,U,17)'=RARPTIEN ;exam references a different report!
103 ...S RACNT=RACNT+1
104 ...;
105 ...;did the user stop the task? Check every five hundred records...
106 ...S:RACNT#500=0 (RAXIT,ZTSTOP)=$$S^%ZTLOAD() Q:RAXIT
107 ...;
108 ...;1-begin exam status check
109 ...Q:$P($G(^RA(72,+$P(RA7003,U,3),0)),U,3)=0 ;cancelled...
110 ...;end exam status check
111 ...;
112 ...;2-begin physician check
113 ...Q:'$P(RA7003,U,15) ;no physician, quit check
114 ...Q:'$D(^TMP("RA STFPHYS-IEN",$J,$P(RA7003,U,15)))#2
115 ...;end physician check
116 ...;
117 ...S RASTAFF=$$EXTERNAL^DILFD(70.03,15,,$P(RA7003,U,15))
118 ...I RARPTYP="CPT" D Q
119 ....;Total the # of CPTs performed by a physician within an i-type;
120 ....;the # on CPTs performed within i-type; the # of procedures
121 ....;performed by physician. all exams are either detailed or series
122 ....;(CPT codes defined) types of procedures.
123 ....D ARY(1)
124 ....Q
125 ...D RVU
126 ...Q
127 ..Q
128 .Q
129 D EN^RAWKLU1 ;output the report
130 D XIT
131 Q
132 ;
133ARY(Y) ;increment the array by one in the case of CPT or by the wRVU
134 ;value
135 ;input: Y=either one when adding the number of CPTs performed by a
136 ; physician, within an i-type or by physician within i-type
137 ; -or- the WRVU value when totaling for the aforementioned criteria
138 ;
139 S $P(^TMP($J,"RA BY STFPHYS",RASTAFF),U,RAIAB(RAITYP))=+$P($G(^TMP($J,"RA BY STFPHYS",RASTAFF)),U,RAIAB(RAITYP))+Y
140 S $P(^TMP($J,"RA BY I-TYPE"),U,RAIAB(RAITYP))=$P(^TMP($J,"RA BY I-TYPE"),U,RAIAB(RAITYP))+Y
141 Q
142 ;
143RVU ;Total the # of wRVUs performed by a physician within an i-type; all
144 ;exams are either detailed or series types of procedures. By definition
145 ;these procedure types MUST have CPT code defined.
146 ;Pass the exam date, CPT, & CPT modifiers into the FEE BASIS function
147 ;to derive the wRVU
148 ;
149 ;get exam date/time
150 N RAXAMDT S RAXAMDT=$P(RA7002,U)
151 ;get the CPT code value
152 S RACPT=$P($G(^RAMIS(71,+$P(RA7003,U,2),0)),U,9) ;pointer to file #81
153 ; 09/27/2006 KAM/BAY Patch RA*5*77 Changed next line to use ^RACPTMSC
154 S RACPT=$P($$NAMCODE^RACPTMSC(RACPT,RAXAMDT),U,1) ;CPT code is 1st pc
155 ;
156 ;get CPT code modifier string
157 S RACPTMOD="",RABILAT=0
158 I $O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"CMOD",0))>0 S RAI=0 D
159 .F S RAI=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"CMOD",RAI)) Q:'RAI D
160 ..S RACPTMOD(0)=+$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"CMOD",RAI,0))
161 ..;09/27/2006 KAM/BAY RA*5*77 Changed next line to use ^RACPTMSC
162 ..S RA813(0)=$$BASICMOD^RACPTMSC(RACPTMOD(0),RAXAMDT)
163 ..I 'RABILAT,$P(RA813(0),U,2)=50 S RABILAT=1 ;bilateral multiplier=2
164 ..S RACPTMOD=RACPTMOD_$P(RA813(0),U,2)_","
165 ..Q
166 .Q
167 ;get wRVU value from FEE BASIS; returns a string: status^value^message
168 ;where status'=1 means "in error". All exams prior to 1/1/1999 will
169 ;use 1999 wRVU values for their calculations.
170 ;03/28/2007 KAM/BAY Rem Call 179232 Added RACYFLG to $S in next line
171 S RAWRVU=$$RVU^FBRVU(RACPT,RACPTMOD,$S(RAXAMDT<2990101:2990101,RACYFLG:RAXAMDT-10000,1:RAXAMDT))
172 ; 09/25/2006 KAM/BAY Remedy Call 154793 Correct 0 RVUs
173 I $P(RAWRVU,U,2)=0,RACPTMOD="" D
174 . S RAWRVU=$$RVU^FBRVU(RACPT,26,$S(RAXAMDT<2990101:2990101,RACYFLG:RAXAMDT-10000,1:RAXAMDT))
175 ;
176 I $P(RAWRVU,U)=1 D
177 .;apply bilateral multiplier if appropriate
178 .S:RABILAT RAWRVU=$P(RAWRVU,U,2)*2
179 .;or not...
180 .S:'RABILAT RAWRVU=$P(RAWRVU,U,2)
181 .I RASCLD S RAWRVU=RAWRVU*$$SFCTR^RAWRVUP($P(RA7002,U,2),RAXAMDT)
182 .Q
183 ;
184 E S RAWRVU=0 ;status some other value than 1; "in error"
185 S:RAWRVU>0 RAWRVU=$J(RAWRVU,1,2) ;do not round the value...
186 D ARY(RAWRVU)
187 K RA813,RABILAT,RACPT,RACPTMOD,RAI,RAWRVU
188 Q
189 ;
190XIT ;kill variables and exit
191 W:$G(ZTSTOP)=1 !,$$CJ^XLFSTR("USER STOPPED PROCESS THROUGH TASKMAN",IOM)
192 K DIRUT,DTOUT,DUOUT,RA7002,RA7003,RABGDTI,RABGDTX,RACNI,RADATE
193 K RADFN,RADTE,RADTI,RAENDTI,RAENDTX,RAIAB,RAITYP,RAMBGDT,RAMENDT
194 K RARPT,RARPTIEN,RARPTVDT,RASTAFF,RAXIT,X,Y,^TMP("RA STFPHYS-IEN",$J)
195 K ^TMP($J,"RA BY STFPHYS"),^TMP($J,"RA BY I-TYPE"),RACYFLG
196 Q
Note: See TracBrowser for help on using the repository browser.