BPSNCPD2 ;BHAM ISC/LJE - Continuation of BPSNCPDP (IB Billing Determination) ;11/7/07 16:01
;;1.0;E CLAIMS MGMT ENGINE;**1,5,6,7,8,10,11,20,28**;JUN 2004;Build 22
;;Per VA Directive 6402, this routine should not be modified.
;
;External reference $$RX^IBNCPDP supported by DBIA 4299
;
; EN - Call IB Billing Determination. If good to go, update MOREDATA array
; Notes about variables
;Input:
; DFN - PATIENT file #2 ien
; BWHERE - Where the code is called from and what needs to be done
; MOREDATA - Initialized by BPSNCPDP and more data is added here.
; Should be passed by reference.
; BPSARRY - Created by STARRAY^BPSNCPD1 and used for IB Determination
; IB - Returned to calling routine. Should be passed by reference.
; 1 = Billable
; 0 or 2 - Not Billable
;
; Variable used/needed but not passed in as a parameter
; CERTIEN - BPS Certification IEN - Not passed but newed/set in BPSNCPDP
; BPJOBFLG - Not passed in but newed/set in BPSNCPCP
;
EN(DFN,BWHERE,MOREDATA,BPSARRY,IB) ;
I '$G(CERTIEN) D
. ;
. I $G(BPSARRY("ACT DTY OVR")),'$G(BPSARRY("PLAN")) D
. . N IEN5902
. . S IEN5902=$$GET1^DIQ(9002313.59,IEN59,901,"I")
. . I 'IEN5902 S IEN5902=1
. . S BPSARRY("PLAN")=$$GET1^DIQ(9002313.59902,IEN5902_","_IEN59_",",".01","I")
. ;
. ;For NCPDP IB call to see if we need to 3rd Party Bill and if so, get insurance/payer sheet info
. S MOREDATA("BILL")=$$RX^IBNCPDP(DFN,.BPSARRY) ;IB CALL
. Q:'$D(MOREDATA("BILL"))
. ;
. ; If calling program is the ECME user screen and we can't bill because of NEEDS SC DETERMINATION
. ; or EI, then prompt the user to see if they want to bill
. I $F(".ERES.ERWV.ERNB.","."_BWHERE_"."),$P(MOREDATA("BILL"),U,1)=0,$G(BPSARRY("SC/EI NO ANSW"))]"",$G(BPJOBFLG)'="B" D
.. N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,I,BPEISC
.. F I=1:1:$L($G(BPSARRY("SC/EI NO ANSW")),",") S BPEISC=$P($G(BPSARRY("SC/EI NO ANSW")),",",I) I BPEISC]"" D
... W !,"The prescription is potentially ",BPEISC,"-related and needs ",BPEISC," determination."
... W !,"Prescriptions related to ",BPEISC," cannot be billed to Third Party Insurance.",!
.. S DIR(0)="Y",DIR("A")="Are you sure you want to bill this prescription"
.. S DIR("B")="NO"
.. S DIR("?")="If you want to bill this prescription, enter 'Yes' - otherwise, enter 'No'"
.. W ! D ^DIR K DIR
.. I '+Y Q
.. S BPSARRY("SC/EI OVR")=1
.. S MOREDATA("BILL")=$$RX^IBNCPDP(DFN,.BPSARRY) ;Call IB again
. ;
. ; Quit if no response from IB call
. Q:'$D(MOREDATA("BILL"))
. ;
. S MOREDATA("ELIG")=$P(MOREDATA("BILL"),U,3) ; patient eligibility V, T, or C
. ;
. S IB=1 ; assume it is billable for now
. ;
. M MOREDATA("IBDATA")=BPSARRY("INS") ; insurance array nodes from IB billing determination
. ;
. ; Clean up the "IBDATA" array nodes as necessary
. ; The code below checks if Sequence #1 is missing and move the next number down if needed.
. ; This can happen when the COB indicator in IB has multiple insurances assigned as secondary but none are
. ; assigned as primary
. I '$D(MOREDATA("IBDATA",1)) D
.. N WW
.. S WW=$O(MOREDATA("IBDATA",""))
.. I WW'="" M MOREDATA("IBDATA",1)=MOREDATA("IBDATA",WW) K MOREDATA("IBDATA",WW)
.. Q
. ;
. S MOREDATA("PATIENT")=$G(DFN)
. S MOREDATA("RX")=$G(BPSARRY("IEN"))
. S $P(MOREDATA("BPSDATA",1),U,1)=$G(BPSARRY("NCPDP QTY"))
. S $P(MOREDATA("BPSDATA",1),U,2)=$G(BPSARRY("COST"))
. S $P(MOREDATA("BPSDATA",1),U,3)=$G(BPSARRY("NDC"))
. S $P(MOREDATA("BPSDATA",1),U,4)=$G(BPSARRY("FILL NUMBER"))
. S $P(MOREDATA("BPSDATA",1),U,5)="" ; Certification Mode
. S $P(MOREDATA("BPSDATA",1),U,6)="" ; Certification IEN
. S $P(MOREDATA("BPSDATA",1),U,7)=$G(BPSARRY("NCPDP UNITS"))
. S $P(MOREDATA("BPSDATA",1),U,8)=$G(BPSARRY("QTY")) ; Billing Quantity
. S $P(MOREDATA("BPSDATA",1),U,9)=$G(BPSARRY("UNITS")) ; Billing Units
. ;
. ; now check IB billing determination results and set variable IB
. I $P(MOREDATA("BILL"),U,1)=0 S IB=2 ;IB says not to bill
. ;
. ; bps*1*20 - file TRI/CVA Non-Billable entries into BPS Transaction
. I IB=2,MOREDATA("ELIG")="T"!(MOREDATA("ELIG")="C") D BPTCNB(.MOREDATA,.BPSARRY)
. Q
;
; If certification mode on and no IB result (somewhat redundant since IB is not called
; for certification), get data from BPS Certification table
I $G(CERTIEN),'$G(IB) D
. N NODE,FLD,NFLD,CERTARY
. S MOREDATA("IBDATA",1,1)="",MOREDATA("IBDATA",1,2)=""
. S MOREDATA("IBDATA",1,3)="",MOREDATA("BPSDATA",1)=""
. S MOREDATA("BILL")="1^^V",IB=1
. S MOREDATA("PATIENT")=$$GET1^DIQ(9002313.31,CERTIEN,903,"I") ;Patient from certification record
. I 'MOREDATA("PATIENT") S MOREDATA("PATIENT")=$G(DFN) ; Patient
. S MOREDATA("RX")=$G(BPSARRY("IEN")) ; RX
. S MOREDATA("ELIG")="V" ; Eligibility
. S $P(MOREDATA("BPSDATA",1),U,5)=1 ;Certify Mode
. S $P(MOREDATA("BPSDATA",1),U,6)=CERTIEN ;Cert IEN
. S $P(MOREDATA("BPSDATA",1),U,8)="" ; Billing Quantity
. S $P(MOREDATA("BPSDATA",1),U,9)="" ; Billing Units
. S $P(MOREDATA("IBDATA",1,1),U,1)=1 ;Plan IEN
. S $P(MOREDATA("IBDATA",1,1),U,4)=$$GET1^DIQ(9002313.31,CERTIEN,.04,"E") ;Billing Payer Sheet Name
. S $P(MOREDATA("IBDATA",1,1),U,10)="01" ;Home State Plan
. S $P(MOREDATA("IBDATA",1,1),U,11)=$$GET1^DIQ(9002313.31,CERTIEN,.05,"E") ;Reversal Payer Sheet Name
. S $P(MOREDATA("IBDATA",1,1),U,12)="" ;Rebill Payer Sheet Name
. S $P(MOREDATA("IBDATA",1,1),U,14)="" ;Plan Name
. S $P(MOREDATA("IBDATA",1,1),U,15)=$$GET1^DIQ(9002313.31,CERTIEN,.08,"E") ;Eligibility Payer Sheet Name
. S $P(MOREDATA("IBDATA",1,1),U,16)=$$GET1^DIQ(9002313.31,CERTIEN,.04,"I") ;Billing Payer Sheet IEN
. S $P(MOREDATA("IBDATA",1,1),U,17)=$$GET1^DIQ(9002313.31,CERTIEN,.05,"I") ;Reversal Payer Sheet IEN
. S $P(MOREDATA("IBDATA",1,1),U,18)="" ; Rebill Payer Sheet IEN
. S $P(MOREDATA("IBDATA",1,1),U,19)=$$GET1^DIQ(9002313.31,CERTIEN,.08,"I") ;Eligibility Payer Sheet IEN
. S $P(MOREDATA("IBDATA",1,2),U,5)=0 ;Admin Fee
. S $P(MOREDATA("IBDATA",1,3),U,1)="" ;Group Name
. S $P(MOREDATA("IBDATA",1,3),U,2)="" ;Insurance Company Phone Number
. S $P(MOREDATA("IBDATA",1,3),U,3)="T00010" ;Plan ID
. S $P(MOREDATA("IBDATA",1,3),U,4)="V" ;Plan Type
. S $P(MOREDATA("IBDATA",1,3),U,5)="" ;Insurance Company IEN
. S $P(MOREDATA("IBDATA",1,3),U,6)=$$GET1^DIQ(9002313.31,CERTIEN,.07,"I") ;COB Indicator
. I $P(MOREDATA("IBDATA",1,3),U,6)="" S $P(MOREDATA("IBDATA",1,3),U,6)=1
. S $P(MOREDATA("IBDATA",1,3),U,7)=1 ;Policy Number (needed for eligibility transmissions)
. S $P(MOREDATA("IBDATA",1,3),U,8)=1 ;Maximum Transactions
. ;
. ;Get data from non-multiple fields and add to MOREDATA
. K CERTARY D GETS^DIQ(9002313.31,CERTIEN_",","1*","","CERTARY")
. S NODE="" F S NODE=$O(CERTARY(9002313.311,NODE)) Q:NODE="" D
.. S FLD="" F S FLD=$O(CERTARY(9002313.311,NODE,FLD)) Q:FLD="" D
... I FLD=.01 S NFLD=CERTARY(9002313.311,NODE,FLD) D
.... I NFLD=101 S $P(MOREDATA("IBDATA",1,1),U,2)=CERTARY(9002313.311,NODE,.02) ;BIN
.... I NFLD=104 S $P(MOREDATA("IBDATA",1,1),U,3)=CERTARY(9002313.311,NODE,.02) ;PCN
.... I NFLD=110 S $P(MOREDATA("IBDATA",1,1),U,13)=CERTARY(9002313.311,NODE,.02) ;Certification ID
. ;
. ;Get data from multiple fields and add to MOREDATA
. K CERTARY D GETS^DIQ(9002313.31,CERTIEN_",","2*","","CERTARY")
. S NODE="" F S NODE=$O(CERTARY(9002313.3121,NODE)) Q:NODE="" D
.. S FLD="" F S FLD=$O(CERTARY(9002313.3121,NODE,FLD)) Q:FLD="" D
... I FLD=.01 S NFLD=CERTARY(9002313.3121,NODE,FLD) D
.... I NFLD=301 S $P(MOREDATA("IBDATA",1,1),U,5)=CERTARY(9002313.3121,NODE,.02) ;Group ID
.... I NFLD=302 S $P(MOREDATA("IBDATA",1,1),U,6)=CERTARY(9002313.3121,NODE,.02) ;Cardholder ID
.... I NFLD=306 S $P(MOREDATA("IBDATA",1,1),U,7)=CERTARY(9002313.3121,NODE,.02) ;Patient Rel Code
.... I NFLD=312 S $P(MOREDATA("IBDATA",1,1),U,8)=CERTARY(9002313.3121,NODE,.02) ;Cardholder First Name
.... I NFLD=313 S $P(MOREDATA("IBDATA",1,1),U,9)=CERTARY(9002313.3121,NODE,.02) ;Cardholder Last Name
.... I NFLD=412 S $P(MOREDATA("IBDATA",1,2),U,1)=CERTARY(9002313.3121,NODE,.02) ;Dispensing Fee
.... I NFLD=423 S $P(MOREDATA("IBDATA",1,2),U,2)=CERTARY(9002313.3121,NODE,.02) ;Basis of Cost Determination
.... I NFLD=426 S $P(MOREDATA("IBDATA",1,2),U,3)=CERTARY(9002313.3121,NODE,.02) ;Usual & Customary - Base Price
.... I NFLD=430 S $P(MOREDATA("IBDATA",1,2),U,4)=CERTARY(9002313.3121,NODE,.02) ;Gross Amt Due
.... I NFLD=442 S $P(MOREDATA("BPSDATA",1),U,1)=CERTARY(9002313.3121,NODE,.02) ;Quantity Dispensed
.... I NFLD=409 S $P(MOREDATA("BPSDATA",1),U,2)=CERTARY(9002313.3121,NODE,.02) ;Unit Cost
.... I NFLD=407 S $P(MOREDATA("BPSDATA",1),U,3)=CERTARY(9002313.3121,NODE,.02) ;NDC
.... I NFLD=403 S $P(MOREDATA("BPSDATA",1),U,4)=+CERTARY(9002313.3121,NODE,.02) ;Fill #
.... I NFLD=600 S $P(MOREDATA("BPSDATA",1),U,7)=CERTARY(9002313.3121,NODE,.02) ;Unit of Measure
. ;
. ; If Gross Amt Due is missing, use Usual and Customary
. I $P(MOREDATA("IBDATA",1,2),U,4)="" S $P(MOREDATA("IBDATA",1,2),U,4)=$P(MOREDATA("IBDATA",1,2),U,3)
. Q
;
; Uppercase the IBDATA
S MOREDATA("IBDATA",1,1)=$$UP^XLFSTR($G(MOREDATA("IBDATA",1,1)))
S MOREDATA("IBDATA",1,2)=$$UP^XLFSTR($G(MOREDATA("IBDATA",1,2)))
S MOREDATA("BPSDATA",1)=$$UP^XLFSTR($G(MOREDATA("BPSDATA",1)))
;
Q
;
BPTCNB(MOREDATA,BPSARRY) ; Add TRICARE/CHAMPVA non-billable entry to BPS Transaction - BPS*1*20
;
N BPSELD,IEN59,RXIEN,FILL,COB
;
; Uppercase the IBDATA before going further
S MOREDATA("IBDATA",1,1)=$$UP^XLFSTR($G(MOREDATA("IBDATA",1,1)))
S MOREDATA("IBDATA",1,2)=$$UP^XLFSTR($G(MOREDATA("IBDATA",1,2)))
S MOREDATA("BPSDATA",1)=$$UP^XLFSTR($G(MOREDATA("BPSDATA",1)))
;
S BPSELD=$S(MOREDATA("ELIG")="T":"TRICARE",MOREDATA("ELIG")="C":"CHAMPVA",1:"UNKNOWN")
S MOREDATA("REQ TYPE")="N" ; TRICARE/CHAMPVA non-billable entry
S MOREDATA("SUBMIT TIME")=$$NOW^XLFDT ; submit time is right now
S MOREDATA("PAYER SEQUENCE")=$G(BPSARRY("RXCOB")) ; payer sequence/COB
S MOREDATA("POLICY")=$P($G(MOREDATA("IBDATA",1,3)),U,7) ; 2.312 policy# ien
S MOREDATA("NON-BILLABLE REASON")=$P($G(MOREDATA("BILL")),U,2) ; reason not billable
S MOREDATA("NON-BILLABLE CLOSED")=0 ; open by default when it is created
;
S RXIEN=$G(MOREDATA("RX"))
S FILL=$G(BPSARRY("FILL NUMBER"))
S COB=$G(BPSARRY("RXCOB"))
S IEN59=$$IEN59^BPSOSRX(RXIEN,FILL,COB)
I 'IEN59 G BPTCNBX
;
D LOG^BPSOSL(IEN59,$T(+0)_"-Start of Adding BPS Transaction for Non-Billable Entry")
D LOG^BPSOSL(IEN59,$T(+0)_"-Patient Eligibility is "_BPSELD)
;
D EN^BPSOSIZ(IEN59,.MOREDATA,"",1) ; adds the entry to 9002313.59
;
D LOG^BPSOSL(IEN59,$T(+0)_"-Validating the BPS Transaction for Non-Billable Entry")
D LOG^BPSOSL(IEN59,$T(+0)_"-Contents of ^BPST("_IEN59_"):")
D LOG59^BPSOSQA(IEN59)
;
D LOG^BPSOSL(IEN59,$T(+0)_"-End of Adding BPS Transaction for Non-Billable Entry")
;
; Update the status of this newly created BPS Transaction to be 99 so it gets filed in BPS Log of Transactions also
D SETSTAT^BPSOSU(IEN59,99) ; for non-billable entries
;
BPTCNBX ;
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HBPSNCPD2 11334 printed Dec 13, 2024@01:51:14 Page 2
BPSNCPD2 ;BHAM ISC/LJE - Continuation of BPSNCPDP (IB Billing Determination) ;11/7/07 16:01
+1 ;;1.0;E CLAIMS MGMT ENGINE;**1,5,6,7,8,10,11,20,28**;JUN 2004;Build 22
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ;External reference $$RX^IBNCPDP supported by DBIA 4299
+5 ;
+6 ; EN - Call IB Billing Determination. If good to go, update MOREDATA array
+7 ; Notes about variables
+8 ;Input:
+9 ; DFN - PATIENT file #2 ien
+10 ; BWHERE - Where the code is called from and what needs to be done
+11 ; MOREDATA - Initialized by BPSNCPDP and more data is added here.
+12 ; Should be passed by reference.
+13 ; BPSARRY - Created by STARRAY^BPSNCPD1 and used for IB Determination
+14 ; IB - Returned to calling routine. Should be passed by reference.
+15 ; 1 = Billable
+16 ; 0 or 2 - Not Billable
+17 ;
+18 ; Variable used/needed but not passed in as a parameter
+19 ; CERTIEN - BPS Certification IEN - Not passed but newed/set in BPSNCPDP
+20 ; BPJOBFLG - Not passed in but newed/set in BPSNCPCP
+21 ;
EN(DFN,BWHERE,MOREDATA,BPSARRY,IB) ;
+1 IF '$GET(CERTIEN)
Begin DoDot:1
+2 ;
+3 IF $GET(BPSARRY("ACT DTY OVR"))
IF '$GET(BPSARRY("PLAN"))
Begin DoDot:2
+4 NEW IEN5902
+5 SET IEN5902=$$GET1^DIQ(9002313.59,IEN59,901,"I")
+6 IF 'IEN5902
SET IEN5902=1
+7 SET BPSARRY("PLAN")=$$GET1^DIQ(9002313.59902,IEN5902_","_IEN59_",",".01","I")
End DoDot:2
+8 ;
+9 ;For NCPDP IB call to see if we need to 3rd Party Bill and if so, get insurance/payer sheet info
+10 ;IB CALL
SET MOREDATA("BILL")=$$RX^IBNCPDP(DFN,.BPSARRY)
+11 if '$DATA(MOREDATA("BILL"))
QUIT
+12 ;
+13 ; If calling program is the ECME user screen and we can't bill because of NEEDS SC DETERMINATION
+14 ; or EI, then prompt the user to see if they want to bill
+15 IF $FIND(".ERES.ERWV.ERNB.","."_BWHERE_".")
IF $PIECE(MOREDATA("BILL"),U,1)=0
IF $GET(BPSARRY("SC/EI NO ANSW"))]""
IF $GET(BPJOBFLG)'="B"
Begin DoDot:2
+16 NEW DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,I,BPEISC
+17 FOR I=1:1:$LENGTH($GET(BPSARRY("SC/EI NO ANSW")),",")
SET BPEISC=$PIECE($GET(BPSARRY("SC/EI NO ANSW")),",",I)
IF BPEISC]""
Begin DoDot:3
+18 WRITE !,"The prescription is potentially ",BPEISC,"-related and needs ",BPEISC," determination."
+19 WRITE !,"Prescriptions related to ",BPEISC," cannot be billed to Third Party Insurance.",!
End DoDot:3
+20 SET DIR(0)="Y"
SET DIR("A")="Are you sure you want to bill this prescription"
+21 SET DIR("B")="NO"
+22 SET DIR("?")="If you want to bill this prescription, enter 'Yes' - otherwise, enter 'No'"
+23 WRITE !
DO ^DIR
KILL DIR
+24 IF '+Y
QUIT
+25 SET BPSARRY("SC/EI OVR")=1
+26 ;Call IB again
SET MOREDATA("BILL")=$$RX^IBNCPDP(DFN,.BPSARRY)
End DoDot:2
+27 ;
+28 ; Quit if no response from IB call
+29 if '$DATA(MOREDATA("BILL"))
QUIT
+30 ;
+31 ; patient eligibility V, T, or C
SET MOREDATA("ELIG")=$PIECE(MOREDATA("BILL"),U,3)
+32 ;
+33 ; assume it is billable for now
SET IB=1
+34 ;
+35 ; insurance array nodes from IB billing determination
MERGE MOREDATA("IBDATA")=BPSARRY("INS")
+36 ;
+37 ; Clean up the "IBDATA" array nodes as necessary
+38 ; The code below checks if Sequence #1 is missing and move the next number down if needed.
+39 ; This can happen when the COB indicator in IB has multiple insurances assigned as secondary but none are
+40 ; assigned as primary
+41 IF '$DATA(MOREDATA("IBDATA",1))
Begin DoDot:2
+42 NEW WW
+43 SET WW=$ORDER(MOREDATA("IBDATA",""))
+44 IF WW'=""
MERGE MOREDATA("IBDATA",1)=MOREDATA("IBDATA",WW)
KILL MOREDATA("IBDATA",WW)
+45 QUIT
End DoDot:2
+46 ;
+47 SET MOREDATA("PATIENT")=$GET(DFN)
+48 SET MOREDATA("RX")=$GET(BPSARRY("IEN"))
+49 SET $PIECE(MOREDATA("BPSDATA",1),U,1)=$GET(BPSARRY("NCPDP QTY"))
+50 SET $PIECE(MOREDATA("BPSDATA",1),U,2)=$GET(BPSARRY("COST"))
+51 SET $PIECE(MOREDATA("BPSDATA",1),U,3)=$GET(BPSARRY("NDC"))
+52 SET $PIECE(MOREDATA("BPSDATA",1),U,4)=$GET(BPSARRY("FILL NUMBER"))
+53 ; Certification Mode
SET $PIECE(MOREDATA("BPSDATA",1),U,5)=""
+54 ; Certification IEN
SET $PIECE(MOREDATA("BPSDATA",1),U,6)=""
+55 SET $PIECE(MOREDATA("BPSDATA",1),U,7)=$GET(BPSARRY("NCPDP UNITS"))
+56 ; Billing Quantity
SET $PIECE(MOREDATA("BPSDATA",1),U,8)=$GET(BPSARRY("QTY"))
+57 ; Billing Units
SET $PIECE(MOREDATA("BPSDATA",1),U,9)=$GET(BPSARRY("UNITS"))
+58 ;
+59 ; now check IB billing determination results and set variable IB
+60 ;IB says not to bill
IF $PIECE(MOREDATA("BILL"),U,1)=0
SET IB=2
+61 ;
+62 ; bps*1*20 - file TRI/CVA Non-Billable entries into BPS Transaction
+63 IF IB=2
IF MOREDATA("ELIG")="T"!(MOREDATA("ELIG")="C")
DO BPTCNB(.MOREDATA,.BPSARRY)
+64 QUIT
End DoDot:1
+65 ;
+66 ; If certification mode on and no IB result (somewhat redundant since IB is not called
+67 ; for certification), get data from BPS Certification table
+68 IF $GET(CERTIEN)
IF '$GET(IB)
Begin DoDot:1
+69 NEW NODE,FLD,NFLD,CERTARY
+70 SET MOREDATA("IBDATA",1,1)=""
SET MOREDATA("IBDATA",1,2)=""
+71 SET MOREDATA("IBDATA",1,3)=""
SET MOREDATA("BPSDATA",1)=""
+72 SET MOREDATA("BILL")="1^^V"
SET IB=1
+73 ;Patient from certification record
SET MOREDATA("PATIENT")=$$GET1^DIQ(9002313.31,CERTIEN,903,"I")
+74 ; Patient
IF 'MOREDATA("PATIENT")
SET MOREDATA("PATIENT")=$GET(DFN)
+75 ; RX
SET MOREDATA("RX")=$GET(BPSARRY("IEN"))
+76 ; Eligibility
SET MOREDATA("ELIG")="V"
+77 ;Certify Mode
SET $PIECE(MOREDATA("BPSDATA",1),U,5)=1
+78 ;Cert IEN
SET $PIECE(MOREDATA("BPSDATA",1),U,6)=CERTIEN
+79 ; Billing Quantity
SET $PIECE(MOREDATA("BPSDATA",1),U,8)=""
+80 ; Billing Units
SET $PIECE(MOREDATA("BPSDATA",1),U,9)=""
+81 ;Plan IEN
SET $PIECE(MOREDATA("IBDATA",1,1),U,1)=1
+82 ;Billing Payer Sheet Name
SET $PIECE(MOREDATA("IBDATA",1,1),U,4)=$$GET1^DIQ(9002313.31,CERTIEN,.04,"E")
+83 ;Home State Plan
SET $PIECE(MOREDATA("IBDATA",1,1),U,10)="01"
+84 ;Reversal Payer Sheet Name
SET $PIECE(MOREDATA("IBDATA",1,1),U,11)=$$GET1^DIQ(9002313.31,CERTIEN,.05,"E")
+85 ;Rebill Payer Sheet Name
SET $PIECE(MOREDATA("IBDATA",1,1),U,12)=""
+86 ;Plan Name
SET $PIECE(MOREDATA("IBDATA",1,1),U,14)=""
+87 ;Eligibility Payer Sheet Name
SET $PIECE(MOREDATA("IBDATA",1,1),U,15)=$$GET1^DIQ(9002313.31,CERTIEN,.08,"E")
+88 ;Billing Payer Sheet IEN
SET $PIECE(MOREDATA("IBDATA",1,1),U,16)=$$GET1^DIQ(9002313.31,CERTIEN,.04,"I")
+89 ;Reversal Payer Sheet IEN
SET $PIECE(MOREDATA("IBDATA",1,1),U,17)=$$GET1^DIQ(9002313.31,CERTIEN,.05,"I")
+90 ; Rebill Payer Sheet IEN
SET $PIECE(MOREDATA("IBDATA",1,1),U,18)=""
+91 ;Eligibility Payer Sheet IEN
SET $PIECE(MOREDATA("IBDATA",1,1),U,19)=$$GET1^DIQ(9002313.31,CERTIEN,.08,"I")
+92 ;Admin Fee
SET $PIECE(MOREDATA("IBDATA",1,2),U,5)=0
+93 ;Group Name
SET $PIECE(MOREDATA("IBDATA",1,3),U,1)=""
+94 ;Insurance Company Phone Number
SET $PIECE(MOREDATA("IBDATA",1,3),U,2)=""
+95 ;Plan ID
SET $PIECE(MOREDATA("IBDATA",1,3),U,3)="T00010"
+96 ;Plan Type
SET $PIECE(MOREDATA("IBDATA",1,3),U,4)="V"
+97 ;Insurance Company IEN
SET $PIECE(MOREDATA("IBDATA",1,3),U,5)=""
+98 ;COB Indicator
SET $PIECE(MOREDATA("IBDATA",1,3),U,6)=$$GET1^DIQ(9002313.31,CERTIEN,.07,"I")
+99 IF $PIECE(MOREDATA("IBDATA",1,3),U,6)=""
SET $PIECE(MOREDATA("IBDATA",1,3),U,6)=1
+100 ;Policy Number (needed for eligibility transmissions)
SET $PIECE(MOREDATA("IBDATA",1,3),U,7)=1
+101 ;Maximum Transactions
SET $PIECE(MOREDATA("IBDATA",1,3),U,8)=1
+102 ;
+103 ;Get data from non-multiple fields and add to MOREDATA
+104 KILL CERTARY
DO GETS^DIQ(9002313.31,CERTIEN_",","1*","","CERTARY")
+105 SET NODE=""
FOR
SET NODE=$ORDER(CERTARY(9002313.311,NODE))
if NODE=""
QUIT
Begin DoDot:2
+106 SET FLD=""
FOR
SET FLD=$ORDER(CERTARY(9002313.311,NODE,FLD))
if FLD=""
QUIT
Begin DoDot:3
+107 IF FLD=.01
SET NFLD=CERTARY(9002313.311,NODE,FLD)
Begin DoDot:4
+108 ;BIN
IF NFLD=101
SET $PIECE(MOREDATA("IBDATA",1,1),U,2)=CERTARY(9002313.311,NODE,.02)
+109 ;PCN
IF NFLD=104
SET $PIECE(MOREDATA("IBDATA",1,1),U,3)=CERTARY(9002313.311,NODE,.02)
+110 ;Certification ID
IF NFLD=110
SET $PIECE(MOREDATA("IBDATA",1,1),U,13)=CERTARY(9002313.311,NODE,.02)
End DoDot:4
End DoDot:3
End DoDot:2
+111 ;
+112 ;Get data from multiple fields and add to MOREDATA
+113 KILL CERTARY
DO GETS^DIQ(9002313.31,CERTIEN_",","2*","","CERTARY")
+114 SET NODE=""
FOR
SET NODE=$ORDER(CERTARY(9002313.3121,NODE))
if NODE=""
QUIT
Begin DoDot:2
+115 SET FLD=""
FOR
SET FLD=$ORDER(CERTARY(9002313.3121,NODE,FLD))
if FLD=""
QUIT
Begin DoDot:3
+116 IF FLD=.01
SET NFLD=CERTARY(9002313.3121,NODE,FLD)
Begin DoDot:4
+117 ;Group ID
IF NFLD=301
SET $PIECE(MOREDATA("IBDATA",1,1),U,5)=CERTARY(9002313.3121,NODE,.02)
+118 ;Cardholder ID
IF NFLD=302
SET $PIECE(MOREDATA("IBDATA",1,1),U,6)=CERTARY(9002313.3121,NODE,.02)
+119 ;Patient Rel Code
IF NFLD=306
SET $PIECE(MOREDATA("IBDATA",1,1),U,7)=CERTARY(9002313.3121,NODE,.02)
+120 ;Cardholder First Name
IF NFLD=312
SET $PIECE(MOREDATA("IBDATA",1,1),U,8)=CERTARY(9002313.3121,NODE,.02)
+121 ;Cardholder Last Name
IF NFLD=313
SET $PIECE(MOREDATA("IBDATA",1,1),U,9)=CERTARY(9002313.3121,NODE,.02)
+122 ;Dispensing Fee
IF NFLD=412
SET $PIECE(MOREDATA("IBDATA",1,2),U,1)=CERTARY(9002313.3121,NODE,.02)
+123 ;Basis of Cost Determination
IF NFLD=423
SET $PIECE(MOREDATA("IBDATA",1,2),U,2)=CERTARY(9002313.3121,NODE,.02)
+124 ;Usual & Customary - Base Price
IF NFLD=426
SET $PIECE(MOREDATA("IBDATA",1,2),U,3)=CERTARY(9002313.3121,NODE,.02)
+125 ;Gross Amt Due
IF NFLD=430
SET $PIECE(MOREDATA("IBDATA",1,2),U,4)=CERTARY(9002313.3121,NODE,.02)
+126 ;Quantity Dispensed
IF NFLD=442
SET $PIECE(MOREDATA("BPSDATA",1),U,1)=CERTARY(9002313.3121,NODE,.02)
+127 ;Unit Cost
IF NFLD=409
SET $PIECE(MOREDATA("BPSDATA",1),U,2)=CERTARY(9002313.3121,NODE,.02)
+128 ;NDC
IF NFLD=407
SET $PIECE(MOREDATA("BPSDATA",1),U,3)=CERTARY(9002313.3121,NODE,.02)
+129 ;Fill #
IF NFLD=403
SET $PIECE(MOREDATA("BPSDATA",1),U,4)=+CERTARY(9002313.3121,NODE,.02)
+130 ;Unit of Measure
IF NFLD=600
SET $PIECE(MOREDATA("BPSDATA",1),U,7)=CERTARY(9002313.3121,NODE,.02)
End DoDot:4
End DoDot:3
End DoDot:2
+131 ;
+132 ; If Gross Amt Due is missing, use Usual and Customary
+133 IF $PIECE(MOREDATA("IBDATA",1,2),U,4)=""
SET $PIECE(MOREDATA("IBDATA",1,2),U,4)=$PIECE(MOREDATA("IBDATA",1,2),U,3)
+134 QUIT
End DoDot:1
+135 ;
+136 ; Uppercase the IBDATA
+137 SET MOREDATA("IBDATA",1,1)=$$UP^XLFSTR($GET(MOREDATA("IBDATA",1,1)))
+138 SET MOREDATA("IBDATA",1,2)=$$UP^XLFSTR($GET(MOREDATA("IBDATA",1,2)))
+139 SET MOREDATA("BPSDATA",1)=$$UP^XLFSTR($GET(MOREDATA("BPSDATA",1)))
+140 ;
+141 QUIT
+142 ;
BPTCNB(MOREDATA,BPSARRY) ; Add TRICARE/CHAMPVA non-billable entry to BPS Transaction - BPS*1*20
+1 ;
+2 NEW BPSELD,IEN59,RXIEN,FILL,COB
+3 ;
+4 ; Uppercase the IBDATA before going further
+5 SET MOREDATA("IBDATA",1,1)=$$UP^XLFSTR($GET(MOREDATA("IBDATA",1,1)))
+6 SET MOREDATA("IBDATA",1,2)=$$UP^XLFSTR($GET(MOREDATA("IBDATA",1,2)))
+7 SET MOREDATA("BPSDATA",1)=$$UP^XLFSTR($GET(MOREDATA("BPSDATA",1)))
+8 ;
+9 SET BPSELD=$SELECT(MOREDATA("ELIG")="T":"TRICARE",MOREDATA("ELIG")="C":"CHAMPVA",1:"UNKNOWN")
+10 ; TRICARE/CHAMPVA non-billable entry
SET MOREDATA("REQ TYPE")="N"
+11 ; submit time is right now
SET MOREDATA("SUBMIT TIME")=$$NOW^XLFDT
+12 ; payer sequence/COB
SET MOREDATA("PAYER SEQUENCE")=$GET(BPSARRY("RXCOB"))
+13 ; 2.312 policy# ien
SET MOREDATA("POLICY")=$PIECE($GET(MOREDATA("IBDATA",1,3)),U,7)
+14 ; reason not billable
SET MOREDATA("NON-BILLABLE REASON")=$PIECE($GET(MOREDATA("BILL")),U,2)
+15 ; open by default when it is created
SET MOREDATA("NON-BILLABLE CLOSED")=0
+16 ;
+17 SET RXIEN=$GET(MOREDATA("RX"))
+18 SET FILL=$GET(BPSARRY("FILL NUMBER"))
+19 SET COB=$GET(BPSARRY("RXCOB"))
+20 SET IEN59=$$IEN59^BPSOSRX(RXIEN,FILL,COB)
+21 IF 'IEN59
GOTO BPTCNBX
+22 ;
+23 DO LOG^BPSOSL(IEN59,$TEXT(+0)_"-Start of Adding BPS Transaction for Non-Billable Entry")
+24 DO LOG^BPSOSL(IEN59,$TEXT(+0)_"-Patient Eligibility is "_BPSELD)
+25 ;
+26 ; adds the entry to 9002313.59
DO EN^BPSOSIZ(IEN59,.MOREDATA,"",1)
+27 ;
+28 DO LOG^BPSOSL(IEN59,$TEXT(+0)_"-Validating the BPS Transaction for Non-Billable Entry")
+29 DO LOG^BPSOSL(IEN59,$TEXT(+0)_"-Contents of ^BPST("_IEN59_"):")
+30 DO LOG59^BPSOSQA(IEN59)
+31 ;
+32 DO LOG^BPSOSL(IEN59,$TEXT(+0)_"-End of Adding BPS Transaction for Non-Billable Entry")
+33 ;
+34 ; Update the status of this newly created BPS Transaction to be 99 so it gets filed in BPS Log of Transactions also
+35 ; for non-billable entries
DO SETSTAT^BPSOSU(IEN59,99)
+36 ;
BPTCNBX ;
+1 QUIT
+2 ;
