Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BPSECMP2

BPSECMP2.m

Go to the documentation of this file.
  1. 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
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. ;Reference to STORESP^IBNCPDP supported by DBIA 4299
  1. ;Reference to ^DPT supported by DBIA 10035
  1. ;Reference to $$SITE^VASITE supported by DBIA 10112
  1. ;Reference to AUDIT^PSOTRI supported by ICR 6156
  1. ;
  1. Q
  1. ; Parameters:
  1. ; CLAIMIEN: IEN from BPS Claims
  1. ; RESPIEN: IEN from BPS Response
  1. ; EVENT: This is used by PSO to create specific events (BILL).
  1. ; USER: User who is creating the event. This is required when EVENT is sent.
  1. IBSEND(CLAIMIEN,RESPIEN,EVENT,USER) ;
  1. N BPSARRY,BPS57,RXIEN,FILLNUM,IND,TRNDX
  1. N CLAIMNFO,RESPNFO,RXINFO,RFINFO,TRANINFO
  1. N RESPONSE,RXACT,CLREAS,BILLNUM,DFN,REQCLAIM
  1. N DIE,DA,DR,AMT,ELIG
  1. ;
  1. ; Quit if there is not a Response or Claim IEN
  1. I '$G(RESPIEN) Q
  1. I '$G(CLAIMIEN) Q
  1. ;
  1. ; Get Claims and Response Data
  1. D GETS^DIQ("9002313.02",CLAIMIEN,"103;400*;401;402;403;430","","CLAIMNFO")
  1. D GETS^DIQ("9002313.0301","1,"_RESPIEN,"112;503;505;506;507;509;518","I","RESPNFO")
  1. ;
  1. ; Get the Transaction IEN and Data
  1. S IND=$S(CLAIMNFO("9002313.02",CLAIMIEN_",","103")="B2":"AER",1:"AE")
  1. S TRNDX=$O(^BPST(IND,CLAIMIEN,""))
  1. I TRNDX="" Q
  1. D GETS^DIQ("9002313.59",TRNDX,"1.05;3;5;13;404;509;510;901.04;1201","I","TRANINFO")
  1. ;
  1. ; If Certify Mode is On, don't send to IB
  1. I $$GET1^DIQ(9002313.59902,"1,"_TRNDX_",","902.22")["MODE ON" Q
  1. ;
  1. ; Get Patient
  1. S DFN=TRANINFO("9002313.59",TRNDX_",",5,"I")
  1. ;
  1. ; Get Policy, Plan ID and Rate Type
  1. S BPSARRY("POLICY")=TRANINFO("9002313.59",TRNDX_",",1.05,"I")
  1. I $D(^BPST(TRNDX,10,1,0)) D
  1. . S BPSARRY("PLAN")=$P(^BPST(TRNDX,10,1,0),U)
  1. . S BPSARRY("RTYPE")=$P(^BPST(TRNDX,10,1,0),U,8)
  1. ;
  1. ; Store RXACT into a local variable as it is will be used a lot
  1. S RXACT=TRANINFO("9002313.59",TRNDX_",",1201,"I")
  1. ;
  1. ; Setup User data
  1. ; If event is passed in, the user should be passed in as well
  1. ; If no Event, but action is Auto-Reversal (AREV) or CMOP
  1. ; processing (CR*/PC), use postmaster (.5)
  1. ; Else use the user from BPS Transaction
  1. I EVENT]"" S BPSARRY("USER")=USER
  1. E I ",AREV,CRLB,CRLX,CRLR,CRRL,PC,"[(","_RXACT_",") S BPSARRY("USER")=.5
  1. E S BPSARRY("USER")=TRANINFO("9002313.59",TRNDX_",",13,"I")
  1. ;
  1. ; Send eligibility response to IB
  1. I RXACT="ELIG" D Q
  1. . S BPSARRY("STATUS")=RXACT
  1. . S BPSARRY("RESPIEN")=RESPIEN
  1. . S BILLNUM=$$STORESP^IBNCPDP(DFN,.BPSARRY)
  1. ;
  1. ; Determine Prescription IEN
  1. S RXIEN=$P(^BPSC(CLAIMIEN,400,1,0),"^",5)
  1. ;
  1. ; If no RX record, this was a certification test so don't send to IB
  1. I $$RXAPI1^BPSUTIL1(RXIEN,.01)="" Q
  1. ;
  1. ; Determine Payer Response
  1. ; Treat Duplicate of Accepted Reversal ("S") as accepted
  1. S RESPONSE=RESPNFO(9002313.0301,"1,"_RESPIEN_",",112,"I")
  1. S RESPONSE=$S(RESPONSE="A":"ACCEPTED",RESPONSE="C":"CAPTURED",RESPONSE="D":"DUPLICATE",RESPONSE="P":"PAYABLE",RESPONSE="R":"REJECTED",RESPONSE="S":"ACCEPTED",1:"OTHER")
  1. ;
  1. ; Get Prescription Information
  1. D RXAPI^BPSUTIL1(RXIEN,".01;4;6;7;8;16;27","RXINFO","IE")
  1. ;
  1. ; Get Refill Info if this is a refill
  1. S FILLNUM=+$E($P(TRNDX,".",2),1,4)
  1. I FILLNUM>0 D RXSUBF^BPSUTIL1(RXIEN,52,52.1,FILLNUM,".01;1;1.1;11","RFINFO","E")
  1. ;
  1. ; Date of Service
  1. S BPSARRY("DOS")=CLAIMNFO("9002313.02",CLAIMIEN_",","401")
  1. I BPSARRY("DOS") S BPSARRY("DOS")=BPSARRY("DOS")-17000000
  1. ;
  1. ; Information needed for PAID/BILLING event
  1. S BPSARRY("PAID")=0
  1. I RESPONSE="PAYABLE"!(RESPONSE="DUPLICATE") D
  1. . ; Patient Pay Amount
  1. . S AMT=$G(RESPNFO(9002313.0301,"1,"_RESPIEN_",",505,"I"))
  1. . I AMT S BPSARRY("PAT RESP")=$$DFF2EXT^BPSECFM(AMT)
  1. . ; Ingredient Cost Paid
  1. . S AMT=$G(RESPNFO(9002313.0301,"1,"_RESPIEN_",",506,"I"))
  1. . I AMT S BPSARRY("ING COST PAID")=$$DFF2EXT^BPSECFM(AMT)
  1. . ; Dispensing Fee Paid
  1. . S AMT=$G(RESPNFO(9002313.0301,"1,"_RESPIEN_",",507,"I"))
  1. . I AMT S BPSARRY("DISP FEE PAID")=$$DFF2EXT^BPSECFM(AMT)
  1. . ; Total Amount Paid
  1. . S BPSARRY("PAID")=$$DFF2EXT^BPSECFM(RESPNFO(9002313.0301,"1,"_RESPIEN_",",509,"I"))
  1. . ; Amount of Copay
  1. . S AMT=$G(RESPNFO(9002313.0301,"1,"_RESPIEN_",",518,"I"))
  1. . I AMT S BPSARRY("COPAY")=$$DFF2EXT^BPSECFM(AMT)
  1. . ;
  1. . S BPSARRY("AUTH #")=RESPNFO(9002313.0301,"1,"_RESPIEN_",",503,"I")
  1. . S BPSARRY("RX NO")=RXINFO(52,RXIEN,.01,"E")
  1. . S BPSARRY("DRUG")=$$RXAPI1^BPSUTIL1(RXIEN,6,"I")
  1. . I FILLNUM<1 S BPSARRY("DAYS SUPPLY")=RXINFO(52,RXIEN,8,"E")
  1. . E S BPSARRY("DAYS SUPPLY")=$G(RFINFO(52.1,FILLNUM,1.1,"E"))
  1. . ; Billing Quantity and Units
  1. . S BPSARRY("QTY")=$G(TRANINFO("9002313.59",TRNDX_",",509,"I"))
  1. . S BPSARRY("UNITS")=$G(TRANINFO("9002313.59",TRNDX_",",510,"I"))
  1. . ; NCPDP Quantity and Units
  1. . S BPSARRY("NCPDP QTY")=$P(CLAIMNFO("9002313.0201","1,"_CLAIMIEN_",","442"),"E7",2)/1000
  1. . S BPSARRY("NCPDP UNITS")=$P(CLAIMNFO("9002313.0201","1,"_CLAIMIEN_",","600"),"28",2)
  1. ;
  1. ; Get primary IB bill# and prior payment amount
  1. I $D(^BPST(TRNDX,10,1,2)) D
  1. . S BPSARRY("PRIMARY BILL")=$P(^BPST(TRNDX,10,1,2),U,8)
  1. . S BPSARRY("PRIOR PAYMENT")=$P(^BPST(TRNDX,10,1,2),U,9)
  1. ;
  1. ; Setup miscellaneous values
  1. S BPSARRY("RXCOB")=$$COB59^BPSUTIL2(TRNDX)
  1. S BPSARRY("NDC")=$$GETNDC^PSONDCUT(RXIEN,FILLNUM)
  1. S BPSARRY("FILL NUMBER")=FILLNUM
  1. S BPSARRY("FILLED BY")=RXINFO(52,RXIEN,16,"I")
  1. S BPSARRY("PRESCRIPTION")=RXIEN
  1. S BPSARRY("BILLED")=$P(CLAIMNFO("9002313.0201","1,"_CLAIMIEN_",","430"),"DU",2)
  1. S BPSARRY("BILLED")=$$DFF2EXT^BPSECFM(BPSARRY("BILLED"))
  1. S BPSARRY("CLAIMID")=$P(CLAIMNFO("9002313.0201","1,"_CLAIMIEN_",","402"),"D2",2)
  1. S BPSARRY("RELEASE DATE")=$S(FILLNUM=0:$$RXAPI1^BPSUTIL1(RXIEN,31,"I"),1:$$RXSUBF1^BPSUTIL1(RXIEN,52,52.1,FILLNUM,17,"I"))
  1. S BPSARRY("RESPONSE")=RESPONSE
  1. S BPSARRY("EPHARM")=$$GET1^DIQ(9002313.59,TRNDX,1.07,"I")
  1. ;
  1. ; If Secondary Claim and Action was ERWV (Resubmit w/o Reversal from ECME User Screen),
  1. ; get the Primary Payer Bill and Prior Payment info from the BPS Log of Transactions
  1. ; entry created during the PRO Option.
  1. I BPSARRY("RXCOB")>1,RXACT="ERWV" D
  1. . S BPS57=""
  1. . F S BPS57=$O(^BPSTL("B",TRNDX,BPS57)) Q:BPS57="" D
  1. . . I $$GET1^DIQ(9002313.57,BPS57,1201)'["P2" Q
  1. . . S BPSARRY("PRIMARY BILL")=$$GET1^DIQ(9002313.57902,"1,"_BPS57,902.3,"I")
  1. . . S BPSARRY("PRIOR PAYMENT")=$$GET1^DIQ(9002313.57902,"1,"_BPS57,902.31)
  1. ;
  1. ; For reversals, get reversal reason and check for closed reason
  1. ; Call IB with Reversal Event
  1. ; If there is a close reason, call IB with CLOSE event
  1. ; and update BPS Claim with close information
  1. I EVENT="",$$ISREVERS^BPSOSU(CLAIMIEN) D Q
  1. . S REQCLAIM=TRANINFO("9002313.59",TRNDX_",",3,"I")
  1. . S BPSARRY("REVERSAL REASON")=TRANINFO("9002313.59",TRNDX_",",404,"I")
  1. . S BPSARRY("RTS-DEL")=0
  1. . ; Get RX action, which determine close event
  1. . I RXACT="RS" S CLREAS="PRESCRIPTION NOT RELEASED",BPSARRY("RTS-DEL")=1
  1. . I RXACT="DE" D
  1. . . S CLREAS="PRESCRIPTION DELETED",BPSARRY("RTS-DEL")=1
  1. . . ; check whether RX was in fact deleted in Pharmacy
  1. . . ; if not then the refill was deleted
  1. . . I $$RXSTATUS^BPSSCRU2(RXIEN)'=13 S BPSARRY("CLOSE COMMENT")="DELETION OF REFILL ONLY - ORIGINAL RX MAY REMAIN ACTIVE"
  1. . ; If accepted inpatient autoreversal, then close the claim
  1. . I RXACT="AREV",RESPONSE="ACCEPTED",REQCLAIM,$P($G(^BPSC(REQCLAIM,0)),U,7)=2 D
  1. .. S CLREAS="INPATIENT RX AUTO-REVERSAL",BPSARRY("CLOSE COMMENT")="INPATIENT PRESCRIPTION"
  1. .. S ELIG=TRANINFO("9002313.59",TRNDX_",",901.04,"I")
  1. .. I ELIG="T"!(ELIG="C") D AUDIT^PSOTRI(RXIEN,FILLNUM,BPSARRY("RXCOB"),$S(ELIG="T":"TRICARE",1:"CHAMPVA")_" INPATIENT AUTO-REVERSAL","I",ELIG)
  1. . I $D(CLREAS) S BPSARRY("CLOSE REASON")=$O(^IBE(356.8,"B",CLREAS,0))
  1. . ;
  1. . ; Call IB for Reversal Event
  1. . S BPSARRY("STATUS")="REVERSED",BILLNUM=$$STORESP^IBNCPDP(DFN,.BPSARRY)
  1. . ; If there is no close reason, quit
  1. . I '$D(BPSARRY("CLOSE REASON")) Q
  1. . ; Call IB for CLOSE event
  1. . ; Note for close, user is always postmaster (.5)
  1. . S BPSARRY("STATUS")="CLOSED",BPSARRY("USER")=.5
  1. . S BILLNUM=$$STORESP^IBNCPDP(DFN,.BPSARRY)
  1. . ;
  1. . ; Populate the original claim request with the close reason
  1. . I REQCLAIM D
  1. .. S DIE="^BPSC(",DA=REQCLAIM
  1. .. S DR="901///1;902///"_$$NOW^XLFDT()_";903////.5;904///"_BPSARRY("CLOSE REASON")
  1. .. D ^DIE
  1. . ; If this is a primary claim, check and send a bulletin if the secondary claim is open or if there
  1. . ; is a non-cancelled IB bill for the secondary claim
  1. . ; NOTE that we only want to do a bulletin for an Inpatient Auto-Reversal or an RX action. If the code
  1. . ; above is modified to create other automatic close events, additional checks may need to be added
  1. . ; before creating the bulletin.
  1. . I BPSARRY("RXCOB")=1 D BULL(RXIEN,FILLNUM,CLAIMIEN,DFN,CLREAS,BPSARRY("CLAIMID"))
  1. ;
  1. ; If we got here, then it is not a reversal
  1. ; If EVENT is set, send Submit event
  1. I EVENT="" S BPSARRY("STATUS")="SUBMITTED",BILLNUM=$$STORESP^IBNCPDP(DFN,.BPSARRY)
  1. ;
  1. ; Sent Paid (Billable) event is the claim was paid and released or EVENT is BILL
  1. ; Note: User is always postmaster except for BackBilling (BB)
  1. I EVENT="BILL"!(RESPONSE="PAYABLE"!(RESPONSE="DUPLICATE")&(BPSARRY("RELEASE DATE")]"")) D
  1. . I RXACT'="BB" S BPSARRY("USER")=.5
  1. . ;set reject flag and store primary plan to serve secondary billing when primary claim was rejected
  1. . I BPSARRY("RXCOB")=2 I $P($$STATUS^BPSOSRX(RXIEN,FILLNUM,,,1),U)["E REJECTED" D
  1. . . N REJS
  1. . . S BPSARRY("PRIMREJ")=1,BPSARRY("PRIMPLAN")=$P(^BPST(+$$IEN59^BPSOSRX(RXIEN,FILLNUM,1),10,1,0),U)
  1. . . D DUR1^BPSNCPD3(RXIEN,FILLNUM,.REJS,"",1)
  1. . . S BPSARRY("REJ CODE LST")=$G(REJS(1,"REJ CODE LST"))
  1. . . M BPSARRY("REJ CODES")=REJS(1,"REJ CODES")
  1. . ;
  1. . S BPSARRY("STATUS")="PAID",BILLNUM=$$STORESP^IBNCPDP(DFN,.BPSARRY)
  1. Q
  1. ;
  1. BULL(RX,FILL,CLAIMIEN,DFN,REASON,ECME) ;
  1. ; Create bulletin to tell OPECC to reverse/close secondary claim
  1. ; Input Parameters
  1. ; RX - Prescription IEN (required)
  1. ; FILL - Fill Number (required)
  1. ; CLAIMIEN - BPS Claims IEN for the primary reversal
  1. ; DFN - Patient IEN
  1. ; REASON - Close Reason
  1. ; ECME - ECME Number
  1. ;
  1. ; Validate parameters
  1. I '$G(RX) Q
  1. I $G(FILL)="" Q
  1. ;
  1. ; Check to see a bulletin needs to be created
  1. I '$$SENDBULL(RX,FILL) Q
  1. ;
  1. N STATION,PRICLAIM,PRIBILL,SECBILL,BPSBILLS,PATNAME,SSN,DOS
  1. N BPSL,BPSX,XMSUB,XMDUZ,XMY,XMTEXT
  1. ;
  1. ; Get Station and Primary claim ID
  1. S STATION=$P($$SITE^VASITE(),U,3) ;IA 10112
  1. S PRICLAIM=$$GET1^DIQ(9002313.02,$G(CLAIMIEN)_",",.01)
  1. ;
  1. ; Get primary and secondary bill number
  1. ; If the bill exists, concatenate the Station number
  1. I $$RXBILL^IBNCPUT3(RX,FILL,"P","",.BPSBILLS)
  1. S PRIBILL=$O(BPSBILLS(""),-1) I PRIBILL S PRIBILL=STATION_"-"_$P(BPSBILLS(PRIBILL),U,1)_" "
  1. K BPSBILLS
  1. I $$RXBILL^IBNCPUT3(RX,FILL,"S","",.BPSBILLS)
  1. S SECBILL=$O(BPSBILLS(""),-1) I SECBILL S SECBILL=STATION_"-"_$P(BPSBILLS(SECBILL),U,1)_" "
  1. ;
  1. ; Get Patient Name and last four digits of the SSN - Supported by IA 10035
  1. I $G(DFN) D
  1. . S PATNAME=$P($G(^DPT(DFN,0)),U,1)
  1. . S SSN=$P($G(^DPT(DFN,0)),U,9)
  1. . S SSN=$E(SSN,$L(SSN)-3,$L(SSN))
  1. ;
  1. ; Get DOS in the correct format
  1. S DOS=$$GET1^DIQ(9002313.02,$G(CLAIMIEN)_",",401)
  1. I DOS S DOS=$E(DOS,5,6)_"/"_$E(DOS,7,8)_"/"_$E(DOS,1,4)
  1. ;
  1. ; Build Body of message
  1. S BPSL=0
  1. S BPSL=BPSL+1,BPSX(BPSL)="Primary claim "_PRIBILL_"(ECME #:"_$G(ECME)_") was closed for the following"
  1. S BPSL=BPSL+1,BPSX(BPSL)="reason: "_$G(REASON)
  1. S BPSL=BPSL+1,BPSX(BPSL)="Secondary claim "_SECBILL_"must be manually closed at this time."
  1. S BPSL=BPSL+1,BPSX(BPSL)=" "
  1. S BPSL=BPSL+1,BPSX(BPSL)="Patient Name: "_$G(PATNAME)_" ("_$G(SSN)_")"
  1. S BPSL=BPSL+1,BPSX(BPSL)="Prescription: "_$$RXAPI1^BPSUTIL1(RX,.01,"E")_" Fill: "_FILL
  1. S BPSL=BPSL+1,BPSX(BPSL)="Drug Name: "_$$RXAPI1^BPSUTIL1(RX,6,"E")
  1. S BPSL=BPSL+1,BPSX(BPSL)="Date of Service: "_DOS
  1. S BPSL=BPSL+1,BPSX(BPSL)="Primary Claim #: "_PRICLAIM
  1. S BPSL=BPSL+1,BPSX(BPSL)="Close Reason (Reason Not Billable): "_$G(REASON)
  1. S BPSL=BPSL+1,BPSX(BPSL)=" "
  1. S BPSL=BPSL+1,BPSX(BPSL)=" "
  1. S BPSL=BPSL+1,BPSX(BPSL)="Note: Depending how the secondary prescription claim was submitted,"
  1. S BPSL=BPSL+1,BPSX(BPSL)="this may require using the ECME User Screen to reverse the payable"
  1. S BPSL=BPSL+1,BPSX(BPSL)="secondary claim or using the correct VistA option to close the paper"
  1. S BPSL=BPSL+1,BPSX(BPSL)="secondary claim."
  1. S BPSL=BPSL+1,BPSX(BPSL)=" "
  1. ;
  1. ; Set variables needed by Mail routines - subject, from, to, body
  1. S XMSUB="ACTION: Close Secondary claim for ECME "_$G(ECME)
  1. S XMDUZ="BPS PACKAGE",XMY("G.BPS OPECC")="",XMTEXT="BPSX("
  1. D ^XMD
  1. Q
  1. ;
  1. SENDBULL(RX,FILL) ;
  1. ; Check if a bulletin should be created, which we want to do if:
  1. ; > There is a non-cancelled IB bill for the secondary claim
  1. ; > There is a open ECME secondary claim
  1. ;
  1. ; Input Parameters
  1. ; RX - Prescription IEN (required)
  1. ; FILL - Fill Number (required)
  1. ; Output
  1. ; 0 - Do not create the bulletin
  1. ; 1 - Create bulletin
  1. ;
  1. ; Validate parameters
  1. I '$G(RX) Q 0
  1. I $G(FILL)="" Q 0
  1. ;
  1. ; If the secondary claim has a non-cancelled bill, create the bulletin
  1. ; This could be true even if there is not a secondary claim in ePharmacy (e.g., for a paper claim)
  1. N BPSBILLS,BILL,ACTIVE,IB
  1. I $$RXBILL^IBNCPUT3(RX,FILL,"S","",.BPSBILLS)
  1. ; Loop through the bills and set ACTIVE flag if any of the bills are not cancelled
  1. S (BILL,ACTIVE)=0 F S BILL=$O(BPSBILLS(BILL)) Q:'BILL!ACTIVE D
  1. . S IB=$G(BPSBILLS(BILL))
  1. . I $P(IB,U,8)'=7,($P(IB,U,2)'="CB"),($P(IB,U,2)'="CN") S ACTIVE=1
  1. I ACTIVE Q 1
  1. ;
  1. ; Do not create the bulletin if the secondary transaction or claim does not exist
  1. N IEN59SEC,CLAIM
  1. S IEN59SEC=$$IEN59^BPSOSRX(RX,FILL,2)
  1. I 'IEN59SEC Q 0
  1. S CLAIM=$P($G(^BPST(IEN59SEC,0)),U,4)
  1. I 'CLAIM Q 0
  1. I '$D(^BPSC(CLAIM)) Q 0
  1. ;
  1. ; Return 1 if the secondary claim is open, 0 if it is closed
  1. Q '$$CLOSED02^BPSSCR03(CLAIM)
  1. ;
  1. DURSYNC(IEN59) ;
  1. ; Synch DURs between ECME and PSO
  1. ; Parameters:
  1. ; IEN59 is the BPS Transaction IEN
  1. N RXIEN,RXFILL
  1. ;
  1. ; Check Parameter
  1. I IEN59="" Q
  1. ;
  1. ; Get Prescription and Fill number
  1. S RXIEN=$$GET1^DIQ(9002313.59,IEN59_",",1.11,"I")
  1. S RXFILL=$$GET1^DIQ(9002313.59902,"1,"_IEN59_",",902.17,"E")
  1. I RXIEN=""!(RXFILL="") Q
  1. ;
  1. ; Call PSO to sync reject codes
  1. D SYNC^PSOREJUT(RXIEN,RXFILL,"",$$COB59^BPSUTIL2(IEN59))
  1. Q
  1. ;
  1. ; Process Other Paid Amount Grouping from the Pricing Segment
  1. ; Note that FDATA, TRANSACT, FDAIEN, and FDAIEN03 are newed
  1. ; and initialized by BPSECMPS
  1. PROCOTH ;
  1. Q:$G(FDATA(TRANSACT,563))=""
  1. N NNDX,FILE,ROOT,FDATA3,FLDNUM
  1. S FILE="9002313.1401"
  1. S ROOT="FDATA3(9002313.1401)"
  1. S NNDX=""
  1. F S NNDX=$O(FDATA(TRANSACT,564,NNDX)) Q:NNDX="" D
  1. .S FLDNUM=.01 D FDA^DILF(FILE,"+"_NNDX_","_FDAIEN03(TRANSACT)_","_FDAIEN(TRANSACT),FLDNUM,"",NNDX,ROOT)
  1. .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)
  1. D UPDATE^DIE("S","FDATA3(9002313.1401)")
  1. Q
  1. ;
  1. ; Process the Benefits Stage fields from the Pricing Segment
  1. ; Note that FDATA, TRANSACT, FDAIEN, and FDAIEN03 are newed
  1. ; and initialized by BPSECMPS
  1. PROCBEN ;
  1. Q:$G(FDATA(TRANSACT,392))=""
  1. N NNDX,FILE,ROOT,FDATA3,FLDNUM
  1. S FILE="9002313.039201"
  1. S ROOT="FDATA3(9002313.039201)"
  1. S NNDX=""
  1. F S NNDX=$O(FDATA(TRANSACT,393,NNDX)) Q:NNDX="" D
  1. .S FLDNUM=.01 D FDA^DILF(FILE,"+"_NNDX_","_FDAIEN03(TRANSACT)_","_FDAIEN(TRANSACT),FLDNUM,"",NNDX,ROOT)
  1. .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)
  1. D UPDATE^DIE("S","FDATA3(9002313.039201)")
  1. Q
  1. ;
  1. ; Process the Additional Message Information Multiple from the Status Segment
  1. ; Note that FDATA, TRANSACT, FDAIEN, and FDAIEN03 are newed
  1. ; and initialized by BPSECMPS
  1. PROCADM ;
  1. N NNDX,FILE,ROOT,FDATA3,FLDNUM,FDATA03,FILE03,ROOT03
  1. S FILE="9002313.13001",ROOT="FDATA3(9002313.13001)"
  1. S FILE03="9002313.0301",ROOT03="FDATA03(9002313.0301)"
  1. S NNDX=""
  1. ; D.0 Processing: 526 is in a multiple with the group 132
  1. I $O(FDATA(TRANSACT,132,0))]"" D Q
  1. . F S NNDX=$O(FDATA(TRANSACT,526,NNDX)) Q:NNDX="" D
  1. . . S FLDNUM=.01 D FDA^DILF(FILE,"+"_NNDX_","_FDAIEN03(TRANSACT)_","_FDAIEN(TRANSACT),FLDNUM,"",NNDX,ROOT)
  1. . . 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)
  1. . D UPDATE^DIE("S","FDATA3(9002313.13001)")
  1. ;
  1. ; 5.1 Processing: 526 is not in a group but is stored in one
  1. I $O(FDATA(TRANSACT,526,0))]"" D Q
  1. . F S NNDX=$O(FDATA(TRANSACT,526,NNDX)) Q:NNDX="" D
  1. . . S FLDNUM=.01 D FDA^DILF(FILE,"+1,"_FDAIEN03(TRANSACT)_","_FDAIEN(TRANSACT),FLDNUM,"",1,ROOT)
  1. . . S FLDNUM=132 D FDA^DILF(FILE,"+1,"_FDAIEN03(TRANSACT)_","_FDAIEN(TRANSACT),FLDNUM,"","01",ROOT)
  1. . . D FDA^DILF(FILE,"+1,"_FDAIEN03(TRANSACT)_","_FDAIEN(TRANSACT),526,"",$G(FDATA(TRANSACT,526,NNDX)),ROOT)
  1. . D UPDATE^DIE("S","FDATA3(9002313.13001)")
  1. . ; Set Additional Message Information Count field
  1. . D FDA^DILF(FILE03,"+"_TRANSACT_","_FDAIEN(TRANSACT),130,"",1,ROOT03)
  1. . D UPDATE^DIE("S","FDATA03(9002313.0301)")
  1. Q
  1. ;
  1. ; Process DUR Response Segment
  1. ; Note that FDATA, TRANSACT, FDAIEN, and FDAIEN03 are newed
  1. ; and initialized by BPSECMPS
  1. PROCDUR ;
  1. Q:$O(FDATA(TRANSACT,567,0))=""
  1. N NNDX,FILE,ROOT,FDAT1101,FLDNUM
  1. S FILE="9002313.1101"
  1. S ROOT="FDAT1101(9002313.1101)"
  1. S NNDX=""
  1. F S NNDX=$O(FDATA(TRANSACT,567,NNDX)) Q:NNDX="" D
  1. .S FLDNUM=".01" D FDA^DILF(FILE,"+"_NNDX_","_FDAIEN03(TRANSACT)_","_FDAIEN(TRANSACT),FLDNUM,"",FDATA(TRANSACT,567,NNDX),ROOT)
  1. .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)
  1. D UPDATE^DIE("S","FDAT1101(9002313.1101)")
  1. Q