- 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 Feb 18, 2025@23:23:20 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