- BPSECMP2 ;BHAM ISC/FCS/DRS - Parse Claim Response ;11/14/07 13:23
- ;;1.0;E CLAIMS MGMT ENGINE;**1,5,6,7,8,10,11,19,35**;JUN 2004;Build 14
- ;;Per VA Directive 6402, this routine should not be modified.
- ;
- ;Reference to STORESP^IBNCPDP supported by DBIA 4299
- ;Reference to ^DPT supported by DBIA 10035
- ;Reference to $$SITE^VASITE supported by DBIA 10112
- ;Reference to AUDIT^PSOTRI supported by ICR 6156
- ;
- Q
- ; Parameters:
- ; CLAIMIEN: IEN from BPS Claims
- ; RESPIEN: IEN from BPS Response
- ; EVENT: This is used by PSO to create specific events (BILL).
- ; USER: User who is creating the event. This is required when EVENT is sent.
- IBSEND(CLAIMIEN,RESPIEN,EVENT,USER) ;
- N BPSARRY,BPS57,RXIEN,FILLNUM,IND,TRNDX
- N CLAIMNFO,RESPNFO,RXINFO,RFINFO,TRANINFO
- N RESPONSE,RXACT,CLREAS,BILLNUM,DFN,REQCLAIM
- N DIE,DA,DR,AMT,ELIG
- ;
- ; Quit if there is not a Response or Claim IEN
- I '$G(RESPIEN) Q
- I '$G(CLAIMIEN) Q
- ;
- ; Get Claims and Response Data
- D GETS^DIQ("9002313.02",CLAIMIEN,"103;400*;401;402;403;430","","CLAIMNFO")
- D GETS^DIQ("9002313.0301","1,"_RESPIEN,"112;503;505;506;507;509;518","I","RESPNFO")
- ;
- ; Get the Transaction IEN and Data
- S IND=$S(CLAIMNFO("9002313.02",CLAIMIEN_",","103")="B2":"AER",1:"AE")
- S TRNDX=$O(^BPST(IND,CLAIMIEN,""))
- I TRNDX="" Q
- D GETS^DIQ("9002313.59",TRNDX,"1.05;3;5;13;404;509;510;901.04;1201","I","TRANINFO")
- ;
- ; If Certify Mode is On, don't send to IB
- I $$GET1^DIQ(9002313.59902,"1,"_TRNDX_",","902.22")["MODE ON" Q
- ;
- ; Get Patient
- S DFN=TRANINFO("9002313.59",TRNDX_",",5,"I")
- ;
- ; Get Policy, Plan ID and Rate Type
- S BPSARRY("POLICY")=TRANINFO("9002313.59",TRNDX_",",1.05,"I")
- I $D(^BPST(TRNDX,10,1,0)) D
- . S BPSARRY("PLAN")=$P(^BPST(TRNDX,10,1,0),U)
- . S BPSARRY("RTYPE")=$P(^BPST(TRNDX,10,1,0),U,8)
- ;
- ; Store RXACT into a local variable as it is will be used a lot
- S RXACT=TRANINFO("9002313.59",TRNDX_",",1201,"I")
- ;
- ; Setup User data
- ; If event is passed in, the user should be passed in as well
- ; If no Event, but action is Auto-Reversal (AREV) or CMOP
- ; processing (CR*/PC), use postmaster (.5)
- ; Else use the user from BPS Transaction
- I EVENT]"" S BPSARRY("USER")=USER
- E I ",AREV,CRLB,CRLX,CRLR,CRRL,PC,"[(","_RXACT_",") S BPSARRY("USER")=.5
- E S BPSARRY("USER")=TRANINFO("9002313.59",TRNDX_",",13,"I")
- ;
- ; Send eligibility response to IB
- I RXACT="ELIG" D Q
- . S BPSARRY("STATUS")=RXACT
- . S BPSARRY("RESPIEN")=RESPIEN
- . S BILLNUM=$$STORESP^IBNCPDP(DFN,.BPSARRY)
- ;
- ; Determine Prescription IEN
- S RXIEN=$P(^BPSC(CLAIMIEN,400,1,0),"^",5)
- ;
- ; If no RX record, this was a certification test so don't send to IB
- I $$RXAPI1^BPSUTIL1(RXIEN,.01)="" Q
- ;
- ; Determine Payer Response
- ; Treat Duplicate of Accepted Reversal ("S") as accepted
- S RESPONSE=RESPNFO(9002313.0301,"1,"_RESPIEN_",",112,"I")
- S RESPONSE=$S(RESPONSE="A":"ACCEPTED",RESPONSE="C":"CAPTURED",RESPONSE="D":"DUPLICATE",RESPONSE="P":"PAYABLE",RESPONSE="R":"REJECTED",RESPONSE="S":"ACCEPTED",1:"OTHER")
- ;
- ; Get Prescription Information
- D RXAPI^BPSUTIL1(RXIEN,".01;4;6;7;8;16;27","RXINFO","IE")
- ;
- ; Get Refill Info if this is a refill
- S FILLNUM=+$E($P(TRNDX,".",2),1,4)
- I FILLNUM>0 D RXSUBF^BPSUTIL1(RXIEN,52,52.1,FILLNUM,".01;1;1.1;11","RFINFO","E")
- ;
- ; Date of Service
- S BPSARRY("DOS")=CLAIMNFO("9002313.02",CLAIMIEN_",","401")
- I BPSARRY("DOS") S BPSARRY("DOS")=BPSARRY("DOS")-17000000
- ;
- ; Information needed for PAID/BILLING event
- S BPSARRY("PAID")=0
- I RESPONSE="PAYABLE"!(RESPONSE="DUPLICATE") D
- . ; Patient Pay Amount
- . S AMT=$G(RESPNFO(9002313.0301,"1,"_RESPIEN_",",505,"I"))
- . I AMT S BPSARRY("PAT RESP")=$$DFF2EXT^BPSECFM(AMT)
- . ; Ingredient Cost Paid
- . S AMT=$G(RESPNFO(9002313.0301,"1,"_RESPIEN_",",506,"I"))
- . I AMT S BPSARRY("ING COST PAID")=$$DFF2EXT^BPSECFM(AMT)
- . ; Dispensing Fee Paid
- . S AMT=$G(RESPNFO(9002313.0301,"1,"_RESPIEN_",",507,"I"))
- . I AMT S BPSARRY("DISP FEE PAID")=$$DFF2EXT^BPSECFM(AMT)
- . ; Total Amount Paid
- . S BPSARRY("PAID")=$$DFF2EXT^BPSECFM(RESPNFO(9002313.0301,"1,"_RESPIEN_",",509,"I"))
- . ; Amount of Copay
- . S AMT=$G(RESPNFO(9002313.0301,"1,"_RESPIEN_",",518,"I"))
- . I AMT S BPSARRY("COPAY")=$$DFF2EXT^BPSECFM(AMT)
- . ;
- . S BPSARRY("AUTH #")=RESPNFO(9002313.0301,"1,"_RESPIEN_",",503,"I")
- . S BPSARRY("RX NO")=RXINFO(52,RXIEN,.01,"E")
- . S BPSARRY("DRUG")=$$RXAPI1^BPSUTIL1(RXIEN,6,"I")
- . I FILLNUM<1 S BPSARRY("DAYS SUPPLY")=RXINFO(52,RXIEN,8,"E")
- . E S BPSARRY("DAYS SUPPLY")=$G(RFINFO(52.1,FILLNUM,1.1,"E"))
- . ; Billing Quantity and Units
- . S BPSARRY("QTY")=$G(TRANINFO("9002313.59",TRNDX_",",509,"I"))
- . S BPSARRY("UNITS")=$G(TRANINFO("9002313.59",TRNDX_",",510,"I"))
- . ; NCPDP Quantity and Units
- . S BPSARRY("NCPDP QTY")=$P(CLAIMNFO("9002313.0201","1,"_CLAIMIEN_",","442"),"E7",2)/1000
- . S BPSARRY("NCPDP UNITS")=$P(CLAIMNFO("9002313.0201","1,"_CLAIMIEN_",","600"),"28",2)
- ;
- ; Get primary IB bill# and prior payment amount
- I $D(^BPST(TRNDX,10,1,2)) D
- . S BPSARRY("PRIMARY BILL")=$P(^BPST(TRNDX,10,1,2),U,8)
- . S BPSARRY("PRIOR PAYMENT")=$P(^BPST(TRNDX,10,1,2),U,9)
- ;
- ; Setup miscellaneous values
- S BPSARRY("RXCOB")=$$COB59^BPSUTIL2(TRNDX)
- S BPSARRY("NDC")=$$GETNDC^PSONDCUT(RXIEN,FILLNUM)
- S BPSARRY("FILL NUMBER")=FILLNUM
- S BPSARRY("FILLED BY")=RXINFO(52,RXIEN,16,"I")
- S BPSARRY("PRESCRIPTION")=RXIEN
- S BPSARRY("BILLED")=$P(CLAIMNFO("9002313.0201","1,"_CLAIMIEN_",","430"),"DU",2)
- S BPSARRY("BILLED")=$$DFF2EXT^BPSECFM(BPSARRY("BILLED"))
- S BPSARRY("CLAIMID")=$P(CLAIMNFO("9002313.0201","1,"_CLAIMIEN_",","402"),"D2",2)
- S BPSARRY("RELEASE DATE")=$S(FILLNUM=0:$$RXAPI1^BPSUTIL1(RXIEN,31,"I"),1:$$RXSUBF1^BPSUTIL1(RXIEN,52,52.1,FILLNUM,17,"I"))
- S BPSARRY("RESPONSE")=RESPONSE
- S BPSARRY("EPHARM")=$$GET1^DIQ(9002313.59,TRNDX,1.07,"I")
- ;
- ; If Secondary Claim and Action was ERWV (Resubmit w/o Reversal from ECME User Screen),
- ; get the Primary Payer Bill and Prior Payment info from the BPS Log of Transactions
- ; entry created during the PRO Option.
- I BPSARRY("RXCOB")>1,RXACT="ERWV" D
- . S BPS57=""
- . F S BPS57=$O(^BPSTL("B",TRNDX,BPS57)) Q:BPS57="" D
- . . I $$GET1^DIQ(9002313.57,BPS57,1201)'["P2" Q
- . . S BPSARRY("PRIMARY BILL")=$$GET1^DIQ(9002313.57902,"1,"_BPS57,902.3,"I")
- . . S BPSARRY("PRIOR PAYMENT")=$$GET1^DIQ(9002313.57902,"1,"_BPS57,902.31)
- ;
- ; For reversals, get reversal reason and check for closed reason
- ; Call IB with Reversal Event
- ; If there is a close reason, call IB with CLOSE event
- ; and update BPS Claim with close information
- I EVENT="",$$ISREVERS^BPSOSU(CLAIMIEN) D Q
- . S REQCLAIM=TRANINFO("9002313.59",TRNDX_",",3,"I")
- . S BPSARRY("REVERSAL REASON")=TRANINFO("9002313.59",TRNDX_",",404,"I")
- . S BPSARRY("RTS-DEL")=0
- . ; Get RX action, which determine close event
- . I RXACT="RS" S CLREAS="PRESCRIPTION NOT RELEASED",BPSARRY("RTS-DEL")=1
- . I RXACT="DE" D
- . . S CLREAS="PRESCRIPTION DELETED",BPSARRY("RTS-DEL")=1
- . . ; check whether RX was in fact deleted in Pharmacy
- . . ; if not then the refill was deleted
- . . I $$RXSTATUS^BPSSCRU2(RXIEN)'=13 S BPSARRY("CLOSE COMMENT")="DELETION OF REFILL ONLY - ORIGINAL RX MAY REMAIN ACTIVE"
- . ; If accepted inpatient autoreversal, then close the claim
- . I RXACT="AREV",RESPONSE="ACCEPTED",REQCLAIM,$P($G(^BPSC(REQCLAIM,0)),U,7)=2 D
- .. S CLREAS="INPATIENT RX AUTO-REVERSAL",BPSARRY("CLOSE COMMENT")="INPATIENT PRESCRIPTION"
- .. S ELIG=TRANINFO("9002313.59",TRNDX_",",901.04,"I")
- .. I ELIG="T"!(ELIG="C") D AUDIT^PSOTRI(RXIEN,FILLNUM,BPSARRY("RXCOB"),$S(ELIG="T":"TRICARE",1:"CHAMPVA")_" INPATIENT AUTO-REVERSAL","I",ELIG)
- . I $D(CLREAS) S BPSARRY("CLOSE REASON")=$O(^IBE(356.8,"B",CLREAS,0))
- . ;
- . ; Call IB for Reversal Event
- . S BPSARRY("STATUS")="REVERSED",BILLNUM=$$STORESP^IBNCPDP(DFN,.BPSARRY)
- . ; If there is no close reason, quit
- . I '$D(BPSARRY("CLOSE REASON")) Q
- . ; Call IB for CLOSE event
- . ; Note for close, user is always postmaster (.5)
- . S BPSARRY("STATUS")="CLOSED",BPSARRY("USER")=.5
- . S BILLNUM=$$STORESP^IBNCPDP(DFN,.BPSARRY)
- . ;
- . ; Populate the original claim request with the close reason
- . I REQCLAIM D
- .. S DIE="^BPSC(",DA=REQCLAIM
- .. 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
- . ; NOTE that we only want to do a bulletin for an Inpatient Auto-Reversal or an RX action. If the code
- . ; above is modified to create other automatic close events, additional checks may need to be added
- . ; before creating the bulletin.
- . I BPSARRY("RXCOB")=1 D BULL(RXIEN,FILLNUM,CLAIMIEN,DFN,CLREAS,BPSARRY("CLAIMID"))
- ;
- ; If we got here, then it is not a reversal
- ; If EVENT is set, send Submit event
- I EVENT="" S BPSARRY("STATUS")="SUBMITTED",BILLNUM=$$STORESP^IBNCPDP(DFN,.BPSARRY)
- ;
- ; Sent Paid (Billable) event is the claim was paid and released or EVENT is BILL
- ; Note: User is always postmaster except for BackBilling (BB)
- I EVENT="BILL"!(RESPONSE="PAYABLE"!(RESPONSE="DUPLICATE")&(BPSARRY("RELEASE DATE")]"")) D
- . I RXACT'="BB" S BPSARRY("USER")=.5
- . ;set reject flag and store primary plan to serve secondary billing when primary claim was rejected
- . I BPSARRY("RXCOB")=2 I $P($$STATUS^BPSOSRX(RXIEN,FILLNUM,,,1),U)["E REJECTED" D
- . . N REJS
- . . S BPSARRY("PRIMREJ")=1,BPSARRY("PRIMPLAN")=$P(^BPST(+$$IEN59^BPSOSRX(RXIEN,FILLNUM,1),10,1,0),U)
- . . D DUR1^BPSNCPD3(RXIEN,FILLNUM,.REJS,"",1)
- . . S BPSARRY("REJ CODE LST")=$G(REJS(1,"REJ CODE LST"))
- . . M BPSARRY("REJ CODES")=REJS(1,"REJ CODES")
- . ;
- . S BPSARRY("STATUS")="PAID",BILLNUM=$$STORESP^IBNCPDP(DFN,.BPSARRY)
- Q
- ;
- BULL(RX,FILL,CLAIMIEN,DFN,REASON,ECME) ;
- ; Create bulletin to tell OPECC to reverse/close secondary claim
- ; Input Parameters
- ; RX - Prescription IEN (required)
- ; FILL - Fill Number (required)
- ; CLAIMIEN - BPS Claims IEN for the primary reversal
- ; DFN - Patient IEN
- ; REASON - Close Reason
- ; ECME - ECME Number
- ;
- ; Validate parameters
- I '$G(RX) Q
- I $G(FILL)="" Q
- ;
- ; Check to see a bulletin needs to be created
- I '$$SENDBULL(RX,FILL) Q
- ;
- N STATION,PRICLAIM,PRIBILL,SECBILL,BPSBILLS,PATNAME,SSN,DOS
- N BPSL,BPSX,XMSUB,XMDUZ,XMY,XMTEXT
- ;
- ; Get Station and Primary claim ID
- S STATION=$P($$SITE^VASITE(),U,3) ;IA 10112
- S PRICLAIM=$$GET1^DIQ(9002313.02,$G(CLAIMIEN)_",",.01)
- ;
- ; Get primary and secondary bill number
- ; If the bill exists, concatenate the Station number
- I $$RXBILL^IBNCPUT3(RX,FILL,"P","",.BPSBILLS)
- S PRIBILL=$O(BPSBILLS(""),-1) I PRIBILL S PRIBILL=STATION_"-"_$P(BPSBILLS(PRIBILL),U,1)_" "
- K BPSBILLS
- I $$RXBILL^IBNCPUT3(RX,FILL,"S","",.BPSBILLS)
- S SECBILL=$O(BPSBILLS(""),-1) I SECBILL S SECBILL=STATION_"-"_$P(BPSBILLS(SECBILL),U,1)_" "
- ;
- ; Get Patient Name and last four digits of the SSN - Supported by IA 10035
- I $G(DFN) D
- . S PATNAME=$P($G(^DPT(DFN,0)),U,1)
- . S SSN=$P($G(^DPT(DFN,0)),U,9)
- . S SSN=$E(SSN,$L(SSN)-3,$L(SSN))
- ;
- ; Get DOS in the correct format
- S DOS=$$GET1^DIQ(9002313.02,$G(CLAIMIEN)_",",401)
- I DOS S DOS=$E(DOS,5,6)_"/"_$E(DOS,7,8)_"/"_$E(DOS,1,4)
- ;
- ; Build Body of message
- S BPSL=0
- S BPSL=BPSL+1,BPSX(BPSL)="Primary claim "_PRIBILL_"(ECME #:"_$G(ECME)_") was closed for the following"
- S BPSL=BPSL+1,BPSX(BPSL)="reason: "_$G(REASON)
- S BPSL=BPSL+1,BPSX(BPSL)="Secondary claim "_SECBILL_"must be manually closed at this time."
- S BPSL=BPSL+1,BPSX(BPSL)=" "
- S BPSL=BPSL+1,BPSX(BPSL)="Patient Name: "_$G(PATNAME)_" ("_$G(SSN)_")"
- S BPSL=BPSL+1,BPSX(BPSL)="Prescription: "_$$RXAPI1^BPSUTIL1(RX,.01,"E")_" Fill: "_FILL
- S BPSL=BPSL+1,BPSX(BPSL)="Drug Name: "_$$RXAPI1^BPSUTIL1(RX,6,"E")
- S BPSL=BPSL+1,BPSX(BPSL)="Date of Service: "_DOS
- S BPSL=BPSL+1,BPSX(BPSL)="Primary Claim #: "_PRICLAIM
- S BPSL=BPSL+1,BPSX(BPSL)="Close Reason (Reason Not Billable): "_$G(REASON)
- S BPSL=BPSL+1,BPSX(BPSL)=" "
- S BPSL=BPSL+1,BPSX(BPSL)=" "
- S BPSL=BPSL+1,BPSX(BPSL)="Note: Depending how the secondary prescription claim was submitted,"
- S BPSL=BPSL+1,BPSX(BPSL)="this may require using the ECME User Screen to reverse the payable"
- S BPSL=BPSL+1,BPSX(BPSL)="secondary claim or using the correct VistA option to close the paper"
- S BPSL=BPSL+1,BPSX(BPSL)="secondary claim."
- S BPSL=BPSL+1,BPSX(BPSL)=" "
- ;
- ; Set variables needed by Mail routines - subject, from, to, body
- S XMSUB="ACTION: Close Secondary claim for ECME "_$G(ECME)
- S XMDUZ="BPS PACKAGE",XMY("G.BPS OPECC")="",XMTEXT="BPSX("
- D ^XMD
- Q
- ;
- SENDBULL(RX,FILL) ;
- ; Check if a bulletin should be created, which we want to do if:
- ; > There is a non-cancelled IB bill for the secondary claim
- ; > There is a open ECME secondary claim
- ;
- ; Input Parameters
- ; RX - Prescription IEN (required)
- ; FILL - Fill Number (required)
- ; Output
- ; 0 - Do not create the bulletin
- ; 1 - Create bulletin
- ;
- ; Validate parameters
- I '$G(RX) Q 0
- I $G(FILL)="" Q 0
- ;
- ; If the secondary claim has a non-cancelled bill, create the bulletin
- ; This could be true even if there is not a secondary claim in ePharmacy (e.g., for a paper claim)
- N BPSBILLS,BILL,ACTIVE,IB
- I $$RXBILL^IBNCPUT3(RX,FILL,"S","",.BPSBILLS)
- ; Loop through the bills and set ACTIVE flag if any of the bills are not cancelled
- S (BILL,ACTIVE)=0 F S BILL=$O(BPSBILLS(BILL)) Q:'BILL!ACTIVE D
- . S IB=$G(BPSBILLS(BILL))
- . I $P(IB,U,8)'=7,($P(IB,U,2)'="CB"),($P(IB,U,2)'="CN") S ACTIVE=1
- I ACTIVE Q 1
- ;
- ; Do not create the bulletin if the secondary transaction or claim does not exist
- N IEN59SEC,CLAIM
- S IEN59SEC=$$IEN59^BPSOSRX(RX,FILL,2)
- I 'IEN59SEC Q 0
- S CLAIM=$P($G(^BPST(IEN59SEC,0)),U,4)
- I 'CLAIM Q 0
- I '$D(^BPSC(CLAIM)) Q 0
- ;
- ; Return 1 if the secondary claim is open, 0 if it is closed
- Q '$$CLOSED02^BPSSCR03(CLAIM)
- ;
- DURSYNC(IEN59) ;
- ; Synch DURs between ECME and PSO
- ; Parameters:
- ; IEN59 is the BPS Transaction IEN
- N RXIEN,RXFILL
- ;
- ; Check Parameter
- I IEN59="" Q
- ;
- ; Get Prescription and Fill number
- S RXIEN=$$GET1^DIQ(9002313.59,IEN59_",",1.11,"I")
- S RXFILL=$$GET1^DIQ(9002313.59902,"1,"_IEN59_",",902.17,"E")
- I RXIEN=""!(RXFILL="") Q
- ;
- ; Call PSO to sync reject codes
- D SYNC^PSOREJUT(RXIEN,RXFILL,"",$$COB59^BPSUTIL2(IEN59))
- Q
- ;
- ; Process Other Paid Amount Grouping from the Pricing Segment
- ; Note that FDATA, TRANSACT, FDAIEN, and FDAIEN03 are newed
- ; and initialized by BPSECMPS
- PROCOTH ;
- Q:$G(FDATA(TRANSACT,563))=""
- N NNDX,FILE,ROOT,FDATA3,FLDNUM
- S FILE="9002313.1401"
- S ROOT="FDATA3(9002313.1401)"
- S NNDX=""
- F S NNDX=$O(FDATA(TRANSACT,564,NNDX)) Q:NNDX="" D
- .S FLDNUM=.01 D FDA^DILF(FILE,"+"_NNDX_","_FDAIEN03(TRANSACT)_","_FDAIEN(TRANSACT),FLDNUM,"",NNDX,ROOT)
- .F FLDNUM=564,565 I $D(FDATA(TRANSACT,FLDNUM,NNDX)) D FDA^DILF(FILE,"+"_NNDX_","_FDAIEN03(TRANSACT)_","_FDAIEN(TRANSACT),FLDNUM,"",$G(FDATA(TRANSACT,FLDNUM,NNDX)),ROOT)
- D UPDATE^DIE("S","FDATA3(9002313.1401)")
- Q
- ;
- ; Process the Benefits Stage fields from the Pricing Segment
- ; Note that FDATA, TRANSACT, FDAIEN, and FDAIEN03 are newed
- ; and initialized by BPSECMPS
- PROCBEN ;
- Q:$G(FDATA(TRANSACT,392))=""
- N NNDX,FILE,ROOT,FDATA3,FLDNUM
- S FILE="9002313.039201"
- S ROOT="FDATA3(9002313.039201)"
- S NNDX=""
- F S NNDX=$O(FDATA(TRANSACT,393,NNDX)) Q:NNDX="" D
- .S FLDNUM=.01 D FDA^DILF(FILE,"+"_NNDX_","_FDAIEN03(TRANSACT)_","_FDAIEN(TRANSACT),FLDNUM,"",NNDX,ROOT)
- .F FLDNUM=393,394 I $D(FDATA(TRANSACT,FLDNUM,NNDX)) D FDA^DILF(FILE,"+"_NNDX_","_FDAIEN03(TRANSACT)_","_FDAIEN(TRANSACT),FLDNUM,"",$G(FDATA(TRANSACT,FLDNUM,NNDX)),ROOT)
- D UPDATE^DIE("S","FDATA3(9002313.039201)")
- Q
- ;
- ; Process the Additional Message Information Multiple from the Status Segment
- ; Note that FDATA, TRANSACT, FDAIEN, and FDAIEN03 are newed
- ; and initialized by BPSECMPS
- PROCADM ;
- N NNDX,FILE,ROOT,FDATA3,FLDNUM,FDATA03,FILE03,ROOT03
- S FILE="9002313.13001",ROOT="FDATA3(9002313.13001)"
- S FILE03="9002313.0301",ROOT03="FDATA03(9002313.0301)"
- S NNDX=""
- ; D.0 Processing: 526 is in a multiple with the group 132
- I $O(FDATA(TRANSACT,132,0))]"" D Q
- . F S NNDX=$O(FDATA(TRANSACT,526,NNDX)) Q:NNDX="" D
- . . S FLDNUM=.01 D FDA^DILF(FILE,"+"_NNDX_","_FDAIEN03(TRANSACT)_","_FDAIEN(TRANSACT),FLDNUM,"",NNDX,ROOT)
- . . F FLDNUM=131,132,526 I $D(FDATA(TRANSACT,FLDNUM,NNDX)) D FDA^DILF(FILE,"+"_NNDX_","_FDAIEN03(TRANSACT)_","_FDAIEN(TRANSACT),FLDNUM,"",$G(FDATA(TRANSACT,FLDNUM,NNDX)),ROOT)
- . D UPDATE^DIE("S","FDATA3(9002313.13001)")
- ;
- ; 5.1 Processing: 526 is not in a group but is stored in one
- I $O(FDATA(TRANSACT,526,0))]"" D Q
- . F S NNDX=$O(FDATA(TRANSACT,526,NNDX)) Q:NNDX="" D
- . . S FLDNUM=.01 D FDA^DILF(FILE,"+1,"_FDAIEN03(TRANSACT)_","_FDAIEN(TRANSACT),FLDNUM,"",1,ROOT)
- . . S FLDNUM=132 D FDA^DILF(FILE,"+1,"_FDAIEN03(TRANSACT)_","_FDAIEN(TRANSACT),FLDNUM,"","01",ROOT)
- . . D FDA^DILF(FILE,"+1,"_FDAIEN03(TRANSACT)_","_FDAIEN(TRANSACT),526,"",$G(FDATA(TRANSACT,526,NNDX)),ROOT)
- . D UPDATE^DIE("S","FDATA3(9002313.13001)")
- . ; Set Additional Message Information Count field
- . D FDA^DILF(FILE03,"+"_TRANSACT_","_FDAIEN(TRANSACT),130,"",1,ROOT03)
- . D UPDATE^DIE("S","FDATA03(9002313.0301)")
- Q
- ;
- ; Process DUR Response Segment
- ; Note that FDATA, TRANSACT, FDAIEN, and FDAIEN03 are newed
- ; and initialized by BPSECMPS
- PROCDUR ;
- Q:$O(FDATA(TRANSACT,567,0))=""
- N NNDX,FILE,ROOT,FDAT1101,FLDNUM
- S FILE="9002313.1101"
- S ROOT="FDAT1101(9002313.1101)"
- S NNDX=""
- F S NNDX=$O(FDATA(TRANSACT,567,NNDX)) Q:NNDX="" D
- .S FLDNUM=".01" D FDA^DILF(FILE,"+"_NNDX_","_FDAIEN03(TRANSACT)_","_FDAIEN(TRANSACT),FLDNUM,"",FDATA(TRANSACT,567,NNDX),ROOT)
- .F FLDNUM=439,528,529,530,531,532,533,544,570 I $D(FDATA(TRANSACT,FLDNUM,NNDX)) D FDA^DILF(FILE,"+"_NNDX_","_FDAIEN03(TRANSACT)_","_FDAIEN(TRANSACT),FLDNUM,"",FDATA(TRANSACT,FLDNUM,NNDX),ROOT)
- D UPDATE^DIE("S","FDAT1101(9002313.1101)")
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HBPSECMP2 18051 printed Jan 18, 2025@02:52:04 Page 2
- BPSECMP2 ;BHAM ISC/FCS/DRS - Parse Claim Response ;11/14/07 13:23
- +1 ;;1.0;E CLAIMS MGMT ENGINE;**1,5,6,7,8,10,11,19,35**;JUN 2004;Build 14
- +2 ;;Per VA Directive 6402, this routine should not be modified.
- +3 ;
- +4 ;Reference to STORESP^IBNCPDP supported by DBIA 4299
- +5 ;Reference to ^DPT supported by DBIA 10035
- +6 ;Reference to $$SITE^VASITE supported by DBIA 10112
- +7 ;Reference to AUDIT^PSOTRI supported by ICR 6156
- +8 ;
- +9 QUIT
- +10 ; Parameters:
- +11 ; CLAIMIEN: IEN from BPS Claims
- +12 ; RESPIEN: IEN from BPS Response
- +13 ; EVENT: This is used by PSO to create specific events (BILL).
- +14 ; USER: User who is creating the event. This is required when EVENT is sent.
- IBSEND(CLAIMIEN,RESPIEN,EVENT,USER) ;
- +1 NEW BPSARRY,BPS57,RXIEN,FILLNUM,IND,TRNDX
- +2 NEW CLAIMNFO,RESPNFO,RXINFO,RFINFO,TRANINFO
- +3 NEW RESPONSE,RXACT,CLREAS,BILLNUM,DFN,REQCLAIM
- +4 NEW DIE,DA,DR,AMT,ELIG
- +5 ;
- +6 ; Quit if there is not a Response or Claim IEN
- +7 IF '$GET(RESPIEN)
- QUIT
- +8 IF '$GET(CLAIMIEN)
- QUIT
- +9 ;
- +10 ; Get Claims and Response Data
- +11 DO GETS^DIQ("9002313.02",CLAIMIEN,"103;400*;401;402;403;430","","CLAIMNFO")
- +12 DO GETS^DIQ("9002313.0301","1,"_RESPIEN,"112;503;505;506;507;509;518","I","RESPNFO")
- +13 ;
- +14 ; Get the Transaction IEN and Data
- +15 SET IND=$SELECT(CLAIMNFO("9002313.02",CLAIMIEN_",","103")="B2":"AER",1:"AE")
- +16 SET TRNDX=$ORDER(^BPST(IND,CLAIMIEN,""))
- +17 IF TRNDX=""
- QUIT
- +18 DO GETS^DIQ("9002313.59",TRNDX,"1.05;3;5;13;404;509;510;901.04;1201","I","TRANINFO")
- +19 ;
- +20 ; If Certify Mode is On, don't send to IB
- +21 IF $$GET1^DIQ(9002313.59902,"1,"_TRNDX_",","902.22")["MODE ON"
- QUIT
- +22 ;
- +23 ; Get Patient
- +24 SET DFN=TRANINFO("9002313.59",TRNDX_",",5,"I")
- +25 ;
- +26 ; Get Policy, Plan ID and Rate Type
- +27 SET BPSARRY("POLICY")=TRANINFO("9002313.59",TRNDX_",",1.05,"I")
- +28 IF $DATA(^BPST(TRNDX,10,1,0))
- Begin DoDot:1
- +29 SET BPSARRY("PLAN")=$PIECE(^BPST(TRNDX,10,1,0),U)
- +30 SET BPSARRY("RTYPE")=$PIECE(^BPST(TRNDX,10,1,0),U,8)
- End DoDot:1
- +31 ;
- +32 ; Store RXACT into a local variable as it is will be used a lot
- +33 SET RXACT=TRANINFO("9002313.59",TRNDX_",",1201,"I")
- +34 ;
- +35 ; Setup User data
- +36 ; If event is passed in, the user should be passed in as well
- +37 ; If no Event, but action is Auto-Reversal (AREV) or CMOP
- +38 ; processing (CR*/PC), use postmaster (.5)
- +39 ; Else use the user from BPS Transaction
- +40 IF EVENT]""
- SET BPSARRY("USER")=USER
- +41 IF '$TEST
- IF ",AREV,CRLB,CRLX,CRLR,CRRL,PC,"[(","_RXACT_",")
- SET BPSARRY("USER")=.5
- +42 IF '$TEST
- SET BPSARRY("USER")=TRANINFO("9002313.59",TRNDX_",",13,"I")
- +43 ;
- +44 ; Send eligibility response to IB
- +45 IF RXACT="ELIG"
- Begin DoDot:1
- +46 SET BPSARRY("STATUS")=RXACT
- +47 SET BPSARRY("RESPIEN")=RESPIEN
- +48 SET BILLNUM=$$STORESP^IBNCPDP(DFN,.BPSARRY)
- End DoDot:1
- QUIT
- +49 ;
- +50 ; Determine Prescription IEN
- +51 SET RXIEN=$PIECE(^BPSC(CLAIMIEN,400,1,0),"^",5)
- +52 ;
- +53 ; If no RX record, this was a certification test so don't send to IB
- +54 IF $$RXAPI1^BPSUTIL1(RXIEN,.01)=""
- QUIT
- +55 ;
- +56 ; Determine Payer Response
- +57 ; Treat Duplicate of Accepted Reversal ("S") as accepted
- +58 SET RESPONSE=RESPNFO(9002313.0301,"1,"_RESPIEN_",",112,"I")
- +59 SET RESPONSE=$SELECT(RESPONSE="A":"ACCEPTED",RESPONSE="C":"CAPTURED",RESPONSE="D":"DUPLICATE",RESPONSE="P":"PAYABLE",RESPONSE="R":"REJECTED",RESPONSE="S":"ACCEPTED",1:"OTHER")
- +60 ;
- +61 ; Get Prescription Information
- +62 DO RXAPI^BPSUTIL1(RXIEN,".01;4;6;7;8;16;27","RXINFO","IE")
- +63 ;
- +64 ; Get Refill Info if this is a refill
- +65 SET FILLNUM=+$EXTRACT($PIECE(TRNDX,".",2),1,4)
- +66 IF FILLNUM>0
- DO RXSUBF^BPSUTIL1(RXIEN,52,52.1,FILLNUM,".01;1;1.1;11","RFINFO","E")
- +67 ;
- +68 ; Date of Service
- +69 SET BPSARRY("DOS")=CLAIMNFO("9002313.02",CLAIMIEN_",","401")
- +70 IF BPSARRY("DOS")
- SET BPSARRY("DOS")=BPSARRY("DOS")-17000000
- +71 ;
- +72 ; Information needed for PAID/BILLING event
- +73 SET BPSARRY("PAID")=0
- +74 IF RESPONSE="PAYABLE"!(RESPONSE="DUPLICATE")
- Begin DoDot:1
- +75 ; Patient Pay Amount
- +76 SET AMT=$GET(RESPNFO(9002313.0301,"1,"_RESPIEN_",",505,"I"))
- +77 IF AMT
- SET BPSARRY("PAT RESP")=$$DFF2EXT^BPSECFM(AMT)
- +78 ; Ingredient Cost Paid
- +79 SET AMT=$GET(RESPNFO(9002313.0301,"1,"_RESPIEN_",",506,"I"))
- +80 IF AMT
- SET BPSARRY("ING COST PAID")=$$DFF2EXT^BPSECFM(AMT)
- +81 ; Dispensing Fee Paid
- +82 SET AMT=$GET(RESPNFO(9002313.0301,"1,"_RESPIEN_",",507,"I"))
- +83 IF AMT
- SET BPSARRY("DISP FEE PAID")=$$DFF2EXT^BPSECFM(AMT)
- +84 ; Total Amount Paid
- +85 SET BPSARRY("PAID")=$$DFF2EXT^BPSECFM(RESPNFO(9002313.0301,"1,"_RESPIEN_",",509,"I"))
- +86 ; Amount of Copay
- +87 SET AMT=$GET(RESPNFO(9002313.0301,"1,"_RESPIEN_",",518,"I"))
- +88 IF AMT
- SET BPSARRY("COPAY")=$$DFF2EXT^BPSECFM(AMT)
- +89 ;
- +90 SET BPSARRY("AUTH #")=RESPNFO(9002313.0301,"1,"_RESPIEN_",",503,"I")
- +91 SET BPSARRY("RX NO")=RXINFO(52,RXIEN,.01,"E")
- +92 SET BPSARRY("DRUG")=$$RXAPI1^BPSUTIL1(RXIEN,6,"I")
- +93 IF FILLNUM<1
- SET BPSARRY("DAYS SUPPLY")=RXINFO(52,RXIEN,8,"E")
- +94 IF '$TEST
- SET BPSARRY("DAYS SUPPLY")=$GET(RFINFO(52.1,FILLNUM,1.1,"E"))
- +95 ; Billing Quantity and Units
- +96 SET BPSARRY("QTY")=$GET(TRANINFO("9002313.59",TRNDX_",",509,"I"))
- +97 SET BPSARRY("UNITS")=$GET(TRANINFO("9002313.59",TRNDX_",",510,"I"))
- +98 ; NCPDP Quantity and Units
- +99 SET BPSARRY("NCPDP QTY")=$PIECE(CLAIMNFO("9002313.0201","1,"_CLAIMIEN_",","442"),"E7",2)/1000
- +100 SET BPSARRY("NCPDP UNITS")=$PIECE(CLAIMNFO("9002313.0201","1,"_CLAIMIEN_",","600"),"28",2)
- End DoDot:1
- +101 ;
- +102 ; Get primary IB bill# and prior payment amount
- +103 IF $DATA(^BPST(TRNDX,10,1,2))
- Begin DoDot:1
- +104 SET BPSARRY("PRIMARY BILL")=$PIECE(^BPST(TRNDX,10,1,2),U,8)
- +105 SET BPSARRY("PRIOR PAYMENT")=$PIECE(^BPST(TRNDX,10,1,2),U,9)
- End DoDot:1
- +106 ;
- +107 ; Setup miscellaneous values
- +108 SET BPSARRY("RXCOB")=$$COB59^BPSUTIL2(TRNDX)
- +109 SET BPSARRY("NDC")=$$GETNDC^PSONDCUT(RXIEN,FILLNUM)
- +110 SET BPSARRY("FILL NUMBER")=FILLNUM
- +111 SET BPSARRY("FILLED BY")=RXINFO(52,RXIEN,16,"I")
- +112 SET BPSARRY("PRESCRIPTION")=RXIEN
- +113 SET BPSARRY("BILLED")=$PIECE(CLAIMNFO("9002313.0201","1,"_CLAIMIEN_",","430"),"DU",2)
- +114 SET BPSARRY("BILLED")=$$DFF2EXT^BPSECFM(BPSARRY("BILLED"))
- +115 SET BPSARRY("CLAIMID")=$PIECE(CLAIMNFO("9002313.0201","1,"_CLAIMIEN_",","402"),"D2",2)
- +116 SET BPSARRY("RELEASE DATE")=$SELECT(FILLNUM=0:$$RXAPI1^BPSUTIL1(RXIEN,31,"I"),1:$$RXSUBF1^BPSUTIL1(RXIEN,52,52.1,FILLNUM,17,"I"))
- +117 SET BPSARRY("RESPONSE")=RESPONSE
- +118 SET BPSARRY("EPHARM")=$$GET1^DIQ(9002313.59,TRNDX,1.07,"I")
- +119 ;
- +120 ; If Secondary Claim and Action was ERWV (Resubmit w/o Reversal from ECME User Screen),
- +121 ; get the Primary Payer Bill and Prior Payment info from the BPS Log of Transactions
- +122 ; entry created during the PRO Option.
- +123 IF BPSARRY("RXCOB")>1
- IF RXACT="ERWV"
- Begin DoDot:1
- +124 SET BPS57=""
- +125 FOR
- SET BPS57=$ORDER(^BPSTL("B",TRNDX,BPS57))
- if BPS57=""
- QUIT
- Begin DoDot:2
- +126 IF $$GET1^DIQ(9002313.57,BPS57,1201)'["P2"
- QUIT
- +127 SET BPSARRY("PRIMARY BILL")=$$GET1^DIQ(9002313.57902,"1,"_BPS57,902.3,"I")
- +128 SET BPSARRY("PRIOR PAYMENT")=$$GET1^DIQ(9002313.57902,"1,"_BPS57,902.31)
- End DoDot:2
- End DoDot:1
- +129 ;
- +130 ; For reversals, get reversal reason and check for closed reason
- +131 ; Call IB with Reversal Event
- +132 ; If there is a close reason, call IB with CLOSE event
- +133 ; and update BPS Claim with close information
- +134 IF EVENT=""
- IF $$ISREVERS^BPSOSU(CLAIMIEN)
- Begin DoDot:1
- +135 SET REQCLAIM=TRANINFO("9002313.59",TRNDX_",",3,"I")
- +136 SET BPSARRY("REVERSAL REASON")=TRANINFO("9002313.59",TRNDX_",",404,"I")
- +137 SET BPSARRY("RTS-DEL")=0
- +138 ; Get RX action, which determine close event
- +139 IF RXACT="RS"
- SET CLREAS="PRESCRIPTION NOT RELEASED"
- SET BPSARRY("RTS-DEL")=1
- +140 IF RXACT="DE"
- Begin DoDot:2
- +141 SET CLREAS="PRESCRIPTION DELETED"
- SET BPSARRY("RTS-DEL")=1
- +142 ; check whether RX was in fact deleted in Pharmacy
- +143 ; if not then the refill was deleted
- +144 IF $$RXSTATUS^BPSSCRU2(RXIEN)'=13
- SET BPSARRY("CLOSE COMMENT")="DELETION OF REFILL ONLY - ORIGINAL RX MAY REMAIN ACTIVE"
- End DoDot:2
- +145 ; If accepted inpatient autoreversal, then close the claim
- +146 IF RXACT="AREV"
- IF RESPONSE="ACCEPTED"
- IF REQCLAIM
- IF $PIECE($GET(^BPSC(REQCLAIM,0)),U,7)=2
- Begin DoDot:2
- +147 SET CLREAS="INPATIENT RX AUTO-REVERSAL"
- SET BPSARRY("CLOSE COMMENT")="INPATIENT PRESCRIPTION"
- +148 SET ELIG=TRANINFO("9002313.59",TRNDX_",",901.04,"I")
- +149 IF ELIG="T"!(ELIG="C")
- DO AUDIT^PSOTRI(RXIEN,FILLNUM,BPSARRY("RXCOB"),$SELECT(ELIG="T":"TRICARE",1:"CHAMPVA")_" INPATIENT AUTO-REVERSAL","I",ELIG)
- End DoDot:2
- +150 IF $DATA(CLREAS)
- SET BPSARRY("CLOSE REASON")=$ORDER(^IBE(356.8,"B",CLREAS,0))
- +151 ;
- +152 ; Call IB for Reversal Event
- +153 SET BPSARRY("STATUS")="REVERSED"
- SET BILLNUM=$$STORESP^IBNCPDP(DFN,.BPSARRY)
- +154 ; If there is no close reason, quit
- +155 IF '$DATA(BPSARRY("CLOSE REASON"))
- QUIT
- +156 ; Call IB for CLOSE event
- +157 ; Note for close, user is always postmaster (.5)
- +158 SET BPSARRY("STATUS")="CLOSED"
- SET BPSARRY("USER")=.5
- +159 SET BILLNUM=$$STORESP^IBNCPDP(DFN,.BPSARRY)
- +160 ;
- +161 ; Populate the original claim request with the close reason
- +162 IF REQCLAIM
- Begin DoDot:2
- +163 SET DIE="^BPSC("
- SET DA=REQCLAIM
- +164 SET DR="901///1;902///"_$$NOW^XLFDT()_";903////.5;904///"_BPSARRY("CLOSE REASON")
- +165 DO ^DIE
- End DoDot:2
- +166 ; If this is a primary claim, check and send a bulletin if the secondary claim is open or if there
- +167 ; is a non-cancelled IB bill for the secondary claim
- +168 ; NOTE that we only want to do a bulletin for an Inpatient Auto-Reversal or an RX action. If the code
- +169 ; above is modified to create other automatic close events, additional checks may need to be added
- +170 ; before creating the bulletin.
- +171 IF BPSARRY("RXCOB")=1
- DO BULL(RXIEN,FILLNUM,CLAIMIEN,DFN,CLREAS,BPSARRY("CLAIMID"))
- End DoDot:1
- QUIT
- +172 ;
- +173 ; If we got here, then it is not a reversal
- +174 ; If EVENT is set, send Submit event
- +175 IF EVENT=""
- SET BPSARRY("STATUS")="SUBMITTED"
- SET BILLNUM=$$STORESP^IBNCPDP(DFN,.BPSARRY)
- +176 ;
- +177 ; Sent Paid (Billable) event is the claim was paid and released or EVENT is BILL
- +178 ; Note: User is always postmaster except for BackBilling (BB)
- +179 IF EVENT="BILL"!(RESPONSE="PAYABLE"!(RESPONSE="DUPLICATE")&(BPSARRY("RELEASE DATE")]""))
- Begin DoDot:1
- +180 IF RXACT'="BB"
- SET BPSARRY("USER")=.5
- +181 ;set reject flag and store primary plan to serve secondary billing when primary claim was rejected
- +182 IF BPSARRY("RXCOB")=2
- IF $PIECE($$STATUS^BPSOSRX(RXIEN,FILLNUM,,,1),U)["E REJECTED"
- Begin DoDot:2
- +183 NEW REJS
- +184 SET BPSARRY("PRIMREJ")=1
- SET BPSARRY("PRIMPLAN")=$PIECE(^BPST(+$$IEN59^BPSOSRX(RXIEN,FILLNUM,1),10,1,0),U)
- +185 DO DUR1^BPSNCPD3(RXIEN,FILLNUM,.REJS,"",1)
- +186 SET BPSARRY("REJ CODE LST")=$GET(REJS(1,"REJ CODE LST"))
- +187 MERGE BPSARRY("REJ CODES")=REJS(1,"REJ CODES")
- End DoDot:2
- +188 ;
- +189 SET BPSARRY("STATUS")="PAID"
- SET BILLNUM=$$STORESP^IBNCPDP(DFN,.BPSARRY)
- End DoDot:1
- +190 QUIT
- +191 ;
- BULL(RX,FILL,CLAIMIEN,DFN,REASON,ECME) ;
- +1 ; Create bulletin to tell OPECC to reverse/close secondary claim
- +2 ; Input Parameters
- +3 ; RX - Prescription IEN (required)
- +4 ; FILL - Fill Number (required)
- +5 ; CLAIMIEN - BPS Claims IEN for the primary reversal
- +6 ; DFN - Patient IEN
- +7 ; REASON - Close Reason
- +8 ; ECME - ECME Number
- +9 ;
- +10 ; Validate parameters
- +11 IF '$GET(RX)
- QUIT
- +12 IF $GET(FILL)=""
- QUIT
- +13 ;
- +14 ; Check to see a bulletin needs to be created
- +15 IF '$$SENDBULL(RX,FILL)
- QUIT
- +16 ;
- +17 NEW STATION,PRICLAIM,PRIBILL,SECBILL,BPSBILLS,PATNAME,SSN,DOS
- +18 NEW BPSL,BPSX,XMSUB,XMDUZ,XMY,XMTEXT
- +19 ;
- +20 ; Get Station and Primary claim ID
- +21 ;IA 10112
- SET STATION=$PIECE($$SITE^VASITE(),U,3)
- +22 SET PRICLAIM=$$GET1^DIQ(9002313.02,$GET(CLAIMIEN)_",",.01)
- +23 ;
- +24 ; Get primary and secondary bill number
- +25 ; If the bill exists, concatenate the Station number
- +26 IF $$RXBILL^IBNCPUT3(RX,FILL,"P","",.BPSBILLS)
- +27 SET PRIBILL=$ORDER(BPSBILLS(""),-1)
- IF PRIBILL
- SET PRIBILL=STATION_"-"_$PIECE(BPSBILLS(PRIBILL),U,1)_" "
- +28 KILL BPSBILLS
- +29 IF $$RXBILL^IBNCPUT3(RX,FILL,"S","",.BPSBILLS)
- +30 SET SECBILL=$ORDER(BPSBILLS(""),-1)
- IF SECBILL
- SET SECBILL=STATION_"-"_$PIECE(BPSBILLS(SECBILL),U,1)_" "
- +31 ;
- +32 ; Get Patient Name and last four digits of the SSN - Supported by IA 10035
- +33 IF $GET(DFN)
- Begin DoDot:1
- +34 SET PATNAME=$PIECE($GET(^DPT(DFN,0)),U,1)
- +35 SET SSN=$PIECE($GET(^DPT(DFN,0)),U,9)
- +36 SET SSN=$EXTRACT(SSN,$LENGTH(SSN)-3,$LENGTH(SSN))
- End DoDot:1
- +37 ;
- +38 ; Get DOS in the correct format
- +39 SET DOS=$$GET1^DIQ(9002313.02,$GET(CLAIMIEN)_",",401)
- +40 IF DOS
- SET DOS=$EXTRACT(DOS,5,6)_"/"_$EXTRACT(DOS,7,8)_"/"_$EXTRACT(DOS,1,4)
- +41 ;
- +42 ; Build Body of message
- +43 SET BPSL=0
- +44 SET BPSL=BPSL+1
- SET BPSX(BPSL)="Primary claim "_PRIBILL_"(ECME #:"_$GET(ECME)_") was closed for the following"
- +45 SET BPSL=BPSL+1
- SET BPSX(BPSL)="reason: "_$GET(REASON)
- +46 SET BPSL=BPSL+1
- SET BPSX(BPSL)="Secondary claim "_SECBILL_"must be manually closed at this time."
- +47 SET BPSL=BPSL+1
- SET BPSX(BPSL)=" "
- +48 SET BPSL=BPSL+1
- SET BPSX(BPSL)="Patient Name: "_$GET(PATNAME)_" ("_$GET(SSN)_")"
- +49 SET BPSL=BPSL+1
- SET BPSX(BPSL)="Prescription: "_$$RXAPI1^BPSUTIL1(RX,.01,"E")_" Fill: "_FILL
- +50 SET BPSL=BPSL+1
- SET BPSX(BPSL)="Drug Name: "_$$RXAPI1^BPSUTIL1(RX,6,"E")
- +51 SET BPSL=BPSL+1
- SET BPSX(BPSL)="Date of Service: "_DOS
- +52 SET BPSL=BPSL+1
- SET BPSX(BPSL)="Primary Claim #: "_PRICLAIM
- +53 SET BPSL=BPSL+1
- SET BPSX(BPSL)="Close Reason (Reason Not Billable): "_$GET(REASON)
- +54 SET BPSL=BPSL+1
- SET BPSX(BPSL)=" "
- +55 SET BPSL=BPSL+1
- SET BPSX(BPSL)=" "
- +56 SET BPSL=BPSL+1
- SET BPSX(BPSL)="Note: Depending how the secondary prescription claim was submitted,"
- +57 SET BPSL=BPSL+1
- SET BPSX(BPSL)="this may require using the ECME User Screen to reverse the payable"
- +58 SET BPSL=BPSL+1
- SET BPSX(BPSL)="secondary claim or using the correct VistA option to close the paper"
- +59 SET BPSL=BPSL+1
- SET BPSX(BPSL)="secondary claim."
- +60 SET BPSL=BPSL+1
- SET BPSX(BPSL)=" "
- +61 ;
- +62 ; Set variables needed by Mail routines - subject, from, to, body
- +63 SET XMSUB="ACTION: Close Secondary claim for ECME "_$GET(ECME)
- +64 SET XMDUZ="BPS PACKAGE"
- SET XMY("G.BPS OPECC")=""
- SET XMTEXT="BPSX("
- +65 DO ^XMD
- +66 QUIT
- +67 ;
- SENDBULL(RX,FILL) ;
- +1 ; Check if a bulletin should be created, which we want to do if:
- +2 ; > There is a non-cancelled IB bill for the secondary claim
- +3 ; > There is a open ECME secondary claim
- +4 ;
- +5 ; Input Parameters
- +6 ; RX - Prescription IEN (required)
- +7 ; FILL - Fill Number (required)
- +8 ; Output
- +9 ; 0 - Do not create the bulletin
- +10 ; 1 - Create bulletin
- +11 ;
- +12 ; Validate parameters
- +13 IF '$GET(RX)
- QUIT 0
- +14 IF $GET(FILL)=""
- QUIT 0
- +15 ;
- +16 ; If the secondary claim has a non-cancelled bill, create the bulletin
- +17 ; This could be true even if there is not a secondary claim in ePharmacy (e.g., for a paper claim)
- +18 NEW BPSBILLS,BILL,ACTIVE,IB
- +19 IF $$RXBILL^IBNCPUT3(RX,FILL,"S","",.BPSBILLS)
- +20 ; Loop through the bills and set ACTIVE flag if any of the bills are not cancelled
- +21 SET (BILL,ACTIVE)=0
- FOR
- SET BILL=$ORDER(BPSBILLS(BILL))
- if 'BILL!ACTIVE
- QUIT
- Begin DoDot:1
- +22 SET IB=$GET(BPSBILLS(BILL))
- +23 IF $PIECE(IB,U,8)'=7
- IF ($PIECE(IB,U,2)'="CB")
- IF ($PIECE(IB,U,2)'="CN")
- SET ACTIVE=1
- End DoDot:1
- +24 IF ACTIVE
- QUIT 1
- +25 ;
- +26 ; Do not create the bulletin if the secondary transaction or claim does not exist
- +27 NEW IEN59SEC,CLAIM
- +28 SET IEN59SEC=$$IEN59^BPSOSRX(RX,FILL,2)
- +29 IF 'IEN59SEC
- QUIT 0
- +30 SET CLAIM=$PIECE($GET(^BPST(IEN59SEC,0)),U,4)
- +31 IF 'CLAIM
- QUIT 0
- +32 IF '$DATA(^BPSC(CLAIM))
- QUIT 0
- +33 ;
- +34 ; Return 1 if the secondary claim is open, 0 if it is closed
- +35 QUIT '$$CLOSED02^BPSSCR03(CLAIM)
- +36 ;
- DURSYNC(IEN59) ;
- +1 ; Synch DURs between ECME and PSO
- +2 ; Parameters:
- +3 ; IEN59 is the BPS Transaction IEN
- +4 NEW RXIEN,RXFILL
- +5 ;
- +6 ; Check Parameter
- +7 IF IEN59=""
- QUIT
- +8 ;
- +9 ; Get Prescription and Fill number
- +10 SET RXIEN=$$GET1^DIQ(9002313.59,IEN59_",",1.11,"I")
- +11 SET RXFILL=$$GET1^DIQ(9002313.59902,"1,"_IEN59_",",902.17,"E")
- +12 IF RXIEN=""!(RXFILL="")
- QUIT
- +13 ;
- +14 ; Call PSO to sync reject codes
- +15 DO SYNC^PSOREJUT(RXIEN,RXFILL,"",$$COB59^BPSUTIL2(IEN59))
- +16 QUIT
- +17 ;
- +18 ; Process Other Paid Amount Grouping from the Pricing Segment
- +19 ; Note that FDATA, TRANSACT, FDAIEN, and FDAIEN03 are newed
- +20 ; and initialized by BPSECMPS
- PROCOTH ;
- +1 if $GET(FDATA(TRANSACT,563))=""
- QUIT
- +2 NEW NNDX,FILE,ROOT,FDATA3,FLDNUM
- +3 SET FILE="9002313.1401"
- +4 SET ROOT="FDATA3(9002313.1401)"
- +5 SET NNDX=""
- +6 FOR
- SET NNDX=$ORDER(FDATA(TRANSACT,564,NNDX))
- if NNDX=""
- QUIT
- Begin DoDot:1
- +7 SET FLDNUM=.01
- DO FDA^DILF(FILE,"+"_NNDX_","_FDAIEN03(TRANSACT)_","_FDAIEN(TRANSACT),FLDNUM,"",NNDX,ROOT)
- +8 FOR FLDNUM=564,565
- IF $DATA(FDATA(TRANSACT,FLDNUM,NNDX))
- DO FDA^DILF(FILE,"+"_NNDX_","_FDAIEN03(TRANSACT)_","_FDAIEN(TRANSACT),FLDNUM,"",$GET(FDATA(TRANSACT,FLDNUM,NNDX)),ROOT)
- End DoDot:1
- +9 DO UPDATE^DIE("S","FDATA3(9002313.1401)")
- +10 QUIT
- +11 ;
- +12 ; Process the Benefits Stage fields from the Pricing Segment
- +13 ; Note that FDATA, TRANSACT, FDAIEN, and FDAIEN03 are newed
- +14 ; and initialized by BPSECMPS
- PROCBEN ;
- +1 if $GET(FDATA(TRANSACT,392))=""
- QUIT
- +2 NEW NNDX,FILE,ROOT,FDATA3,FLDNUM
- +3 SET FILE="9002313.039201"
- +4 SET ROOT="FDATA3(9002313.039201)"
- +5 SET NNDX=""
- +6 FOR
- SET NNDX=$ORDER(FDATA(TRANSACT,393,NNDX))
- if NNDX=""
- QUIT
- Begin DoDot:1
- +7 SET FLDNUM=.01
- DO FDA^DILF(FILE,"+"_NNDX_","_FDAIEN03(TRANSACT)_","_FDAIEN(TRANSACT),FLDNUM,"",NNDX,ROOT)
- +8 FOR FLDNUM=393,394
- IF $DATA(FDATA(TRANSACT,FLDNUM,NNDX))
- DO FDA^DILF(FILE,"+"_NNDX_","_FDAIEN03(TRANSACT)_","_FDAIEN(TRANSACT),FLDNUM,"",$GET(FDATA(TRANSACT,FLDNUM,NNDX)),ROOT)
- End DoDot:1
- +9 DO UPDATE^DIE("S","FDATA3(9002313.039201)")
- +10 QUIT
- +11 ;
- +12 ; Process the Additional Message Information Multiple from the Status Segment
- +13 ; Note that FDATA, TRANSACT, FDAIEN, and FDAIEN03 are newed
- +14 ; and initialized by BPSECMPS
- PROCADM ;
- +1 NEW NNDX,FILE,ROOT,FDATA3,FLDNUM,FDATA03,FILE03,ROOT03
- +2 SET FILE="9002313.13001"
- SET ROOT="FDATA3(9002313.13001)"
- +3 SET FILE03="9002313.0301"
- SET ROOT03="FDATA03(9002313.0301)"
- +4 SET NNDX=""
- +5 ; D.0 Processing: 526 is in a multiple with the group 132
- +6 IF $ORDER(FDATA(TRANSACT,132,0))]""
- Begin DoDot:1
- +7 FOR
- SET NNDX=$ORDER(FDATA(TRANSACT,526,NNDX))
- if NNDX=""
- QUIT
- Begin DoDot:2
- +8 SET FLDNUM=.01
- DO FDA^DILF(FILE,"+"_NNDX_","_FDAIEN03(TRANSACT)_","_FDAIEN(TRANSACT),FLDNUM,"",NNDX,ROOT)
- +9 FOR FLDNUM=131,132,526
- IF $DATA(FDATA(TRANSACT,FLDNUM,NNDX))
- DO FDA^DILF(FILE,"+"_NNDX_","_FDAIEN03(TRANSACT)_","_FDAIEN(TRANSACT),FLDNUM,"",$GET(FDATA(TRANSACT,FLDNUM,NNDX)),ROOT)
- End DoDot:2
- +10 DO UPDATE^DIE("S","FDATA3(9002313.13001)")
- End DoDot:1
- QUIT
- +11 ;
- +12 ; 5.1 Processing: 526 is not in a group but is stored in one
- +13 IF $ORDER(FDATA(TRANSACT,526,0))]""
- Begin DoDot:1
- +14 FOR
- SET NNDX=$ORDER(FDATA(TRANSACT,526,NNDX))
- if NNDX=""
- QUIT
- Begin DoDot:2
- +15 SET FLDNUM=.01
- DO FDA^DILF(FILE,"+1,"_FDAIEN03(TRANSACT)_","_FDAIEN(TRANSACT),FLDNUM,"",1,ROOT)
- +16 SET FLDNUM=132
- DO FDA^DILF(FILE,"+1,"_FDAIEN03(TRANSACT)_","_FDAIEN(TRANSACT),FLDNUM,"","01",ROOT)
- +17 DO FDA^DILF(FILE,"+1,"_FDAIEN03(TRANSACT)_","_FDAIEN(TRANSACT),526,"",$GET(FDATA(TRANSACT,526,NNDX)),ROOT)
- End DoDot:2
- +18 DO UPDATE^DIE("S","FDATA3(9002313.13001)")
- +19 ; Set Additional Message Information Count field
- +20 DO FDA^DILF(FILE03,"+"_TRANSACT_","_FDAIEN(TRANSACT),130,"",1,ROOT03)
- +21 DO UPDATE^DIE("S","FDATA03(9002313.0301)")
- End DoDot:1
- QUIT
- +22 QUIT
- +23 ;
- +24 ; Process DUR Response Segment
- +25 ; Note that FDATA, TRANSACT, FDAIEN, and FDAIEN03 are newed
- +26 ; and initialized by BPSECMPS
- PROCDUR ;
- +1 if $ORDER(FDATA(TRANSACT,567,0))=""
- QUIT
- +2 NEW NNDX,FILE,ROOT,FDAT1101,FLDNUM
- +3 SET FILE="9002313.1101"
- +4 SET ROOT="FDAT1101(9002313.1101)"
- +5 SET NNDX=""
- +6 FOR
- SET NNDX=$ORDER(FDATA(TRANSACT,567,NNDX))
- if NNDX=""
- QUIT
- Begin DoDot:1
- +7 SET FLDNUM=".01"
- DO FDA^DILF(FILE,"+"_NNDX_","_FDAIEN03(TRANSACT)_","_FDAIEN(TRANSACT),FLDNUM,"",FDATA(TRANSACT,567,NNDX),ROOT)
- +8 FOR FLDNUM=439,528,529,530,531,532,533,544,570
- IF $DATA(FDATA(TRANSACT,FLDNUM,NNDX))
- DO FDA^DILF(FILE,"+"_NNDX_","_FDAIEN03(TRANSACT)_","_FDAIEN(TRANSACT),FLDNUM,"",FDATA(TRANSACT,FLDNUM,NNDX),ROOT)
- End DoDot:1
- +9 DO UPDATE^DIE("S","FDAT1101(9002313.1101)")
- +10 QUIT