Context Navigation

← Previous Change
Next Change →

RAWKLU.m

Timestamp:

Dec 4, 2009, 12:11:15 AM (14 years ago)

Author:

George Lilly

Message:

revised back to 6/30/08 version

File:

: 1 edited

WorldVistAEHR/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAWKLU.m (modified) (1 diff)

Legend:

: Unmodified
: Added
: Removed

WorldVistAEHR/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAWKLU.m

-              r613
+              r623
+RAWKLU  ;HISC/GJC-physician workload statistics by wRVU or CPT ;10/26/05  14:57
+        ;;5.0;Radiology/Nuclear Medicine;**64,77,91**;Mar 16, 1998;Build 1
+        ;01/23/08 BAY/KAM Remedy Call 227583 Patch *91 Change RVU Reports to
+        ;         use Report End Date instead of Current date when setting
+        ;         the flag to determine if necessary to use last year's RVU
+        ;         data and retrieve RVU data by Verified date instead of
+        ;         Exam date
+        ;09/25/06 KAM/BAY Remedy Call 154793 PATCH *77 RVU with 0 value
+        ;         and changed CPT calls from ^ICPTCOD to ^RACPTMSC
+        ;         eliminating the need for IA's 1995 amd 1996
+        ;03/28/07 KAM/BAY Remedy Call 179232 Patch RA*5*77
+        ;         Add check to see if current RVU data is available and if
+        ;         not use previous year RVU data
+        ;
+        ;DBIA#:4799 ($$RVU^FBRVU) return wRVU value for CPT, CPT Mod, & exam
+        ;      date/time
+        ;DBIA#:10060 EN1^RASELCT enacts 10060 which allows lookups on the NEW
+        ;            PERSON (#200) file
+        ;DBIA#:10063 ($$S^%ZTLOAD)
+        ;DBIA#:10103 ($$FMTE^XLFDT) & ($$NOW^XLFDT)
+        ;DBIA#:10104 ($$CJ^XLFSTR)
+        ;DBIA#:1519  ($$EN^XUTMDEVQ)
+        ;
+EN(RARPTYP,RASCLD)      ;Identifies the option that the user wishes to execute.
+        ;input: RARPTYP="CPT" for the CPT workload report -or- "RVU" for
+        ;       wRVU workload report. Exit if the value is neither 'CPT'
+        ;       or 'RVU'.
+        ;       RASCLD=null for the CPT report, zero for non-scaled wRVU, & one
+        ;       for the scaled wRVU report.
+        ;
+        I RARPTYP'="CPT",(RARPTYP'="RVU") Q
+        I RARPTYP="CPT",(RASCLD'="") Q
+        K ^TMP($J,"RA STFPHYS"),^TMP("RA STFPHYS-IEN",$J)
+        I RARPTYP="RVU" W !!,"Please note that this report is best suited for display on a 132 column device."
+        ;
+PHYST   ;allow the user to select one/many/all physicians
+        ;(w/ staff classification) ;DBIA#: 10060
+        S RADIC="^VA(200,",RADIC(0)="QEAMZ",RAUTIL="RA STFPHYS"
+        S RADIC("A")="Select Physician: ",RADIC("B")="All"
+        S RADIC("S")="I $D(^VA(200,""ARC"",""S"",+Y))\10"
+        W !! D EN1^RASELCT(.RADIC,RAUTIL) K %W,%Y1,DIC,RADIC,RAQUIT,RAUTIL,X,Y
+        ;did the user select physicians to compile data on? if not, quit
+        I $O(^TMP($J,"RA STFPHYS",""))="" D  Q
+        .W !!?3,$C(7),"Staff Physician data was not selected."
+        .Q
+        ;
+        ;build a new staff physician array (the other array is subscripted by
+        ;physician name then IEN) subscripting by staff physician IEN this
+        ;allows us to check the IEN of the staff physician selected by the
+        ;user against the IEN of the staff physician on the exam record
+        S X="" F  S X=$O(^TMP($J,"RA STFPHYS",X)) Q:X=""  D
+        .S Y=0
+        .F  S Y=$O(^TMP($J,"RA STFPHYS",X,Y)) Q:'Y  S ^TMP("RA STFPHYS-IEN",$J,Y)=""
+        .Q
+        ;
+        K ^TMP($J,"RA STFPHYS") S RADATE=$$FMTE^XLFDT($$NOW^XLFDT\1,1)
+        ;
+STRTDT  ;Prompt the user for a starting date (VERIFIED DATE)
+        S RASTART=$$STRTDT^RAWKLU1(RADATE,2110101)
+        I RASTART=-1 D XIT Q
+        S RABGDTI=$P(RASTART,U),RABGDTX=$P(RASTART,U,2),RAMBGDT=RABGDTI-.0001
+        ;need inv. verified date to search ^RARPT("AA",
+        S RAMBGDT=9999999.9999-RAMBGDT
+        K RASTART
+        ;
+ENDDT   ;Prompt the user for an ending date (VERIFIED DATE)
+        S RAEND=$$ENDDT^RAWKLU1(RABGDTI,RABGDTX)
+        I RAEND=-1 D XIT Q
+        S RAENDTI=$P(RAEND,U),RAENDTX=$P(RAEND,U,2),RAMENDT=RAENDTI+.9999
+        ;need inv. verified date to search ^RARPT("AA",
+        S RAMENDT=9999999.9999-RAMENDT
+        K RAEND
+        ;
+        F I="RARPTYP","^TMP(""RA STFPHYS-IEN"",$J,","RADATE","RAB*","RAM*","RAE*","RASCLD" S ZTSAVE(I)=""
+        S I="RA print "_$S(RARPTYP="CPT":"CPTs",1:"wRVUs")_" totals for physicians within imaging type"
+        D EN^XUTMDEVQ("START^RAWKLU",I,.ZTSAVE,,1)
+        I +$G(ZTSK)>0 W !!,"Task Number: "_ZTSK,!
+        K I,ZTSAVE,ZTSK
+        Q
+        ;
+START   ;check exams based on criteria input by user; physician & exam D/T
+        ;eliminate the exam record is one of the following conditions is true:
+        ;1-the status of the exam is 'Cancelled'
+        ;2-the physician(s) selected are not the primary staff for the exam
+        ;
+        ;03/28/07 KAM/BAY Remedy Call 179232 Added next line
+        S RACYFLG=0
+        ;03/28/07 KAM/BAY RA*5*77/179232 Added Fee Basis Data Check
+        D CHKCY^RAWKLU2
+        S:$D(ZTQUEUED)#2 ZTREQ="@"
+        K ^TMP($J,"RA BY STFPHYS"),^TMP($J,"RA BY I-TYPE")
+        S ^TMP($J,"RA BY I-TYPE")="0^0^0^0^0^0^0^0^0",CNT=0
+        ;define where the totals for imaging type will reside on the globals
+        F RAI="RAD","MRI","CT","US","NM","VAS","ANI","CARD","MAM" S CNT=CNT+1,RAIAB(RAI)=CNT
+        K RAI,CNT S RARPTVDT=RAMBGDT,(RACNT,RAXIT)=0
+        F  S RARPTVDT=$O(^RARPT("AA",RARPTVDT),-1) Q:'RARPTVDT!(RARPTVDT<RAMENDT)  D  Q:RAXIT
+        .S RARPTIEN=0
+        .F  S RARPTIEN=$O(^RARPT("AA",RARPTVDT,RARPTIEN)) Q:'RARPTIEN  D  Q:RAXIT
+        ..S RARPT=$G(^RARPT(RARPTIEN,0)),RADFN=+$P(RARPT,U,2),RADTE=+$P(RARPT,U,3)
+        ..S RADTI=9999999.9999-RADTE,RA7002=$G(^RADPT(RADFN,"DT",RADTI,0))
+        ..Q:$P(RA7002,U,2)=""  ;no imaging type defined
+        ..S RAITYP=$P($G(^RA(79.2,$P(RA7002,U,2),0)),U,3) ;abbreviation
+        ..Q:'($D(RAIAB(RAITYP))#2)
+        ..S RACNI=0
+        ..F  S RACNI=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI)) Q:'RACNI  D  Q:RAXIT
+        ...S RA7003=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)) Q:RA7003=""  ;missing exam node
+        ...Q:$P(RA7003,U,17)'=RARPTIEN  ;exam references a different report!
+        ...S RACNT=RACNT+1
+        ...;
+        ...;did the user stop the task? Check every five hundred records...
+        ...S:RACNT#500=0 (RAXIT,ZTSTOP)=$$S^%ZTLOAD() Q:RAXIT
+        ...;
+        ...;1-begin exam status check
+        ...Q:$P($G(^RA(72,+$P(RA7003,U,3),0)),U,3)=0  ;cancelled...
+        ...;end exam status check
+        ...;
+        ...;2-begin physician check
+        ...Q:'$P(RA7003,U,15)  ;no physician, quit check
+        ...Q:'$D(^TMP("RA STFPHYS-IEN",$J,$P(RA7003,U,15)))#2
+        ...;end physician check
+        ...;
+        ...S RASTAFF=$$EXTERNAL^DILFD(70.03,15,,$P(RA7003,U,15))
+        ...I RARPTYP="CPT" D  Q
+        ....;Total the # of CPTs performed by a physician within an i-type;
+        ....;the # on CPTs performed within i-type; the # of procedures
+        ....;performed by physician. all exams are either detailed or series
+        ....;(CPT codes defined) types of procedures.
+        ....D ARY(1)
+        ....Q
+        ...D RVU
+        ...Q
+        ..Q
+        .Q
+        D EN^RAWKLU1 ;output the report
+        D XIT
+        Q
+        ;
+ARY(Y)  ;increment the array by one in the case of CPT or by the wRVU
+        ;value
+        ;input: Y=either one when adding the number of CPTs performed by a
+        ;         physician, within an i-type or by physician within i-type
+        ;    -or- the WRVU value when totaling for the aforementioned criteria
+        ;
+        S $P(^TMP($J,"RA BY STFPHYS",RASTAFF),U,RAIAB(RAITYP))=+$P($G(^TMP($J,"RA BY STFPHYS",RASTAFF)),U,RAIAB(RAITYP))+Y
+        S $P(^TMP($J,"RA BY I-TYPE"),U,RAIAB(RAITYP))=$P(^TMP($J,"RA BY I-TYPE"),U,RAIAB(RAITYP))+Y
+        Q
+        ;
+RVU     ;Total the # of wRVUs performed by a physician within an i-type; all
+        ;exams are either detailed or series types of procedures. By definition
+        ;these procedure types MUST have CPT code defined.
+        ;Pass the exam date, CPT, & CPT modifiers into the FEE BASIS function
+        ;to derive the wRVU
+        ;
+        ;get exam date/time
+        N RAXAMDT S RAXAMDT=$P(RA7002,U)
+        ;get the CPT code value
+        S RACPT=$P($G(^RAMIS(71,+$P(RA7003,U,2),0)),U,9) ;pointer to file #81
+        ; 09/27/2006 KAM/BAY Patch RA*5*77 Changed next line to use ^RACPTMSC
+        S RACPT=$P($$NAMCODE^RACPTMSC(RACPT,RAXAMDT),U,1) ;CPT code is 1st pc
+        ;
+        ;get CPT code modifier string
+        S RACPTMOD="",RABILAT=0
+        I $O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"CMOD",0))>0 S RAI=0 D
+        .F  S RAI=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"CMOD",RAI)) Q:'RAI  D
+        ..S RACPTMOD(0)=+$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"CMOD",RAI,0))
+        ..;09/27/2006 KAM/BAY RA*5*77 Changed next line to use ^RACPTMSC
+        ..S RA813(0)=$$BASICMOD^RACPTMSC(RACPTMOD(0),RAXAMDT)
+        ..I 'RABILAT,$P(RA813(0),U,2)=50 S RABILAT=1 ;bilateral multiplier=2
+        ..S RACPTMOD=RACPTMOD_$P(RA813(0),U,2)_","
+        ..Q
+        .Q
+        ;get wRVU value from FEE BASIS; returns a string: status^value^message
+        ;where status'=1 means "in error". All exams prior to 1/1/1999 will
+        ;use 1999 wRVU values for their calculations.
+        ;03/28/2007 KAM/BAY Rem Call 179232 Added RACYFLG to $S in next line
+        ;01/23/2008 KAM/BAY RA*5*91 Remedy Call 227583 Changed the next line
+        ;                   to use the Verified date of the exam date
+        S RAWRVU=$$RVU^FBRVU(RACPT,RACPTMOD,$S((9999999.9999-RARPTVDT)<2990101:2990101,RACYFLG:(9999999.9999-RARPTVDT)-10000,1:(9999999.9999-RARPTVDT)))
+        ; 09/25/2006 KAM/BAY Remedy Call 154793 Correct 0 RVUs
+        I $P(RAWRVU,U,2)=0,RACPTMOD="" D
+        . ;01/23/2008 KAM/BAY RA*5*91 Remedy Call 227583 Changed the next lin
+        . ;                   to use the Verified date of the exam date
+        . S RAWRVU=$$RVU^FBRVU(RACPT,26,$S((9999999.9999-RARPTVDT)<2990101:2990101,RACYFLG:(9999999.9999-RARPTVDT)-10000,1:(9999999.9999-RARPTVDT)))
+        ;
+        I $P(RAWRVU,U)=1 D
+        .;apply bilateral multiplier if appropriate
+        .S:RABILAT RAWRVU=$P(RAWRVU,U,2)*2
+        .;or not...
+        .S:'RABILAT RAWRVU=$P(RAWRVU,U,2)
+        .I RASCLD S RAWRVU=RAWRVU*$$SFCTR^RAWRVUP($P(RA7002,U,2),RAXAMDT)
+        .Q
+        ;
+        E  S RAWRVU=0 ;status some other value than 1; "in error"
+        S:RAWRVU>0 RAWRVU=$J(RAWRVU,1,2) ;do not round the value...
+        D ARY(RAWRVU)
+        K RA813,RABILAT,RACPT,RACPTMOD,RAI,RAWRVU
+        Q
+        ;
+XIT     ;kill variables and exit
+        W:$G(ZTSTOP)=1 !,$$CJ^XLFSTR("USER STOPPED PROCESS THROUGH TASKMAN",IOM)
+        K DIRUT,DTOUT,DUOUT,RA7002,RA7003,RABGDTI,RABGDTX,RACNI,RADATE
+        K RADFN,RADTE,RADTI,RAENDTI,RAENDTX,RAIAB,RAITYP,RAMBGDT,RAMENDT
+        K RARPT,RARPTIEN,RARPTVDT,RASTAFF,RAXIT,X,Y,^TMP("RA STFPHYS-IEN",$J)
+        K ^TMP($J,"RA BY STFPHYS"),^TMP($J,"RA BY I-TYPE"),RACYFLG
+        Q
+RAWKLU ;HISC/GJC-physician workload statistics by wRVU or CPT ;10/26/05  14:57
+ ;;5.0;Radiology/Nuclear Medicine;**64,77**;Mar 16, 1998;Build 7
+ ;09/25/06 KAM/BAY Remedy Call 154793 PATCH *77 RVU with 0 value
+ ;         and changed CPT calls from ^ICPTCOD to ^RACPTMSC
+ ;         eliminating the need for IA's 1995 amd 1996
+ ;03/28/07 KAM/BAY Remedy Call 179232 Patch RA*5*77
+ ;         Add check to see if current RVU data is available and if
+ ;         not use previous year RVU data
+ ;
+ ;DBIA#:4799 ($$RVU^FBRVU) return wRVU value for CPT, CPT Mod, & exam
+ ;      date/time
+ ;DBIA#:10060 EN1^RASELCT enacts 10060 which allows lookups on the NEW
+ ;            PERSON (#200) file
+ ;DBIA#:10063 ($$S^%ZTLOAD)
+ ;DBIA#:10103 ($$FMTE^XLFDT) & ($$NOW^XLFDT)
+ ;DBIA#:10104 ($$CJ^XLFSTR)
+ ;DBIA#:1519  ($$EN^XUTMDEVQ)
+ ;
+EN(RARPTYP,RASCLD) ;Identifies the option that the user wishes to execute.
+ ;input: RARPTYP="CPT" for the CPT workload report -or- "RVU" for
+ ;       wRVU workload report. Exit if the value is neither 'CPT'
+ ;       or 'RVU'.
+ ;       RASCLD=null for the CPT report, zero for non-scaled wRVU, & one
+ ;       for the scaled wRVU report.
+ ;
+ I RARPTYP'="CPT",(RARPTYP'="RVU") Q
+ I RARPTYP="CPT",(RASCLD'="") Q
+ K ^TMP($J,"RA STFPHYS"),^TMP("RA STFPHYS-IEN",$J)
+ I RARPTYP="RVU" W !!,"Please note that this report is best suited for display on a 132 column device."
+ ;
+PHYST ;allow the user to select one/many/all physicians
+ ;(w/ staff classification) ;DBIA#: 10060
+ S RADIC="^VA(200,",RADIC(0)="QEAMZ",RAUTIL="RA STFPHYS"
+ S RADIC("A")="Select Physician: ",RADIC("B")="All"
+ S RADIC("S")="I $D(^VA(200,""ARC"",""S"",+Y))\10"
+ W !! D EN1^RASELCT(.RADIC,RAUTIL) K %W,%Y1,DIC,RADIC,RAQUIT,RAUTIL,X,Y
+ ;did the user select physicians to compile data on? if not, quit
+ I $O(^TMP($J,"RA STFPHYS",""))="" D  Q
+ .W !!?3,$C(7),"Staff Physician data was not selected."
+ .Q
+ ;
+ ;build a new staff physician array (the other array is subscripted by
+ ;physician name then IEN) subscripting by staff physician IEN this
+ ;allows us to check the IEN of the staff physician selected by the
+ ;user against the IEN of the staff physician on the exam record
+ S X="" F  S X=$O(^TMP($J,"RA STFPHYS",X)) Q:X=""  D
+ .S Y=0
+ .F  S Y=$O(^TMP($J,"RA STFPHYS",X,Y)) Q:'Y  S ^TMP("RA STFPHYS-IEN",$J,Y)=""
+ .Q
+ ;
+ K ^TMP($J,"RA STFPHYS") S RADATE=$$FMTE^XLFDT($$NOW^XLFDT\1,1)
+ ;
+STRTDT ;Prompt the user for a starting date (VERIFIED DATE)
+ S RASTART=$$STRTDT^RAWKLU1(RADATE,2110101)
+ I RASTART=-1 D XIT Q
+ S RABGDTI=$P(RASTART,U),RABGDTX=$P(RASTART,U,2),RAMBGDT=RABGDTI-.0001
+ ;need inv. verified date to search ^RARPT("AA",
+ S RAMBGDT=9999999.9999-RAMBGDT
+ K RASTART
+ ;
+ENDDT ;Prompt the user for an ending date (VERIFIED DATE)
+ S RAEND=$$ENDDT^RAWKLU1(RABGDTI,RABGDTX)
+ I RAEND=-1 D XIT Q
+ S RAENDTI=$P(RAEND,U),RAENDTX=$P(RAEND,U,2),RAMENDT=RAENDTI+.9999
+ ;need inv. verified date to search ^RARPT("AA",
+ S RAMENDT=9999999.9999-RAMENDT
+ K RAEND
+ ;
+ F I="RARPTYP","^TMP(""RA STFPHYS-IEN"",$J,","RADATE","RAB*","RAM*","RAE*","RASCLD" S ZTSAVE(I)=""
+ S I="RA print "_$S(RARPTYP="CPT":"CPTs",1:"wRVUs")_" totals for physicians within imaging type"
+ D EN^XUTMDEVQ("START^RAWKLU",I,.ZTSAVE,,1)
+ I +$G(ZTSK)>0 W !!,"Task Number: "_ZTSK,!
+ K I,ZTSAVE,ZTSK
+ Q
+ ;
+START ;check exams based on criteria input by user; physician & exam D/T
+ ;eliminate the exam record is one of the following conditions is true:
+ ;1-the status of the exam is 'Cancelled'
+ ;2-the physician(s) selected are not the primary staff for the exam
+ ;
+ ;03/28/07 KAM/BAY Remedy Call 179232 Added next line
+ S RACYFLG=0
+ ;03/28/07 KAM/BAY RA*5*77/179232 Added Fee Basis Data Check
+ D CHKCY^RAWKLU2
+ S:$D(ZTQUEUED)#2 ZTREQ="@"
+ K ^TMP($J,"RA BY STFPHYS"),^TMP($J,"RA BY I-TYPE")
+ S ^TMP($J,"RA BY I-TYPE")="0^0^0^0^0^0^0^0^0",CNT=0
+ ;define where the totals for imaging type will reside on the globals
+ F RAI="RAD","MRI","CT","US","NM","VAS","ANI","CARD","MAM" S CNT=CNT+1,RAIAB(RAI)=CNT
+ K RAI,CNT S RARPTVDT=RAMBGDT,(RACNT,RAXIT)=0
+ F  S RARPTVDT=$O(^RARPT("AA",RARPTVDT),-1) Q:'RARPTVDT!(RARPTVDT<RAMENDT)  D  Q:RAXIT
+ .S RARPTIEN=0
+ .F  S RARPTIEN=$O(^RARPT("AA",RARPTVDT,RARPTIEN)) Q:'RARPTIEN  D  Q:RAXIT
+ ..S RARPT=$G(^RARPT(RARPTIEN,0)),RADFN=+$P(RARPT,U,2),RADTE=+$P(RARPT,U,3)
+ ..S RADTI=9999999.9999-RADTE,RA7002=$G(^RADPT(RADFN,"DT",RADTI,0))
+ ..Q:$P(RA7002,U,2)=""  ;no imaging type defined
+ ..S RAITYP=$P($G(^RA(79.2,$P(RA7002,U,2),0)),U,3) ;abbreviation
+ ..Q:'($D(RAIAB(RAITYP))#2)
+ ..S RACNI=0
+ ..F  S RACNI=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI)) Q:'RACNI  D  Q:RAXIT
+ ...S RA7003=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)) Q:RA7003=""  ;missing exam node
+ ...Q:$P(RA7003,U,17)'=RARPTIEN  ;exam references a different report!
+ ...S RACNT=RACNT+1
+ ...;
+ ...;did the user stop the task? Check every five hundred records...
+ ...S:RACNT#500=0 (RAXIT,ZTSTOP)=$$S^%ZTLOAD() Q:RAXIT
+ ...;
+ ...;1-begin exam status check
+ ...Q:$P($G(^RA(72,+$P(RA7003,U,3),0)),U,3)=0  ;cancelled...
+ ...;end exam status check
+ ...;
+ ...;2-begin physician check
+ ...Q:'$P(RA7003,U,15)  ;no physician, quit check
+ ...Q:'$D(^TMP("RA STFPHYS-IEN",$J,$P(RA7003,U,15)))#2
+ ...;end physician check
+ ...;
+ ...S RASTAFF=$$EXTERNAL^DILFD(70.03,15,,$P(RA7003,U,15))
+ ...I RARPTYP="CPT" D  Q
+ ....;Total the # of CPTs performed by a physician within an i-type;
+ ....;the # on CPTs performed within i-type; the # of procedures
+ ....;performed by physician. all exams are either detailed or series
+ ....;(CPT codes defined) types of procedures.
+ ....D ARY(1)
+ ....Q
+ ...D RVU
+ ...Q
+ ..Q
+ .Q
+ D EN^RAWKLU1 ;output the report
+ D XIT
+ Q
+ ;
+ARY(Y) ;increment the array by one in the case of CPT or by the wRVU
+ ;value
+ ;input: Y=either one when adding the number of CPTs performed by a
+ ;         physician, within an i-type or by physician within i-type
+ ;    -or- the WRVU value when totaling for the aforementioned criteria
+ ;
+ S $P(^TMP($J,"RA BY STFPHYS",RASTAFF),U,RAIAB(RAITYP))=+$P($G(^TMP($J,"RA BY STFPHYS",RASTAFF)),U,RAIAB(RAITYP))+Y
+ S $P(^TMP($J,"RA BY I-TYPE"),U,RAIAB(RAITYP))=$P(^TMP($J,"RA BY I-TYPE"),U,RAIAB(RAITYP))+Y
+ Q
+ ;
+RVU ;Total the # of wRVUs performed by a physician within an i-type; all
+ ;exams are either detailed or series types of procedures. By definition
+ ;these procedure types MUST have CPT code defined.
+ ;Pass the exam date, CPT, & CPT modifiers into the FEE BASIS function
+ ;to derive the wRVU
+ ;
+ ;get exam date/time
+ N RAXAMDT S RAXAMDT=$P(RA7002,U)
+ ;get the CPT code value
+ S RACPT=$P($G(^RAMIS(71,+$P(RA7003,U,2),0)),U,9) ;pointer to file #81
+ ; 09/27/2006 KAM/BAY Patch RA*5*77 Changed next line to use ^RACPTMSC
+ S RACPT=$P($$NAMCODE^RACPTMSC(RACPT,RAXAMDT),U,1) ;CPT code is 1st pc
+ ;
+ ;get CPT code modifier string
+ S RACPTMOD="",RABILAT=0
+ I $O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"CMOD",0))>0 S RAI=0 D
+ .F  S RAI=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"CMOD",RAI)) Q:'RAI  D
+ ..S RACPTMOD(0)=+$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"CMOD",RAI,0))
+ ..;09/27/2006 KAM/BAY RA*5*77 Changed next line to use ^RACPTMSC
+ ..S RA813(0)=$$BASICMOD^RACPTMSC(RACPTMOD(0),RAXAMDT)
+ ..I 'RABILAT,$P(RA813(0),U,2)=50 S RABILAT=1 ;bilateral multiplier=2
+ ..S RACPTMOD=RACPTMOD_$P(RA813(0),U,2)_","
+ ..Q
+ .Q
+ ;get wRVU value from FEE BASIS; returns a string: status^value^message
+ ;where status'=1 means "in error". All exams prior to 1/1/1999 will
+ ;use 1999 wRVU values for their calculations.
+ ;03/28/2007 KAM/BAY Rem Call 179232 Added RACYFLG to $S in next line
+ S RAWRVU=$$RVU^FBRVU(RACPT,RACPTMOD,$S(RAXAMDT<2990101:2990101,RACYFLG:RAXAMDT-10000,1:RAXAMDT))
+ ; 09/25/2006 KAM/BAY Remedy Call 154793 Correct 0 RVUs
+ I $P(RAWRVU,U,2)=0,RACPTMOD="" D
+ . S RAWRVU=$$RVU^FBRVU(RACPT,26,$S(RAXAMDT<2990101:2990101,RACYFLG:RAXAMDT-10000,1:RAXAMDT))
+ ;
+ I $P(RAWRVU,U)=1 D
+ .;apply bilateral multiplier if appropriate
+ .S:RABILAT RAWRVU=$P(RAWRVU,U,2)*2
+ .;or not...
+ .S:'RABILAT RAWRVU=$P(RAWRVU,U,2)
+ .I RASCLD S RAWRVU=RAWRVU*$$SFCTR^RAWRVUP($P(RA7002,U,2),RAXAMDT)
+ .Q
+ ;
+ E  S RAWRVU=0 ;status some other value than 1; "in error"
+ S:RAWRVU>0 RAWRVU=$J(RAWRVU,1,2) ;do not round the value...
+ D ARY(RAWRVU)
+ K RA813,RABILAT,RACPT,RACPTMOD,RAI,RAWRVU
+ Q
+ ;
+XIT ;kill variables and exit
+ W:$G(ZTSTOP)=1 !,$$CJ^XLFSTR("USER STOPPED PROCESS THROUGH TASKMAN",IOM)
+ K DIRUT,DTOUT,DUOUT,RA7002,RA7003,RABGDTI,RABGDTX,RACNI,RADATE
+ K RADFN,RADTE,RADTI,RAENDTI,RAENDTX,RAIAB,RAITYP,RAMBGDT,RAMENDT
+ K RARPT,RARPTIEN,RARPTVDT,RASTAFF,RAXIT,X,Y,^TMP("RA STFPHYS-IEN",$J)
+ K ^TMP($J,"RA BY STFPHYS"),^TMP($J,"RA BY I-TYPE"),RACYFLG
+ Q

Note: See TracChangeset for help on using the changeset viewer.

Context Navigation

Changeset 623 for WorldVistAEHR/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAWKLU.m

Legend:

WorldVistAEHR/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAWKLU.m

Download in other formats: