FBAAFSF ;WCIOFO/dmk,SAB-OUTPATIENT 75TH PERCENTILE FEE SCHEDULE ;5/18/1999
;;3.5;FEE BASIS;**4**;JAN 30, 1995
;
Q
;
PRCTL(CPT,MODL,DOS) ; Calculate 75th Percentile Fee Schedule Amount
; input
; CPT - CPT/HCPCS code, external, required
; MODL - list of optional CPT/HCPCS modifiers (external values)
; delimited by commas
; DOS - date of service, fileman format, required
; returns $ amount or null if not on schedule
N FBAMT,FBERR
;
; initialize
S FBAMT=""
K FBERR
;
;validate parameters
S CPT=$G(CPT)
S DOS=$G(DOS)
I CPT="" D ERR^FBAAFS("Missing CPT")
I DOS'?7N D ERR^FBAAFS("Invalid Date of Service")
;
I '$D(FBERR) D
. ; get data from 163.99 (stored in previous fiscal year)
. N FBDA,FBFY,FBI,FBMOD,FBMODA,FBMODLE,FBX
. S FBFY=$E(DOS,1,3)+1700+$E(DOS,4) ; fiscal year of service
. ;
. ; build a sorted list of the CPT modifiers
. F FBI=1:1 S FBMOD=$P(MODL,",",FBI) Q:FBMOD="" S FBMODA(FBMOD)=""
. S (FBMOD,FBMODLE)=""
. F S FBMOD=$O(FBMODA(FBMOD)) Q:FBMOD="" S FBMODLE=FBMODLE_","_FBMOD
. S:$E(FBMODLE)="," FBMODLE=$E(FBMODLE,2,999)
. ;
. ; build lookup value from CPT and sorted list of modifiers
. S FBX=CPT_$S(FBMODLE]"":"-"_FBMODLE,1:"")
. ; look in file
. S FBDA=$O(^FBAA(163.99,"B",FBX,0))
. I FBDA S FBAMT=$P($G(^FBAA(163.99,FBDA,"FY",FBFY-1,0)),U,5)
;
; return result
Q FBAMT
;
;FBAAFSF
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBAAFSF 1414 printed Dec 13, 2024@01:55:30 Page 2
FBAAFSF ;WCIOFO/dmk,SAB-OUTPATIENT 75TH PERCENTILE FEE SCHEDULE ;5/18/1999
+1 ;;3.5;FEE BASIS;**4**;JAN 30, 1995
+2 ;
+3 QUIT
+4 ;
PRCTL(CPT,MODL,DOS) ; Calculate 75th Percentile Fee Schedule Amount
+1 ; input
+2 ; CPT - CPT/HCPCS code, external, required
+3 ; MODL - list of optional CPT/HCPCS modifiers (external values)
+4 ; delimited by commas
+5 ; DOS - date of service, fileman format, required
+6 ; returns $ amount or null if not on schedule
+7 NEW FBAMT,FBERR
+8 ;
+9 ; initialize
+10 SET FBAMT=""
+11 KILL FBERR
+12 ;
+13 ;validate parameters
+14 SET CPT=$GET(CPT)
+15 SET DOS=$GET(DOS)
+16 IF CPT=""
DO ERR^FBAAFS("Missing CPT")
+17 IF DOS'?7N
DO ERR^FBAAFS("Invalid Date of Service")
+18 ;
+19 IF '$DATA(FBERR)
Begin DoDot:1
+20 ; get data from 163.99 (stored in previous fiscal year)
+21 NEW FBDA,FBFY,FBI,FBMOD,FBMODA,FBMODLE,FBX
+22 ; fiscal year of service
SET FBFY=$EXTRACT(DOS,1,3)+1700+$EXTRACT(DOS,4)
+23 ;
+24 ; build a sorted list of the CPT modifiers
+25 FOR FBI=1:1
SET FBMOD=$PIECE(MODL,",",FBI)
if FBMOD=""
QUIT
SET FBMODA(FBMOD)=""
+26 SET (FBMOD,FBMODLE)=""
+27 FOR
SET FBMOD=$ORDER(FBMODA(FBMOD))
if FBMOD=""
QUIT
SET FBMODLE=FBMODLE_","_FBMOD
+28 if $EXTRACT(FBMODLE)=","
SET FBMODLE=$EXTRACT(FBMODLE,2,999)
+29 ;
+30 ; build lookup value from CPT and sorted list of modifiers
+31 SET FBX=CPT_$SELECT(FBMODLE]"":"-"_FBMODLE,1:"")
+32 ; look in file
+33 SET FBDA=$ORDER(^FBAA(163.99,"B",FBX,0))
+34 IF FBDA
SET FBAMT=$PIECE($GET(^FBAA(163.99,FBDA,"FY",FBFY-1,0)),U,5)
End DoDot:1
+35 ;
+36 ; return result
+37 QUIT FBAMT
+38 ;
+39 ;FBAAFSF
