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 Sep 23, 2025@19:31:33 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
