- RAWRVUP ;HISC/GJC-Display procedures with their wRVU values ;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 and added default scaling
- ; factors
- ;
- ;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)
- ;DBIA#:4432 (LASTCY^FBAAFSR) return last calendar year file
- ; 162.99 was updated
- ;
- EN(RASCLD) ;entry point
- ;input: RASCLD=one if scaled, 0 if un-scaled
- K ^TMP($J,"RA PROCEDURES")
- ;
- PROC ;allow the user to select one/many/all Rad/Nuc Med procedures
- S RADIC="^RAMIS(71,",RADIC(0)="QEAMZ",RAUTIL="RA PROCEDURES"
- S RADIC("A")="Select Procedures: ",RADIC("B")="All",RAXIT=0
- ;screen: based on user selection of procedure activity and that the
- ;procedure must have a CPT code (only detailed and series procedures)
- S RADIC("S")="I $P(^(0),U,9)" ;must have a CPT code (detailed/series)
- W !! D EN1^RASELCT(.RADIC,RAUTIL)
- S RAXIT=RAQUIT 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 PROCEDURES",""))="" D D XIT Q
- .W !!?3,$C(7),"Rad/Nuc Med Procedures were not selected."
- .Q
- ;
- F I="RASCLD","^TMP($J,""RA PROCEDURES""," S ZTSAVE(I)=""
- S I="RA print wRVUs for Rad/Nuc Med procedures"
- D EN^XUTMDEVQ("START^RAWRVUP",I,.ZTSAVE,,1)
- I +$G(ZTSK)>0 W !!,"Task Number: "_ZTSK,!
- K I,ZTSAVE,ZTSK
- Q
- ;
- START ;
- S:$D(ZTQUEUED)#2 ZTREQ="@"
- ; 03/29/07 KAM/BAY Patch RA*5*77/179232 Added RACYFLG to next line
- S $P(RALN,"-",IOM+1)="",(RACNT,RAPG,RAXIT,RACYFLG)=0
- ;03/29/07 KAM/BAY RA*5*77/179232 Added Fee Basis Data Check
- D CHKCY
- S RARUNDT=$$FMTE^XLFDT(DT,"1P")
- S RAHDR="PROCEDURE CPT CODE AND"_$S(RASCLD=1:" SCALED",1:"")_" WORK RELATIVE VALUE UNITS (wRVU)"
- S RAX="" D HDR
- F S RAX=$O(^TMP($J,"RA PROCEDURES",RAX)) Q:RAX="" D Q:RAXIT
- .S RAY=0
- .F S RAY=$O(^TMP($J,"RA PROCEDURES",RAX,RAY)) Q:'RAY D Q:RAXIT
- ..S RACNT=RACNT+1 S:RACNT#500=0 (RAXIT,ZTSTOP)=$$S^%ZTLOAD() Q:RAXIT
- ..S RAMIS(0)=$G(^RAMIS(71,RAY,0))
- ..S RAPROC=$E($P(RAMIS(0),U),1,35) ;truncate to thirty-five chars
- ..S RAPTYPE=$S($P(RAMIS(0),U,6)="D":"Detailed",1:"Series")
- ..S RAITYPE=$P($G(^RA(79.2,+$P(RAMIS(0),U,12),0)),U,3)
- ..;09/27/2006 KAM/BAY RA*5*77 Changed next line to use ^RACPTMSC
- ..S RACPT=$P(RAMIS(0),U,9),RACPT=$P($$NAMCODE^RACPTMSC(RACPT,DT),U,1)
- ..;determine if there are default CPT modifiers for this procedure; if
- ..;so, does one indicate 'bilateral'? If bilateral multiply wRVU by two.
- ..S RACPTMOD="",RABILAT=0
- ..I $O(^RAMIS(71,RAY,"DCM",0))>0 S RAI=0 D
- ...F S RAI=$O(^RAMIS(71,RAY,"DCM",RAI)) Q:'RAI D
- ....S RACPTMOD(0)=+$G(^RAMIS(71,RAY,"DCM",RAI,0))
- ....;09/27/2006 KAM/BAY RA*5*77 Changed next line to use ^RACPTMSC
- ....S RA813(0)=$$BASICMOD^RACPTMSC(RACPTMOD(0),DT)
- ....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"
- .. ;03/29/07 KAM/BAY RA*5*77/179232 Added $S to next line
- ..S RAWRVU=$$RVU^FBRVU(RACPT,RACPTMOD,$S(RACYFLG:DT-10000,1:DT))
- .. ; 09/25/2006 Remedy call 154793 Correct 0 RVUs
- .. I $P(RAWRVU,U,2)=0,RACPTMOD="" D
- ... ;03/29/07 KAM/BAY RA*5*77/179232 Added $S to next line
- ... S RAWRVU=$$RVU^FBRVU(RACPT,26,$S(RACYFLG:DT-10000,1:DT))
- .. ;
- ..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)
- ...Q
- ..E S RAWRVU=0 ;status some other value than 1; "in error"
- ..;
- ..S:RAWRVU>0 RAWRVU=$J(RAWRVU,1,2)
- ..;
- SCALED ..;when scaled find scaled wRVU value
- ..I RASCLD=1,(RAWRVU>0) D
- ...S RASFACTR=$$SFCTR(+$P(RAMIS(0),U,12)) ;pass i-type ptr
- ...S RASWRVU=$J((RAWRVU*RASFACTR),1,2)
- ...Q
- ..E S RASWRVU=0 ;mult by zero
- ..;
- ..W !,RAPROC,?37,RAPTYPE,?48,RAITYPE,?58,RACPT,?68,$S(RASCLD=1:$J(RASWRVU,7,2),1:$J(RAWRVU,7,2))
- ..I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5() D:'RAXIT HDR
- ..Q
- .Q
- I 'RAXIT,(RASCLD) S RASFACTR(0)="" D
- .I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5() Q:RAXIT D HDR
- .W !!,"For calendar year "_($E(DT,1,3)+1700)_" the following scaling factors apply:"
- .S I=0
- . ;04/13/07 KAM/BAY RA*5*77 Modified next line to loop thru all imaging types
- .F S I=$O(^RA(79.2,I)) Q:'I D Q:RAXIT
- ..S I(0)=$G(^RA(79.2,I,0))
- ..I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5() Q:RAXIT D HDR
- ..; 04/13/07 KAM/BAY RA*5*77 Added $S to next line
- .. 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)")
- ..Q
- .S RAXIT=$$EOS^RAUTL5()
- .Q
- D XIT
- Q
- ;
- HDR ; Header for our report
- W:RAPG!($E(IOST,1,2)="C-") @IOF
- S RAPG=RAPG+1 W !?(IOM-$L(RAHDR)\2),RAHDR
- W !,"Run Date: ",RARUNDT,?68,"Page: ",RAPG
- ;03/28/07 KAM/BAY RA*5*77/179232 Added next 2 lines
- I $G(RACYFLG) D
- . W !,?7,"***This report was prepared with "_$$LASTCY^FBAAFSR()_" Calendar Year RVU Data***"
- W:'$D(RASFACTR(0))#2 !!,"Procedure",?37,"Proc Type",?48,"Img Type",?58,"CPT Code",?68,$S(RASCLD=1:" S",1:" ")_"wRVU"
- W:$D(RASFACTR(0))#2 !!,"Imaging Type",?34,"Abbreviation",?51,"wRVU scaling factor"
- W !,RALN
- Q
- ;
- XIT ;kill variables and exit
- I 'RAXIT W:'RACNT !,$$CJ^XLFSTR("No data found for this report",IOM)
- K DILN,DTOUT,DUOUT,I,POP,RA813,RABILAT,RACNT,RACPT,RACPTMOD,RAHDR,RAI
- K RAITYPE,RALN,RAMIS,RAPTYPE,RAPG,RAPROC,RARUNDT,RASCLD,RASFACTR
- K RASWRVU,RAWRVU,RAX,RAXIT,RAY,RAYEAR,X,Y,RACYFLG
- K ^TMP($J,"RA PROCEDURES")
- Q
- ;
- SFCTR(RAITYP,RAYEAR) ;return the calendar year specific scaling factor for a
- ;specific imaging type
- ;input: RAITYP=imaging type
- ; RAYEAR=internal FM date/time format; resolves to current year
- ;return: calendar year specific scaling factor
- N RASF,RAYR S RAYEAR=$G(RAYEAR,DT) ;default to DT (current year)
- S (RAYEAR,RAYR)=$E(RAYEAR,1,3)+1700
- S RASF=+$O(^RA(79.2,RAITYP,"CY","B",RAYEAR,0))
- ;if RASF=0 for the current year, check for the most recent year
- I RASF=0 D
- .S RAYEAR=+$O(^RA(79.2,1,"CY","B",RAYEAR),-1)
- .S RASF=+$O(^RA(79.2,RAITYP,"CY","B",RAYEAR,0))
- .Q
- S RASF=+$P($G(^RA(79.2,RAITYP,"CY",RASF,0)),U,2)
- S:RASF=0 RASF=1 ;defaults to one
- Q $J(RASF,$L(RASF),2)_$S(RAYEAR:" ("_RAYR_")",1:"")
- ;
- CHKCY ;03/28/2007 KAM/BAY RA*5*77 Remedy Call 179232 Check for latest RVU
- ;data from Fee Basis
- S RACYFLG=0,Y=$G(DT) D DD^%DT
- I $$LASTCY^FBAAFSR()<$P(Y," ",3) S RACYFLG=1
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAWRVUP 7067 printed Jan 18, 2025@03:41:48 Page 2
- RAWRVUP ;HISC/GJC-Display procedures with their wRVU values ;10/26/05 14:57
- +1 ;;5.0;Radiology/Nuclear Medicine;**64,77**;Mar 16, 1998;Build 7
- +2 ;09/25/06 KAM/BAY Remedy Call 154793 PATCH *77 RVU with 0 value
- +3 ; and changed CPT calls from ^ICPTCOD to ^RACPTMSC
- +4 ; eliminating the need for IA's 1995 amd 1996
- +5 ;03/28/07 KAM/BAY Remedy Call 179232 Patch RA*5*77
- +6 ; Add check to see if current RVU data is available and if
- +7 ; not use previous year RVU data and added default scaling
- +8 ; factors
- +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 ;DBIA#:4432 (LASTCY^FBAAFSR) return last calendar year file
- +19 ; 162.99 was updated
- +20 ;
- EN(RASCLD) ;entry point
- +1 ;input: RASCLD=one if scaled, 0 if un-scaled
- +2 KILL ^TMP($JOB,"RA PROCEDURES")
- +3 ;
- PROC ;allow the user to select one/many/all Rad/Nuc Med procedures
- +1 SET RADIC="^RAMIS(71,"
- SET RADIC(0)="QEAMZ"
- SET RAUTIL="RA PROCEDURES"
- +2 SET RADIC("A")="Select Procedures: "
- SET RADIC("B")="All"
- SET RAXIT=0
- +3 ;screen: based on user selection of procedure activity and that the
- +4 ;procedure must have a CPT code (only detailed and series procedures)
- +5 ;must have a CPT code (detailed/series)
- SET RADIC("S")="I $P(^(0),U,9)"
- +6 WRITE !!
- DO EN1^RASELCT(.RADIC,RAUTIL)
- +7 SET RAXIT=RAQUIT
- KILL %W,%Y1,DIC,RADIC,RAQUIT,RAUTIL,X,Y
- +8 ;did the user select physicians to compile data on? if not, quit
- +9 IF $ORDER(^TMP($JOB,"RA PROCEDURES",""))=""
- Begin DoDot:1
- +10 WRITE !!?3,$CHAR(7),"Rad/Nuc Med Procedures were not selected."
- +11 QUIT
- End DoDot:1
- DO XIT
- QUIT
- +12 ;
- +13 FOR I="RASCLD","^TMP($J,""RA PROCEDURES"","
- SET ZTSAVE(I)=""
- +14 SET I="RA print wRVUs for Rad/Nuc Med procedures"
- +15 DO EN^XUTMDEVQ("START^RAWRVUP",I,.ZTSAVE,,1)
- +16 IF +$GET(ZTSK)>0
- WRITE !!,"Task Number: "_ZTSK,!
- +17 KILL I,ZTSAVE,ZTSK
- +18 QUIT
- +19 ;
- START ;
- +1 if $DATA(ZTQUEUED)#2
- SET ZTREQ="@"
- +2 ; 03/29/07 KAM/BAY Patch RA*5*77/179232 Added RACYFLG to next line
- +3 SET $PIECE(RALN,"-",IOM+1)=""
- SET (RACNT,RAPG,RAXIT,RACYFLG)=0
- +4 ;03/29/07 KAM/BAY RA*5*77/179232 Added Fee Basis Data Check
- +5 DO CHKCY
- +6 SET RARUNDT=$$FMTE^XLFDT(DT,"1P")
- +7 SET RAHDR="PROCEDURE CPT CODE AND"_$SELECT(RASCLD=1:" SCALED",1:"")_" WORK RELATIVE VALUE UNITS (wRVU)"
- +8 SET RAX=""
- DO HDR
- +9 FOR
- SET RAX=$ORDER(^TMP($JOB,"RA PROCEDURES",RAX))
- if RAX=""
- QUIT
- Begin DoDot:1
- +10 SET RAY=0
- +11 FOR
- SET RAY=$ORDER(^TMP($JOB,"RA PROCEDURES",RAX,RAY))
- if 'RAY
- QUIT
- Begin DoDot:2
- +12 SET RACNT=RACNT+1
- if RACNT#500=0
- SET (RAXIT,ZTSTOP)=$$S^%ZTLOAD()
- if RAXIT
- QUIT
- +13 SET RAMIS(0)=$GET(^RAMIS(71,RAY,0))
- +14 ;truncate to thirty-five chars
- SET RAPROC=$EXTRACT($PIECE(RAMIS(0),U),1,35)
- +15 SET RAPTYPE=$SELECT($PIECE(RAMIS(0),U,6)="D":"Detailed",1:"Series")
- +16 SET RAITYPE=$PIECE($GET(^RA(79.2,+$PIECE(RAMIS(0),U,12),0)),U,3)
- +17 ;09/27/2006 KAM/BAY RA*5*77 Changed next line to use ^RACPTMSC
- +18 SET RACPT=$PIECE(RAMIS(0),U,9)
- SET RACPT=$PIECE($$NAMCODE^RACPTMSC(RACPT,DT),U,1)
- +19 ;determine if there are default CPT modifiers for this procedure; if
- +20 ;so, does one indicate 'bilateral'? If bilateral multiply wRVU by two.
- +21 SET RACPTMOD=""
- SET RABILAT=0
- +22 IF $ORDER(^RAMIS(71,RAY,"DCM",0))>0
- SET RAI=0
- Begin DoDot:3
- +23 FOR
- SET RAI=$ORDER(^RAMIS(71,RAY,"DCM",RAI))
- if 'RAI
- QUIT
- Begin DoDot:4
- +24 SET RACPTMOD(0)=+$GET(^RAMIS(71,RAY,"DCM",RAI,0))
- +25 ;09/27/2006 KAM/BAY RA*5*77 Changed next line to use ^RACPTMSC
- +26 SET RA813(0)=$$BASICMOD^RACPTMSC(RACPTMOD(0),DT)
- +27 ;bilateral multiplier=2
- IF 'RABILAT
- IF $PIECE(RA813(0),U,2)=50
- SET RABILAT=1
- +28 SET RACPTMOD=RACPTMOD_$PIECE(RA813(0),U,2)_","
- +29 QUIT
- End DoDot:4
- +30 QUIT
- End DoDot:3
- +31 ;get wRVU value from FEE BASIS; returns a string: status^value^message
- +32 ;where status'=1 means "in error"
- +33 ;03/29/07 KAM/BAY RA*5*77/179232 Added $S to next line
- +34 SET RAWRVU=$$RVU^FBRVU(RACPT,RACPTMOD,$SELECT(RACYFLG:DT-10000,1:DT))
- +35 ; 09/25/2006 Remedy call 154793 Correct 0 RVUs
- +36 IF $PIECE(RAWRVU,U,2)=0
- IF RACPTMOD=""
- Begin DoDot:3
- +37 ;03/29/07 KAM/BAY RA*5*77/179232 Added $S to next line
- +38 SET RAWRVU=$$RVU^FBRVU(RACPT,26,$SELECT(RACYFLG:DT-10000,1:DT))
- End DoDot:3
- +39 ;
- +40 IF $PIECE(RAWRVU,U)=1
- Begin DoDot:3
- +41 ;apply bilateral multiplier if appropriate
- +42 if RABILAT
- SET RAWRVU=$PIECE(RAWRVU,U,2)*2
- +43 ;or not...
- +44 if 'RABILAT
- SET RAWRVU=$PIECE(RAWRVU,U,2)
- +45 QUIT
- End DoDot:3
- +46 ;status some other value than 1; "in error"
- IF '$TEST
- SET RAWRVU=0
- +47 ;
- +48 if RAWRVU>0
- SET RAWRVU=$JUSTIFY(RAWRVU,1,2)
- +49 ;
- SCALED ;when scaled find scaled wRVU value
- +1 IF RASCLD=1
- IF (RAWRVU>0)
- Begin DoDot:3
- +2 ;pass i-type ptr
- SET RASFACTR=$$SFCTR(+$PIECE(RAMIS(0),U,12))
- +3 SET RASWRVU=$JUSTIFY((RAWRVU*RASFACTR),1,2)
- +4 QUIT
- End DoDot:3
- +5 ;mult by zero
- IF '$TEST
- SET RASWRVU=0
- +6 ;
- +7 WRITE !,RAPROC,?37,RAPTYPE,?48,RAITYPE,?58,RACPT,?68,$SELECT(RASCLD=1:$JUSTIFY(RASWRVU,7,2),1:$JUSTIFY(RAWRVU,7,2))
- +8 IF $Y>(IOSL-4)
- SET RAXIT=$$EOS^RAUTL5()
- if 'RAXIT
- DO HDR
- +9 QUIT
- End DoDot:2
- if RAXIT
- QUIT
- +10 QUIT
- End DoDot:1
- if RAXIT
- QUIT
- +11 IF 'RAXIT
- IF (RASCLD)
- SET RASFACTR(0)=""
- Begin DoDot:1
- +12 IF $Y>(IOSL-4)
- SET RAXIT=$$EOS^RAUTL5()
- if RAXIT
- QUIT
- DO HDR
- +13 WRITE !!,"For calendar year "_($EXTRACT(DT,1,3)+1700)_" the following scaling factors apply:"
- +14 SET I=0
- +15 ;04/13/07 KAM/BAY RA*5*77 Modified next line to loop thru all imaging types
- +16 FOR
- SET I=$ORDER(^RA(79.2,I))
- if 'I
- QUIT
- Begin DoDot:2
- +17 SET I(0)=$GET(^RA(79.2,I,0))
- +18 IF $Y>(IOSL-4)
- SET RAXIT=$$EOS^RAUTL5()
- if RAXIT
- QUIT
- DO HDR
- +19 ; 04/13/07 KAM/BAY RA*5*77 Added $S to next line
- +20 WRITE !,$PIECE(I(0),U),?34,$PIECE(I(0),U,3),?49,$SELECT($ORDER(^RA(79.2,I,"CY",0))>0:$$SFCTR^RAWRVUP(I,DT),1:"1.00 (default)")
- +21 QUIT
- End DoDot:2
- if RAXIT
- QUIT
- +22 SET RAXIT=$$EOS^RAUTL5()
- +23 QUIT
- End DoDot:1
- +24 DO XIT
- +25 QUIT
- +26 ;
- HDR ; Header for our report
- +1 if RAPG!($EXTRACT(IOST,1,2)="C-")
- WRITE @IOF
- +2 SET RAPG=RAPG+1
- WRITE !?(IOM-$LENGTH(RAHDR)\2),RAHDR
- +3 WRITE !,"Run Date: ",RARUNDT,?68,"Page: ",RAPG
- +4 ;03/28/07 KAM/BAY RA*5*77/179232 Added next 2 lines
- +5 IF $GET(RACYFLG)
- Begin DoDot:1
- +6 WRITE !,?7,"***This report was prepared with "_$$LASTCY^FBAAFSR()_" Calendar Year RVU Data***"
- End DoDot:1
- +7 if '$DATA(RASFACTR(0))#2
- WRITE !!,"Procedure",?37,"Proc Type",?48,"Img Type",?58,"CPT Code",?68,$SELECT(RASCLD=1:" S",1:" ")_"wRVU"
- +8 if $DATA(RASFACTR(0))#2
- WRITE !!,"Imaging Type",?34,"Abbreviation",?51,"wRVU scaling factor"
- +9 WRITE !,RALN
- +10 QUIT
- +11 ;
- XIT ;kill variables and exit
- +1 IF 'RAXIT
- if 'RACNT
- WRITE !,$$CJ^XLFSTR("No data found for this report",IOM)
- +2 KILL DILN,DTOUT,DUOUT,I,POP,RA813,RABILAT,RACNT,RACPT,RACPTMOD,RAHDR,RAI
- +3 KILL RAITYPE,RALN,RAMIS,RAPTYPE,RAPG,RAPROC,RARUNDT,RASCLD,RASFACTR
- +4 KILL RASWRVU,RAWRVU,RAX,RAXIT,RAY,RAYEAR,X,Y,RACYFLG
- +5 KILL ^TMP($JOB,"RA PROCEDURES")
- +6 QUIT
- +7 ;
- SFCTR(RAITYP,RAYEAR) ;return the calendar year specific scaling factor for a
- +1 ;specific imaging type
- +2 ;input: RAITYP=imaging type
- +3 ; RAYEAR=internal FM date/time format; resolves to current year
- +4 ;return: calendar year specific scaling factor
- +5 ;default to DT (current year)
- NEW RASF,RAYR
- SET RAYEAR=$GET(RAYEAR,DT)
- +6 SET (RAYEAR,RAYR)=$EXTRACT(RAYEAR,1,3)+1700
- +7 SET RASF=+$ORDER(^RA(79.2,RAITYP,"CY","B",RAYEAR,0))
- +8 ;if RASF=0 for the current year, check for the most recent year
- +9 IF RASF=0
- Begin DoDot:1
- +10 SET RAYEAR=+$ORDER(^RA(79.2,1,"CY","B",RAYEAR),-1)
- +11 SET RASF=+$ORDER(^RA(79.2,RAITYP,"CY","B",RAYEAR,0))
- +12 QUIT
- End DoDot:1
- +13 SET RASF=+$PIECE($GET(^RA(79.2,RAITYP,"CY",RASF,0)),U,2)
- +14 ;defaults to one
- if RASF=0
- SET RASF=1
- +15 QUIT $JUSTIFY(RASF,$LENGTH(RASF),2)_$SELECT(RAYEAR:" ("_RAYR_")",1:"")
- +16 ;
- CHKCY ;03/28/2007 KAM/BAY RA*5*77 Remedy Call 179232 Check for latest RVU
- +1 ;data from Fee Basis
- +2 SET RACYFLG=0
- SET Y=$GET(DT)
- DO DD^%DT
- +3 IF $$LASTCY^FBAAFSR()<$PIECE(Y," ",3)
- SET RACYFLG=1
- +4 QUIT