115 lines
6.4 KiB
Mathematica
115 lines
6.4 KiB
Mathematica
BPSNCPD2 ;BHAM ISC/LJE - Continuation of BPSNCPDP (IB Billing Determiation) ;08/01/03
|
|
;;1.0;E CLAIMS MGMT ENGINE;**1,5**;JUN 2004;Build 45
|
|
;;Per VHA Directive 2004-038, 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 - shows where the code is called from and what needs to be done
|
|
; the following should be passed by reference:
|
|
; MOREDATA - Initialized by BPSNCPDP and more data is added here
|
|
; BPSARRY - Created by STARRAY^BPSNCPD1 and used for IB Determination
|
|
; IB - Returned to BPSNCPDP
|
|
; CERTIEN - BPS Certification IEN - Not passed but newed/set in BPSNCPDP
|
|
;
|
|
EN(DFN,BWHERE,MOREDATA,BPSARRY,IB) ;
|
|
I '$G(CERTIEN) D I IB=2 Q
|
|
. ;
|
|
. ;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 BWHERE="ERES",$P(MOREDATA("BILL"),U,1)=0,$G(BPSARRY("SC/EI NO ANSW"))]"" 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"))
|
|
. I $P(MOREDATA("BILL"),U,1)=0 S IB=2 Q ;IB says not to bill
|
|
. S IB=1
|
|
. M MOREDATA("IBDATA")=BPSARRY("INS")
|
|
. S $P(MOREDATA("BPSDATA",1),U,1)=BPSARRY("QTY")
|
|
. S $P(MOREDATA("BPSDATA",1),U,2)=BPSARRY("COST")
|
|
. S $P(MOREDATA("BPSDATA",1),U,3)=BPSARRY("NDC")
|
|
. S $P(MOREDATA("BPSDATA",1),U,4)=BFILL
|
|
. S $P(MOREDATA("BPSDATA",1),U,5)="" ; Certify Mode
|
|
. S $P(MOREDATA("BPSDATA",1),U,6)="" ; Cert IEN
|
|
. S $P(MOREDATA("BPSDATA",1),U,7)=BPSARRY("UNITS")
|
|
;
|
|
; 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("BILL")=1
|
|
. S MOREDATA("IBDATA",1,1)="",MOREDATA("IBDATA",1,2)="",MOREDATA("BPSDATA",1)=""
|
|
. S $P(MOREDATA("BPSDATA",1),U,5)=1 ;Certify Mode
|
|
. S $P(MOREDATA("BPSDATA",1),U,6)=CERTIEN ;Cert IEN
|
|
. 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") ;Payer Sheet
|
|
. S $P(MOREDATA("IBDATA",1,1),U,10)="01" ;Home State Plan
|
|
. S $P(MOREDATA("IBDATA",1,1),U,11)="" ;B2 Payer Sheet (reversal)
|
|
. S $P(MOREDATA("IBDATA",1,1),U,12)="" ;B3 Payer Sheet (rebill)
|
|
. S $P(MOREDATA("IBDATA",1,1),U,14)="" ;Plan Name
|
|
. S $P(MOREDATA("IBDATA",1,2),U,5)=0 ;Admin Fee
|
|
. ;
|
|
. ;Get data from non-mulitple 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 mulitple 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) ;Qty
|
|
.... 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)
|
|
;
|
|
; The code below checks if Sequence one is missing and move the next number down if needed.
|
|
; DMB - This is existing code so I am not sure if it is needed or not.
|
|
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)
|
|
;
|
|
; Uppercase the IBDATA
|
|
; DMB - Assume this was adding in case any of the BPS Certification data was entered as lowercase
|
|
S MOREDATA("IBDATA",1,1)=$TR(MOREDATA("IBDATA",1,1),"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
|
|
S MOREDATA("IBDATA",1,2)=$TR(MOREDATA("IBDATA",1,2),"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
|
|
S MOREDATA("BPSDATA",1)=$TR(MOREDATA("BPSDATA",1),"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
|
|
;
|
|
Q
|