Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RAWKLU3

RAWKLU3.m

Go to the documentation of this file.
  1. RAWKLU3 ;HISC/GJC-physician wRVU (scaled too) by procedure ;10/26/05 14:57 [3/15/06 12:30pm]
  1. ;;5.0;Radiology/Nuclear Medicine;**64,77**;Mar 16, 1998;Build 7
  1. ;
  1. ;03/28/07 KAM/BAY Remedy Call 179232 Patch RA*5*77
  1. ; Add note to header if current calendar year data was
  1. ; not used in the report creation and added default
  1. ; scaling factors
  1. ;
  1. ;DBIA#:2541 ($$KSP^XUPARAM) returns the DEFAULT INSTITUTION (#217)
  1. ; from the KERNEL SYSTEM PARAMETERS (#8989.3) file.
  1. ;DBIA#:2171 ($$NAME^XUAF4) resolves the DEFAULT INSTITUTION value into
  1. ; the name of the facility
  1. ;DBIA#:10063 ($$S^%ZTLOAD)
  1. ;DBIA#:10103 ($$FMTE^XLFDT) & ($$NOW^XLFDT)
  1. ;DBIA#:10104 ($$CJ^XLFSTR)
  1. ;
  1. EN ;entry point; called from RAWKLU2...
  1. S RAFAC=$$NAME^XUAF4(+$$KSP^XUPARAM("INST"))
  1. S:RAFAC="" RAFAC="***undefined facility name***"
  1. S $P(RALN,"-",IOM+1)="",(RACNT,RAPG,RAXIT)=0
  1. S RAHDR="IMAGING PHYSICIAN "_$S(RASCLD=1:"SCALED",1:"UN-SCALED")_" wRVU SUMMARY BY CPT"
  1. S RARDATE=$$FMTE^XLFDT($$NOW^XLFDT,"1D")
  1. ;
  1. ;get the data from the global array and print it...
  1. D HDR S RASTF=""
  1. F S RASTF=$O(^TMP($J,"RA BY STFPHYS",RASTF)) Q:RASTF="" D Q:RAXIT D PHYTTL
  1. .S RADAT(0)=$G(^TMP($J,"RA BY STFPHYS",RASTF))
  1. .S RATTLXP=$P(RADAT(0),U),RATLRVUP=$P(RADAT(0),U,2)
  1. .W !,RASTF S RACPT=""
  1. .F S RACPT=$O(^TMP($J,"RA BY STFPHYS",RASTF,RACPT)) Q:RACPT="" D Q:RAXIT
  1. ..S RAWRVU=""
  1. ..F S RAWRVU=$O(^TMP($J,"RA BY STFPHYS",RASTF,RACPT,RAWRVU)) Q:RAWRVU="" D Q:RAXIT
  1. ...S RAPRC=""
  1. ...F S RAPRC=$O(^TMP($J,"RA BY STFPHYS",RASTF,RACPT,RAWRVU,RAPRC)) Q:RAPRC="" D Q:RAXIT
  1. ....S RADAT(1)=$G(^TMP($J,"RA BY STFPHYS",RASTF,RACPT,RAWRVU,RAPRC))
  1. ....S RATTLX=$P(RADAT(1),U,2) ;total # of exams
  1. ....S RATTLRVU=$P(RADAT(1),U,3) ;total wRVU for a multiple occurances of the same CPT
  1. ....S RACNT=RACNT+1 S:RACNT#500=0 (RAXIT,ZTSTOP)=$$S^%ZTLOAD() Q:RAXIT
  1. ....I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5() Q:RAXIT D HDR
  1. ....W !?2,RACPT,?12,$E(RAPRC,1,35),?50,$J(RAWRVU,6,2),?58,$J(RATTLX,8,0),?70,$J(RATTLRVU,8,2)
  1. ....Q
  1. ...Q
  1. ..Q
  1. .Q
  1. ;
  1. I RAXIT D XIT Q
  1. I 'RACNT W !,$$CJ^XLFSTR("No data found for this report",IOM) D XIT Q
  1. ;
  1. DSPSFTR ;display CY i-type scaling factors if appropriate
  1. ;04/13/2007 KAM/BAY RA*5*77 added default scaling factors
  1. I RASCLD=1 S RASFACTR="" D
  1. .I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5() Q:RAXIT D HDR
  1. .W !!,"For calendar year "_($E(DT,1,3)+1700)_" the following scaling factors apply:"
  1. .S I=0
  1. . ;04/13/07 KAM/BAY RA*5*77 Modified next line to loop thru all imaging types
  1. .F S I=$O(^RA(79.2,I)) Q:'I D Q:RAXIT
  1. ..S I(0)=$G(^RA(79.2,I,0))
  1. ..I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5() Q:RAXIT D HDR
  1. .. ;04/13/07 KAM/BAY Added $S to next line
  1. .. 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)")
  1. ..Q
  1. .Q
  1. XIT ;exit and kill variables
  1. K I,RACNT,RACPT,RADAT,RAFAC,RAHDR,RAI,RALN,RAPG,RAPRC,RARDATE,RASFACTR
  1. K RASTF,RATLRVUP,RATTLRVU,RATTLX,RATTLXP,RAWRVU
  1. Q
  1. ;
  1. HDR ; Header for our report
  1. W:RAPG!($E(IOST,1,2)="C-") @IOF
  1. S RAPG=RAPG+1
  1. W !?(IOM-$L(RAHDR)\2),RAHDR
  1. W !,"Run Date: ",RARDATE,?68,"Page: ",RAPG
  1. W !,"Facility: ",RAFAC,?41,"Date Range: ",RABGDTX_" - "_RAENDTX
  1. ;header formatting logic for CPT scaled/un-scaled wRVU reports
  1. ;03/28/07 KAM/BAY RA*5*77/179232 Added next 2 lines
  1. I $G(RACYFLG) D
  1. . W !,?7,"***This report was prepared with "_$$LASTCY^FBAAFSR()_" Calendar Year RVU Data***"
  1. 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")
  1. W:$D(RASFACTR)#2 !,"Imaging Type",?34,"Abbreviation",?49,"wRVU scaling factor"
  1. W !,RALN
  1. Q
  1. ;
  1. PHYTTL ;print the procedure & wRVU totals for the staff physician
  1. I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5() Q:RAXIT D HDR
  1. W !?59,"-------",?71,"-------",!?58,$J(RATTLXP,8,0),?70,$J(RATLRVUP,8,2)
  1. Q
  1. ;