source: FOIAVistA/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAWKLU1.m@ 802

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

initial load of FOIAVistA 6/30/08 version
File size: 7.0 KB
Line 
1RAWKLU1 ;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 ;03/28/07 KAM/BAY Remedy Call 179232 Patch RA*5*77
4 ; Add note to header if current calendar year data was
5 ; not used used in the report creation and add default
6 ; scaling factors to print
7 ;
8 ;DBIA#:2541 ($$KSP^XUPARAM) returns the DEFAULT INSTITUTION (#217)
9 ; from the KERNEL SYSTEM PARAMETERS (#8989.3) file.
10 ;DBIA#:2171 ($$NAME^XUAF4) resolves the DEFAULT INSTITUTION value into
11 ; the name of the facility
12 ;DBIA#:10063 ($$S^%ZTLOAD)
13 ;DBIA#:10103 ($$FMTE^XLFDT) & ($$NOW^XLFDT)
14 ;
15EN ;entry point; called from RAWKLU...
16 S RAFAC=$$NAME^XUAF4(+$$KSP^XUPARAM("INST"))
17 S:RAFAC="" RAFAC="***undefined facility name***"
18 S $P(RALN,"-",IOM+1)="",(RACNT,RAPG)=0
19 S RAHDR="IMAGING PHYSICIAN WORKLOAD SUMMARY BY "
20 I RARPTYP="CPT" S RAHDR=RAHDR_"NUMBER OF CPT CODES"
21 I RARPTYP="RVU" S RAHDR=RAHDR_$S(RASCLD=1:"SCALED ",1:"")_"PROFESSIONAL COMPONENT CMS RVU"
22 S RARDATE=$$FMTE^XLFDT($$NOW^XLFDT,"1D")
23 ;
24 ;$O through physician names; print totals...
25 I RARPTYP="RVU" S RATMP="("_$S(RASCLD'=1:"un-s",1:"S")_"caled wRVU)"
26 S RAPCE=$S(RARPTYP="CPT":3,RARPTYP="RVU"&(IOM=132):5,1:7)
27 S RATRUNC=$S(RARPTYP="CPT":20,RARPTYP="RVU"&(IOM=80):23,1:27)
28 S RAWDTH=$S(RARPTYP="CPT":5,1:8),RADEC=$S(RARPTYP="RVU":2,1:0)
29 D HDR S RAX=""
30 F S RAX=$O(^TMP($J,"RA BY STFPHYS",RAX)) Q:RAX="" D Q:RAXIT
31 .S RACNT=RACNT+1,RAY=$G(^TMP($J,"RA BY STFPHYS",RAX)),RATOT=0
32 .;did the user stop the task? Check every five hundred records...
33 .S:RACNT#500=0 (RAXIT,ZTSTOP)=$$S^%ZTLOAD() Q:RAXIT
34 .W !,$E(RAX,1,RATRUNC) ;physician name
35 .D WRITE(RAPCE,0,RAY,RAWDTH,RADEC)
36 .S RAFMAT=$P($T(CFMAT+10),";;",2,99)
37 .;single physician total for all i-types - adj RAWDTH for totals
38 .W ?$P(RAFMAT,U,RAPCE),$J(RATOT,$S(RAWDTH=8:10,1:6),RADEC)
39 .I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5() Q:RAXIT D HDR
40 .Q
41 ;print the imaging type and physician totals...
42 I RAXIT D XIT Q
43 I 'RACNT W !,$$CJ^XLFSTR("No data found for this report",IOM) D XIT Q
44 I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5() Q:RAXIT D HDR
45 S RAY=$G(^TMP($J,"RA BY I-TYPE")),RATOT=0
46 W !!,"Physician Total"
47 D WRITE(RAPCE,0,RAY,RAWDTH,RADEC)
48 S RAFMAT=$P($T(CFMAT+10),";;",2,99)
49 ;total for all physicians for all i-types - adj RAWDTH for totals
50 W ?$P(RAFMAT,U,RAPCE),$J(RATOT,$S(RAWDTH=8:10,1:6),RADEC) ;physician total for all i-types
51 I RASCLD=1 S RASFACTR="" D
52 .I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5() Q:RAXIT D HDR
53 .W !!,"For calendar year "_($E(DT,1,3)+1700)_" the following scaling factors apply:"
54 .S I=0
55 . ;04/13/07 KAM/BAY RA*5*77 Modified next line to loop thru all imaging types
56 .F S I=$O(^RA(79.2,I)) Q:'I D Q:RAXIT
57 ..S I(0)=$G(^RA(79.2,I,0))
58 ..I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5() Q:RAXIT D HDR
59 .. ;04/13/07 KAM/BAY Added $S to next line for default
60 .. W !,$P(I(0),U),?34,$P(I(0),U,3),?49,$S($O(^RA(79.2,I,"CY",0))>0:$$SFCTR^RAWRVUP(I,DT),1:"1.00 (default)")
61 ..Q
62 .Q
63XIT ;exit and kill variables
64 K I,RACNT,RADEC,RAFAC,RAFMAT,RAHDR,RAI,RALN,RAPCE,RAPG,RARDATE,RASFACTR,RATAB,RATMP,RATOT
65 K RATRUNC,RAWDTH,RAX,RAY
66 Q
67 ;
68HDR ; Header for our report
69 W:RAPG!($E(IOST,1,2)="C-") @IOF
70 S RAPG=RAPG+1
71 W !?(IOM-$L(RAHDR)\2),RAHDR
72 W !,"Run Date: ",RARDATE,?68,"Page: ",RAPG
73 W !,"Facility: ",$E(RAFAC,1,40),?41,"Date Range: ",RABGDTX_" - "_RAENDTX
74 ;03/28/07 KAM/BAY RA*5*77/179232 Added next 2 lines
75 I $G(RACYFLG) D
76 . W !,?7,"***This report was prepared with "_$$LASTCY^FBAAFSR()_" Calendar Year RVU Data***"
77 ;header formatting logic for CPT & RVU reports
78 W:RARPTYP="RVU" !,$$CJ^XLFSTR(RATMP,IOM)
79 W:RARPTYP="CPT" ! ;CPT report
80 N RAPCE S RAPCE=$S(RARPTYP="CPT":2,RARPTYP="RVU"&(IOM=132):4,1:6)
81 I '$D(RASFACTR)#2 D
82 .W !,"Physician" D WRITE(RAPCE,1)
83 W:$D(RASFACTR)#2 !,"Imaging Type",?34,"Abbreviation",?49,"wRVU scaling factor"
84 W !,RALN
85 Q
86 ;
87STRTDT(RADATE,RAEARLY) ;Prompt the user for the starting date report verified
88 ;RADATE-Today's date; DT-implicitly defined as today's date(internal format)
89 ;RAEARLY-Earliest conceivable starting date
90 W ! K DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y N RARSLT
91 S DIR(0)="DA^"_RAEARLY_":"_"DT:PEX"
92 S DIR("A",1)="Calculate physician workload over a date range; enter a start date"
93 S DIR("A")="of: "
94 S DIR("?",1)="Workload is assigned on the date the report is verified, not the date"
95 S DIR("?",2)="the report is dictated.",DIR("?",3)=""
96 S DIR("?",4)="This is the date from which our search will begin. The starting"
97 S DIR("?",5)="date must not precede: "_$$FMTE^XLFDT(RAEARLY,"1D")_" and must not come after: "_RADATE_"."
98 S DIR("?")="Dates associated with a time will not be accepted."
99 S DIR("B")=RADATE D ^DIR
100 S:$D(DIRUT) RARSLT=-1 S:'$D(DIRUT) RARSLT=Y_U_Y(0)
101 K DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
102 Q RARSLT
103 ;
104ENDDT(RABGDTI,RABGDTX) ;Prompt the user for the ending date report verified (no greater than a
105 ;year after the start date input by the user)
106 ;DT-implicitly defined as today's date(internal format)
107 ;RABGDTI-The search start date (selected by the user; internal format)
108 ;RABGDTX-The search start date (selected by the user; external format)
109 W ! K DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y N RAEND,RARSLT
110 ;is today's date 365 days or more past the start date? If yes, calculate end date
111 ;by adding a year to the start date selected by the user
112 I $$FMDIFF^XLFDT(DT,RABGDTI,1)'<365 S RAEND=$$FMADD^XLFDT(RABGDTI,365,0,0,0)
113 ;if not, default using DT (today's date)
114 S:'$D(RAEND)#2 RAEND=DT
115 S DIR(0)="DA^"_RABGDTI_":"_RAEND_":PEX"
116 S DIR("A")="Enter an end date of: "
117 S DIR("?",1)="Workload is assigned on the date the report is verified, not the date"
118 S DIR("?",2)="the report is dictated.",DIR("?",3)=""
119 S DIR("?",4)="This is the date in which our search will end. The ending date"
120 S DIR("?",5)="must not precede: "_RABGDTX_" and must not exceed: "_$$FMTE^XLFDT(RAEND,"1D")_"."
121 S DIR("?")="Dates associated with a time will not be accepted."
122 S DIR("B")=$$FMTE^XLFDT(RAEND,"1D") D ^DIR K DIR
123 S:$D(DIRUT) RARSLT=-1 S:'$D(DIRUT) RARSLT=Y_U_Y(0)
124 K DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
125 Q RARSLT
126 ;
127WRITE(RAPCE,HDR,RAY,RAWDTH,RADEC) ;Write out the column headers and the data for our reports.
128 ;input: RAPCE=the piece of data referenced from the format string defined in CFMAT (req'd)
129 ; HDR=1 if called from the HDR subroutine, else HDR is 0 (req'd)
130 ; RAY=data to be printed; not a label (optional)
131 ; RAWDTH=field width; right justified (optional)
132 ; RADEC=number of decimal places; either zero or two (optional)
133 S RANGE=$S(HDR=1:10,1:9)
134 F RAI=1:1:RANGE S RAFMAT=$P($T(CFMAT+RAI),";;",2,99) D
135 .S RATAB=$P(RAFMAT,U,RAPCE) S:HDR=0 RATOT=RATOT+$P(RAY,U,RAI)
136 .I $P(RAFMAT,U)="NUC",((RAPCE=6)!(RAPCE=7)) W ! ;RVU on 80
137 .W ?RATAB,$S(HDR=1:$P(RAFMAT,U),1:$J(+$P(RAY,U,RAI),RAWDTH,RADEC))
138 .Q
139 K RANGE
140 Q
141 ;
142CFMAT ;ImgTyp Abbr^colabbr-cpt80^col-data80^colabbr-rvu132^col-data132^colabbr-rvu80^col-data80
143 ;;RAD^23^21^34^29^30^25
144 ;;MRI^29^27^45^40^40^35
145 ;;CT^36^33^56^50^51^45
146 ;;US^42^39^66^60^61^55
147 ;;NUC^47^45^75^70^14^9
148 ;;VAS^53^51^85^80^25^20
149 ;;ANI^59^57^95^91^36^31
150 ;;CARD^64^63^104^100^46^42
151 ;;MAM^70^67^115^110^58^53
152 ;;Total^75^74^125^120^70^65
153 ;;
Note: See TracBrowser for help on using the repository browser.