- BPSBUTL ;BHAM ISC/MFR/VA/DLF - IB Communication Utilities ;06/01/2004
- ;;1.0;E CLAIMS MGMT ENGINE;**1,3,2,5,7,8,9,10,11,15,20,24,31**;JUN 2004;Build 16
- ;;Per VA Directive 6402, this routine should not be modified.
- ;Reference to STORESP^IBNCPDP supported by DBIA 4299
- Q
- ;
- ;CLAIM - pointer to #9002313.02
- ;TRNDX - ptr to #9002313.59
- ;REASON - text name of the close reason
- ;PAPER - 1=drop to paper
- ;RELCOP - 1 (Yes) or 0 (No) release copay or not?
- ;COMMENT - comment
- ;ERROR - array by reference for error details
- ;BPSCLO - 1 indicates call coming from ECME User Screen action CLO
- ;
- CLOSE(CLAIM,TRNDX,REASON,PAPER,RELCOP,COMMENT,ERROR,BPSCLO) ; Send IB an update on the CLAIM status for a Closed Claim
- N DFN,BPSARRY,BILLNUM,CLAIMNFO,FILLNUM,RXIEN,TRANINFO
- ;
- ; - Data gathering
- D GETS^DIQ("9002313.59",TRNDX,"1.11;9","I","TRANINFO")
- S RXIEN=TRANINFO(9002313.59,TRNDX_",",1.11,"I")
- I $$RXAPI1^BPSUTIL1(RXIEN,.01)="" S ERROR="Prescription not found." Q
- S BPSARRY("FILL NUMBER")=TRANINFO(9002313.59,TRNDX_",",9,"I")
- D GETS^DIQ("9002313.02",CLAIM,"400*;401;402;403;426","","CLAIMNFO")
- S BPSARRY("DOS")=$G(CLAIMNFO("9002313.02",CLAIM_",","401"))
- I BPSARRY("DOS") S BPSARRY("DOS")=BPSARRY("DOS")-17000000
- S FILLNUM=+BPSARRY("FILL NUMBER")
- S DFN=$$RXAPI1^BPSUTIL1(RXIEN,2,"I")
- S BPSARRY("FILLED BY")=$$RXAPI1^BPSUTIL1(RXIEN,16,"I")
- S BPSARRY("PRESCRIPTION")=RXIEN
- S BPSARRY("BILLED")=$$DFF2EXT^BPSECFM($P(CLAIMNFO("9002313.0201","1,"_CLAIM_",","426"),"DQ",2))
- S BPSARRY("CLAIMID")=$P(CLAIMNFO("9002313.0201","1,"_CLAIM_",","402"),"D2",2)
- S BPSARRY("PLAN")=$P(^BPST(TRNDX,10,1,0),"^")
- S BPSARRY("STATUS")="CLOSED"
- S BPSARRY("PAID")=0
- S BPSARRY("RELEASE DATE")=$S(FILLNUM=0:$$RXAPI1^BPSUTIL1(RXIEN,31,"I"),1:$$RXSUBF1^BPSUTIL1(RXIEN,52,52.1,FILLNUM,17,"I"))
- I $G(BPSCLO) S BPSARRY("USER")=DUZ
- E S BPSARRY("USER")=$$GET1^DIQ(9002313.59,TRNDX,13,"I")
- S BPSARRY("EPHARM")=$$GET1^DIQ(9002313.59,TRNDX,1.07,"I")
- S BPSARRY("RXCOB")=$$COB59^BPSUTIL2(TRNDX)
- I REASON'="" D
- . S BPSARRY("CLOSE REASON")=$O(^IBE(356.8,"B",REASON,0))
- . S BPSARRY("DROP TO PAPER")=+$G(PAPER)
- . S BPSARRY("RELEASE COPAY")=+$G(RELCOP)
- I $G(COMMENT)]"" S BPSARRY("CLOSE COMMENT")=COMMENT
- ;
- ; If dropped to Paper, increment the counter in BPS Statistics
- I BPSARRY("DROP TO PAPER")=1 D INCSTAT^BPSOSUD("R",8)
- ;
- ; Call IB
- S BILLNUM=$$STORESP^IBNCPDP(DFN,.BPSARRY)
- Q
- ; Send IB an update on the CLAIM status for a restocked or deleted prescription
- CLOSE2(RXIEN,BFILL,BWHERE) ;
- N IEN59,BPSARRY,DFN,BILLNUM,FILL,REASON
- N CLAIMNFO
- N DIE,DA,DR
- ;
- ; Check parameters
- I '$G(RXIEN) S ERROR="No prescription parameter" Q
- I $G(BFILL)="" S ERROR="No fill parameter" Q
- I $G(BWHERE)="" S ERROR="No RX Action parameter" Q
- ;
- I $$RXAPI1^BPSUTIL1(RXIEN,.01)="" S ERROR="Prescription not found." Q
- I ",DE,RS,"'[(","_BWHERE_",") S ERROR="Invalid BWHERE parameter" Q
- ;
- ; Calculate the transaction IEN and see that it exists
- S IEN59=$$IEN59^BPSOSRX(RXIEN,BFILL,1)
- I '$D(^BPST(IEN59,0)) Q
- ;
- ; Get claim data
- S CLAIM=$P(^BPST(IEN59,0),"^",4)
- I 'CLAIM S ERROR="Claim not found in BPS Transaction" Q
- D GETS^DIQ("9002313.02",CLAIM,"400*;401;402;426","","CLAIMNFO")
- S BPSARRY("FILL NUMBER")=+BFILL
- S BPSARRY("DOS")=$G(CLAIMNFO("9002313.02",CLAIM_",","401"))
- I BPSARRY("DOS") S BPSARRY("DOS")=BPSARRY("DOS")-17000000
- ;
- ; Get prescription data
- S FILLNUM=BPSARRY("FILL NUMBER")
- S DFN=$$RXAPI1^BPSUTIL1(RXIEN,2,"I")
- S BPSARRY("FILLED BY")=$$RXAPI1^BPSUTIL1(RXIEN,16,"I")
- S BPSARRY("PRESCRIPTION")=RXIEN
- S BPSARRY("BILLED")=$$DFF2EXT^BPSECFM($P(CLAIMNFO("9002313.0201","1,"_CLAIM_",","426"),"DQ",2))
- S BPSARRY("CLAIMID")=$P(CLAIMNFO("9002313.0201","1,"_CLAIM_",","402"),"D2",2)
- S BPSARRY("PLAN")=$P(^BPST(IEN59,10,1,0),"^")
- S BPSARRY("STATUS")="CLOSED"
- S BPSARRY("PAID")=0
- S BPSARRY("RELEASE DATE")=$S(FILLNUM=0:$$RXAPI1^BPSUTIL1(RXIEN,31,"I"),1:$$RXSUBF1^BPSUTIL1(RXIEN,52,52.1,FILLNUM,17,"I"))
- S BPSARRY("USER")=.5
- S BPSARRY("EPHARM")=$$GET1^DIQ(9002313.59,IEN59,1.07,"I")
- S BPSARRY("RXCOB")=$$COB59^BPSUTIL2(IEN59)
- ;
- ; Determine the reversal reason based on the BWHERE value
- I BWHERE="RS" S REASON="PRESCRIPTION NOT RELEASED"
- I BWHERE="DE" S REASON="PRESCRIPTION DELETED"
- I REASON]"" S BPSARRY("CLOSE REASON")=$O(^IBE(356.8,"B",REASON,0))
- ;
- ;if a refill was deleted while RX is still active (not deleted) then send DELETION OF REFILL comment for CT record
- I BWHERE="DE",$$RXSTATUS^BPSSCRU2(RXIEN)'=13 S BPSARRY("CLOSE COMMENT")="DELETION OF REFILL ONLY - ORIGINAL RX MAY REMAIN ACTIVE"
- ;
- ;
- ; Update IB
- S BILLNUM=$$STORESP^IBNCPDP(DFN,.BPSARRY)
- ;
- ; Update the claim file that the claim is closed and the reason why.
- S DIE="^BPSC(",DA=CLAIM
- S DR="901///1;902///"_$$NOW^XLFDT()_";903////.5;904///"_BPSARRY("CLOSE REASON")
- D ^DIE
- ;
- ; If this is a primary claim, check and send a bulletin if the secondary claim is open or if there
- ; is a non-cancelled IB bill for the secondary claim
- I BPSARRY("RXCOB")=1 D BULL^BPSECMP2(RXIEN,BFILL,CLAIM,DFN,REASON,BPSARRY("CLAIMID"))
- Q
- ;
- ; Function to return Transaction, claim, and response IENs
- ; Parameters:
- ; RXI: Prescription IEN
- ; RXR: Fill Number
- ; COB: COB Indicator
- ; Returns:
- ; IEN59^Claim IEN^Response IEN^Reversal Claim IEN^Reversal Response IEN^Prescription/Service Ref Number from BPS CLAIMS file
- CLAIM(RXI,RXR,COB) ;
- N IEN59,CLAIMIEN,RESPIEN,REVCLAIM,REVRESP,ECMENUM
- I '$G(RXI) Q ""
- ; Note that IEN59 will treat RXR="" as the original fill (0)
- ; and COB="" as primary (1)
- S IEN59=$$IEN59^BPSOSRX(RXI,$G(RXR),$G(COB))
- I '$D(^BPST(IEN59,0)) Q ""
- S CLAIMIEN=$P(^BPST(IEN59,0),"^",4),RESPIEN=$P(^BPST(IEN59,0),"^",5)
- S REVCLAIM=$P($G(^BPST(IEN59,4)),"^",1),REVRESP=$P($G(^BPST(IEN59,4)),"^",2)
- S ECMENUM=$$ECMENUM^BPSSCRU2(IEN59)
- Q IEN59_U_CLAIMIEN_U_RESPIEN_U_REVCLAIM_U_REVRESP_U_ECMENUM
- ;
- ; NABP - Return the value in the Service Provider ID (201-B1) field
- ; of the claim. Note that as of the NPI release (BPS*1*2), this
- ; API may return NPI instead of NABP/NCPDP
- NABP(RXP,BFILL) ;
- I '$G(RXP) Q ""
- I $G(BFILL)="" S BFILL=0
- N BPSTIEN,BPSCIEN,DFILL,NABP
- S DFILL=$E($TR($J("",4-$L(BFILL))," ","0")_BFILL,1,4)
- S BPSTIEN=RXP_"."_DFILL_"1"
- I 'BPSTIEN Q ""
- S BPSCIEN=$P($G(^BPST(BPSTIEN,0)),U,4)
- I 'BPSCIEN Q ""
- S NABP=$P($G(^BPSC(BPSCIEN,200)),U)
- Q NABP
- ;
- ; DIVNCPDP - For a specific outpatient site, return the NPI & NCPDP.
- ; Note that the procedure name is misleading but when originally
- ; coded, this procedure only returned NCPDP.
- ;
- ; Input
- ; BPSDIV - Outpatient Site (#59)
- ; Output
- ; "" - No BPSDIV passed in
- ; NCPDP and NPI separated by a caret
- DIVNCPDP(BPSDIV) ;
- N BPSPHARM,NPI,NCPDP
- I '$G(BPSDIV) Q "^"
- ;
- ; Get the NCPDP
- S NCPDP=""
- S BPSPHARM=$$GETPHARM^BPSUTIL(BPSDIV)
- I BPSPHARM S NCPDP=$$GET1^DIQ(9002313.56,BPSPHARM_",",.02)
- ;
- ; Get the NPI and validate it
- S NPI=+$$NPI^BPSNPI("Pharmacy_ID",BPSDIV)
- I NPI=-1 S NPI=""
- ;
- Q NCPDP_"^"_NPI
- ;
- ;ADDCOMM - Add a comment to a ECME claim
- ;Input:
- ; BPRX - ien in file #52
- ; BPREF - refill number (0,1,2,...)
- ; BPRCMNT - comment text
- ;Output:
- ; 1 - okay
- ; -1 - failed
- ADDCOMM(BPRX,BPREF,BPRCMNT,BPBKG) ;
- ;
- ;BPRX (required) - Prescription IEN
- ;BPREF (optional) - Refill number
- ;BPRCMNT (required) - Comment text
- ;BPBKG (optional) - Value 1 indicates process is running in background - BPS*1*15
- ;
- N IEN59,BPNOW,BPREC,BPDA,BPERR
- ; Check parameters
- I '$G(BPRX) Q -1
- I $G(BPRCMNT)="" Q -1
- ; Get BPS Transaction number, if needed, and check for existance
- S IEN59=$$IEN59^BPSOSRX(BPRX,$G(BPREF),1)
- I IEN59="" Q -1
- I '$D(^BPST(IEN59)) Q -1
- ; Lock record and quit if you cannot get the lock
- L +^BPST(9002313.59111,+IEN59):10
- I '$T Q -1
- ; Create record and file data
- S BPNOW=$$NOW^XLFDT
- D INSITEM^BPSCMT01(9002313.59111,+IEN59,BPNOW)
- S BPREC=$O(^BPST(IEN59,11,"B",BPNOW,99999999),-1)
- I BPREC>0 D
- .;If BPBKG is passed this is a background process and user is POSTMASTER - BPS*1*15
- . S BPDA(9002313.59111,BPREC_","_IEN59_",",.02)=$S($G(BPBKG):.5,1:+$G(DUZ))
- . S BPDA(9002313.59111,BPREC_","_IEN59_",",.03)=$E($G(BPRCMNT),1,63)
- . D FILE^DIE("","BPDA","BPERR")
- L -^BPST(9002313.59111,+IEN59)
- ; Quit with result
- I BPREC>0,'$D(BPERR) Q 1
- Q -1
- ;
- ;REOPEN - Reopen closed claim
- ;Input:
- ; BP59 - ien in BPS TRANSACTION file
- ; BP02 - ien in BPS CLAIMS file
- ; BPREOPDT - reopen date/time
- ; BPDUZ - user DUZ (#200 ien)
- ; BPCOMM - reopen comment text
- ;Output:
- ; 0^message_error - error
- ; 1 - success
- REOPEN(BP59,BP02,BPREOPDT,BPDUZ,BPCOMM) ;
- N RECIENS,BPDA,ERRARR,BPREFNO,BPRXIEN,BPZ,BPSARRY,BPDFN,BPRETVAL,BPZ1
- S BPDFN=$P($G(^BPST(BP59,0)),U,6)
- S BPREFNO=$P($G(^BPST(BP59,1)),U)
- I BPREFNO="" Q "0^Null Fill Number"
- S BPRXIEN=$P($G(^BPST(BP59,1)),U,11)
- I BPRXIEN="" Q "0^Null RX ien Number"
- ;in VA there is only one med/claim but in some cases it can different than "1"
- ;so take the latest one
- S BPZ=$O(^BPSC(BP02,400,9999999),-1)
- I BPRXIEN="" Q "0^Database Error"
- ;============
- ;Now update ECME database
- S BPRETVAL=$$UPDREOP^BPSREOP1(BP02,0,BPREOPDT,BPDUZ,BPCOMM)
- I +BPRETVAL=0 D Q BPRETVAL
- . ;try to reverse it in case it was done partially
- . I $$UPDREOP^BPSREOP1(BP02,1,"@",+BPDUZ,"@")
- ;============
- ;Now call IB API for "REOPEN" event
- S BPSARRY("STATUS")="REOPEN"
- S BPSARRY("DOS")=$P($G(^BPSC(BP02,401)),U)
- I BPSARRY("DOS") S BPSARRY("DOS")=BPSARRY("DOS")-17000000
- S BPSARRY("FILL NUMBER")=BPREFNO
- S BPSARRY("PRESCRIPTION")=BPRXIEN
- S BPSARRY("CLAIMID")=$$CONVCLID^BPSSCRU6($P($G(^BPSC(BP02,400,+BPZ,400)),U,2))
- S BPSARRY("DRUG")=$$DRUGIEN^BPSSCRU6(BPRXIEN,BPDFN)
- S BPSARRY("PLAN")=$P($G(^BPST(BP59,10,1,0)),"^")
- S BPSARRY("USER")=BPDUZ
- S BPSARRY("REOPEN COMMENT")=BPCOMM
- S BPSARRY("EPHARM")=$$GET1^DIQ(9002313.59,BP59,1.07,"I")
- S BPSARRY("RXCOB")=$$COB59^BPSUTIL2(BP59)
- S BPRETVAL=$$STORESP^IBNCPDP(BPDFN,.BPSARRY)
- ;if successful
- I +BPRETVAL>0 Q "1^ReOpening Claim: "_$P($G(^BPSC(BP02,0)),U)_" ... OK"
- ;===========
- ;if it was unsuccessful
- ;reverse ECME database (keep the user who made the attempt)
- I $$UPDREOP^BPSREOP1(BP02,1,"@",+BPDUZ,"@")
- ;return IB error message
- Q BPRETVAL
- ;
- GETDAT(RX,FIL,COB,LDOS,LDSUP) ;Returns Last Date of Service and Last Days Supply
- ;Input:
- ; RX (req) --> RX IEN
- ; FIL (req) --> Fill number
- ; COB (opt) --> Coordination of Benifits indicator; default is 1
- ;Output:
- ; LDOS --> Last Date of Service
- ; LDSUP --> Last Days Supply
- ;
- Q:'($G(RX))!($G(FIL)="")
- S:'$G(COB) COB=1
- N IEN59,IEN02,STAT,IEN57
- S IEN02=""
- S IEN59=$$IEN59^BPSOSRX(RX,FIL,COB)
- S STAT=$P($G(^BPST(IEN59,0)),U,2)
- I STAT=99 S IEN02=$P($G(^BPST(IEN59,0)),U,4)
- I IEN02="" D
- . S IEN57=""
- . F S IEN57=$O(^BPSTL("B",IEN59,IEN57),-1) Q:IEN57=""!(IEN02) D
- .. S STAT=$P($G(^BPSTL(IEN57,0)),U,2)
- .. I STAT=99 S IEN02=$P($G(^BPSTL(IEN57,0)),U,4)
- I 'IEN02 S (LDOS,LDSUP)="" Q
- S LDOS=$$GET1^DIQ(9002313.02,IEN02,401,"E") ;LAST DATE OF SERVICE
- I LDOS S LDOS=LDOS-17000000 ;CONVERT DATE TO FILEMAN FORMAT
- S LDSUP=$$GET1^DIQ(9002313.0201,"1,"_IEN02,405,"I") ;LAST DAYS SUPPLY
- I LDSUP'="" S LDSUP=+$E(LDSUP,3,99) ; remove the "D5" NCPDP field ID (bps*1*15)
- Q
- ;
- NFLDT(RX,FIL,COB) ;Returns Next Avail Fill Date (B04-BT) from ECME - BPS*1.0*15
- ;Input:
- ; RX (req) --> RX IEN
- ; FIL (req) --> Fill number
- ; COB (opt) --> Coordination of Benefits indicator; default is 1
- ;Output:
- ; NFLDT --> Next Avail Fill Date
- Q:'$G(RX)!($G(FIL)="") ""
- S:'$G(COB) COB=1
- N IEN59,IEN02,STAT,NFLDT,IEN03
- S IEN02=""
- S IEN59=$$IEN59^BPSOSRX(RX,FIL,COB)
- S IEN03=+$P($G(^BPST(IEN59,0)),U,5),NFLDT=""
- S:IEN03 NFLDT=$$GET1^DIQ(9002313.0301,"1,"_IEN03,2004,"I") ;NEXT FILL DATE
- S:NFLDT NFLDT=NFLDT-17000000 ;CONVERT DATE TO FILEMAN FORMAT
- Q NFLDT
- ;
- BBILL(RX,RFILL,COB) ;Return Back Bill Indicator for Pharmacy - BPS*1.0*15
- N IEN59,RXACT
- ;Return 0 if no RXI value input
- I '$G(RX) Q 0
- ; Note that $$IEN59 will treat RFILL="" as the original fill (0)
- S IEN59=$$IEN59^BPSOSRX(RX,$G(RFILL),$G(COB))
- ;No transaction found return 0
- I '$D(^BPST(IEN59,0)) Q 0
- ;Determine if RX ACTION (field #1201) is Back Bill
- S RXACT=$P($G(^BPST(IEN59,12)),U)
- ;Back Bill code not found return 0
- I RXACT'="BB",RXACT'="P2",RXACT'="P2S" Q 0
- ;Otherwise return Back Bill indicator
- Q 1
- ;
- AMT(RX,FIL,COB) ; Return Gross Amount Due - BPS*1*15
- ; RX - rx ien
- ; FIL - fill#, defaults to original fill if not passed in
- ; COB - cob payer sequence, defaults to 1 if not passed in
- ;
- N AMT,IEN59,QN
- S AMT=""
- I '$G(RX) G AMTX
- S IEN59=$$IEN59^BPSOSRX(RX,$G(FIL),$G(COB)) ; ien to BPS Transaction file
- I '$D(^BPST(IEN59,0)) G AMTX ; make sure it exists
- S QN=+$O(^BPST(IEN59,10,0)) I 'QN G AMTX ; get 9002313.59902 subfile ien
- S AMT=+$P($G(^BPST(IEN59,10,QN,2)),U,4) ; gross amount due, field 902.15
- AMTX ;
- Q AMT
- ;
- ELIG(RX,FIL,COB) ; Veteran Eligibility - BPS*1*15
- ; RX - rx ien
- ; FIL - fill#, defaults to original fill if not passed in
- ; COB - cob payer sequence, defaults to 1 if not passed in
- ;
- Q:'$G(RX) ""
- ; ien to BPS Transaction file
- N IEN59 S IEN59=$$IEN59^BPSOSRX(RX,$G(FIL),$G(COB)) Q:'IEN59 ""
- Q:'$D(^BPST(IEN59,0)) ""
- ; ELIGIBILITY field 901.04
- Q $P($G(^BPST(IEN59,9)),U,4)
- ;
- GETBAMT(RXIEN,FILL,COB) ; Retrieve the billed amount
- ; RXIEN = Prescription ien (required)
- ; FILL# = Fill Number (optional, defaults to latest fill)
- ; COB = Coordination of Benefits (optional, defaults to 1)
- N X,BAMT,CLAIMIEN
- S X=$$CLAIM(RXIEN,$G(FILL),$G(COB))
- S CLAIMIEN=$P(X,U,2)
- S BAMT=$$TOTPRICE^BPSSCRLG(CLAIMIEN)
- Q BAMT
- ;
- RESUBMIT(RX,REFILL,COB) ; Return Resubmit indicator for Pharmacy - BPS*1*20.
- N BPSIEN59,BPSRXACT
- I '$G(RX) Q 0
- ;
- ; Determine BPS Transaction number. If none, Quit with '0'.
- ;
- S BPSIEN59=$$IEN59^BPSOSRX(RX,$G(REFILL),$G(COB))
- I 'BPSIEN59 Q 0
- I '$D(^BPST(BPSIEN59,0)) Q 0
- ;
- ; Pull the RX Action from the BPS Transaction. If it's not one that
- ; indicates resubmission from the ECME User Screen, then Quit with
- ; '0'. Otherwise, Quit with '1'.
- ;
- S BPSRXACT=$$GET1^DIQ(9002313.59,BPSIEN59_",",1201)
- I ",ERES,ERWV,ERNB,"'[(","_BPSRXACT_",") Q 0
- Q 1
- ;
- GETCOB(RXIEN,FILL) ; Retrieve the COB payer sequence for usage by PSO
- ; Input: RXIEN and FILL (both are required)
- ; Output: Function value will be one of the following
- ; "" (if the prescription fill cannot be found in BPS Transaction)
- ; -1 (when there are multiple COB's/payers found in BPS Transaction)
- ; Otherwise,
- ; COB#^BPS Transaction IEN
- N RET,PRI59,SEC59
- S RET=""
- I '$G(RXIEN) G GETCOBX
- I $G(FILL)="" G GETCOBX
- ;
- S PRI59=+$$IEN59^BPSOSRX(RXIEN,FILL,1) ; possible primary BPS transaction ien
- S SEC59=+$$IEN59^BPSOSRX(RXIEN,FILL,2) ; possible secondary BPS transaction ien
- ;
- I $D(^BPST(PRI59)),$D(^BPST(SEC59)) S RET=-1 G GETCOBX ; both payers exist, get out
- I $D(^BPST(PRI59)) S RET=1_U_PRI59 G GETCOBX
- I $D(^BPST(SEC59)) S RET=2_U_SEC59 G GETCOBX
- ;
- GETCOBX ;
- Q RET
- ;
- ADDFLDS(RX,FIL,COB) ;Returns Additional NCPDP fields from ECME
- ;Input:
- ; RX (req) --> RX IEN
- ; FIL (req) --> Fill number
- ; COB (req) --> 1=Primary, 2=Secondary, 3=Tertiary
- ;Output:
- ; BPSREC --> a string separated by "^" containing the output of the BPSARR array
- ;
- Q:'$G(RX)!($G(FIL)="") ""
- N BPSAMT,BPSARR,BPSCNT,BPSEDT,BPSFLDS,BPSREC,BPSSDT,IEN03,IEN59
- ;
- S IEN59=$$IEN59^BPSOSRX(RX,FIL,COB)
- S IEN03=+$P($G(^BPST(IEN59,0)),U,5)
- ;
- I '$G(IEN03) Q "" ; Quit if INE03 is not found
- ;
- S BPSFLDS="931;932;933;934;935;936;937;938;943;944;2219;2220;2224;2225"
- D GETS^DIQ(9002313.0301,"1,"_IEN03,BPSFLDS,"IE","BPSARR")
- ;
- S BPSREC="",BPSCNT=0
- F I=1:1:$L(BPSFLDS,";") S BPSCNT=BPSCNT+1 D
- . S $P(BPSREC,U,BPSCNT)=BPSARR(9002313.0301,"1,"_IEN03_",",+$P(BPSFLDS,";",I),"E")
- ;
- ; Convert Dates to Fileman Format (936,937)
- S BPSSDT=BPSARR(9002313.0301,"1,"_IEN03_",",936,"I") ; MAX AMT START DATE
- S:BPSSDT BPSSDT=BPSSDT-17000000,$P(BPSREC,U,6)=BPSSDT
- S BPSEDT=BPSARR(9002313.0301,"1,"_IEN03_",",937,"I") ; MAX AMT END DATE
- S:BPSEDT BPSEDT=BPSEDT-17000000,$P(BPSREC,U,7)=BPSEDT
- ;
- Q BPSREC
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HBPSBUTL 16794 printed Feb 18, 2025@23:17:07 Page 2
- BPSBUTL ;BHAM ISC/MFR/VA/DLF - IB Communication Utilities ;06/01/2004
- +1 ;;1.0;E CLAIMS MGMT ENGINE;**1,3,2,5,7,8,9,10,11,15,20,24,31**;JUN 2004;Build 16
- +2 ;;Per VA Directive 6402, this routine should not be modified.
- +3 ;Reference to STORESP^IBNCPDP supported by DBIA 4299
- +4 QUIT
- +5 ;
- +6 ;CLAIM - pointer to #9002313.02
- +7 ;TRNDX - ptr to #9002313.59
- +8 ;REASON - text name of the close reason
- +9 ;PAPER - 1=drop to paper
- +10 ;RELCOP - 1 (Yes) or 0 (No) release copay or not?
- +11 ;COMMENT - comment
- +12 ;ERROR - array by reference for error details
- +13 ;BPSCLO - 1 indicates call coming from ECME User Screen action CLO
- +14 ;
- CLOSE(CLAIM,TRNDX,REASON,PAPER,RELCOP,COMMENT,ERROR,BPSCLO) ; Send IB an update on the CLAIM status for a Closed Claim
- +1 NEW DFN,BPSARRY,BILLNUM,CLAIMNFO,FILLNUM,RXIEN,TRANINFO
- +2 ;
- +3 ; - Data gathering
- +4 DO GETS^DIQ("9002313.59",TRNDX,"1.11;9","I","TRANINFO")
- +5 SET RXIEN=TRANINFO(9002313.59,TRNDX_",",1.11,"I")
- +6 IF $$RXAPI1^BPSUTIL1(RXIEN,.01)=""
- SET ERROR="Prescription not found."
- QUIT
- +7 SET BPSARRY("FILL NUMBER")=TRANINFO(9002313.59,TRNDX_",",9,"I")
- +8 DO GETS^DIQ("9002313.02",CLAIM,"400*;401;402;403;426","","CLAIMNFO")
- +9 SET BPSARRY("DOS")=$GET(CLAIMNFO("9002313.02",CLAIM_",","401"))
- +10 IF BPSARRY("DOS")
- SET BPSARRY("DOS")=BPSARRY("DOS")-17000000
- +11 SET FILLNUM=+BPSARRY("FILL NUMBER")
- +12 SET DFN=$$RXAPI1^BPSUTIL1(RXIEN,2,"I")
- +13 SET BPSARRY("FILLED BY")=$$RXAPI1^BPSUTIL1(RXIEN,16,"I")
- +14 SET BPSARRY("PRESCRIPTION")=RXIEN
- +15 SET BPSARRY("BILLED")=$$DFF2EXT^BPSECFM($PIECE(CLAIMNFO("9002313.0201","1,"_CLAIM_",","426"),"DQ",2))
- +16 SET BPSARRY("CLAIMID")=$PIECE(CLAIMNFO("9002313.0201","1,"_CLAIM_",","402"),"D2",2)
- +17 SET BPSARRY("PLAN")=$PIECE(^BPST(TRNDX,10,1,0),"^")
- +18 SET BPSARRY("STATUS")="CLOSED"
- +19 SET BPSARRY("PAID")=0
- +20 SET BPSARRY("RELEASE DATE")=$SELECT(FILLNUM=0:$$RXAPI1^BPSUTIL1(RXIEN,31,"I"),1:$$RXSUBF1^BPSUTIL1(RXIEN,52,52.1,FILLNUM,17,"I"))
- +21 IF $GET(BPSCLO)
- SET BPSARRY("USER")=DUZ
- +22 IF '$TEST
- SET BPSARRY("USER")=$$GET1^DIQ(9002313.59,TRNDX,13,"I")
- +23 SET BPSARRY("EPHARM")=$$GET1^DIQ(9002313.59,TRNDX,1.07,"I")
- +24 SET BPSARRY("RXCOB")=$$COB59^BPSUTIL2(TRNDX)
- +25 IF REASON'=""
- Begin DoDot:1
- +26 SET BPSARRY("CLOSE REASON")=$ORDER(^IBE(356.8,"B",REASON,0))
- +27 SET BPSARRY("DROP TO PAPER")=+$GET(PAPER)
- +28 SET BPSARRY("RELEASE COPAY")=+$GET(RELCOP)
- End DoDot:1
- +29 IF $GET(COMMENT)]""
- SET BPSARRY("CLOSE COMMENT")=COMMENT
- +30 ;
- +31 ; If dropped to Paper, increment the counter in BPS Statistics
- +32 IF BPSARRY("DROP TO PAPER")=1
- DO INCSTAT^BPSOSUD("R",8)
- +33 ;
- +34 ; Call IB
- +35 SET BILLNUM=$$STORESP^IBNCPDP(DFN,.BPSARRY)
- +36 QUIT
- +37 ; Send IB an update on the CLAIM status for a restocked or deleted prescription
- CLOSE2(RXIEN,BFILL,BWHERE) ;
- +1 NEW IEN59,BPSARRY,DFN,BILLNUM,FILL,REASON
- +2 NEW CLAIMNFO
- +3 NEW DIE,DA,DR
- +4 ;
- +5 ; Check parameters
- +6 IF '$GET(RXIEN)
- SET ERROR="No prescription parameter"
- QUIT
- +7 IF $GET(BFILL)=""
- SET ERROR="No fill parameter"
- QUIT
- +8 IF $GET(BWHERE)=""
- SET ERROR="No RX Action parameter"
- QUIT
- +9 ;
- +10 IF $$RXAPI1^BPSUTIL1(RXIEN,.01)=""
- SET ERROR="Prescription not found."
- QUIT
- +11 IF ",DE,RS,"'[(","_BWHERE_",")
- SET ERROR="Invalid BWHERE parameter"
- QUIT
- +12 ;
- +13 ; Calculate the transaction IEN and see that it exists
- +14 SET IEN59=$$IEN59^BPSOSRX(RXIEN,BFILL,1)
- +15 IF '$DATA(^BPST(IEN59,0))
- QUIT
- +16 ;
- +17 ; Get claim data
- +18 SET CLAIM=$PIECE(^BPST(IEN59,0),"^",4)
- +19 IF 'CLAIM
- SET ERROR="Claim not found in BPS Transaction"
- QUIT
- +20 DO GETS^DIQ("9002313.02",CLAIM,"400*;401;402;426","","CLAIMNFO")
- +21 SET BPSARRY("FILL NUMBER")=+BFILL
- +22 SET BPSARRY("DOS")=$GET(CLAIMNFO("9002313.02",CLAIM_",","401"))
- +23 IF BPSARRY("DOS")
- SET BPSARRY("DOS")=BPSARRY("DOS")-17000000
- +24 ;
- +25 ; Get prescription data
- +26 SET FILLNUM=BPSARRY("FILL NUMBER")
- +27 SET DFN=$$RXAPI1^BPSUTIL1(RXIEN,2,"I")
- +28 SET BPSARRY("FILLED BY")=$$RXAPI1^BPSUTIL1(RXIEN,16,"I")
- +29 SET BPSARRY("PRESCRIPTION")=RXIEN
- +30 SET BPSARRY("BILLED")=$$DFF2EXT^BPSECFM($PIECE(CLAIMNFO("9002313.0201","1,"_CLAIM_",","426"),"DQ",2))
- +31 SET BPSARRY("CLAIMID")=$PIECE(CLAIMNFO("9002313.0201","1,"_CLAIM_",","402"),"D2",2)
- +32 SET BPSARRY("PLAN")=$PIECE(^BPST(IEN59,10,1,0),"^")
- +33 SET BPSARRY("STATUS")="CLOSED"
- +34 SET BPSARRY("PAID")=0
- +35 SET BPSARRY("RELEASE DATE")=$SELECT(FILLNUM=0:$$RXAPI1^BPSUTIL1(RXIEN,31,"I"),1:$$RXSUBF1^BPSUTIL1(RXIEN,52,52.1,FILLNUM,17,"I"))
- +36 SET BPSARRY("USER")=.5
- +37 SET BPSARRY("EPHARM")=$$GET1^DIQ(9002313.59,IEN59,1.07,"I")
- +38 SET BPSARRY("RXCOB")=$$COB59^BPSUTIL2(IEN59)
- +39 ;
- +40 ; Determine the reversal reason based on the BWHERE value
- +41 IF BWHERE="RS"
- SET REASON="PRESCRIPTION NOT RELEASED"
- +42 IF BWHERE="DE"
- SET REASON="PRESCRIPTION DELETED"
- +43 IF REASON]""
- SET BPSARRY("CLOSE REASON")=$ORDER(^IBE(356.8,"B",REASON,0))
- +44 ;
- +45 ;if a refill was deleted while RX is still active (not deleted) then send DELETION OF REFILL comment for CT record
- +46 IF BWHERE="DE"
- IF $$RXSTATUS^BPSSCRU2(RXIEN)'=13
- SET BPSARRY("CLOSE COMMENT")="DELETION OF REFILL ONLY - ORIGINAL RX MAY REMAIN ACTIVE"
- +47 ;
- +48 ;
- +49 ; Update IB
- +50 SET BILLNUM=$$STORESP^IBNCPDP(DFN,.BPSARRY)
- +51 ;
- +52 ; Update the claim file that the claim is closed and the reason why.
- +53 SET DIE="^BPSC("
- SET DA=CLAIM
- +54 SET DR="901///1;902///"_$$NOW^XLFDT()_";903////.5;904///"_BPSARRY("CLOSE REASON")
- +55 DO ^DIE
- +56 ;
- +57 ; If this is a primary claim, check and send a bulletin if the secondary claim is open or if there
- +58 ; is a non-cancelled IB bill for the secondary claim
- +59 IF BPSARRY("RXCOB")=1
- DO BULL^BPSECMP2(RXIEN,BFILL,CLAIM,DFN,REASON,BPSARRY("CLAIMID"))
- +60 QUIT
- +61 ;
- +62 ; Function to return Transaction, claim, and response IENs
- +63 ; Parameters:
- +64 ; RXI: Prescription IEN
- +65 ; RXR: Fill Number
- +66 ; COB: COB Indicator
- +67 ; Returns:
- +68 ; IEN59^Claim IEN^Response IEN^Reversal Claim IEN^Reversal Response IEN^Prescription/Service Ref Number from BPS CLAIMS file
- CLAIM(RXI,RXR,COB) ;
- +1 NEW IEN59,CLAIMIEN,RESPIEN,REVCLAIM,REVRESP,ECMENUM
- +2 IF '$GET(RXI)
- QUIT ""
- +3 ; Note that IEN59 will treat RXR="" as the original fill (0)
- +4 ; and COB="" as primary (1)
- +5 SET IEN59=$$IEN59^BPSOSRX(RXI,$GET(RXR),$GET(COB))
- +6 IF '$DATA(^BPST(IEN59,0))
- QUIT ""
- +7 SET CLAIMIEN=$PIECE(^BPST(IEN59,0),"^",4)
- SET RESPIEN=$PIECE(^BPST(IEN59,0),"^",5)
- +8 SET REVCLAIM=$PIECE($GET(^BPST(IEN59,4)),"^",1)
- SET REVRESP=$PIECE($GET(^BPST(IEN59,4)),"^",2)
- +9 SET ECMENUM=$$ECMENUM^BPSSCRU2(IEN59)
- +10 QUIT IEN59_U_CLAIMIEN_U_RESPIEN_U_REVCLAIM_U_REVRESP_U_ECMENUM
- +11 ;
- +12 ; NABP - Return the value in the Service Provider ID (201-B1) field
- +13 ; of the claim. Note that as of the NPI release (BPS*1*2), this
- +14 ; API may return NPI instead of NABP/NCPDP
- NABP(RXP,BFILL) ;
- +1 IF '$GET(RXP)
- QUIT ""
- +2 IF $GET(BFILL)=""
- SET BFILL=0
- +3 NEW BPSTIEN,BPSCIEN,DFILL,NABP
- +4 SET DFILL=$EXTRACT($TRANSLATE($JUSTIFY("",4-$LENGTH(BFILL))," ","0")_BFILL,1,4)
- +5 SET BPSTIEN=RXP_"."_DFILL_"1"
- +6 IF 'BPSTIEN
- QUIT ""
- +7 SET BPSCIEN=$PIECE($GET(^BPST(BPSTIEN,0)),U,4)
- +8 IF 'BPSCIEN
- QUIT ""
- +9 SET NABP=$PIECE($GET(^BPSC(BPSCIEN,200)),U)
- +10 QUIT NABP
- +11 ;
- +12 ; DIVNCPDP - For a specific outpatient site, return the NPI & NCPDP.
- +13 ; Note that the procedure name is misleading but when originally
- +14 ; coded, this procedure only returned NCPDP.
- +15 ;
- +16 ; Input
- +17 ; BPSDIV - Outpatient Site (#59)
- +18 ; Output
- +19 ; "" - No BPSDIV passed in
- +20 ; NCPDP and NPI separated by a caret
- DIVNCPDP(BPSDIV) ;
- +1 NEW BPSPHARM,NPI,NCPDP
- +2 IF '$GET(BPSDIV)
- QUIT "^"
- +3 ;
- +4 ; Get the NCPDP
- +5 SET NCPDP=""
- +6 SET BPSPHARM=$$GETPHARM^BPSUTIL(BPSDIV)
- +7 IF BPSPHARM
- SET NCPDP=$$GET1^DIQ(9002313.56,BPSPHARM_",",.02)
- +8 ;
- +9 ; Get the NPI and validate it
- +10 SET NPI=+$$NPI^BPSNPI("Pharmacy_ID",BPSDIV)
- +11 IF NPI=-1
- SET NPI=""
- +12 ;
- +13 QUIT NCPDP_"^"_NPI
- +14 ;
- +15 ;ADDCOMM - Add a comment to a ECME claim
- +16 ;Input:
- +17 ; BPRX - ien in file #52
- +18 ; BPREF - refill number (0,1,2,...)
- +19 ; BPRCMNT - comment text
- +20 ;Output:
- +21 ; 1 - okay
- +22 ; -1 - failed
- ADDCOMM(BPRX,BPREF,BPRCMNT,BPBKG) ;
- +1 ;
- +2 ;BPRX (required) - Prescription IEN
- +3 ;BPREF (optional) - Refill number
- +4 ;BPRCMNT (required) - Comment text
- +5 ;BPBKG (optional) - Value 1 indicates process is running in background - BPS*1*15
- +6 ;
- +7 NEW IEN59,BPNOW,BPREC,BPDA,BPERR
- +8 ; Check parameters
- +9 IF '$GET(BPRX)
- QUIT -1
- +10 IF $GET(BPRCMNT)=""
- QUIT -1
- +11 ; Get BPS Transaction number, if needed, and check for existance
- +12 SET IEN59=$$IEN59^BPSOSRX(BPRX,$GET(BPREF),1)
- +13 IF IEN59=""
- QUIT -1
- +14 IF '$DATA(^BPST(IEN59))
- QUIT -1
- +15 ; Lock record and quit if you cannot get the lock
- +16 LOCK +^BPST(9002313.59111,+IEN59):10
- +17 IF '$TEST
- QUIT -1
- +18 ; Create record and file data
- +19 SET BPNOW=$$NOW^XLFDT
- +20 DO INSITEM^BPSCMT01(9002313.59111,+IEN59,BPNOW)
- +21 SET BPREC=$ORDER(^BPST(IEN59,11,"B",BPNOW,99999999),-1)
- +22 IF BPREC>0
- Begin DoDot:1
- +23 ;If BPBKG is passed this is a background process and user is POSTMASTER - BPS*1*15
- +24 SET BPDA(9002313.59111,BPREC_","_IEN59_",",.02)=$SELECT($GET(BPBKG):.5,1:+$GET(DUZ))
- +25 SET BPDA(9002313.59111,BPREC_","_IEN59_",",.03)=$EXTRACT($GET(BPRCMNT),1,63)
- +26 DO FILE^DIE("","BPDA","BPERR")
- End DoDot:1
- +27 LOCK -^BPST(9002313.59111,+IEN59)
- +28 ; Quit with result
- +29 IF BPREC>0
- IF '$DATA(BPERR)
- QUIT 1
- +30 QUIT -1
- +31 ;
- +32 ;REOPEN - Reopen closed claim
- +33 ;Input:
- +34 ; BP59 - ien in BPS TRANSACTION file
- +35 ; BP02 - ien in BPS CLAIMS file
- +36 ; BPREOPDT - reopen date/time
- +37 ; BPDUZ - user DUZ (#200 ien)
- +38 ; BPCOMM - reopen comment text
- +39 ;Output:
- +40 ; 0^message_error - error
- +41 ; 1 - success
- REOPEN(BP59,BP02,BPREOPDT,BPDUZ,BPCOMM) ;
- +1 NEW RECIENS,BPDA,ERRARR,BPREFNO,BPRXIEN,BPZ,BPSARRY,BPDFN,BPRETVAL,BPZ1
- +2 SET BPDFN=$PIECE($GET(^BPST(BP59,0)),U,6)
- +3 SET BPREFNO=$PIECE($GET(^BPST(BP59,1)),U)
- +4 IF BPREFNO=""
- QUIT "0^Null Fill Number"
- +5 SET BPRXIEN=$PIECE($GET(^BPST(BP59,1)),U,11)
- +6 IF BPRXIEN=""
- QUIT "0^Null RX ien Number"
- +7 ;in VA there is only one med/claim but in some cases it can different than "1"
- +8 ;so take the latest one
- +9 SET BPZ=$ORDER(^BPSC(BP02,400,9999999),-1)
- +10 IF BPRXIEN=""
- QUIT "0^Database Error"
- +11 ;============
- +12 ;Now update ECME database
- +13 SET BPRETVAL=$$UPDREOP^BPSREOP1(BP02,0,BPREOPDT,BPDUZ,BPCOMM)
- +14 IF +BPRETVAL=0
- Begin DoDot:1
- +15 ;try to reverse it in case it was done partially
- +16 IF $$UPDREOP^BPSREOP1(BP02,1,"@",+BPDUZ,"@")
- End DoDot:1
- QUIT BPRETVAL
- +17 ;============
- +18 ;Now call IB API for "REOPEN" event
- +19 SET BPSARRY("STATUS")="REOPEN"
- +20 SET BPSARRY("DOS")=$PIECE($GET(^BPSC(BP02,401)),U)
- +21 IF BPSARRY("DOS")
- SET BPSARRY("DOS")=BPSARRY("DOS")-17000000
- +22 SET BPSARRY("FILL NUMBER")=BPREFNO
- +23 SET BPSARRY("PRESCRIPTION")=BPRXIEN
- +24 SET BPSARRY("CLAIMID")=$$CONVCLID^BPSSCRU6($PIECE($GET(^BPSC(BP02,400,+BPZ,400)),U,2))
- +25 SET BPSARRY("DRUG")=$$DRUGIEN^BPSSCRU6(BPRXIEN,BPDFN)
- +26 SET BPSARRY("PLAN")=$PIECE($GET(^BPST(BP59,10,1,0)),"^")
- +27 SET BPSARRY("USER")=BPDUZ
- +28 SET BPSARRY("REOPEN COMMENT")=BPCOMM
- +29 SET BPSARRY("EPHARM")=$$GET1^DIQ(9002313.59,BP59,1.07,"I")
- +30 SET BPSARRY("RXCOB")=$$COB59^BPSUTIL2(BP59)
- +31 SET BPRETVAL=$$STORESP^IBNCPDP(BPDFN,.BPSARRY)
- +32 ;if successful
- +33 IF +BPRETVAL>0
- QUIT "1^ReOpening Claim: "_$PIECE($GET(^BPSC(BP02,0)),U)_" ... OK"
- +34 ;===========
- +35 ;if it was unsuccessful
- +36 ;reverse ECME database (keep the user who made the attempt)
- +37 IF $$UPDREOP^BPSREOP1(BP02,1,"@",+BPDUZ,"@")
- +38 ;return IB error message
- +39 QUIT BPRETVAL
- +40 ;
- GETDAT(RX,FIL,COB,LDOS,LDSUP) ;Returns Last Date of Service and Last Days Supply
- +1 ;Input:
- +2 ; RX (req) --> RX IEN
- +3 ; FIL (req) --> Fill number
- +4 ; COB (opt) --> Coordination of Benifits indicator; default is 1
- +5 ;Output:
- +6 ; LDOS --> Last Date of Service
- +7 ; LDSUP --> Last Days Supply
- +8 ;
- +9 if '($GET(RX))!($GET(FIL)="")
- QUIT
- +10 if '$GET(COB)
- SET COB=1
- +11 NEW IEN59,IEN02,STAT,IEN57
- +12 SET IEN02=""
- +13 SET IEN59=$$IEN59^BPSOSRX(RX,FIL,COB)
- +14 SET STAT=$PIECE($GET(^BPST(IEN59,0)),U,2)
- +15 IF STAT=99
- SET IEN02=$PIECE($GET(^BPST(IEN59,0)),U,4)
- +16 IF IEN02=""
- Begin DoDot:1
- +17 SET IEN57=""
- +18 FOR
- SET IEN57=$ORDER(^BPSTL("B",IEN59,IEN57),-1)
- if IEN57=""!(IEN02)
- QUIT
- Begin DoDot:2
- +19 SET STAT=$PIECE($GET(^BPSTL(IEN57,0)),U,2)
- +20 IF STAT=99
- SET IEN02=$PIECE($GET(^BPSTL(IEN57,0)),U,4)
- End DoDot:2
- End DoDot:1
- +21 IF 'IEN02
- SET (LDOS,LDSUP)=""
- QUIT
- +22 ;LAST DATE OF SERVICE
- SET LDOS=$$GET1^DIQ(9002313.02,IEN02,401,"E")
- +23 ;CONVERT DATE TO FILEMAN FORMAT
- IF LDOS
- SET LDOS=LDOS-17000000
- +24 ;LAST DAYS SUPPLY
- SET LDSUP=$$GET1^DIQ(9002313.0201,"1,"_IEN02,405,"I")
- +25 ; remove the "D5" NCPDP field ID (bps*1*15)
- IF LDSUP'=""
- SET LDSUP=+$EXTRACT(LDSUP,3,99)
- +26 QUIT
- +27 ;
- NFLDT(RX,FIL,COB) ;Returns Next Avail Fill Date (B04-BT) from ECME - BPS*1.0*15
- +1 ;Input:
- +2 ; RX (req) --> RX IEN
- +3 ; FIL (req) --> Fill number
- +4 ; COB (opt) --> Coordination of Benefits indicator; default is 1
- +5 ;Output:
- +6 ; NFLDT --> Next Avail Fill Date
- +7 if '$GET(RX)!($GET(FIL)="")
- QUIT ""
- +8 if '$GET(COB)
- SET COB=1
- +9 NEW IEN59,IEN02,STAT,NFLDT,IEN03
- +10 SET IEN02=""
- +11 SET IEN59=$$IEN59^BPSOSRX(RX,FIL,COB)
- +12 SET IEN03=+$PIECE($GET(^BPST(IEN59,0)),U,5)
- SET NFLDT=""
- +13 ;NEXT FILL DATE
- if IEN03
- SET NFLDT=$$GET1^DIQ(9002313.0301,"1,"_IEN03,2004,"I")
- +14 ;CONVERT DATE TO FILEMAN FORMAT
- if NFLDT
- SET NFLDT=NFLDT-17000000
- +15 QUIT NFLDT
- +16 ;
- BBILL(RX,RFILL,COB) ;Return Back Bill Indicator for Pharmacy - BPS*1.0*15
- +1 NEW IEN59,RXACT
- +2 ;Return 0 if no RXI value input
- +3 IF '$GET(RX)
- QUIT 0
- +4 ; Note that $$IEN59 will treat RFILL="" as the original fill (0)
- +5 SET IEN59=$$IEN59^BPSOSRX(RX,$GET(RFILL),$GET(COB))
- +6 ;No transaction found return 0
- +7 IF '$DATA(^BPST(IEN59,0))
- QUIT 0
- +8 ;Determine if RX ACTION (field #1201) is Back Bill
- +9 SET RXACT=$PIECE($GET(^BPST(IEN59,12)),U)
- +10 ;Back Bill code not found return 0
- +11 IF RXACT'="BB"
- IF RXACT'="P2"
- IF RXACT'="P2S"
- QUIT 0
- +12 ;Otherwise return Back Bill indicator
- +13 QUIT 1
- +14 ;
- AMT(RX,FIL,COB) ; Return Gross Amount Due - BPS*1*15
- +1 ; RX - rx ien
- +2 ; FIL - fill#, defaults to original fill if not passed in
- +3 ; COB - cob payer sequence, defaults to 1 if not passed in
- +4 ;
- +5 NEW AMT,IEN59,QN
- +6 SET AMT=""
- +7 IF '$GET(RX)
- GOTO AMTX
- +8 ; ien to BPS Transaction file
- SET IEN59=$$IEN59^BPSOSRX(RX,$GET(FIL),$GET(COB))
- +9 ; make sure it exists
- IF '$DATA(^BPST(IEN59,0))
- GOTO AMTX
- +10 ; get 9002313.59902 subfile ien
- SET QN=+$ORDER(^BPST(IEN59,10,0))
- IF 'QN
- GOTO AMTX
- +11 ; gross amount due, field 902.15
- SET AMT=+$PIECE($GET(^BPST(IEN59,10,QN,2)),U,4)
- AMTX ;
- +1 QUIT AMT
- +2 ;
- ELIG(RX,FIL,COB) ; Veteran Eligibility - BPS*1*15
- +1 ; RX - rx ien
- +2 ; FIL - fill#, defaults to original fill if not passed in
- +3 ; COB - cob payer sequence, defaults to 1 if not passed in
- +4 ;
- +5 if '$GET(RX)
- QUIT ""
- +6 ; ien to BPS Transaction file
- +7 NEW IEN59
- SET IEN59=$$IEN59^BPSOSRX(RX,$GET(FIL),$GET(COB))
- if 'IEN59
- QUIT ""
- +8 if '$DATA(^BPST(IEN59,0))
- QUIT ""
- +9 ; ELIGIBILITY field 901.04
- +10 QUIT $PIECE($GET(^BPST(IEN59,9)),U,4)
- +11 ;
- GETBAMT(RXIEN,FILL,COB) ; Retrieve the billed amount
- +1 ; RXIEN = Prescription ien (required)
- +2 ; FILL# = Fill Number (optional, defaults to latest fill)
- +3 ; COB = Coordination of Benefits (optional, defaults to 1)
- +4 NEW X,BAMT,CLAIMIEN
- +5 SET X=$$CLAIM(RXIEN,$GET(FILL),$GET(COB))
- +6 SET CLAIMIEN=$PIECE(X,U,2)
- +7 SET BAMT=$$TOTPRICE^BPSSCRLG(CLAIMIEN)
- +8 QUIT BAMT
- +9 ;
- RESUBMIT(RX,REFILL,COB) ; Return Resubmit indicator for Pharmacy - BPS*1*20.
- +1 NEW BPSIEN59,BPSRXACT
- +2 IF '$GET(RX)
- QUIT 0
- +3 ;
- +4 ; Determine BPS Transaction number. If none, Quit with '0'.
- +5 ;
- +6 SET BPSIEN59=$$IEN59^BPSOSRX(RX,$GET(REFILL),$GET(COB))
- +7 IF 'BPSIEN59
- QUIT 0
- +8 IF '$DATA(^BPST(BPSIEN59,0))
- QUIT 0
- +9 ;
- +10 ; Pull the RX Action from the BPS Transaction. If it's not one that
- +11 ; indicates resubmission from the ECME User Screen, then Quit with
- +12 ; '0'. Otherwise, Quit with '1'.
- +13 ;
- +14 SET BPSRXACT=$$GET1^DIQ(9002313.59,BPSIEN59_",",1201)
- +15 IF ",ERES,ERWV,ERNB,"'[(","_BPSRXACT_",")
- QUIT 0
- +16 QUIT 1
- +17 ;
- GETCOB(RXIEN,FILL) ; Retrieve the COB payer sequence for usage by PSO
- +1 ; Input: RXIEN and FILL (both are required)
- +2 ; Output: Function value will be one of the following
- +3 ; "" (if the prescription fill cannot be found in BPS Transaction)
- +4 ; -1 (when there are multiple COB's/payers found in BPS Transaction)
- +5 ; Otherwise,
- +6 ; COB#^BPS Transaction IEN
- +7 NEW RET,PRI59,SEC59
- +8 SET RET=""
- +9 IF '$GET(RXIEN)
- GOTO GETCOBX
- +10 IF $GET(FILL)=""
- GOTO GETCOBX
- +11 ;
- +12 ; possible primary BPS transaction ien
- SET PRI59=+$$IEN59^BPSOSRX(RXIEN,FILL,1)
- +13 ; possible secondary BPS transaction ien
- SET SEC59=+$$IEN59^BPSOSRX(RXIEN,FILL,2)
- +14 ;
- +15 ; both payers exist, get out
- IF $DATA(^BPST(PRI59))
- IF $DATA(^BPST(SEC59))
- SET RET=-1
- GOTO GETCOBX
- +16 IF $DATA(^BPST(PRI59))
- SET RET=1_U_PRI59
- GOTO GETCOBX
- +17 IF $DATA(^BPST(SEC59))
- SET RET=2_U_SEC59
- GOTO GETCOBX
- +18 ;
- GETCOBX ;
- +1 QUIT RET
- +2 ;
- ADDFLDS(RX,FIL,COB) ;Returns Additional NCPDP fields from ECME
- +1 ;Input:
- +2 ; RX (req) --> RX IEN
- +3 ; FIL (req) --> Fill number
- +4 ; COB (req) --> 1=Primary, 2=Secondary, 3=Tertiary
- +5 ;Output:
- +6 ; BPSREC --> a string separated by "^" containing the output of the BPSARR array
- +7 ;
- +8 if '$GET(RX)!($GET(FIL)="")
- QUIT ""
- +9 NEW BPSAMT,BPSARR,BPSCNT,BPSEDT,BPSFLDS,BPSREC,BPSSDT,IEN03,IEN59
- +10 ;
- +11 SET IEN59=$$IEN59^BPSOSRX(RX,FIL,COB)
- +12 SET IEN03=+$PIECE($GET(^BPST(IEN59,0)),U,5)
- +13 ;
- +14 ; Quit if INE03 is not found
- IF '$GET(IEN03)
- QUIT ""
- +15 ;
- +16 SET BPSFLDS="931;932;933;934;935;936;937;938;943;944;2219;2220;2224;2225"
- +17 DO GETS^DIQ(9002313.0301,"1,"_IEN03,BPSFLDS,"IE","BPSARR")
- +18 ;
- +19 SET BPSREC=""
- SET BPSCNT=0
- +20 FOR I=1:1:$LENGTH(BPSFLDS,";")
- SET BPSCNT=BPSCNT+1
- Begin DoDot:1
- +21 SET $PIECE(BPSREC,U,BPSCNT)=BPSARR(9002313.0301,"1,"_IEN03_",",+$PIECE(BPSFLDS,";",I),"E")
- End DoDot:1
- +22 ;
- +23 ; Convert Dates to Fileman Format (936,937)
- +24 ; MAX AMT START DATE
- SET BPSSDT=BPSARR(9002313.0301,"1,"_IEN03_",",936,"I")
- +25 if BPSSDT
- SET BPSSDT=BPSSDT-17000000
- SET $PIECE(BPSREC,U,6)=BPSSDT
- +26 ; MAX AMT END DATE
- SET BPSEDT=BPSARR(9002313.0301,"1,"_IEN03_",",937,"I")
- +27 if BPSEDT
- SET BPSEDT=BPSEDT-17000000
- SET $PIECE(BPSREC,U,7)=BPSEDT
- +28 ;
- +29 QUIT BPSREC