FBAAFSF.m

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 ---FBAAFSF   1414     printed  Apr 09, 2024@21:02:16                                                                                                                                                                                                     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