Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: FBAAFS

FBAAFS.m

Go to the documentation of this file.
  1. 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
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. LOOKUP ; Entry point for option to get fee schedule amount
  1. ; without having to enter in a payment
  1. ;
  1. W !!
  1. ;
  1. ; ask date of service - required
  1. S DIR(0)="D^::EX",DIR("A")="Enter date of service"
  1. S DIR("B")=$$FMTE^XLFDT($S($G(FBDATE):FBDATE,1:DT))
  1. D ^DIR K DIR I $D(DIRUT) G LOOKUPX
  1. S FBDATE=+Y
  1. I FBDATE<2990901 W !,"Note: Date is prior to VA implementation of RBRVS fee schedule (9/1/99).",!
  1. ;
  1. D CPTM^FBAALU(FBDATE) I 'FBGOT G LOOKUPX
  1. S FBCPT=FBX
  1. S FBMODLE=$$MODL^FBAAUTL4("FBMODA","E")
  1. ;
  1. ; ask vendor - optional
  1. S DIR(0)="PO^161.2:EM",DIR("A")="Enter Fee Basis Vendor [optional]"
  1. D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) G LOOKUPX
  1. S FBVEN=$P(Y,U)
  1. ;
  1. ; ask zip - required
  1. D ASKZIP(FBVEN,FBDATE) I FBZIP="" G LOOKUPX
  1. ;
  1. ; ask place of service OR facility
  1. ;S DIR(0)="SA^0:NON-FACILITY;1:FACILITY",DIR("A")="Place of Service: "
  1. ;S DIR("B")="NON-FACILITY"
  1. ;D ^DIR K DIR I $D(DIRUT) G LOOKUPX
  1. ;S FBFAC=Y
  1. D POS^FBAACO1 I '$G(FBHCFA(30)) G LOOKUPX
  1. S FBFAC=$$FAC(FBHCFA(30))
  1. I FBFAC="" W $C(7),!,"Error: Can't determine if facility or non-facility setting" G LOOKUPX
  1. ;
  1. ; report schedule amount
  1. S FBRSLT=$$GET^FBAAFS(FBCPT,FBMODLE,FBDATE,FBZIP,FBFAC)
  1. I $P($G(FBRSLT),U)]"" D
  1. . W !?5,"Amount to Pay: $ ",$P(FBRSLT,U)," from the "
  1. . W:$P(FBRSLT,U,3)]"" $P(FBRSLT,U,3)," " ; year if returned
  1. . W:$P(FBRSLT,U,2)]"" $$EXTERNAL^DILFD(162.03,45,"",$P(FBRSLT,U,2))
  1. I $P($G(FBRSLT),U)']"" D
  1. . W !?5,"Unable to determine a FEE schedule amount.",!
  1. . I $D(FBERR) D DERR
  1. ;
  1. G LOOKUP
  1. ;
  1. LOOKUPX ; exit for lookup
  1. K DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
  1. K FBAACP,FBAAOUT,FBCPT,FBDATE,FBERR,FBFAC,FBGOT,FBMOD,FBMODLE,FBMODS
  1. K FBRSLT,FBVEN,FBX,FBZIP
  1. Q
  1. ;
  1. GET(CPT,MODL,DOS,ZIP,FAC,TIME,FB1725) ; call to calculate Fee Schedule amount
  1. ; Input
  1. ; CPT - CPT/HCPCS code, external value, required
  1. ; MODL - list of optional CPT/HCPCS modifiers, external values
  1. ; delimited by commas
  1. ; DOS - date of service, fileman format, required
  1. ; ZIP - zip code, 5 digit, required
  1. ; FAC - facility flag, 0 or 1, required
  1. ; indicates if procedure was performed in facility (1)
  1. ; or non-facility (0)
  1. ; TIME - anesthesia time (minutes), reserved for future use
  1. ; FB1725 - Boolean, if Mill-Bill (1), or not Mill-Bill (0)
  1. ; Returns string
  1. ; dollar amount^schedule used^schedule year (only when RBRVS)
  1. ;
  1. N FBAMT,FBERR,FBSCH,FBSCHYR
  1. ; initialization
  1. S (FBAMT,FBSCH,FBSCHYR)=""
  1. K FBERR
  1. S CPT=$G(CPT)
  1. S DOS=$G(DOS)
  1. S ZIP=$G(ZIP)
  1. S FAC=$G(FAC)
  1. S TIME=$G(TIME)
  1. S FB1725=$G(FB1725)
  1. ;
  1. ; validate input parameters
  1. I CPT="" D ERR("Missing CPT")
  1. I DOS'?7N D ERR("Invalid Date of Service")
  1. ;
  1. ; try RBRVS schedule
  1. I '$D(FBERR) D
  1. . S FBX=$$RBRVS^FBAAFSR(CPT,MODL,DOS,ZIP,FAC,TIME)
  1. . S:$P(FBX,U)]"" FBAMT=$P(FBX,U),FBSCH="R",FBSCHYR=$P(FBX,U,2)
  1. . K FBERR
  1. ;
  1. ; If claim is not "Mill-Bill" and is not on the RBRVS schedule
  1. ; try 75th percentile schedule. If claim is "Mill-Bill" then
  1. ; quit and allow user to enter Amount Claimed.
  1. I '$D(FBERR),FB1725'=1,FBAMT']"" D
  1. . S FBAMT=$$PRCTL^FBAAFSF(CPT,MODL,DOS)
  1. . S:FBAMT]"" FBSCH="F",FBSCHYR=""
  1. . K FBERR
  1. ;
  1. ; return result
  1. K FBERR
  1. Q $S(FBAMT]"":FBAMT_U_FBSCH_U_FBSCHYR,1:"")
  1. ;
  1. ERR(MSG) ; add error message to array
  1. S FBERR=$G(FBERR)+1
  1. S FBERR(FBERR)=MSG
  1. Q
  1. ;
  1. DERR ; display error messages
  1. N FBI
  1. F FBI=0 F S FBI=$O(FBERR(FBI)) Q:'FBI W !,FBERR(FBI)
  1. Q
  1. ;
  1. ASKZIP(FBVEN,FBDOS) ;called from payment routines to ask user the
  1. ;site of service zip code.
  1. ; input
  1. ; FBVEN - (optional) internal entry number of vendor (#161.2)
  1. ; used to determine a default zip code
  1. ; FBDOS - (optional) date of service
  1. ; used to determine if GPCIs are available for the zip code
  1. ; output
  1. ; FBZIP - zip code, 5 digit
  1. ; FBAAOUT if user '^' out without answering
  1. N DIR,DUOUT,DIRUT,DTOUT,X,Y
  1. N FBCY,FBGPCIY0
  1. ASKZIP1 ;
  1. S FBZIP=""
  1. S DIR(0)="162.03,42"
  1. ; set default zip code if vendor available
  1. I $G(FBVEN) D
  1. . S X=$P($P($G(^FBAAV(FBVEN,0)),U,6),"-")
  1. . I X]"" S DIR("B")=X
  1. D ^DIR K DIR I $D(DIRUT) S FBAAOUT=1 Q
  1. S FBZIP=Y
  1. ;
  1. ; if date after VA implementation then check for GPCIs
  1. I $G(FBDOS)]"",FBDOS>2990900 D I Y D ASKZIP1
  1. . S FBCY=$E(FBDOS,1,3)+1700
  1. . ; if year after most recent RBRVS schedule then use prior year sched
  1. . I FBCY>$$LASTCY^FBAAFSR() S FBCY=FBCY-1
  1. . D ZIP^FBAAFSR(FBCY,FBZIP)
  1. . S Y=0 I FBGPCIY0="" D
  1. . . W $C(7),!,"Warning: ",FBCY," GPCIs are not on file for this zip code."
  1. . . S DIR(0)="Y",DIR("A")="Do you want to enter a different zip code"
  1. . . S DIR("B")="YES"
  1. . . S DIR("?",1)="Geographic Practice Cost Index (GPCI) values are"
  1. . . S DIR("?",2)="needed for calculation of the RBRVS physician fee"
  1. . . S DIR("?",3)="schedule amount. There are not any GPCI values on"
  1. . . S DIR("?",4)="file for the specified year and zip code."
  1. . . S DIR("?")="Answer YES to enter a different zip code."
  1. . . D ^DIR K DIR
  1. Q
  1. ;
  1. ASKTIME ;called to ask time in minutes if the service provided
  1. ;is an anesthesia service (00100-01999)
  1. ;return FBTIME equal to # of minutes or zero if '^'/timeout
  1. ;return FBAAOUT if user does not answer
  1. S FBTIME=0
  1. S DIR(0)="162.03,43" D ^DIR K DIR I $D(DTOUT)!($D(DUOUT)) S FBAAOUT=1 Q
  1. S FBTIME=+Y
  1. I '$G(FBTIME) D G ASKTIME
  1. . W !,$C(7),"Time entry is required!",!
  1. Q
  1. ;
  1. ANES(CPT) ; call to determine if the CPT code has a major category
  1. ;of anesthesia.
  1. ; CPT = 5 digit CPT code (EXTERNAL)
  1. ; returns 1 if CPT is an anesthesia code else return 0.
  1. ;
  1. N FBCAT,FBMCAT
  1. S CPT=$G(CPT)
  1. S FBCAT=$P($$CPT^ICPTCOD(CPT),U,4)
  1. S FBMCAT=$P($$CAT^ICPTAPIU(FBCAT),U,4)
  1. Q $S(FBMCAT="ANESTHESIA":1,1:0)
  1. ;
  1. FAC(POS) ; call to determine if the place of service is a facility
  1. ; Input
  1. ; POS - place of service, internal, pointer to #353.1
  1. ; Returns 0 or 1 or null
  1. ; = 0 if place of service is non-facility setting
  1. ; = 1 if place of service is facility setting
  1. ; = null value if type of setting could not be determined
  1. N CODE,RET
  1. S (CODE,RET)=""
  1. I $G(POS)]"" S CODE=$$GET1^DIQ(353.1,POS,.01)
  1. ; list of codes considered as facility settings
  1. S FCODE="^05^06^07^08^21^22^23^24^26^31^34^41^42^51^52^53^56^61^"
  1. ; list of codes considered as non-facility settings
  1. 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^"
  1. I FCODE[(U_CODE_U) S RET=1
  1. I NFCODE[(U_CODE_U) S RET=0
  1. Q RET
  1. ;
  1. ;FBAAFS