source: FOIAVistA/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAWKLU3.m@ 1806

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

initial load of FOIAVistA 6/30/08 version

File size: 3.8 KB
Line 
1RAWKLU3 ;HISC/GJC-physician wRVU (scaled too) by procedure ;10/26/05 14:57 [3/15/06 12:30pm]
2 ;;5.0;Radiology/Nuclear Medicine;**64,77**;Mar 16, 1998;Build 7
3 ;
4 ;03/28/07 KAM/BAY Remedy Call 179232 Patch RA*5*77
5 ; Add note to header if current calendar year data was
6 ; not used in the report creation and added default
7 ; scaling factors
8 ;
9 ;DBIA#:2541 ($$KSP^XUPARAM) returns the DEFAULT INSTITUTION (#217)
10 ; from the KERNEL SYSTEM PARAMETERS (#8989.3) file.
11 ;DBIA#:2171 ($$NAME^XUAF4) resolves the DEFAULT INSTITUTION value into
12 ; the name of the facility
13 ;DBIA#:10063 ($$S^%ZTLOAD)
14 ;DBIA#:10103 ($$FMTE^XLFDT) & ($$NOW^XLFDT)
15 ;DBIA#:10104 ($$CJ^XLFSTR)
16 ;
17EN ;entry point; called from RAWKLU2...
18 S RAFAC=$$NAME^XUAF4(+$$KSP^XUPARAM("INST"))
19 S:RAFAC="" RAFAC="***undefined facility name***"
20 S $P(RALN,"-",IOM+1)="",(RACNT,RAPG,RAXIT)=0
21 S RAHDR="IMAGING PHYSICIAN "_$S(RASCLD=1:"SCALED",1:"UN-SCALED")_" wRVU SUMMARY BY CPT"
22 S RARDATE=$$FMTE^XLFDT($$NOW^XLFDT,"1D")
23 ;
24 ;get the data from the global array and print it...
25 D HDR S RASTF=""
26 F S RASTF=$O(^TMP($J,"RA BY STFPHYS",RASTF)) Q:RASTF="" D Q:RAXIT D PHYTTL
27 .S RADAT(0)=$G(^TMP($J,"RA BY STFPHYS",RASTF))
28 .S RATTLXP=$P(RADAT(0),U),RATLRVUP=$P(RADAT(0),U,2)
29 .W !,RASTF S RACPT=""
30 .F S RACPT=$O(^TMP($J,"RA BY STFPHYS",RASTF,RACPT)) Q:RACPT="" D Q:RAXIT
31 ..S RAWRVU=""
32 ..F S RAWRVU=$O(^TMP($J,"RA BY STFPHYS",RASTF,RACPT,RAWRVU)) Q:RAWRVU="" D Q:RAXIT
33 ...S RAPRC=""
34 ...F S RAPRC=$O(^TMP($J,"RA BY STFPHYS",RASTF,RACPT,RAWRVU,RAPRC)) Q:RAPRC="" D Q:RAXIT
35 ....S RADAT(1)=$G(^TMP($J,"RA BY STFPHYS",RASTF,RACPT,RAWRVU,RAPRC))
36 ....S RATTLX=$P(RADAT(1),U,2) ;total # of exams
37 ....S RATTLRVU=$P(RADAT(1),U,3) ;total wRVU for a multiple occurances of the same CPT
38 ....S RACNT=RACNT+1 S:RACNT#500=0 (RAXIT,ZTSTOP)=$$S^%ZTLOAD() Q:RAXIT
39 ....I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5() Q:RAXIT D HDR
40 ....W !?2,RACPT,?12,$E(RAPRC,1,35),?50,$J(RAWRVU,6,2),?58,$J(RATTLX,8,0),?70,$J(RATTLRVU,8,2)
41 ....Q
42 ...Q
43 ..Q
44 .Q
45 ;
46 I RAXIT D XIT Q
47 I 'RACNT W !,$$CJ^XLFSTR("No data found for this report",IOM) D XIT Q
48 ;
49DSPSFTR ;display CY i-type scaling factors if appropriate
50 ;04/13/2007 KAM/BAY RA*5*77 added default scaling factors
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
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,RACPT,RADAT,RAFAC,RAHDR,RAI,RALN,RAPG,RAPRC,RARDATE,RASFACTR
65 K RASTF,RATLRVUP,RATTLRVU,RATTLX,RATTLXP,RAWRVU
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: ",RAFAC,?41,"Date Range: ",RABGDTX_" - "_RAENDTX
74 ;header formatting logic for CPT scaled/un-scaled wRVU reports
75 ;03/28/07 KAM/BAY RA*5*77/179232 Added next 2 lines
76 I $G(RACYFLG) D
77 . W !,?7,"***This report was prepared with "_$$LASTCY^FBAAFSR()_" Calendar Year RVU Data***"
78 W:'$D(RASFACTR)#2 !!,"Staff Physician",?58,"Total #",?73,"Total",!?2,"CPT Code",?12,"Procedure",?51,$S(RASCLD=1:"SwRVU",1:" wRVU"),?58,"of exams",?73,$S(RASCLD=1:"SwRVU",1:" wRVU")
79 W:$D(RASFACTR)#2 !,"Imaging Type",?34,"Abbreviation",?49,"wRVU scaling factor"
80 W !,RALN
81 Q
82 ;
83PHYTTL ;print the procedure & wRVU totals for the staff physician
84 I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5() Q:RAXIT D HDR
85 W !?59,"-------",?71,"-------",!?58,$J(RATTLXP,8,0),?70,$J(RATLRVUP,8,2)
86 Q
87 ;
Note: See TracBrowser for help on using the repository browser.