FBAAV0 ;AISC/GRR - ELECTRONICALLY TRANSMIT FEE DATA ;3/22/2012
;;3.5;FEE BASIS;**3,4,55,89,98,116,108,132,139,123,158**;JAN 30, 1995;Build 94
;;Per VA Directive 6402, this routine should not be modified.
;
; References to API $$CODEABA^ICDEX supported by ICR #5747
;
K ^TMP($J,"FBAABATCH"),^TMP($J,"FBVADAT") D DT^DICRW
;
N FBTRT S FBTRT=0 ; Flag indicating if any transactions are found that need to be transmitted
I $D(^FBAA(161.7,"AC","S")) S FBTRT=1 ; supervisor closed batch
I $D(^FBAA(161.7,"AC","R")) S FBTRT=1 ; reviewed after pricer batch
I $D(^FBAA(161.25,"AE")) S FBTRT=1 ; vendor correction
I +$O(^FBAA(161.26,"AC","P",0)) S FBTRT=1 ; FB patient master record changes
I +$O(^FBAA(161.96,"AS","P",0)) S FBTRT=1 ; ipac vendor agreement MRA changes (FB*3.5*123)
I 'FBTRT W !,*7,"There are no transactions requiring transmission",*7 Q
;
W !!,"This option will transmit all Batches and MRA's ready to be transmitted",!,"to Austin"
RD W !! S DIR(0)="Y",DIR("A")="Are you sure you want to continue",DIR("B")="No" D ^DIR K DIR G END:'Y
L +^FBAA(161.7,"AC"):0 G:'$T LOCK^FBAAUTL1
W !!,"The following Batches will be transmitted: " F FBSTAT="S","R" F J=0:0 S J=$O(^FBAA(161.7,"AC",FBSTAT,J)) Q:J'>0 S FBATCH=$G(^FBAA(161.7,J,0)) D
.Q:'+FBATCH
.I (FBSTAT="S"&($P(FBATCH,U,15)="Y"))!(+$P(FBATCH,U,9)) S ^TMP($J,"FBAABATCH",J)="" W !,+FBATCH
RTRAN ;Entry from Re-transmit MRA routine
D ADDRESS^FBAAV01 G END:VATERR K VAT
D WAIT^DICD,STATION^FBAAUTL,HD^FBAAUTL I $D(FB("ERROR")) G END
S TOTSTR=0,$P(PAD," ",200)=" "
D ^FBAAV1:$D(^FBAA(161.25,"AE")) ; Vendor MRA
D ^FBAAV4:$D(^FBAA(161.26,"AC","P")) ; Patient MRA
D ^FBAAV8:$D(^FBAA(161.96,"AS","P")) ; IPAC agreement MRA (FB*3.5*123)
;
F J=0:0 S J=$O(^TMP($J,"FBAABATCH",J)) Q:J'>0 I $D(^FBAA(161.7,J,0)) S Y(0)=^(0) D SET1,DET:FBAABT="B3",DETP^FBAAV2:FBAABT="B5",DETT^FBAAV3:FBAABT="B2",^FBAAV5:FBAABT="B9"
END L -^FBAA(161.7,"AC") D KILL^FBAAV1 Q
SET1 ; build the payment batch header string (used by all four formats)
S FBAABN=$P(Y(0),"^",1),FBAABN=$E("0000000",$L(FBAABN)+1,7)_FBAABN ;FB*3.5*158
S FBAAON=$E($P(Y(0),"^",2),3,6) ;obligation #
S FBAACD=$$AUSDT^FBAAV3(DT)
S FBAACP=$E($P(Y(0),"^",2),1,2) ;obligation #
S FBAABT=$P(Y(0),"^",3) ;Type
S FBAAAP=$$AUSAMT^FBAAV3($P(Y(0),"^",9),11) ;total dollars
S FBSTAT=$P(^FBAA(161.7,J,"ST"),"^") ;status
S FBCHB=$P(Y(0),"^",15) ;contract hospital batch
S FBEXMPT=$P(Y(0),"^",18) ;batch exempt
S X=$$SUB^FBAAUTL5(+$P(Y(0),U,8)_"-"_$P(Y(0),U,2)) ;station # - obligation #
S FBAASN=$$LJ^XLFSTR($S(X]"":X,1:FBAASN),6," ")
I FBSTAT="R"!(FBSTAT="S"&(FBCHB'["Y"))!(FBSTAT="S"&($G(FBEXMPT)="Y")) S FBSTR=FBHD_$S(FBAABT="B2":"BT",1:FBAABT)_FBAACD_FBAASN_FBAABN_" "_FBAAAP_FBAACP_" $"
Q
DET ;entry point to process B3 (outpatient/ancillary) batch
; input (partial list)
; J - Batch IEN in file 161.7
; FBAAON - last 4 of obligation number
; FBAASN - station number (formatted)
S FBTXT=0
D CKB3V^FBAAV01 I $G(FBERR) K FBERR Q
; HIPAA 5010 - line items that have 0.00 amount paid are now required to go to Central Fee
F K=0:0 S K=$O(^FBAAC("AC",J,K)) Q:K'>0 F L=0:0 S L=$O(^FBAAC("AC",J,K,L)) Q:L'>0 F M=0:0 S M=$O(^FBAAC("AC",J,K,L,M)) Q:M'>0 F N=0:0 S N=$O(^FBAAC("AC",J,K,L,M,N)) Q:N'>0 S Y(0)=$G(^FBAAC(K,1,L,1,M,1,N,0)) I Y(0)]"" D
.N FBDTSR1,FBPICN
.S FBDTSR1=+$G(^FBAAC(K,1,L,1,M,0))
.S FBPICN=K_U_L_U_M_U_N
.S FBPICN=$$ORGICN^FBAAVR5(162.03,FBPICN)
.S FBY=$G(^FBAAC(K,1,L,1,M,1,N,2))
.S FBY3=$G(^FBAAC(K,1,L,1,M,1,N,3))
.S FBY9=$G(^FBAAC(K,1,L,1,M,1,N,9))
.I 'FBTXT S FBTXT=1 D NEWMSG^FBAAV01,STORE^FBAAV01,UPD
.D GOT
;
D:FBTXT XMIT^FBAAV01
Q
;
GOT ; process a B3 line item
;
N DFN,FBADJ,FBADJA1,FBADJA2,FBADJR1,FBADJR2,FBADMIT,FBAUTHF,FBIENS
N FBMOD1,FBMOD2,FBMOD3,FBMOD4,FBPNAMX,FBUNITS,FBX,FBNPI
N FBCSID,FBEDIF,FBCNTRN,FBFPPSID,FBCRARC,FBPYMTH,FBAUTHNUM
N FBIA,FBDODINV,FBAMTC,FBLNITM
;
S FBIENS=N_","_M_","_L_","_K_","
;
S FBLNITM=+$P(FBY3,U,2),FBLNITM=$$RJ^XLFSTR(FBLNITM,3,0) ;FPPS LINE ITEM
;
S FBEDIF=$S($P($G(^FBAAC(K,1,L,1,M,1,N,3)),"^")]"":"Y",1:" ") ;EDI flag
; get CPT modifiers
D
. N FBMODA,FBMODL
. D MODDATA^FBAAUTL4(K,L,M,N)
. S FBMODL=$$MODL^FBAAUTL4("FBMODA","E")
. S FBMOD1=$$RJ^XLFSTR($P(FBMODL,",",1),5," ")
. S FBMOD2=$$RJ^XLFSTR($P(FBMODL,",",2),5," ")
. S FBMOD3=$$RJ^XLFSTR($P(FBMODL,",",3),5," ")
. S FBMOD4=$$RJ^XLFSTR($P(FBMODL,",",4),5," ")
;
S FBPAYT=$P(Y(0),"^",20),FBPAYT=$S(FBPAYT]"":FBPAYT,1:"V") ;PAYMENT TYPE
;
S FBVID=$P($G(^FBAAV(L,0)),U,2) ;VENDOR ID
S FBVID=FBVID_$E(PAD,$L(FBVID)+1,11)
;
; FB*3.5*123 - get IPAC variables
S FBIA=+$P(FBY3,U,6) ; IPAC agreement ptr
S FBIA=$S(FBIA:$P($G(^FBAA(161.95,FBIA,0)),U,1),1:"") ; IPAC external agreement id# or ""
S FBIA=$$LJ^XLFSTR(FBIA,"10T") ; format to 10 characters
S FBDODINV=$P(FBY3,U,7),FBDODINV=$$LJ^XLFSTR(FBDODINV,"22T") ; DoD invoice# formatted to 22 characters
;
S:FBPAYT="R" FBVID=$E(PAD,1,11)
S FBNPI=$$EN^FBNPILK(L) ;SET THE NPI TO BE PASSED TO FBAAV01,FBAAV2,FBAAV5
;
D POV^FBAAUTL2
S POV=$S(POV']"":"",POV="A":6,POV="B":7,POV="C":8,POV="D":9,POV="E":10,1:POV)
S POV=$S(POV']"":99,$D(^FBAA(161.82,POV,0)):$P(^(0),"^",3),1:99)
S FBPOV=POV
S FBTT=$S(FBTT]"":FBTT,1:1)
S FBCPT=$$CPT^FBAAUTL4($P(Y(0),"^")),FBCPT=$S($L(FBCPT)=5:FBCPT,1:" ") ;SERVICE PROVIDED
S FBPSA=$$PSA^FBAAV5(+$P(Y(0),U,12),+FBAASN) I $L(+FBPSA)'=3 S FBPSA=999
S FBPATT=$P(Y(0),"^",17),FBPATT=$S(FBPATT]"":FBPATT,1:10)
S FBTD=$$AUSDT^FBAAV3(FBDTSR1) ; formatted treatment date
S FBSUSP=$P(Y(0),"^",5),FBSUSP=$S(FBSUSP]"":FBSUSP,1:" ")
S FBSUSP=$S(FBSUSP=" ":" ",$D(^FBAA(161.27,+FBSUSP,0)):$P(^(0),"^"),1:" ")
S FBAP=$$AUSAMT^FBAAV3($P(Y(0),"^",3),8) ; amount paid
S FBAMTC=$$AUSAMT^FBAAV3($P(Y(0),U,2),12) ;amount claimed FB*3.5*158 - service line billed amount
S FBPOS=+$P(Y(0),"^",25),FBPOS=$S(FBPOS:$P(^IBE(353.1,FBPOS,0),"^"),1:" ")
S FBHCFA=+$P(Y(0),"^",26),FBHCFA=$S(FBHCFA:$P(^IBE(353.2,FBHCFA,0),"^"),1:""),FBHCFA=$E(PAD,$L(FBHCFA)+1,2)_FBHCFA
S FBVTOS=+$P(Y(0),"^",24),FBVTOS=$S(FBVTOS:$P(^FBAA(163.85,FBVTOS,0),"^",2),1:" ")
; FB*3.5*139-DEM-Modifications for ICD-10 remediation
S FBPD=+$P(Y(0),"^",23)
S FBPD=$S(FBPD:$$ICD9^FBCSV1(FBPD,$G(FBDTSR1)),1:"")
; decimal is stripped only from ICD-10 diagnosis codes.
I FBPD'="",$$CODEABA^ICDEX(FBPD,80,30)>0 S:FBPD["." FBPD=$P(FBPD,".",1)_$P(FBPD,".",2)
S FBPD=$E(PAD,$L(FBPD)+1,7)_FBPD
; End 139
S FBINVN=$P(Y(0),"^",16)
S FBINVN=$E("000000000",$L(FBINVN)+1,9)_FBINVN
S FBAUTHF=$S($P(Y(0),U,13)["FB583":"U",1:"A") ; auth/unauth flag
S FBDIN=$$AUSDT^FBAAV3($P(Y(0),"^",15)) ; invoice date rec'd
S FBADMIT=$$AUSDT^FBAAV3($$B3ADMIT(FBIENS)) ; formatted admission date
;
S VAPA("P")=""
S DFN=K
; Note - before this point Y(0) was the 0 node of subfile #162.03
; - after this point Y(0) will be the 0 node of file #2
S Y(0)=$G(^DPT(+K,0)) Q:Y(0)']""
D PAT^FBAAUTL2
; obtain date of birth, must follow call to PAT^FBAAUTL2 to overwrite
; the value returned from it
S FBDOB=$$AUSDT^FBAAV3($P(Y(0),"^",3)) ; date of birth
D ADD^VADPT
S FBPNAMX=$$HL7NAME^FBAAV2(DFN) ; patient name
S FBUNITS=$P(FBY,U,14)
S:FBUNITS<1 FBUNITS=1
S FBUNITS=$$RJ^XLFSTR(FBUNITS,5,0) ; volume indicator (units paid)
S FBCSID=$$LJ^XLFSTR($P(FBY,"^",16),20," ") ; patient acct #
D
. N FBCNTRP
. S FBCNTRP=$P(FBY3,"^",8)
. S FBCNTRN=$S(FBCNTRP:$P($G(^FBAA(161.43,FBCNTRP,0)),"^"),1:"")
. S FBCNTRN=$$LJ^XLFSTR(FBCNTRN,20," ") ; contract number
;
S FBFPPSID=$E($P(FBY3,U),1,12),FBFPPSID=$$RJ^XLFSTR(FBFPPSID,12,0) ;FPPS Claim Number
; Authorization Number
S FBAUTHNUM=$P(FBY9,U)
I FBAUTHNUM']"" D
. S FBAUTHNUM=$$AUTHOP1(FBIENS) ;inpatient authorization used for outpatient service
. S:FBAUTHNUM']"" FBAUTHNUM=$$AUTHOP2(DFN,FBDTSR1) ;out for out
;
S FBAUTHNUM=$$LJ^XLFSTR(FBAUTHNUM,"29T"," ") ;AUTHORIZATION NUMBER
; get and format adjustment reason codes and amounts (if any)
D CRARC(FBIENS,.FBCRARC) ; FB*3.5*158
S FBPYMTH=$$PYMTH($P(FBY,U,7))
S FBST=$S($P(VAPA(5),"^")="":" ",$D(^DIC(5,$P(VAPA(5),"^"),0)):$P(^(0),"^",2),1:" ")
I $L(FBST)>2 S FBST="**"
S:$L(FBST)'=2 FBST=$E(PAD,$L(FBST)+1,2)_FBST
S FBCTY=$S($P(VAPA(7),"^",1)="":" ",FBST=" ":" ",$D(^DIC(5,$P(VAPA(5),"^"),1,$P(VAPA(7),"^"),0)):$P(^(0),"^",3),1:" ")
I $L(FBCTY)'=3 S FBCTY=$E("000",$L(FBCTY)+1,3)_FBCTY
S FBZIP=$S('+$G(VAPA(11)):VAPA(6),+VAPA(11):$P(VAPA(11),U),1:VAPA(6)),FBZIP=$TR(FBZIP,"-","")_$E("000000000",$L(FBZIP)+1,9)
D STRING^FBAAV01
Q
;
AUTHOP2(DFN,FBSDT) ; get the outpatient authorization number
; input:
; DFN -> patient IEN
; FBSDT -> date of service
; output:
; authorization #, format: patient IEN-authorization IEN
;
N ANUM,FBFDT,I,FB2DT
S ANUM=""
Q:'$D(^FBAAA(DFN,1)) ANUM
S FBFDT=9999999
F S FBFDT=$O(^FBAAA(DFN,1,"B",FBFDT),-1) Q:'FBFDT D Q:+ANUM
. S I=0
. F S I=$O(^FBAAA(DFN,1,"B",FBFDT,I)) Q:'I I $D(^FBAAA(DFN,1,I,0)) D Q:+ANUM
. . S FB2DT=$P(^FBAAA(DFN,1,I,0),U,2)
. . I FBFDT<=FBSDT,FBSDT<=FB2DT D
. . . S ANUM=DFN_"-"_I
Q ANUM
;
AUTHOP1(IENS) ;get the authorization number from ^FB7078
;
N REFNUM
S REFNUM=""
D GETS^DIQ(162.03,IENS,"27","I","FB")
I $D(FB),FB(162.03,IENS,27,"I")["FB7078" D
. S FB7078=$P(FB(162.03,IENS,27,"I"),";")
. S:$D(^FB7078(FB7078,0)) REFNUM=$P(^FB7078(FB7078,0),U)
Q REFNUM
;
CRARC(FBIENS,FBCRARC) ; load CARCs and RARCs
;
N FBADJ,FBRRMK
D LOADADJ^FBAAFA(FBIENS,.FBADJ)
D LOADRR^FBAAFR(FBIENS,.FBRRMK)
D CRARC^FBAAUTL(.FBADJ,.FBRRMK,.FBCRARC)
Q
;
PYMTH(IEN) ; get Payment Methodology code - FB*3.5*158
;
;input --> IEN: ien of entry in FEE BASIS PAYMENT METHODOLOGY file (#163.98)
;output --> CODE (163.98,1) or null
;
N FBC
S FBC=" "
I IEN,$D(^FBAA(163.98,IEN)) S FBC=$P(^(IEN,0),U,2)
Q FBC
;
UPD ; update the batch file
N Y
S DA=J,(DIC,DIE)="^FBAA(161.7,"
S DR="11////^S X=""T"";12////^S X=DT"
D ^DIE
Q
;
STORE D STORE^FBAAV01 Q
;
B3ADMIT(FBIENS) ; Determine Admission Date for a B3 payment line item
; input
; FBIENS - IENS (FileMan format) for subfile 162.03 entry
; returns admission date in internal FileMan format or null value
;
N FB7078,FBRET
S FBRET=""
S FB7078=$$GET1^DIQ(162.03,FBIENS,27,"I") ; associated 7078/583
; (the unauthorized ancillary claims will have the treatment date
; instead of the inpatient admission date so nothing is sent to
; Austin for them)
;
; if line items points to a 7078 authorization then return a date
I $P(FB7078,";",2)="FB7078(" D
. N FBY
. S FBY=$G(^FB7078(+FB7078,0))
. ; if fee program is civil hospital then return 7078 date of admission
. I $P(FBY,U,11)=6 S FBRET=$P(FBY,U,15)
. ; if fee program is CNH then return 7078 authorized from date
. I $P(FBY,U,11)=7 S FBRET=$P(FBY,U,4)
;
Q FBRET
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBAAV0 11024 printed Sep 23, 2025@19:32:58 Page 2
FBAAV0 ;AISC/GRR - ELECTRONICALLY TRANSMIT FEE DATA ;3/22/2012
+1 ;;3.5;FEE BASIS;**3,4,55,89,98,116,108,132,139,123,158**;JAN 30, 1995;Build 94
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; References to API $$CODEABA^ICDEX supported by ICR #5747
+5 ;
+6 KILL ^TMP($JOB,"FBAABATCH"),^TMP($JOB,"FBVADAT")
DO DT^DICRW
+7 ;
+8 ; Flag indicating if any transactions are found that need to be transmitted
NEW FBTRT
SET FBTRT=0
+9 ; supervisor closed batch
IF $DATA(^FBAA(161.7,"AC","S"))
SET FBTRT=1
+10 ; reviewed after pricer batch
IF $DATA(^FBAA(161.7,"AC","R"))
SET FBTRT=1
+11 ; vendor correction
IF $DATA(^FBAA(161.25,"AE"))
SET FBTRT=1
+12 ; FB patient master record changes
IF +$ORDER(^FBAA(161.26,"AC","P",0))
SET FBTRT=1
+13 ; ipac vendor agreement MRA changes (FB*3.5*123)
IF +$ORDER(^FBAA(161.96,"AS","P",0))
SET FBTRT=1
+14 IF 'FBTRT
WRITE !,*7,"There are no transactions requiring transmission",*7
QUIT
+15 ;
+16 WRITE !!,"This option will transmit all Batches and MRA's ready to be transmitted",!,"to Austin"
RD WRITE !!
SET DIR(0)="Y"
SET DIR("A")="Are you sure you want to continue"
SET DIR("B")="No"
DO ^DIR
KILL DIR
if 'Y
GOTO END
+1 LOCK +^FBAA(161.7,"AC"):0
if '$TEST
GOTO LOCK^FBAAUTL1
+2 WRITE !!,"The following Batches will be transmitted: "
FOR FBSTAT="S","R"
FOR J=0:0
SET J=$ORDER(^FBAA(161.7,"AC",FBSTAT,J))
if J'>0
QUIT
SET FBATCH=$GET(^FBAA(161.7,J,0))
Begin DoDot:1
+3 if '+FBATCH
QUIT
+4 IF (FBSTAT="S"&($PIECE(FBATCH,U,15)="Y"))!(+$PIECE(FBATCH,U,9))
SET ^TMP($JOB,"FBAABATCH",J)=""
WRITE !,+FBATCH
End DoDot:1
RTRAN ;Entry from Re-transmit MRA routine
+1 DO ADDRESS^FBAAV01
if VATERR
GOTO END
KILL VAT
+2 DO WAIT^DICD
DO STATION^FBAAUTL
DO HD^FBAAUTL
IF $DATA(FB("ERROR"))
GOTO END
+3 SET TOTSTR=0
SET $PIECE(PAD," ",200)=" "
+4 ; Vendor MRA
if $DATA(^FBAA(161.25,"AE"))
DO ^FBAAV1
+5 ; Patient MRA
if $DATA(^FBAA(161.26,"AC","P"))
DO ^FBAAV4
+6 ; IPAC agreement MRA (FB*3.5*123)
if $DATA(^FBAA(161.96,"AS","P"))
DO ^FBAAV8
+7 ;
+8 FOR J=0:0
SET J=$ORDER(^TMP($JOB,"FBAABATCH",J))
if J'>0
QUIT
IF $DATA(^FBAA(161.7,J,0))
SET Y(0)=^(0)
DO SET1
if FBAABT="B3"
DO DET
if FBAABT="B5"
DO DETP^FBAAV2
if FBAABT="B2"
DO DETT^FBAAV3
if FBAABT="B9"
DO ^FBAAV5
END LOCK -^FBAA(161.7,"AC")
DO KILL^FBAAV1
QUIT
SET1 ; build the payment batch header string (used by all four formats)
+1 ;FB*3.5*158
SET FBAABN=$PIECE(Y(0),"^",1)
SET FBAABN=$EXTRACT("0000000",$LENGTH(FBAABN)+1,7)_FBAABN
+2 ;obligation #
SET FBAAON=$EXTRACT($PIECE(Y(0),"^",2),3,6)
+3 SET FBAACD=$$AUSDT^FBAAV3(DT)
+4 ;obligation #
SET FBAACP=$EXTRACT($PIECE(Y(0),"^",2),1,2)
+5 ;Type
SET FBAABT=$PIECE(Y(0),"^",3)
+6 ;total dollars
SET FBAAAP=$$AUSAMT^FBAAV3($PIECE(Y(0),"^",9),11)
+7 ;status
SET FBSTAT=$PIECE(^FBAA(161.7,J,"ST"),"^")
+8 ;contract hospital batch
SET FBCHB=$PIECE(Y(0),"^",15)
+9 ;batch exempt
SET FBEXMPT=$PIECE(Y(0),"^",18)
+10 ;station # - obligation #
SET X=$$SUB^FBAAUTL5(+$PIECE(Y(0),U,8)_"-"_$PIECE(Y(0),U,2))
+11 SET FBAASN=$$LJ^XLFSTR($SELECT(X]"":X,1:FBAASN),6," ")
+12 IF FBSTAT="R"!(FBSTAT="S"&(FBCHB'["Y"))!(FBSTAT="S"&($GET(FBEXMPT)="Y"))
SET FBSTR=FBHD_$SELECT(FBAABT="B2":"BT",1:FBAABT)_FBAACD_FBAASN_FBAABN_" "_FBAAAP_FBAACP_" $"
+13 QUIT
DET ;entry point to process B3 (outpatient/ancillary) batch
+1 ; input (partial list)
+2 ; J - Batch IEN in file 161.7
+3 ; FBAAON - last 4 of obligation number
+4 ; FBAASN - station number (formatted)
+5 SET FBTXT=0
+6 DO CKB3V^FBAAV01
IF $GET(FBERR)
KILL FBERR
QUIT
+7 ; HIPAA 5010 - line items that have 0.00 amount paid are now required to go to Central Fee
+8 FOR K=0:0
SET K=$ORDER(^FBAAC("AC",J,K))
if K'>0
QUIT
FOR L=0:0
SET L=$ORDER(^FBAAC("AC",J,K,L))
if L'>0
QUIT
FOR M=0:0
SET M=$ORDER(^FBAAC("AC",J,K,L,M))
if M'>0
QUIT
FOR N=0:0
SET N=$ORDER(^FBAAC("AC",J,K,L,M,N))
if N'>0
QUIT
SET Y(0)=$GET(^FBAAC(K,1,L,1,M,1,N,0))
IF Y(0)]""
Begin DoDot:1
+9 NEW FBDTSR1,FBPICN
+10 SET FBDTSR1=+$GET(^FBAAC(K,1,L,1,M,0))
+11 SET FBPICN=K_U_L_U_M_U_N
+12 SET FBPICN=$$ORGICN^FBAAVR5(162.03,FBPICN)
+13 SET FBY=$GET(^FBAAC(K,1,L,1,M,1,N,2))
+14 SET FBY3=$GET(^FBAAC(K,1,L,1,M,1,N,3))
+15 SET FBY9=$GET(^FBAAC(K,1,L,1,M,1,N,9))
+16 IF 'FBTXT
SET FBTXT=1
DO NEWMSG^FBAAV01
DO STORE^FBAAV01
DO UPD
+17 DO GOT
End DoDot:1
+18 ;
+19 if FBTXT
DO XMIT^FBAAV01
+20 QUIT
+21 ;
GOT ; process a B3 line item
+1 ;
+2 NEW DFN,FBADJ,FBADJA1,FBADJA2,FBADJR1,FBADJR2,FBADMIT,FBAUTHF,FBIENS
+3 NEW FBMOD1,FBMOD2,FBMOD3,FBMOD4,FBPNAMX,FBUNITS,FBX,FBNPI
+4 NEW FBCSID,FBEDIF,FBCNTRN,FBFPPSID,FBCRARC,FBPYMTH,FBAUTHNUM
+5 NEW FBIA,FBDODINV,FBAMTC,FBLNITM
+6 ;
+7 SET FBIENS=N_","_M_","_L_","_K_","
+8 ;
+9 ;FPPS LINE ITEM
SET FBLNITM=+$PIECE(FBY3,U,2)
SET FBLNITM=$$RJ^XLFSTR(FBLNITM,3,0)
+10 ;
+11 ;EDI flag
SET FBEDIF=$SELECT($PIECE($GET(^FBAAC(K,1,L,1,M,1,N,3)),"^")]"":"Y",1:" ")
+12 ; get CPT modifiers
+13 Begin DoDot:1
+14 NEW FBMODA,FBMODL
+15 DO MODDATA^FBAAUTL4(K,L,M,N)
+16 SET FBMODL=$$MODL^FBAAUTL4("FBMODA","E")
+17 SET FBMOD1=$$RJ^XLFSTR($PIECE(FBMODL,",",1),5," ")
+18 SET FBMOD2=$$RJ^XLFSTR($PIECE(FBMODL,",",2),5," ")
+19 SET FBMOD3=$$RJ^XLFSTR($PIECE(FBMODL,",",3),5," ")
+20 SET FBMOD4=$$RJ^XLFSTR($PIECE(FBMODL,",",4),5," ")
End DoDot:1
+21 ;
+22 ;PAYMENT TYPE
SET FBPAYT=$PIECE(Y(0),"^",20)
SET FBPAYT=$SELECT(FBPAYT]"":FBPAYT,1:"V")
+23 ;
+24 ;VENDOR ID
SET FBVID=$PIECE($GET(^FBAAV(L,0)),U,2)
+25 SET FBVID=FBVID_$EXTRACT(PAD,$LENGTH(FBVID)+1,11)
+26 ;
+27 ; FB*3.5*123 - get IPAC variables
+28 ; IPAC agreement ptr
SET FBIA=+$PIECE(FBY3,U,6)
+29 ; IPAC external agreement id# or ""
SET FBIA=$SELECT(FBIA:$PIECE($GET(^FBAA(161.95,FBIA,0)),U,1),1:"")
+30 ; format to 10 characters
SET FBIA=$$LJ^XLFSTR(FBIA,"10T")
+31 ; DoD invoice# formatted to 22 characters
SET FBDODINV=$PIECE(FBY3,U,7)
SET FBDODINV=$$LJ^XLFSTR(FBDODINV,"22T")
+32 ;
+33 if FBPAYT="R"
SET FBVID=$EXTRACT(PAD,1,11)
+34 ;SET THE NPI TO BE PASSED TO FBAAV01,FBAAV2,FBAAV5
SET FBNPI=$$EN^FBNPILK(L)
+35 ;
+36 DO POV^FBAAUTL2
+37 SET POV=$SELECT(POV']"":"",POV="A":6,POV="B":7,POV="C":8,POV="D":9,POV="E":10,1:POV)
+38 SET POV=$SELECT(POV']"":99,$DATA(^FBAA(161.82,POV,0)):$PIECE(^(0),"^",3),1:99)
+39 SET FBPOV=POV
+40 SET FBTT=$SELECT(FBTT]"":FBTT,1:1)
+41 ;SERVICE PROVIDED
SET FBCPT=$$CPT^FBAAUTL4($PIECE(Y(0),"^"))
SET FBCPT=$SELECT($LENGTH(FBCPT)=5:FBCPT,1:" ")
+42 SET FBPSA=$$PSA^FBAAV5(+$PIECE(Y(0),U,12),+FBAASN)
IF $LENGTH(+FBPSA)'=3
SET FBPSA=999
+43 SET FBPATT=$PIECE(Y(0),"^",17)
SET FBPATT=$SELECT(FBPATT]"":FBPATT,1:10)
+44 ; formatted treatment date
SET FBTD=$$AUSDT^FBAAV3(FBDTSR1)
+45 SET FBSUSP=$PIECE(Y(0),"^",5)
SET FBSUSP=$SELECT(FBSUSP]"":FBSUSP,1:" ")
+46 SET FBSUSP=$SELECT(FBSUSP=" ":" ",$DATA(^FBAA(161.27,+FBSUSP,0)):$PIECE(^(0),"^"),1:" ")
+47 ; amount paid
SET FBAP=$$AUSAMT^FBAAV3($PIECE(Y(0),"^",3),8)
+48 ;amount claimed FB*3.5*158 - service line billed amount
SET FBAMTC=$$AUSAMT^FBAAV3($PIECE(Y(0),U,2),12)
+49 SET FBPOS=+$PIECE(Y(0),"^",25)
SET FBPOS=$SELECT(FBPOS:$PIECE(^IBE(353.1,FBPOS,0),"^"),1:" ")
+50 SET FBHCFA=+$PIECE(Y(0),"^",26)
SET FBHCFA=$SELECT(FBHCFA:$PIECE(^IBE(353.2,FBHCFA,0),"^"),1:"")
SET FBHCFA=$EXTRACT(PAD,$LENGTH(FBHCFA)+1,2)_FBHCFA
+51 SET FBVTOS=+$PIECE(Y(0),"^",24)
SET FBVTOS=$SELECT(FBVTOS:$PIECE(^FBAA(163.85,FBVTOS,0),"^",2),1:" ")
+52 ; FB*3.5*139-DEM-Modifications for ICD-10 remediation
+53 SET FBPD=+$PIECE(Y(0),"^",23)
+54 SET FBPD=$SELECT(FBPD:$$ICD9^FBCSV1(FBPD,$GET(FBDTSR1)),1:"")
+55 ; decimal is stripped only from ICD-10 diagnosis codes.
+56 IF FBPD'=""
IF $$CODEABA^ICDEX(FBPD,80,30)>0
if FBPD["."
SET FBPD=$PIECE(FBPD,".",1)_$PIECE(FBPD,".",2)
+57 SET FBPD=$EXTRACT(PAD,$LENGTH(FBPD)+1,7)_FBPD
+58 ; End 139
+59 SET FBINVN=$PIECE(Y(0),"^",16)
+60 SET FBINVN=$EXTRACT("000000000",$LENGTH(FBINVN)+1,9)_FBINVN
+61 ; auth/unauth flag
SET FBAUTHF=$SELECT($PIECE(Y(0),U,13)["FB583":"U",1:"A")
+62 ; invoice date rec'd
SET FBDIN=$$AUSDT^FBAAV3($PIECE(Y(0),"^",15))
+63 ; formatted admission date
SET FBADMIT=$$AUSDT^FBAAV3($$B3ADMIT(FBIENS))
+64 ;
+65 SET VAPA("P")=""
+66 SET DFN=K
+67 ; Note - before this point Y(0) was the 0 node of subfile #162.03
+68 ; - after this point Y(0) will be the 0 node of file #2
+69 SET Y(0)=$GET(^DPT(+K,0))
if Y(0)']""
QUIT
+70 DO PAT^FBAAUTL2
+71 ; obtain date of birth, must follow call to PAT^FBAAUTL2 to overwrite
+72 ; the value returned from it
+73 ; date of birth
SET FBDOB=$$AUSDT^FBAAV3($PIECE(Y(0),"^",3))
+74 DO ADD^VADPT
+75 ; patient name
SET FBPNAMX=$$HL7NAME^FBAAV2(DFN)
+76 SET FBUNITS=$PIECE(FBY,U,14)
+77 if FBUNITS<1
SET FBUNITS=1
+78 ; volume indicator (units paid)
SET FBUNITS=$$RJ^XLFSTR(FBUNITS,5,0)
+79 ; patient acct #
SET FBCSID=$$LJ^XLFSTR($PIECE(FBY,"^",16),20," ")
+80 Begin DoDot:1
+81 NEW FBCNTRP
+82 SET FBCNTRP=$PIECE(FBY3,"^",8)
+83 SET FBCNTRN=$SELECT(FBCNTRP:$PIECE($GET(^FBAA(161.43,FBCNTRP,0)),"^"),1:"")
+84 ; contract number
SET FBCNTRN=$$LJ^XLFSTR(FBCNTRN,20," ")
End DoDot:1
+85 ;
+86 ;FPPS Claim Number
SET FBFPPSID=$EXTRACT($PIECE(FBY3,U),1,12)
SET FBFPPSID=$$RJ^XLFSTR(FBFPPSID,12,0)
+87 ; Authorization Number
+88 SET FBAUTHNUM=$PIECE(FBY9,U)
+89 IF FBAUTHNUM']""
Begin DoDot:1
+90 ;inpatient authorization used for outpatient service
SET FBAUTHNUM=$$AUTHOP1(FBIENS)
+91 ;out for out
if FBAUTHNUM']""
SET FBAUTHNUM=$$AUTHOP2(DFN,FBDTSR1)
End DoDot:1
+92 ;
+93 ;AUTHORIZATION NUMBER
SET FBAUTHNUM=$$LJ^XLFSTR(FBAUTHNUM,"29T"," ")
+94 ; get and format adjustment reason codes and amounts (if any)
+95 ; FB*3.5*158
DO CRARC(FBIENS,.FBCRARC)
+96 SET FBPYMTH=$$PYMTH($PIECE(FBY,U,7))
+97 SET FBST=$SELECT($PIECE(VAPA(5),"^")="":" ",$DATA(^DIC(5,$PIECE(VAPA(5),"^"),0)):$PIECE(^(0),"^",2),1:" ")
+98 IF $LENGTH(FBST)>2
SET FBST="**"
+99 if $LENGTH(FBST)'=2
SET FBST=$EXTRACT(PAD,$LENGTH(FBST)+1,2)_FBST
+100 SET FBCTY=$SELECT($PIECE(VAPA(7),"^",1)="":" ",FBST=" ":" ",$DATA(^DIC(5,$PIECE(VAPA(5),"^"),1,$PIECE(VAPA(7),"^"),0)):$PIECE(^(0),"^",3),1:" ")
+101 IF $LENGTH(FBCTY)'=3
SET FBCTY=$EXTRACT("000",$LENGTH(FBCTY)+1,3)_FBCTY
+102 SET FBZIP=$SELECT('+$GET(VAPA(11)):VAPA(6),+VAPA(11):$PIECE(VAPA(11),U),1:VAPA(6))
SET FBZIP=$TRANSLATE(FBZIP,"-","")_$EXTRACT("000000000",$LENGTH(FBZIP)+1,9)
+103 DO STRING^FBAAV01
+104 QUIT
+105 ;
AUTHOP2(DFN,FBSDT) ; get the outpatient authorization number
+1 ; input:
+2 ; DFN -> patient IEN
+3 ; FBSDT -> date of service
+4 ; output:
+5 ; authorization #, format: patient IEN-authorization IEN
+6 ;
+7 NEW ANUM,FBFDT,I,FB2DT
+8 SET ANUM=""
+9 if '$DATA(^FBAAA(DFN,1))
QUIT ANUM
+10 SET FBFDT=9999999
+11 FOR
SET FBFDT=$ORDER(^FBAAA(DFN,1,"B",FBFDT),-1)
if 'FBFDT
QUIT
Begin DoDot:1
+12 SET I=0
+13 FOR
SET I=$ORDER(^FBAAA(DFN,1,"B",FBFDT,I))
if 'I
QUIT
IF $DATA(^FBAAA(DFN,1,I,0))
Begin DoDot:2
+14 SET FB2DT=$PIECE(^FBAAA(DFN,1,I,0),U,2)
+15 IF FBFDT<=FBSDT
IF FBSDT<=FB2DT
Begin DoDot:3
+16 SET ANUM=DFN_"-"_I
End DoDot:3
End DoDot:2
if +ANUM
QUIT
End DoDot:1
if +ANUM
QUIT
+17 QUIT ANUM
+18 ;
AUTHOP1(IENS) ;get the authorization number from ^FB7078
+1 ;
+2 NEW REFNUM
+3 SET REFNUM=""
+4 DO GETS^DIQ(162.03,IENS,"27","I","FB")
+5 IF $DATA(FB)
IF FB(162.03,IENS,27,"I")["FB7078"
Begin DoDot:1
+6 SET FB7078=$PIECE(FB(162.03,IENS,27,"I"),";")
+7 if $DATA(^FB7078(FB7078,0))
SET REFNUM=$PIECE(^FB7078(FB7078,0),U)
End DoDot:1
+8 QUIT REFNUM
+9 ;
CRARC(FBIENS,FBCRARC) ; load CARCs and RARCs
+1 ;
+2 NEW FBADJ,FBRRMK
+3 DO LOADADJ^FBAAFA(FBIENS,.FBADJ)
+4 DO LOADRR^FBAAFR(FBIENS,.FBRRMK)
+5 DO CRARC^FBAAUTL(.FBADJ,.FBRRMK,.FBCRARC)
+6 QUIT
+7 ;
PYMTH(IEN) ; get Payment Methodology code - FB*3.5*158
+1 ;
+2 ;input --> IEN: ien of entry in FEE BASIS PAYMENT METHODOLOGY file (#163.98)
+3 ;output --> CODE (163.98,1) or null
+4 ;
+5 NEW FBC
+6 SET FBC=" "
+7 IF IEN
IF $DATA(^FBAA(163.98,IEN))
SET FBC=$PIECE(^(IEN,0),U,2)
+8 QUIT FBC
+9 ;
UPD ; update the batch file
+1 NEW Y
+2 SET DA=J
SET (DIC,DIE)="^FBAA(161.7,"
+3 SET DR="11////^S X=""T"";12////^S X=DT"
+4 DO ^DIE
+5 QUIT
+6 ;
STORE DO STORE^FBAAV01
QUIT
+1 ;
B3ADMIT(FBIENS) ; Determine Admission Date for a B3 payment line item
+1 ; input
+2 ; FBIENS - IENS (FileMan format) for subfile 162.03 entry
+3 ; returns admission date in internal FileMan format or null value
+4 ;
+5 NEW FB7078,FBRET
+6 SET FBRET=""
+7 ; associated 7078/583
SET FB7078=$$GET1^DIQ(162.03,FBIENS,27,"I")
+8 ; (the unauthorized ancillary claims will have the treatment date
+9 ; instead of the inpatient admission date so nothing is sent to
+10 ; Austin for them)
+11 ;
+12 ; if line items points to a 7078 authorization then return a date
+13 IF $PIECE(FB7078,";",2)="FB7078("
Begin DoDot:1
+14 NEW FBY
+15 SET FBY=$GET(^FB7078(+FB7078,0))
+16 ; if fee program is civil hospital then return 7078 date of admission
+17 IF $PIECE(FBY,U,11)=6
SET FBRET=$PIECE(FBY,U,15)
+18 ; if fee program is CNH then return 7078 authorized from date
+19 IF $PIECE(FBY,U,11)=7
SET FBRET=$PIECE(FBY,U,4)
End DoDot:1
+20 ;
+21 QUIT FBRET
