- 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 Feb 18, 2025@23:21:56 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