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

FBAAV01.m

Go to the documentation of this file.
  1. FBAAV01 ;AISC/GRR - ELECTRONICALLY TRANSMIT FEE DATA CONTINUED ;6/15/2009
  1. ;;3.5;FEE BASIS;**89,98,108,123,158**;JAN 30, 1995;Build 94
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. NEWMSG ;get new message number, reset line counter
  1. ;FBLN=line counter, FBFEE=FEE message counter, FBNVP=NVP message counter
  1. ;FBOKTX=1 if message pending, 0 otherwise
  1. S FBXMZ=0,FBJ=$G(J),FBK=$G(K) S:'$D(FBFEE) FBFEE=1 S:'$D(FBNVP) FBNVP=1
  1. S XMSUB=$S('$D(FBFLAG):"FEE BASIS MESSAGE # "_FBFEE,1:"FEE NON-VA HOSP TO PRICER MESSAGE # "_FBNVP),XMDUZ=DUZ
  1. S FBOKTX=0
  1. D XMZ^XMA2
  1. I '$D(XMZ)!(XMZ'>0) G NEWMSG
  1. S FBXMZ=XMZ,FBLN=0,FBOKTX=1,J=FBJ,K=FBK K XMZ
  1. Q
  1. ;
  1. XMIT ;send message, increment message counter
  1. ;FBLN=line counter, FBFEE=FEE message counter, FBNVP=NVP message counter
  1. ;FBXMFEE(=FEE recipient array, FBXMNVP(=NVP recipient array
  1. S FBJ=J,FBK=K K XMY D ROUT
  1. S XMZ=FBXMZ,^XMB(3.9,XMZ,2,0)="^3.92A^"_FBLN_"^"_FBLN_"^"_DT
  1. S XMDUN=$P(^VA(200,DUZ,0),U) D ENT1^XMD
  1. S FBLN=0,FBOKTX=0
  1. D INCRM ;increment message counter
  1. S J=FBJ,K=FBK
  1. Q
  1. ;
  1. ROUT ;set up recipients for message
  1. I $D(FBFLAG) S FBI=0 F S FBI=$O(FBXMNVP(FBI)) Q:'FBI S X=FBXMNVP(FBI),XMN=0,XMDF="" D INST^XMA21 K XMN,XMDF
  1. I '$D(FBFLAG) S FBI=0 F S FBI=$O(FBXMFEE(FBI)) Q:'FBI S X=FBXMFEE(FBI),XMN=0,XMDF="" D INST^XMA21 K XMN,XMDF
  1. S XMY(DUZ)="",XMDUZ=DUZ Q
  1. ;
  1. INCRM ;increment message counter
  1. I $D(FBFLAG) S FBNVP=FBNVP+1
  1. E S FBFEE=FBFEE+1
  1. Q
  1. ;
  1. INCRL ;increment line counter
  1. S FBLN=FBLN+1 Q
  1. ;
  1. STORE ;set message string
  1. D INCRL S ^XMB(3.9,FBXMZ,2,FBLN,0)=FBSTR
  1. Q
  1. ;
  1. ADDRESS ;set up recipient array, FBXMFEE( for FEE router, FBXMNVP( for NVP router
  1. F VATNAME="FEE","NVP" D ^VATRAN G:VATERR ADDQ S FBI=0 F S FBI=$O(VAT(FBI)) Q:'FBI S FBVAR="FBXM"_VATNAME_"("_FBI_")" S @FBVAR=VAT(FBI)
  1. ADDQ Q
  1. ;Following checks for Austin Name Field in Vendor file in order to continue transmitting that batch.
  1. CKB3V F FB1=0:0 S FB1=$O(^FBAAC("AC",J,FB1)) Q:'FB1!($G(FBERR)) F FB2=0:0 S FB2=$O(^FBAAC("AC",J,FB1,FB2)) Q:FB2'>0!($G(FBERR)) D CHKV
  1. Q
  1. CKB5V F FB1=0:0 S FB1=$O(^FBAA(162.1,"AE",J,FB1)) Q:'FB1!($G(FBERR)) I $G(^FBAA(162.1,FB1,0)) S FB2=+$P(^(0),"^",4) D CHKV
  1. Q
  1. CKB9V F FB1=0:0 S FB1=$O(^FBAAI("AC",J,FB1)) Q:'FB1!($G(FBERR)) I $G(^FBAAI(FB1,0)) S FB2=+$P(^(0),"^",3) D CHKV
  1. Q
  1. CHKV I $$CKVEN^FBAADV(FB2) W !!,*7,"VENDOR: ",$$VNAME^FBNHEXP(FB2)," Not approved in Austin yet.",!,"Batch # ",FBAABN," CANNOT BE TRANSMITTED!!!" S FBERR=1
  1. Q
  1. ;
  1. STRING ; called from FBAAV0 to build 'B3' payment record; also called by DSIFPAY5 (FBCS) with DBIA# 5093
  1. ;
  1. S FBPICN=$$PADZ(FBPICN,30)
  1. ;
  1. ; build 1st line
  1. S FBSTR=3_FBAASN_FBSSN_FBPAYT_FBPNAMX_FBVID_" "_FBAP_FBAAON_FBSUSP
  1. S FBSTR=FBSTR_FBPOV_FBPATT_FBTD_FBTT_FBDIN_FBINVN
  1. S FBSTR=FBSTR_$E(PAD,1,33)_FBST_FBCTY_FBZIP ; reserved for foreign addr
  1. S FBSTR=FBSTR_$E(FBPSA,1,3)_FBCPT_FBPOS_FBHCFA_FBVTOS_FBPD
  1. S FBSTR=FBSTR_+$P($G(FBY),U,2)_$E(PAD,1,8)_FBPICN ;Internal Control Number
  1. S FBSTR=FBSTR_$S(+FBY:$$AUSDT^FBAAV3(+FBY),1:FBDIN)_FBADMIT_FBDOB_"~"
  1. D STORE
  1. ;
  1. ; build 2nd line
  1. S FBSTR=FBUNITS_FBAUTHF_FBMOD1_FBMOD2_FBMOD3_FBMOD4
  1. S FBADJR1=$S($D(FBCRARC(1)):$P(FBCRARC(1),U,2),1:""),FBADJR1=$$RJ^XLFSTR(FBADJR1,5," ")
  1. S FBADJR2=$S($D(FBCRARC(2)):$P(FBCRARC(2),U,2),1:""),FBADJR2=$$RJ^XLFSTR(FBADJR2,5," ")
  1. S FBSTR=FBSTR_FBADJR1_FBADJR2
  1. S FBADJA1=$S($D(FBCRARC(1)):$P(FBCRARC(1),U,3),1:0),FBADJA1=$$AUSAMT^FBAAV3(FBADJA1,9,1)
  1. S FBADJA2=$S($D(FBCRARC(2)):$P(FBCRARC(2),U,3),1:0),FBADJA2=$$AUSAMT^FBAAV3(FBADJA2,9,1)
  1. S FBSTR=FBSTR_FBADJA1_FBADJA2
  1. S FBSTR=FBSTR_FBNPI_FBCSID_FBEDIF_FBCNTRN
  1. ;
  1. ; FB*3.5*123 - esg - Check to make sure IPAC variables are defined
  1. I '$D(FBIA)!'$D(FBDODINV) D IPAC(K,L,M,N,.FBIA,.FBDODINV) ; set and format the IPAC variables if coming from FBCS
  1. ;
  1. S FBSTR=FBSTR_FBIA_FBDODINV_"~" ; FB*3.5*123 - IPAC data formatted in FBAAV0 or below in IPAC
  1. D STORE
  1. ;
  1. ; 3rd line
  1. S FBSTR=FBFPPSID ; FPPS Claim Number
  1. S FBSTR=FBSTR_FBAUTHNUM ;AUTHORIZATION NUMBER
  1. S FBLNITM=$$RJ^XLFSTR(FBLNITM,3,0) ;fpps line item
  1. S FBSTR=FBSTR_FBLNITM
  1. S FBSTR=FBSTR_FBAMTC ;Service Line Billed Amount = Claimed Amount
  1. ;
  1. S FBADJG=$S($D(FBCRARC(1)):$P(FBCRARC(1),U),1:""),FBADJG=$$RJ^XLFSTR(FBADJG,2," ")
  1. S FBRRC1=$S($D(FBCRARC(1)):$P(FBCRARC(1),U,4),1:""),FBRRC1=$$RJ^XLFSTR(FBRRC1,6," ")
  1. S FBRRC2=$S($D(FBCRARC(1)):$P(FBCRARC(1),U,5),1:""),FBRRC2=$$RJ^XLFSTR(FBRRC2,6," ")
  1. S FBSTR=FBSTR_FBADJG_FBRRC1_FBRRC2
  1. ;
  1. S FBADJG=$S($D(FBCRARC(2)):$P(FBCRARC(2),U),1:""),FBADJG=$$RJ^XLFSTR(FBADJG,2," ")
  1. S FBRRC1=$S($D(FBCRARC(2)):$P(FBCRARC(2),U,4),1:""),FBRRC1=$$RJ^XLFSTR(FBRRC1,6," ")
  1. S FBRRC2=$S($D(FBCRARC(2)):$P(FBCRARC(2),U,5),1:""),FBRRC2=$$RJ^XLFSTR(FBRRC2,6," ")
  1. S FBSTR=FBSTR_FBADJG_FBRRC1_FBRRC2
  1. ;
  1. F FBI=3:1:5 D
  1. . S FBADJG=$S($D(FBCRARC(FBI)):$P(FBCRARC(FBI),U),1:""),FBADJG=$$RJ^XLFSTR(FBADJG,2," ")
  1. . S FBADJR=$S($D(FBCRARC(FBI)):$P(FBCRARC(FBI),U,2),1:""),FBADJR=$$RJ^XLFSTR(FBADJR,5," ")
  1. . S FBRRC1=$S($D(FBCRARC(FBI)):$P(FBCRARC(FBI),U,4),1:""),FBRRC1=$$RJ^XLFSTR(FBRRC1,6," ")
  1. . S FBRRC2=$S($D(FBCRARC(FBI)):$P(FBCRARC(FBI),U,5),1:""),FBRRC2=$$RJ^XLFSTR(FBRRC2,6," ")
  1. . S FBADJA=$S($D(FBCRARC(FBI)):$P(FBCRARC(FBI),U,3),1:0),FBADJA=$$AUSAMT^FBAAV3(FBADJA,9,1)
  1. . S FBSTR=FBSTR_FBADJG_FBADJR_FBRRC1_FBRRC2_FBADJA
  1. ;
  1. S FBSTR=FBSTR_$$RJ^XLFSTR(FBPYMTH,1," ")
  1. S FBSTR=FBSTR_" " ;Additional Payment Indicator
  1. S FBSTR=FBSTR_" " ;Additional Payment Type
  1. S FBSTR=FBSTR_$$PADZ(0,30) ;Parent Internal Control Number
  1. ;
  1. S FBSTR=FBSTR_"~$"
  1. D STORE
  1. ;
  1. K FBPICN,FBY
  1. K FBIA,FBDODINV ; FB*3.5*123 kill IPAC variables after using them. They will get rebuilt by the next claim.
  1. Q
  1. ;
  1. PADZ(X,Y) ;call to pad 'X' with leading zeros' to a field length of 'Y'
  1. ;
  1. I $S('$L(X):1,'Y:1,Y<$L(X):1,1:0) Q ""
  1. N Z S Z=0,$P(Z,0,Y)=0
  1. Q $E(Z,$L(X)+1,Y)_X
  1. ;
  1. IPAC(K,L,M,N,FBIA,FBDODINV) ; set IPAC variables if being called from FBCS
  1. ; K - 162.03 subscript#1 - DFN
  1. ; L - 162.03 subscript#2 - vendor ien
  1. ; M - 162.03 subscript#3 - treatment date subfile ien
  1. ; N - 162.03 subscript#4 - service provided subfile ien
  1. ; Output:
  1. ; FBIA - formatted IPAC agreement ID# (pass by reference) - will be 10 characters in length
  1. ; FBDODINV - formatted DoD invoice# (pass by reference) - will be 22 characters in length
  1. ;
  1. N FBY2,FBY3,FBIPIEN
  1. S (FBIA,FBDODINV)=""
  1. I '$$IPACREQD^FBAAMP(L) G IPACX ; IPAC data is not required so get out
  1. ;
  1. S FBY2=$G(^FBAAC(K,1,L,1,M,1,N,2)) ; 2 node of file 162.03
  1. S FBY3=$G(^FBAAC(K,1,L,1,M,1,N,3)) ; 3 node of file 162.03
  1. S FBIA=+$P(FBY3,U,6) ; .05 field IPAC agreement ien
  1. S FBIA=$S(FBIA:$P($G(^FBAA(161.95,FBIA,0)),U,1),1:"") ; IPAC agreement ID# or ""
  1. S FBDODINV=$P(FBY3,U,7) ; IPAC DoD invoice#
  1. ;
  1. ; if IPAC agreement is not on file, but there is only one active IPAC on file for the vendor, then save it/use it
  1. I FBIA="" S FBIA=$$IPACID^FBAAMP(L,.FBIPIEN) I FBIA'="",FBIPIEN D
  1. . N FBIENS,FBIAFDA
  1. . S FBIENS=N_","_M_","_L_","_K_","
  1. . S FBIAFDA(162.03,FBIENS,.05)=FBIPIEN ; ipac agreement ien
  1. . D FILE^DIE("","FBIAFDA") ; update the database
  1. . Q
  1. ;
  1. ; if IPAC agreement is still not found, then report an error condition to Central Fee
  1. I FBIA="" S FBIA="9999999999" ; error value to be sent to Central Fee so they reject it back to VistA
  1. ;
  1. ; if DoD invoice# is not on file, then attempt to use field# 49 PATIENT ACCOUNT NUMBER. use it/save it if it exists
  1. I FBDODINV="" S FBDODINV=$P(FBY2,U,16) I FBDODINV'="" D
  1. . N FBIENS,FBIAFDA
  1. . S FBIENS=N_","_M_","_L_","_K_","
  1. . S FBIAFDA(162.03,FBIENS,.055)=FBDODINV ; DoD invoice#
  1. . D FILE^DIE("","FBIAFDA") ; update the database
  1. . Q
  1. ;
  1. ; if DoD invoice# is still not found, then report an error condition to Central Fee
  1. I FBDODINV="" S FBDODINV="9999999999999999999999" ; error value to be sent to Central Fee
  1. ;
  1. IPACX ;
  1. S FBIA=$$LJ^XLFSTR(FBIA,"10T") ; IPAC agreement id#
  1. S FBDODINV=$$LJ^XLFSTR(FBDODINV,"22T") ; DoD invoice#
  1. Q
  1. ;