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

FBAAV0.m

Go to the documentation of this file.
  1. 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
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. ; References to API $$CODEABA^ICDEX supported by ICR #5747
  1. ;
  1. K ^TMP($J,"FBAABATCH"),^TMP($J,"FBVADAT") D DT^DICRW
  1. ;
  1. N FBTRT S FBTRT=0 ; Flag indicating if any transactions are found that need to be transmitted
  1. I $D(^FBAA(161.7,"AC","S")) S FBTRT=1 ; supervisor closed batch
  1. I $D(^FBAA(161.7,"AC","R")) S FBTRT=1 ; reviewed after pricer batch
  1. I $D(^FBAA(161.25,"AE")) S FBTRT=1 ; vendor correction
  1. I +$O(^FBAA(161.26,"AC","P",0)) S FBTRT=1 ; FB patient master record changes
  1. I +$O(^FBAA(161.96,"AS","P",0)) S FBTRT=1 ; ipac vendor agreement MRA changes (FB*3.5*123)
  1. I 'FBTRT W !,*7,"There are no transactions requiring transmission",*7 Q
  1. ;
  1. W !!,"This option will transmit all Batches and MRA's ready to be transmitted",!,"to Austin"
  1. 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
  1. L +^FBAA(161.7,"AC"):0 G:'$T LOCK^FBAAUTL1
  1. 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
  1. .Q:'+FBATCH
  1. .I (FBSTAT="S"&($P(FBATCH,U,15)="Y"))!(+$P(FBATCH,U,9)) S ^TMP($J,"FBAABATCH",J)="" W !,+FBATCH
  1. RTRAN ;Entry from Re-transmit MRA routine
  1. D ADDRESS^FBAAV01 G END:VATERR K VAT
  1. D WAIT^DICD,STATION^FBAAUTL,HD^FBAAUTL I $D(FB("ERROR")) G END
  1. S TOTSTR=0,$P(PAD," ",200)=" "
  1. D ^FBAAV1:$D(^FBAA(161.25,"AE")) ; Vendor MRA
  1. D ^FBAAV4:$D(^FBAA(161.26,"AC","P")) ; Patient MRA
  1. D ^FBAAV8:$D(^FBAA(161.96,"AS","P")) ; IPAC agreement MRA (FB*3.5*123)
  1. ;
  1. 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"
  1. END L -^FBAA(161.7,"AC") D KILL^FBAAV1 Q
  1. SET1 ; build the payment batch header string (used by all four formats)
  1. S FBAABN=$P(Y(0),"^",1),FBAABN=$E("0000000",$L(FBAABN)+1,7)_FBAABN ;FB*3.5*158
  1. S FBAAON=$E($P(Y(0),"^",2),3,6) ;obligation #
  1. S FBAACD=$$AUSDT^FBAAV3(DT)
  1. S FBAACP=$E($P(Y(0),"^",2),1,2) ;obligation #
  1. S FBAABT=$P(Y(0),"^",3) ;Type
  1. S FBAAAP=$$AUSAMT^FBAAV3($P(Y(0),"^",9),11) ;total dollars
  1. S FBSTAT=$P(^FBAA(161.7,J,"ST"),"^") ;status
  1. S FBCHB=$P(Y(0),"^",15) ;contract hospital batch
  1. S FBEXMPT=$P(Y(0),"^",18) ;batch exempt
  1. S X=$$SUB^FBAAUTL5(+$P(Y(0),U,8)_"-"_$P(Y(0),U,2)) ;station # - obligation #
  1. S FBAASN=$$LJ^XLFSTR($S(X]"":X,1:FBAASN),6," ")
  1. 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_" $"
  1. Q
  1. DET ;entry point to process B3 (outpatient/ancillary) batch
  1. ; input (partial list)
  1. ; J - Batch IEN in file 161.7
  1. ; FBAAON - last 4 of obligation number
  1. ; FBAASN - station number (formatted)
  1. S FBTXT=0
  1. D CKB3V^FBAAV01 I $G(FBERR) K FBERR Q
  1. ; HIPAA 5010 - line items that have 0.00 amount paid are now required to go to Central Fee
  1. 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
  1. .N FBDTSR1,FBPICN
  1. .S FBDTSR1=+$G(^FBAAC(K,1,L,1,M,0))
  1. .S FBPICN=K_U_L_U_M_U_N
  1. .S FBPICN=$$ORGICN^FBAAVR5(162.03,FBPICN)
  1. .S FBY=$G(^FBAAC(K,1,L,1,M,1,N,2))
  1. .S FBY3=$G(^FBAAC(K,1,L,1,M,1,N,3))
  1. .S FBY9=$G(^FBAAC(K,1,L,1,M,1,N,9))
  1. .I 'FBTXT S FBTXT=1 D NEWMSG^FBAAV01,STORE^FBAAV01,UPD
  1. .D GOT
  1. ;
  1. D:FBTXT XMIT^FBAAV01
  1. Q
  1. ;
  1. GOT ; process a B3 line item
  1. ;
  1. N DFN,FBADJ,FBADJA1,FBADJA2,FBADJR1,FBADJR2,FBADMIT,FBAUTHF,FBIENS
  1. N FBMOD1,FBMOD2,FBMOD3,FBMOD4,FBPNAMX,FBUNITS,FBX,FBNPI
  1. N FBCSID,FBEDIF,FBCNTRN,FBFPPSID,FBCRARC,FBPYMTH,FBAUTHNUM
  1. N FBIA,FBDODINV,FBAMTC,FBLNITM
  1. ;
  1. S FBIENS=N_","_M_","_L_","_K_","
  1. ;
  1. S FBLNITM=+$P(FBY3,U,2),FBLNITM=$$RJ^XLFSTR(FBLNITM,3,0) ;FPPS LINE ITEM
  1. ;
  1. S FBEDIF=$S($P($G(^FBAAC(K,1,L,1,M,1,N,3)),"^")]"":"Y",1:" ") ;EDI flag
  1. ; get CPT modifiers
  1. D
  1. . N FBMODA,FBMODL
  1. . D MODDATA^FBAAUTL4(K,L,M,N)
  1. . S FBMODL=$$MODL^FBAAUTL4("FBMODA","E")
  1. . S FBMOD1=$$RJ^XLFSTR($P(FBMODL,",",1),5," ")
  1. . S FBMOD2=$$RJ^XLFSTR($P(FBMODL,",",2),5," ")
  1. . S FBMOD3=$$RJ^XLFSTR($P(FBMODL,",",3),5," ")
  1. . S FBMOD4=$$RJ^XLFSTR($P(FBMODL,",",4),5," ")
  1. ;
  1. S FBPAYT=$P(Y(0),"^",20),FBPAYT=$S(FBPAYT]"":FBPAYT,1:"V") ;PAYMENT TYPE
  1. ;
  1. S FBVID=$P($G(^FBAAV(L,0)),U,2) ;VENDOR ID
  1. S FBVID=FBVID_$E(PAD,$L(FBVID)+1,11)
  1. ;
  1. ; FB*3.5*123 - get IPAC variables
  1. S FBIA=+$P(FBY3,U,6) ; IPAC agreement ptr
  1. S FBIA=$S(FBIA:$P($G(^FBAA(161.95,FBIA,0)),U,1),1:"") ; IPAC external agreement id# or ""
  1. S FBIA=$$LJ^XLFSTR(FBIA,"10T") ; format to 10 characters
  1. S FBDODINV=$P(FBY3,U,7),FBDODINV=$$LJ^XLFSTR(FBDODINV,"22T") ; DoD invoice# formatted to 22 characters
  1. ;
  1. S:FBPAYT="R" FBVID=$E(PAD,1,11)
  1. S FBNPI=$$EN^FBNPILK(L) ;SET THE NPI TO BE PASSED TO FBAAV01,FBAAV2,FBAAV5
  1. ;
  1. D POV^FBAAUTL2
  1. S POV=$S(POV']"":"",POV="A":6,POV="B":7,POV="C":8,POV="D":9,POV="E":10,1:POV)
  1. S POV=$S(POV']"":99,$D(^FBAA(161.82,POV,0)):$P(^(0),"^",3),1:99)
  1. S FBPOV=POV
  1. S FBTT=$S(FBTT]"":FBTT,1:1)
  1. S FBCPT=$$CPT^FBAAUTL4($P(Y(0),"^")),FBCPT=$S($L(FBCPT)=5:FBCPT,1:" ") ;SERVICE PROVIDED
  1. S FBPSA=$$PSA^FBAAV5(+$P(Y(0),U,12),+FBAASN) I $L(+FBPSA)'=3 S FBPSA=999
  1. S FBPATT=$P(Y(0),"^",17),FBPATT=$S(FBPATT]"":FBPATT,1:10)
  1. S FBTD=$$AUSDT^FBAAV3(FBDTSR1) ; formatted treatment date
  1. S FBSUSP=$P(Y(0),"^",5),FBSUSP=$S(FBSUSP]"":FBSUSP,1:" ")
  1. S FBSUSP=$S(FBSUSP=" ":" ",$D(^FBAA(161.27,+FBSUSP,0)):$P(^(0),"^"),1:" ")
  1. S FBAP=$$AUSAMT^FBAAV3($P(Y(0),"^",3),8) ; amount paid
  1. S FBAMTC=$$AUSAMT^FBAAV3($P(Y(0),U,2),12) ;amount claimed FB*3.5*158 - service line billed amount
  1. S FBPOS=+$P(Y(0),"^",25),FBPOS=$S(FBPOS:$P(^IBE(353.1,FBPOS,0),"^"),1:" ")
  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
  1. S FBVTOS=+$P(Y(0),"^",24),FBVTOS=$S(FBVTOS:$P(^FBAA(163.85,FBVTOS,0),"^",2),1:" ")
  1. ; FB*3.5*139-DEM-Modifications for ICD-10 remediation
  1. S FBPD=+$P(Y(0),"^",23)
  1. S FBPD=$S(FBPD:$$ICD9^FBCSV1(FBPD,$G(FBDTSR1)),1:"")
  1. ; decimal is stripped only from ICD-10 diagnosis codes.
  1. I FBPD'="",$$CODEABA^ICDEX(FBPD,80,30)>0 S:FBPD["." FBPD=$P(FBPD,".",1)_$P(FBPD,".",2)
  1. S FBPD=$E(PAD,$L(FBPD)+1,7)_FBPD
  1. ; End 139
  1. S FBINVN=$P(Y(0),"^",16)
  1. S FBINVN=$E("000000000",$L(FBINVN)+1,9)_FBINVN
  1. S FBAUTHF=$S($P(Y(0),U,13)["FB583":"U",1:"A") ; auth/unauth flag
  1. S FBDIN=$$AUSDT^FBAAV3($P(Y(0),"^",15)) ; invoice date rec'd
  1. S FBADMIT=$$AUSDT^FBAAV3($$B3ADMIT(FBIENS)) ; formatted admission date
  1. ;
  1. S VAPA("P")=""
  1. S DFN=K
  1. ; Note - before this point Y(0) was the 0 node of subfile #162.03
  1. ; - after this point Y(0) will be the 0 node of file #2
  1. S Y(0)=$G(^DPT(+K,0)) Q:Y(0)']""
  1. D PAT^FBAAUTL2
  1. ; obtain date of birth, must follow call to PAT^FBAAUTL2 to overwrite
  1. ; the value returned from it
  1. S FBDOB=$$AUSDT^FBAAV3($P(Y(0),"^",3)) ; date of birth
  1. D ADD^VADPT
  1. S FBPNAMX=$$HL7NAME^FBAAV2(DFN) ; patient name
  1. S FBUNITS=$P(FBY,U,14)
  1. S:FBUNITS<1 FBUNITS=1
  1. S FBUNITS=$$RJ^XLFSTR(FBUNITS,5,0) ; volume indicator (units paid)
  1. S FBCSID=$$LJ^XLFSTR($P(FBY,"^",16),20," ") ; patient acct #
  1. D
  1. . N FBCNTRP
  1. . S FBCNTRP=$P(FBY3,"^",8)
  1. . S FBCNTRN=$S(FBCNTRP:$P($G(^FBAA(161.43,FBCNTRP,0)),"^"),1:"")
  1. . S FBCNTRN=$$LJ^XLFSTR(FBCNTRN,20," ") ; contract number
  1. ;
  1. S FBFPPSID=$E($P(FBY3,U),1,12),FBFPPSID=$$RJ^XLFSTR(FBFPPSID,12,0) ;FPPS Claim Number
  1. ; Authorization Number
  1. S FBAUTHNUM=$P(FBY9,U)
  1. I FBAUTHNUM']"" D
  1. . S FBAUTHNUM=$$AUTHOP1(FBIENS) ;inpatient authorization used for outpatient service
  1. . S:FBAUTHNUM']"" FBAUTHNUM=$$AUTHOP2(DFN,FBDTSR1) ;out for out
  1. ;
  1. S FBAUTHNUM=$$LJ^XLFSTR(FBAUTHNUM,"29T"," ") ;AUTHORIZATION NUMBER
  1. ; get and format adjustment reason codes and amounts (if any)
  1. D CRARC(FBIENS,.FBCRARC) ; FB*3.5*158
  1. S FBPYMTH=$$PYMTH($P(FBY,U,7))
  1. S FBST=$S($P(VAPA(5),"^")="":" ",$D(^DIC(5,$P(VAPA(5),"^"),0)):$P(^(0),"^",2),1:" ")
  1. I $L(FBST)>2 S FBST="**"
  1. S:$L(FBST)'=2 FBST=$E(PAD,$L(FBST)+1,2)_FBST
  1. S FBCTY=$S($P(VAPA(7),"^",1)="":" ",FBST=" ":" ",$D(^DIC(5,$P(VAPA(5),"^"),1,$P(VAPA(7),"^"),0)):$P(^(0),"^",3),1:" ")
  1. I $L(FBCTY)'=3 S FBCTY=$E("000",$L(FBCTY)+1,3)_FBCTY
  1. 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)
  1. D STRING^FBAAV01
  1. Q
  1. ;
  1. AUTHOP2(DFN,FBSDT) ; get the outpatient authorization number
  1. ; input:
  1. ; DFN -> patient IEN
  1. ; FBSDT -> date of service
  1. ; output:
  1. ; authorization #, format: patient IEN-authorization IEN
  1. ;
  1. N ANUM,FBFDT,I,FB2DT
  1. S ANUM=""
  1. Q:'$D(^FBAAA(DFN,1)) ANUM
  1. S FBFDT=9999999
  1. F S FBFDT=$O(^FBAAA(DFN,1,"B",FBFDT),-1) Q:'FBFDT D Q:+ANUM
  1. . S I=0
  1. . F S I=$O(^FBAAA(DFN,1,"B",FBFDT,I)) Q:'I I $D(^FBAAA(DFN,1,I,0)) D Q:+ANUM
  1. . . S FB2DT=$P(^FBAAA(DFN,1,I,0),U,2)
  1. . . I FBFDT<=FBSDT,FBSDT<=FB2DT D
  1. . . . S ANUM=DFN_"-"_I
  1. Q ANUM
  1. ;
  1. AUTHOP1(IENS) ;get the authorization number from ^FB7078
  1. ;
  1. N REFNUM
  1. S REFNUM=""
  1. D GETS^DIQ(162.03,IENS,"27","I","FB")
  1. I $D(FB),FB(162.03,IENS,27,"I")["FB7078" D
  1. . S FB7078=$P(FB(162.03,IENS,27,"I"),";")
  1. . S:$D(^FB7078(FB7078,0)) REFNUM=$P(^FB7078(FB7078,0),U)
  1. Q REFNUM
  1. ;
  1. CRARC(FBIENS,FBCRARC) ; load CARCs and RARCs
  1. ;
  1. N FBADJ,FBRRMK
  1. D LOADADJ^FBAAFA(FBIENS,.FBADJ)
  1. D LOADRR^FBAAFR(FBIENS,.FBRRMK)
  1. D CRARC^FBAAUTL(.FBADJ,.FBRRMK,.FBCRARC)
  1. Q
  1. ;
  1. PYMTH(IEN) ; get Payment Methodology code - FB*3.5*158
  1. ;
  1. ;input --> IEN: ien of entry in FEE BASIS PAYMENT METHODOLOGY file (#163.98)
  1. ;output --> CODE (163.98,1) or null
  1. ;
  1. N FBC
  1. S FBC=" "
  1. I IEN,$D(^FBAA(163.98,IEN)) S FBC=$P(^(IEN,0),U,2)
  1. Q FBC
  1. ;
  1. UPD ; update the batch file
  1. N Y
  1. S DA=J,(DIC,DIE)="^FBAA(161.7,"
  1. S DR="11////^S X=""T"";12////^S X=DT"
  1. D ^DIE
  1. Q
  1. ;
  1. STORE D STORE^FBAAV01 Q
  1. ;
  1. B3ADMIT(FBIENS) ; Determine Admission Date for a B3 payment line item
  1. ; input
  1. ; FBIENS - IENS (FileMan format) for subfile 162.03 entry
  1. ; returns admission date in internal FileMan format or null value
  1. ;
  1. N FB7078,FBRET
  1. S FBRET=""
  1. S FB7078=$$GET1^DIQ(162.03,FBIENS,27,"I") ; associated 7078/583
  1. ; (the unauthorized ancillary claims will have the treatment date
  1. ; instead of the inpatient admission date so nothing is sent to
  1. ; Austin for them)
  1. ;
  1. ; if line items points to a 7078 authorization then return a date
  1. I $P(FB7078,";",2)="FB7078(" D
  1. . N FBY
  1. . S FBY=$G(^FB7078(+FB7078,0))
  1. . ; if fee program is civil hospital then return 7078 date of admission
  1. . I $P(FBY,U,11)=6 S FBRET=$P(FBY,U,15)
  1. . ; if fee program is CNH then return 7078 authorized from date
  1. . I $P(FBY,U,11)=7 S FBRET=$P(FBY,U,4)
  1. ;
  1. Q FBRET