- FBAAFS ;WCIOFO/dmk,SAB-OUTPATIENT FEE SCHEDULE ; 10/31/12 3:04pm
- ;;3.5;FEE BASIS;**4,53,71,92,99,111,115,143**;JAN 30, 1995;Build 20
- ;;Per VA Directive 6402, this routine should not be modified.
- LOOKUP ; Entry point for option to get fee schedule amount
- ; without having to enter in a payment
- ;
- W !!
- ;
- ; ask date of service - required
- S DIR(0)="D^::EX",DIR("A")="Enter date of service"
- S DIR("B")=$$FMTE^XLFDT($S($G(FBDATE):FBDATE,1:DT))
- D ^DIR K DIR I $D(DIRUT) G LOOKUPX
- S FBDATE=+Y
- I FBDATE<2990901 W !,"Note: Date is prior to VA implementation of RBRVS fee schedule (9/1/99).",!
- ;
- D CPTM^FBAALU(FBDATE) I 'FBGOT G LOOKUPX
- S FBCPT=FBX
- S FBMODLE=$$MODL^FBAAUTL4("FBMODA","E")
- ;
- ; ask vendor - optional
- S DIR(0)="PO^161.2:EM",DIR("A")="Enter Fee Basis Vendor [optional]"
- D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) G LOOKUPX
- S FBVEN=$P(Y,U)
- ;
- ; ask zip - required
- D ASKZIP(FBVEN,FBDATE) I FBZIP="" G LOOKUPX
- ;
- ; ask place of service OR facility
- ;S DIR(0)="SA^0:NON-FACILITY;1:FACILITY",DIR("A")="Place of Service: "
- ;S DIR("B")="NON-FACILITY"
- ;D ^DIR K DIR I $D(DIRUT) G LOOKUPX
- ;S FBFAC=Y
- D POS^FBAACO1 I '$G(FBHCFA(30)) G LOOKUPX
- S FBFAC=$$FAC(FBHCFA(30))
- I FBFAC="" W $C(7),!,"Error: Can't determine if facility or non-facility setting" G LOOKUPX
- ;
- ; report schedule amount
- S FBRSLT=$$GET^FBAAFS(FBCPT,FBMODLE,FBDATE,FBZIP,FBFAC)
- I $P($G(FBRSLT),U)]"" D
- . W !?5,"Amount to Pay: $ ",$P(FBRSLT,U)," from the "
- . W:$P(FBRSLT,U,3)]"" $P(FBRSLT,U,3)," " ; year if returned
- . W:$P(FBRSLT,U,2)]"" $$EXTERNAL^DILFD(162.03,45,"",$P(FBRSLT,U,2))
- I $P($G(FBRSLT),U)']"" D
- . W !?5,"Unable to determine a FEE schedule amount.",!
- . I $D(FBERR) D DERR
- ;
- G LOOKUP
- ;
- LOOKUPX ; exit for lookup
- K DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
- K FBAACP,FBAAOUT,FBCPT,FBDATE,FBERR,FBFAC,FBGOT,FBMOD,FBMODLE,FBMODS
- K FBRSLT,FBVEN,FBX,FBZIP
- Q
- ;
- GET(CPT,MODL,DOS,ZIP,FAC,TIME,FB1725) ; call to calculate Fee Schedule amount
- ; Input
- ; CPT - CPT/HCPCS code, external value, required
- ; MODL - list of optional CPT/HCPCS modifiers, external values
- ; delimited by commas
- ; DOS - date of service, fileman format, required
- ; ZIP - zip code, 5 digit, required
- ; FAC - facility flag, 0 or 1, required
- ; indicates if procedure was performed in facility (1)
- ; or non-facility (0)
- ; TIME - anesthesia time (minutes), reserved for future use
- ; FB1725 - Boolean, if Mill-Bill (1), or not Mill-Bill (0)
- ; Returns string
- ; dollar amount^schedule used^schedule year (only when RBRVS)
- ;
- N FBAMT,FBERR,FBSCH,FBSCHYR
- ; initialization
- S (FBAMT,FBSCH,FBSCHYR)=""
- K FBERR
- S CPT=$G(CPT)
- S DOS=$G(DOS)
- S ZIP=$G(ZIP)
- S FAC=$G(FAC)
- S TIME=$G(TIME)
- S FB1725=$G(FB1725)
- ;
- ; validate input parameters
- I CPT="" D ERR("Missing CPT")
- I DOS'?7N D ERR("Invalid Date of Service")
- ;
- ; try RBRVS schedule
- I '$D(FBERR) D
- . S FBX=$$RBRVS^FBAAFSR(CPT,MODL,DOS,ZIP,FAC,TIME)
- . S:$P(FBX,U)]"" FBAMT=$P(FBX,U),FBSCH="R",FBSCHYR=$P(FBX,U,2)
- . K FBERR
- ;
- ; If claim is not "Mill-Bill" and is not on the RBRVS schedule
- ; try 75th percentile schedule. If claim is "Mill-Bill" then
- ; quit and allow user to enter Amount Claimed.
- I '$D(FBERR),FB1725'=1,FBAMT']"" D
- . S FBAMT=$$PRCTL^FBAAFSF(CPT,MODL,DOS)
- . S:FBAMT]"" FBSCH="F",FBSCHYR=""
- . K FBERR
- ;
- ; return result
- K FBERR
- Q $S(FBAMT]"":FBAMT_U_FBSCH_U_FBSCHYR,1:"")
- ;
- ERR(MSG) ; add error message to array
- S FBERR=$G(FBERR)+1
- S FBERR(FBERR)=MSG
- Q
- ;
- DERR ; display error messages
- N FBI
- F FBI=0 F S FBI=$O(FBERR(FBI)) Q:'FBI W !,FBERR(FBI)
- Q
- ;
- ASKZIP(FBVEN,FBDOS) ;called from payment routines to ask user the
- ;site of service zip code.
- ; input
- ; FBVEN - (optional) internal entry number of vendor (#161.2)
- ; used to determine a default zip code
- ; FBDOS - (optional) date of service
- ; used to determine if GPCIs are available for the zip code
- ; output
- ; FBZIP - zip code, 5 digit
- ; FBAAOUT if user '^' out without answering
- N DIR,DUOUT,DIRUT,DTOUT,X,Y
- N FBCY,FBGPCIY0
- ASKZIP1 ;
- S FBZIP=""
- S DIR(0)="162.03,42"
- ; set default zip code if vendor available
- I $G(FBVEN) D
- . S X=$P($P($G(^FBAAV(FBVEN,0)),U,6),"-")
- . I X]"" S DIR("B")=X
- D ^DIR K DIR I $D(DIRUT) S FBAAOUT=1 Q
- S FBZIP=Y
- ;
- ; if date after VA implementation then check for GPCIs
- I $G(FBDOS)]"",FBDOS>2990900 D I Y D ASKZIP1
- . S FBCY=$E(FBDOS,1,3)+1700
- . ; if year after most recent RBRVS schedule then use prior year sched
- . I FBCY>$$LASTCY^FBAAFSR() S FBCY=FBCY-1
- . D ZIP^FBAAFSR(FBCY,FBZIP)
- . S Y=0 I FBGPCIY0="" D
- . . W $C(7),!,"Warning: ",FBCY," GPCIs are not on file for this zip code."
- . . S DIR(0)="Y",DIR("A")="Do you want to enter a different zip code"
- . . S DIR("B")="YES"
- . . S DIR("?",1)="Geographic Practice Cost Index (GPCI) values are"
- . . S DIR("?",2)="needed for calculation of the RBRVS physician fee"
- . . S DIR("?",3)="schedule amount. There are not any GPCI values on"
- . . S DIR("?",4)="file for the specified year and zip code."
- . . S DIR("?")="Answer YES to enter a different zip code."
- . . D ^DIR K DIR
- Q
- ;
- ASKTIME ;called to ask time in minutes if the service provided
- ;is an anesthesia service (00100-01999)
- ;return FBTIME equal to # of minutes or zero if '^'/timeout
- ;return FBAAOUT if user does not answer
- S FBTIME=0
- S DIR(0)="162.03,43" D ^DIR K DIR I $D(DTOUT)!($D(DUOUT)) S FBAAOUT=1 Q
- S FBTIME=+Y
- I '$G(FBTIME) D G ASKTIME
- . W !,$C(7),"Time entry is required!",!
- Q
- ;
- ANES(CPT) ; call to determine if the CPT code has a major category
- ;of anesthesia.
- ; CPT = 5 digit CPT code (EXTERNAL)
- ; returns 1 if CPT is an anesthesia code else return 0.
- ;
- N FBCAT,FBMCAT
- S CPT=$G(CPT)
- S FBCAT=$P($$CPT^ICPTCOD(CPT),U,4)
- S FBMCAT=$P($$CAT^ICPTAPIU(FBCAT),U,4)
- Q $S(FBMCAT="ANESTHESIA":1,1:0)
- ;
- FAC(POS) ; call to determine if the place of service is a facility
- ; Input
- ; POS - place of service, internal, pointer to #353.1
- ; Returns 0 or 1 or null
- ; = 0 if place of service is non-facility setting
- ; = 1 if place of service is facility setting
- ; = null value if type of setting could not be determined
- N CODE,RET
- S (CODE,RET)=""
- I $G(POS)]"" S CODE=$$GET1^DIQ(353.1,POS,.01)
- ; list of codes considered as facility settings
- S FCODE="^05^06^07^08^21^22^23^24^26^31^34^41^42^51^52^53^56^61^"
- ; list of codes considered as non-facility settings
- S NFCODE="^01^03^04^09^11^12^13^14^15^16^17^20^25^32^33^49^50^54^55^57^60^62^65^71^72^81^99^"
- I FCODE[(U_CODE_U) S RET=1
- I NFCODE[(U_CODE_U) S RET=0
- Q RET
- ;
- ;FBAAFS
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBAAFS 6722 printed Jan 18, 2025@02:56:42 Page 2
- FBAAFS ;WCIOFO/dmk,SAB-OUTPATIENT FEE SCHEDULE ; 10/31/12 3:04pm
- +1 ;;3.5;FEE BASIS;**4,53,71,92,99,111,115,143**;JAN 30, 1995;Build 20
- +2 ;;Per VA Directive 6402, this routine should not be modified.
- LOOKUP ; Entry point for option to get fee schedule amount
- +1 ; without having to enter in a payment
- +2 ;
- +3 WRITE !!
- +4 ;
- +5 ; ask date of service - required
- +6 SET DIR(0)="D^::EX"
- SET DIR("A")="Enter date of service"
- +7 SET DIR("B")=$$FMTE^XLFDT($SELECT($GET(FBDATE):FBDATE,1:DT))
- +8 DO ^DIR
- KILL DIR
- IF $DATA(DIRUT)
- GOTO LOOKUPX
- +9 SET FBDATE=+Y
- +10 IF FBDATE<2990901
- WRITE !,"Note: Date is prior to VA implementation of RBRVS fee schedule (9/1/99).",!
- +11 ;
- +12 DO CPTM^FBAALU(FBDATE)
- IF 'FBGOT
- GOTO LOOKUPX
- +13 SET FBCPT=FBX
- +14 SET FBMODLE=$$MODL^FBAAUTL4("FBMODA","E")
- +15 ;
- +16 ; ask vendor - optional
- +17 SET DIR(0)="PO^161.2:EM"
- SET DIR("A")="Enter Fee Basis Vendor [optional]"
- +18 DO ^DIR
- KILL DIR
- IF $DATA(DTOUT)!$DATA(DUOUT)
- GOTO LOOKUPX
- +19 SET FBVEN=$PIECE(Y,U)
- +20 ;
- +21 ; ask zip - required
- +22 DO ASKZIP(FBVEN,FBDATE)
- IF FBZIP=""
- GOTO LOOKUPX
- +23 ;
- +24 ; ask place of service OR facility
- +25 ;S DIR(0)="SA^0:NON-FACILITY;1:FACILITY",DIR("A")="Place of Service: "
- +26 ;S DIR("B")="NON-FACILITY"
- +27 ;D ^DIR K DIR I $D(DIRUT) G LOOKUPX
- +28 ;S FBFAC=Y
- +29 DO POS^FBAACO1
- IF '$GET(FBHCFA(30))
- GOTO LOOKUPX
- +30 SET FBFAC=$$FAC(FBHCFA(30))
- +31 IF FBFAC=""
- WRITE $CHAR(7),!,"Error: Can't determine if facility or non-facility setting"
- GOTO LOOKUPX
- +32 ;
- +33 ; report schedule amount
- +34 SET FBRSLT=$$GET^FBAAFS(FBCPT,FBMODLE,FBDATE,FBZIP,FBFAC)
- +35 IF $PIECE($GET(FBRSLT),U)]""
- Begin DoDot:1
- +36 WRITE !?5,"Amount to Pay: $ ",$PIECE(FBRSLT,U)," from the "
- +37 ; year if returned
- if $PIECE(FBRSLT,U,3)]""
- WRITE $PIECE(FBRSLT,U,3)," "
- +38 if $PIECE(FBRSLT,U,2)]""
- WRITE $$EXTERNAL^DILFD(162.03,45,"",$PIECE(FBRSLT,U,2))
- End DoDot:1
- +39 IF $PIECE($GET(FBRSLT),U)']""
- Begin DoDot:1
- +40 WRITE !?5,"Unable to determine a FEE schedule amount.",!
- +41 IF $DATA(FBERR)
- DO DERR
- End DoDot:1
- +42 ;
- +43 GOTO LOOKUP
- +44 ;
- LOOKUPX ; exit for lookup
- +1 KILL DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
- +2 KILL FBAACP,FBAAOUT,FBCPT,FBDATE,FBERR,FBFAC,FBGOT,FBMOD,FBMODLE,FBMODS
- +3 KILL FBRSLT,FBVEN,FBX,FBZIP
- +4 QUIT
- +5 ;
- GET(CPT,MODL,DOS,ZIP,FAC,TIME,FB1725) ; call to calculate Fee Schedule amount
- +1 ; Input
- +2 ; CPT - CPT/HCPCS code, external value, required
- +3 ; MODL - list of optional CPT/HCPCS modifiers, external values
- +4 ; delimited by commas
- +5 ; DOS - date of service, fileman format, required
- +6 ; ZIP - zip code, 5 digit, required
- +7 ; FAC - facility flag, 0 or 1, required
- +8 ; indicates if procedure was performed in facility (1)
- +9 ; or non-facility (0)
- +10 ; TIME - anesthesia time (minutes), reserved for future use
- +11 ; FB1725 - Boolean, if Mill-Bill (1), or not Mill-Bill (0)
- +12 ; Returns string
- +13 ; dollar amount^schedule used^schedule year (only when RBRVS)
- +14 ;
- +15 NEW FBAMT,FBERR,FBSCH,FBSCHYR
- +16 ; initialization
- +17 SET (FBAMT,FBSCH,FBSCHYR)=""
- +18 KILL FBERR
- +19 SET CPT=$GET(CPT)
- +20 SET DOS=$GET(DOS)
- +21 SET ZIP=$GET(ZIP)
- +22 SET FAC=$GET(FAC)
- +23 SET TIME=$GET(TIME)
- +24 SET FB1725=$GET(FB1725)
- +25 ;
- +26 ; validate input parameters
- +27 IF CPT=""
- DO ERR("Missing CPT")
- +28 IF DOS'?7N
- DO ERR("Invalid Date of Service")
- +29 ;
- +30 ; try RBRVS schedule
- +31 IF '$DATA(FBERR)
- Begin DoDot:1
- +32 SET FBX=$$RBRVS^FBAAFSR(CPT,MODL,DOS,ZIP,FAC,TIME)
- +33 if $PIECE(FBX,U)]""
- SET FBAMT=$PIECE(FBX,U)
- SET FBSCH="R"
- SET FBSCHYR=$PIECE(FBX,U,2)
- +34 KILL FBERR
- End DoDot:1
- +35 ;
- +36 ; If claim is not "Mill-Bill" and is not on the RBRVS schedule
- +37 ; try 75th percentile schedule. If claim is "Mill-Bill" then
- +38 ; quit and allow user to enter Amount Claimed.
- +39 IF '$DATA(FBERR)
- IF FB1725'=1
- IF FBAMT']""
- Begin DoDot:1
- +40 SET FBAMT=$$PRCTL^FBAAFSF(CPT,MODL,DOS)
- +41 if FBAMT]""
- SET FBSCH="F"
- SET FBSCHYR=""
- +42 KILL FBERR
- End DoDot:1
- +43 ;
- +44 ; return result
- +45 KILL FBERR
- +46 QUIT $SELECT(FBAMT]"":FBAMT_U_FBSCH_U_FBSCHYR,1:"")
- +47 ;
- ERR(MSG) ; add error message to array
- +1 SET FBERR=$GET(FBERR)+1
- +2 SET FBERR(FBERR)=MSG
- +3 QUIT
- +4 ;
- DERR ; display error messages
- +1 NEW FBI
- +2 FOR FBI=0
- FOR
- SET FBI=$ORDER(FBERR(FBI))
- if 'FBI
- QUIT
- WRITE !,FBERR(FBI)
- +3 QUIT
- +4 ;
- ASKZIP(FBVEN,FBDOS) ;called from payment routines to ask user the
- +1 ;site of service zip code.
- +2 ; input
- +3 ; FBVEN - (optional) internal entry number of vendor (#161.2)
- +4 ; used to determine a default zip code
- +5 ; FBDOS - (optional) date of service
- +6 ; used to determine if GPCIs are available for the zip code
- +7 ; output
- +8 ; FBZIP - zip code, 5 digit
- +9 ; FBAAOUT if user '^' out without answering
- +10 NEW DIR,DUOUT,DIRUT,DTOUT,X,Y
- +11 NEW FBCY,FBGPCIY0
- ASKZIP1 ;
- +1 SET FBZIP=""
- +2 SET DIR(0)="162.03,42"
- +3 ; set default zip code if vendor available
- +4 IF $GET(FBVEN)
- Begin DoDot:1
- +5 SET X=$PIECE($PIECE($GET(^FBAAV(FBVEN,0)),U,6),"-")
- +6 IF X]""
- SET DIR("B")=X
- End DoDot:1
- +7 DO ^DIR
- KILL DIR
- IF $DATA(DIRUT)
- SET FBAAOUT=1
- QUIT
- +8 SET FBZIP=Y
- +9 ;
- +10 ; if date after VA implementation then check for GPCIs
- +11 IF $GET(FBDOS)]""
- IF FBDOS>2990900
- Begin DoDot:1
- +12 SET FBCY=$EXTRACT(FBDOS,1,3)+1700
- +13 ; if year after most recent RBRVS schedule then use prior year sched
- +14 IF FBCY>$$LASTCY^FBAAFSR()
- SET FBCY=FBCY-1
- +15 DO ZIP^FBAAFSR(FBCY,FBZIP)
- +16 SET Y=0
- IF FBGPCIY0=""
- Begin DoDot:2
- +17 WRITE $CHAR(7),!,"Warning: ",FBCY," GPCIs are not on file for this zip code."
- +18 SET DIR(0)="Y"
- SET DIR("A")="Do you want to enter a different zip code"
- +19 SET DIR("B")="YES"
- +20 SET DIR("?",1)="Geographic Practice Cost Index (GPCI) values are"
- +21 SET DIR("?",2)="needed for calculation of the RBRVS physician fee"
- +22 SET DIR("?",3)="schedule amount. There are not any GPCI values on"
- +23 SET DIR("?",4)="file for the specified year and zip code."
- +24 SET DIR("?")="Answer YES to enter a different zip code."
- +25 DO ^DIR
- KILL DIR
- End DoDot:2
- End DoDot:1
- IF Y
- DO ASKZIP1
- +26 QUIT
- +27 ;
- ASKTIME ;called to ask time in minutes if the service provided
- +1 ;is an anesthesia service (00100-01999)
- +2 ;return FBTIME equal to # of minutes or zero if '^'/timeout
- +3 ;return FBAAOUT if user does not answer
- +4 SET FBTIME=0
- +5 SET DIR(0)="162.03,43"
- DO ^DIR
- KILL DIR
- IF $DATA(DTOUT)!($DATA(DUOUT))
- SET FBAAOUT=1
- QUIT
- +6 SET FBTIME=+Y
- +7 IF '$GET(FBTIME)
- Begin DoDot:1
- +8 WRITE !,$CHAR(7),"Time entry is required!",!
- End DoDot:1
- GOTO ASKTIME
- +9 QUIT
- +10 ;
- ANES(CPT) ; call to determine if the CPT code has a major category
- +1 ;of anesthesia.
- +2 ; CPT = 5 digit CPT code (EXTERNAL)
- +3 ; returns 1 if CPT is an anesthesia code else return 0.
- +4 ;
- +5 NEW FBCAT,FBMCAT
- +6 SET CPT=$GET(CPT)
- +7 SET FBCAT=$PIECE($$CPT^ICPTCOD(CPT),U,4)
- +8 SET FBMCAT=$PIECE($$CAT^ICPTAPIU(FBCAT),U,4)
- +9 QUIT $SELECT(FBMCAT="ANESTHESIA":1,1:0)
- +10 ;
- FAC(POS) ; call to determine if the place of service is a facility
- +1 ; Input
- +2 ; POS - place of service, internal, pointer to #353.1
- +3 ; Returns 0 or 1 or null
- +4 ; = 0 if place of service is non-facility setting
- +5 ; = 1 if place of service is facility setting
- +6 ; = null value if type of setting could not be determined
- +7 NEW CODE,RET
- +8 SET (CODE,RET)=""
- +9 IF $GET(POS)]""
- SET CODE=$$GET1^DIQ(353.1,POS,.01)
- +10 ; list of codes considered as facility settings
- +11 SET FCODE="^05^06^07^08^21^22^23^24^26^31^34^41^42^51^52^53^56^61^"
- +12 ; list of codes considered as non-facility settings
- +13 SET NFCODE="^01^03^04^09^11^12^13^14^15^16^17^20^25^32^33^49^50^54^55^57^60^62^65^71^72^81^99^"
- +14 IF FCODE[(U_CODE_U)
- SET RET=1
- +15 IF NFCODE[(U_CODE_U)
- SET RET=0
- +16 QUIT RET
- +17 ;
- +18 ;FBAAFS