- 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 Feb 18, 2025@23:17:38 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 ;