Released BPS*1*6 SEQ #6 Extracted from mail message **KIDS**:BPS*1.0*6^ **INSTALL NAME** BPS*1.0*6 "BLD",7433,0) BPS*1.0*6^E CLAIMS MGMT ENGINE^0^3080425^y "BLD",7433,4,0) ^9.64PA^9002313.59^2 "BLD",7433,4,9002313.32,0) 9002313.32 "BLD",7433,4,9002313.32,222) y^y^f^^^^n "BLD",7433,4,9002313.59,0) 9002313.59 "BLD",7433,4,9002313.59,2,0) ^9.641^9002313.59^1 "BLD",7433,4,9002313.59,2,9002313.59,0) BPS TRANSACTION (File-top level) "BLD",7433,4,9002313.59,2,9002313.59,1,0) ^9.6411^901.04^1 "BLD",7433,4,9002313.59,2,9002313.59,1,901.04,0) ELIGIBILITY "BLD",7433,4,9002313.59,222) y^y^p^^^^n^^n "BLD",7433,4,9002313.59,224) "BLD",7433,4,"APDD",9002313.59,9002313.59) "BLD",7433,4,"APDD",9002313.59,9002313.59,901.04) "BLD",7433,4,"B",9002313.32,9002313.32) "BLD",7433,4,"B",9002313.59,9002313.59) "BLD",7433,6.3) 10 "BLD",7433,"INID") n "BLD",7433,"KRN",0) ^9.67PA^8989.52^19 "BLD",7433,"KRN",.4,0) .4 "BLD",7433,"KRN",.401,0) .401 "BLD",7433,"KRN",.402,0) .402 "BLD",7433,"KRN",.403,0) .403 "BLD",7433,"KRN",.5,0) .5 "BLD",7433,"KRN",.84,0) .84 "BLD",7433,"KRN",3.6,0) 3.6 "BLD",7433,"KRN",3.8,0) 3.8 "BLD",7433,"KRN",9.2,0) 9.2 "BLD",7433,"KRN",9.8,0) 9.8 "BLD",7433,"KRN",9.8,"NM",0) ^9.68A^12^12 "BLD",7433,"KRN",9.8,"NM",1,0) BPSECMPS^^0^B69380294 "BLD",7433,"KRN",9.8,"NM",2,0) BPSNCPD2^^0^B37690318 "BLD",7433,"KRN",9.8,"NM",3,0) BPSOSIY^^0^B54076368 "BLD",7433,"KRN",9.8,"NM",4,0) BPSTEST^^0^B48227959 "BLD",7433,"KRN",9.8,"NM",5,0) BPSNCPDP^^0^B71265922 "BLD",7433,"KRN",9.8,"NM",6,0) BPSECMP2^^0^B65371165 "BLD",7433,"KRN",9.8,"NM",7,0) BPSNCPD1^^0^B70088175 "BLD",7433,"KRN",9.8,"NM",8,0) BPS10P6^^0^B1462824 "BLD",7433,"KRN",9.8,"NM",9,0) BPSSCRRV^^0^B16310738 "BLD",7433,"KRN",9.8,"NM",10,0) BPSNCPD3^^0^B16349234 "BLD",7433,"KRN",9.8,"NM",11,0) BPSUTIL^^0^B11432819 "BLD",7433,"KRN",9.8,"NM",12,0) BPSNCPD4^^0^B4013558 "BLD",7433,"KRN",9.8,"NM","B","BPS10P6",8) "BLD",7433,"KRN",9.8,"NM","B","BPSECMP2",6) "BLD",7433,"KRN",9.8,"NM","B","BPSECMPS",1) "BLD",7433,"KRN",9.8,"NM","B","BPSNCPD1",7) "BLD",7433,"KRN",9.8,"NM","B","BPSNCPD2",2) "BLD",7433,"KRN",9.8,"NM","B","BPSNCPD3",10) "BLD",7433,"KRN",9.8,"NM","B","BPSNCPD4",12) "BLD",7433,"KRN",9.8,"NM","B","BPSNCPDP",5) "BLD",7433,"KRN",9.8,"NM","B","BPSOSIY",3) "BLD",7433,"KRN",9.8,"NM","B","BPSSCRRV",9) "BLD",7433,"KRN",9.8,"NM","B","BPSTEST",4) "BLD",7433,"KRN",9.8,"NM","B","BPSUTIL",11) "BLD",7433,"KRN",19,0) 19 "BLD",7433,"KRN",19.1,0) 19.1 "BLD",7433,"KRN",101,0) 101 "BLD",7433,"KRN",409.61,0) 409.61 "BLD",7433,"KRN",771,0) 771 "BLD",7433,"KRN",870,0) 870 "BLD",7433,"KRN",8989.51,0) 8989.51 "BLD",7433,"KRN",8989.52,0) 8989.52 "BLD",7433,"KRN",8994,0) 8994 "BLD",7433,"KRN","B",.4,.4) "BLD",7433,"KRN","B",.401,.401) "BLD",7433,"KRN","B",.402,.402) "BLD",7433,"KRN","B",.403,.403) "BLD",7433,"KRN","B",.5,.5) "BLD",7433,"KRN","B",.84,.84) "BLD",7433,"KRN","B",3.6,3.6) "BLD",7433,"KRN","B",3.8,3.8) "BLD",7433,"KRN","B",9.2,9.2) "BLD",7433,"KRN","B",9.8,9.8) "BLD",7433,"KRN","B",19,19) "BLD",7433,"KRN","B",19.1,19.1) "BLD",7433,"KRN","B",101,101) "BLD",7433,"KRN","B",409.61,409.61) "BLD",7433,"KRN","B",771,771) "BLD",7433,"KRN","B",870,870) "BLD",7433,"KRN","B",8989.51,8989.51) "BLD",7433,"KRN","B",8989.52,8989.52) "BLD",7433,"KRN","B",8994,8994) "BLD",7433,"PRE") BPS10P6 "BLD",7433,"QUES",0) ^9.62^^ "BLD",7433,"REQB",0) ^9.611^1^1 "BLD",7433,"REQB",1,0) BPS*1.0*5^2 "BLD",7433,"REQB","B","BPS*1.0*5",1) "FIA",9002313.32) BPS PAYER RESPONSE OVERRIDES "FIA",9002313.32,0) ^BPS(9002313.32, "FIA",9002313.32,0,0) 9002313.32 "FIA",9002313.32,0,1) y^y^f^^^^n "FIA",9002313.32,0,10) "FIA",9002313.32,0,11) "FIA",9002313.32,0,"RLRO") "FIA",9002313.32,0,"VR") 1.0^BPS "FIA",9002313.32,9002313.32) 0 "FIA",9002313.32,9002313.321) 0 "FIA",9002313.59) BPS TRANSACTION "FIA",9002313.59,0) ^BPST( "FIA",9002313.59,0,0) 9002313.59O "FIA",9002313.59,0,1) y^y^p^^^^n^^n "FIA",9002313.59,0,10) "FIA",9002313.59,0,11) "FIA",9002313.59,0,"RLRO") "FIA",9002313.59,0,"VR") 1.0^BPS "FIA",9002313.59,9002313.59) 1 "FIA",9002313.59,9002313.59,901.04) "MBREQ") 0 "PKG",570,-1) 1^1 "PKG",570,0) E CLAIMS MGMT ENGINE^BPS^ELECTRONIC CLAIMS MGT "PKG",570,22,0) ^9.49I^1^1 "PKG",570,22,1,0) 1.0^3041008^3041108^66481 "PKG",570,22,1,"PAH",1,0) 6^3080425 "PRE") BPS10P6 "QUES","XPF1",0) Y "QUES","XPF1","??") ^D REP^XPDH "QUES","XPF1","A") Shall I write over your |FLAG| File "QUES","XPF1","B") YES "QUES","XPF1","M") D XPF1^XPDIQ "QUES","XPF2",0) Y "QUES","XPF2","??") ^D DTA^XPDH "QUES","XPF2","A") Want my data |FLAG| yours "QUES","XPF2","B") YES "QUES","XPF2","M") D XPF2^XPDIQ "QUES","XPI1",0) YO "QUES","XPI1","??") ^D INHIBIT^XPDH "QUES","XPI1","A") Want KIDS to INHIBIT LOGONs during the install "QUES","XPI1","B") NO "QUES","XPI1","M") D XPI1^XPDIQ "QUES","XPM1",0) PO^VA(200,:EM "QUES","XPM1","??") ^D MG^XPDH "QUES","XPM1","A") Enter the Coordinator for Mail Group '|FLAG|' "QUES","XPM1","B") "QUES","XPM1","M") D XPM1^XPDIQ "QUES","XPO1",0) Y "QUES","XPO1","??") ^D MENU^XPDH "QUES","XPO1","A") Want KIDS to Rebuild Menu Trees Upon Completion of Install "QUES","XPO1","B") NO "QUES","XPO1","M") D XPO1^XPDIQ "QUES","XPZ1",0) Y "QUES","XPZ1","??") ^D OPT^XPDH "QUES","XPZ1","A") Want to DISABLE Scheduled Options, Menu Options, and Protocols "QUES","XPZ1","B") NO "QUES","XPZ1","M") D XPZ1^XPDIQ "QUES","XPZ2",0) Y "QUES","XPZ2","??") ^D RTN^XPDH "QUES","XPZ2","A") Want to MOVE routines to other CPUs "QUES","XPZ2","B") NO "QUES","XPZ2","M") D XPZ2^XPDIQ "RTN") 12 "RTN","BPS10P6") 0^8^B1462824^n/a "RTN","BPS10P6",1,0) BPS10P6 ;OAK/ELZ - ENVIORNMENT CHECK FOR BPS*1*6 ;11/14/07 17:56 "RTN","BPS10P6",2,0) ;;1.0;E CLAIMS MGMT ENGINE;**6**;JUN 2004;Build 10 "RTN","BPS10P6",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","BPS10P6",4,0) ; "RTN","BPS10P6",5,0) ; environment check for BPS*1*6 "RTN","BPS10P6",6,0) ; this check will make sure the post install from the previous BPS*1*5 completed "RTN","BPS10P6",7,0) ; if it did not complete this patch will not be installed "RTN","BPS10P6",8,0) ; "RTN","BPS10P6",9,0) I $D(^DD(9002313.992389,0)) D "RTN","BPS10P6",10,0) . W !,"WRITE OFF SELF PAY field of BPS SETUP file exists!!!!",! "RTN","BPS10P6",11,0) . W !,"You should log a Remedy ticket and contact EPS, the post install from patch" "RTN","BPS10P6",12,0) . W !,"BPS*1*5 did not complete, you will need to run EN1^BPS01P5 to complete the" "RTN","BPS10P6",13,0) . W !,"post install before you can install this patch." "RTN","BPS10P6",14,0) . S XPDABORT=1 "RTN","BPS10P6",15,0) Q "RTN","BPS10P6",16,0) ; "RTN","BPSECMP2") 0^6^B65371165^B64422717 "RTN","BPSECMP2",1,0) BPSECMP2 ;BHAM ISC/FCS/DRS - Parse Claim Response ;11/14/07 13:23 "RTN","BPSECMP2",2,0) ;;1.0;E CLAIMS MGMT ENGINE;**1,5,6**;JUN 2004;Build 10 "RTN","BPSECMP2",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","BPSECMP2",4,0) ;Reference to STORESP^IBNCPDP supported by DBIA 4299 "RTN","BPSECMP2",5,0) Q "RTN","BPSECMP2",6,0) ; Parameters: "RTN","BPSECMP2",7,0) ; CLAIMIEN: IEN from BPS Claims "RTN","BPSECMP2",8,0) ; RESPIEN: IEN from BPS Response "RTN","BPSECMP2",9,0) ; EVENT: This is used by PSO to create specific events (BILL). "RTN","BPSECMP2",10,0) ; USER: User who is creating the event. This is required when EVENT is sent. "RTN","BPSECMP2",11,0) IBSEND(CLAIMIEN,RESPIEN,EVENT,USER) ; "RTN","BPSECMP2",12,0) N BPSARRY,RXIEN,FILLNUM,IND,TRNDX,RELDATE,X,Y,%DT "RTN","BPSECMP2",13,0) N CLAIMNFO,RESPNFO,RXINFO,RFINFO,TRANINFO "RTN","BPSECMP2",14,0) N RESPONSE,RXACT,CLREAS,BILLNUM,DFN,REQCLAIM "RTN","BPSECMP2",15,0) N DIE,DA,DR "RTN","BPSECMP2",16,0) ; "RTN","BPSECMP2",17,0) ; Quit if there is not a Response or Claim IEN "RTN","BPSECMP2",18,0) I '$G(RESPIEN) Q "RTN","BPSECMP2",19,0) I '$G(CLAIMIEN) Q "RTN","BPSECMP2",20,0) ; "RTN","BPSECMP2",21,0) ; Get Claims and Response Data "RTN","BPSECMP2",22,0) D GETS^DIQ("9002313.02",CLAIMIEN,"103;400*;401;402;403;426","","CLAIMNFO") "RTN","BPSECMP2",23,0) D GETS^DIQ("9002313.0301","1,"_RESPIEN,"112;503;509;518","I","RESPNFO") "RTN","BPSECMP2",24,0) ; "RTN","BPSECMP2",25,0) ; Get the Transaction IEN and Data "RTN","BPSECMP2",26,0) S IND=$S(CLAIMNFO("9002313.02",CLAIMIEN_",","103")="B2":"AER",1:"AE") "RTN","BPSECMP2",27,0) S TRNDX=$O(^BPST(IND,CLAIMIEN,"")) "RTN","BPSECMP2",28,0) I TRNDX="" Q "RTN","BPSECMP2",29,0) D GETS^DIQ("9002313.59",TRNDX,"3;13;404;501;1201","I","TRANINFO") "RTN","BPSECMP2",30,0) ; "RTN","BPSECMP2",31,0) ; Determine Prescription IEN "RTN","BPSECMP2",32,0) S RXIEN=$P(^BPSC(CLAIMIEN,400,1,0),"^",5) "RTN","BPSECMP2",33,0) ; "RTN","BPSECMP2",34,0) ; If Certify Mode is On, don't send to IB "RTN","BPSECMP2",35,0) I $$GET1^DIQ(9002313.59902,"1,"_TRNDX_",","902.22")["MODE ON" Q "RTN","BPSECMP2",36,0) ; "RTN","BPSECMP2",37,0) ; Testing for Certification Only - DLF "RTN","BPSECMP2",38,0) I $$RXAPI1^BPSUTIL1(RXIEN,.01)="" Q "RTN","BPSECMP2",39,0) ; "RTN","BPSECMP2",40,0) ; Store RXACT into a local variable as it is will be used a lot "RTN","BPSECMP2",41,0) S RXACT=TRANINFO("9002313.59",TRNDX_",",1201,"I") "RTN","BPSECMP2",42,0) ; "RTN","BPSECMP2",43,0) ; Setup User data "RTN","BPSECMP2",44,0) ; If event is passed in, the user should be passed in as well "RTN","BPSECMP2",45,0) ; If no Event, but action is Auto-Reversal (AREV) or CMOP (CR*/PC/RL), "RTN","BPSECMP2",46,0) ; user postmaster (.5) "RTN","BPSECMP2",47,0) ; Else use the user from BPS Transaction "RTN","BPSECMP2",48,0) I EVENT]"" S BPSARRY("USER")=USER "RTN","BPSECMP2",49,0) E I ",AREV,CRLB,CRLX,CRLR,PC,RL,"[(","_RXACT_",") S BPSARRY("USER")=.5 "RTN","BPSECMP2",50,0) E S BPSARRY("USER")=TRANINFO("9002313.59",TRNDX_",",13,"I") "RTN","BPSECMP2",51,0) ; "RTN","BPSECMP2",52,0) ; Determine Payer Response "RTN","BPSECMP2",53,0) ; Treat Duplicate of Accepted Reversal ("S") as accepted "RTN","BPSECMP2",54,0) S RESPONSE=RESPNFO(9002313.0301,"1,"_RESPIEN_",",112,"I") "RTN","BPSECMP2",55,0) S RESPONSE=$S(RESPONSE="A":"ACCEPTED",RESPONSE="C":"CAPTURED",RESPONSE="D":"DUPLICATE",RESPONSE="P":"PAYABLE",RESPONSE="R":"REJECTED",RESPONSE="S":"ACCEPTED",1:"OTHER") "RTN","BPSECMP2",56,0) ; "RTN","BPSECMP2",57,0) ; Get Prescription Information "RTN","BPSECMP2",58,0) D RXAPI^BPSUTIL1(RXIEN,".01;4;6;8;16;27","RXINFO","IE") "RTN","BPSECMP2",59,0) ; "RTN","BPSECMP2",60,0) ; Get Refill Info if this is a refill "RTN","BPSECMP2",61,0) S FILLNUM=+$E($P(TRNDX,".",2),1,4) "RTN","BPSECMP2",62,0) I FILLNUM>0 D RXSUBF^BPSUTIL1(RXIEN,52,52.1,FILLNUM,".01;1.1;11","RFINFO","E") "RTN","BPSECMP2",63,0) ; "RTN","BPSECMP2",64,0) ; Fill Date "RTN","BPSECMP2",65,0) S BPSARRY("FILL DATE")=CLAIMNFO("9002313.0201","1,"_CLAIMIEN_",","401") "RTN","BPSECMP2",66,0) S %DT="X",X=BPSARRY("FILL DATE") D ^%DT S:Y'=-1 BPSARRY("FILL DATE")=Y "RTN","BPSECMP2",67,0) ; "RTN","BPSECMP2",68,0) ; Information needed for PAID/BILLING event "RTN","BPSECMP2",69,0) S BPSARRY("PAID")=0 "RTN","BPSECMP2",70,0) I RESPONSE="PAYABLE" D "RTN","BPSECMP2",71,0) . S BPSARRY("PAID")=$$DFF2EXT^BPSECFM(RESPNFO(9002313.0301,"1,"_RESPIEN_",",509,"I")) "RTN","BPSECMP2",72,0) . S BPSARRY("COPAY")=$$DFF2EXT^BPSECFM(RESPNFO(9002313.0301,"1,"_RESPIEN_",",518,"I")) "RTN","BPSECMP2",73,0) . S BPSARRY("AUTH #")=RESPNFO(9002313.0301,"1,"_RESPIEN_",",503,"I") "RTN","BPSECMP2",74,0) . S BPSARRY("RX NO")=RXINFO(52,RXIEN,.01,"E") "RTN","BPSECMP2",75,0) . S BPSARRY("DRUG")=$$RXAPI1^BPSUTIL1(RXIEN,6,"I") "RTN","BPSECMP2",76,0) . S BPSARRY("QTY")=$G(TRANINFO(9002313.59,TRNDX_",",501,"I")) "RTN","BPSECMP2",77,0) . I FILLNUM<1 D "RTN","BPSECMP2",78,0) .. S BPSARRY("DAYS SUPPLY")=RXINFO(52,RXIEN,8,"E") "RTN","BPSECMP2",79,0) . E D "RTN","BPSECMP2",80,0) .. S BPSARRY("DAYS SUPPLY")=$G(RFINFO(52.1,FILLNUM,1.1,"E")) "RTN","BPSECMP2",81,0) ; "RTN","BPSECMP2",82,0) ; Get Plan info "RTN","BPSECMP2",83,0) I $D(^BPST(TRNDX,10,1,0)) S BPSARRY("PLAN")=$P(^BPST(TRNDX,10,1,0),"^") "RTN","BPSECMP2",84,0) ; "RTN","BPSECMP2",85,0) ; Setup miscellaneous values "RTN","BPSECMP2",86,0) S DFN=$$RXAPI1^BPSUTIL1(RXIEN,2,"I") "RTN","BPSECMP2",87,0) S BPSARRY("NDC")=$$GETNDC^PSONDCUT(RXIEN,FILLNUM) "RTN","BPSECMP2",88,0) S BPSARRY("FILL NUMBER")=FILLNUM "RTN","BPSECMP2",89,0) S BPSARRY("FILLED BY")=RXINFO(52,RXIEN,16,"I") "RTN","BPSECMP2",90,0) S BPSARRY("PRESCRIPTION")=RXIEN "RTN","BPSECMP2",91,0) S BPSARRY("BILLED")=$P(CLAIMNFO("9002313.0201","1,"_CLAIMIEN_",","426"),"DQ",2) "RTN","BPSECMP2",92,0) S BPSARRY("BILLED")=$$DFF2EXT^BPSECFM(BPSARRY("BILLED")) "RTN","BPSECMP2",93,0) S BPSARRY("CLAIMID")=$P(CLAIMNFO("9002313.0201","1,"_CLAIMIEN_",","402"),"D2",2) "RTN","BPSECMP2",94,0) S RELDATE=$S(FILLNUM=0:$$RXAPI1^BPSUTIL1(RXIEN,31,"I"),1:$$RXSUBF1^BPSUTIL1(RXIEN,52,52.1,FILLNUM,17,"I")) "RTN","BPSECMP2",95,0) S BPSARRY("RELEASE DATE")=$P(RELDATE,".") "RTN","BPSECMP2",96,0) S BPSARRY("RESPONSE")=RESPONSE "RTN","BPSECMP2",97,0) S BPSARRY("EPHARM")=$$GET1^DIQ(9002313.59,TRNDX,1.07,"I") "RTN","BPSECMP2",98,0) ; "RTN","BPSECMP2",99,0) ; For reversals, get reversal reason and check for closed reason "RTN","BPSECMP2",100,0) ; Call IB with Reversal Event "RTN","BPSECMP2",101,0) ; If there is a close reason, call IB with CLOSE event "RTN","BPSECMP2",102,0) ; and update BPS Claim with close information "RTN","BPSECMP2",103,0) I EVENT="",$$ISREVERS^BPSOSU(CLAIMIEN) D Q "RTN","BPSECMP2",104,0) . S REQCLAIM=TRANINFO("9002313.59",TRNDX_",",3,"I") "RTN","BPSECMP2",105,0) . S BPSARRY("REVERSAL REASON")=TRANINFO("9002313.59",TRNDX_",",404,"I") "RTN","BPSECMP2",106,0) . S BPSARRY("RTS-DEL")=0 "RTN","BPSECMP2",107,0) . ; Get RX action, which determine close event "RTN","BPSECMP2",108,0) . I RXACT="RS" S CLREAS="PRESCRIPTION NOT RELEASED",BPSARRY("RTS-DEL")=1 "RTN","BPSECMP2",109,0) . I RXACT="DE" D "RTN","BPSECMP2",110,0) . . S CLREAS="PRESCRIPTION DELETED",BPSARRY("RTS-DEL")=1 "RTN","BPSECMP2",111,0) . . ; check whether RX was in fact deleted in Pharmacy "RTN","BPSECMP2",112,0) . . ; if not then the refill was deleted "RTN","BPSECMP2",113,0) . . I $$RXSTATUS^BPSSCRU2(RXIEN)'=13 S BPSARRY("CLOSE COMMENT")="DELETION OF REFILL ONLY - ORIGINAL RX MAY REMAIN ACTIVE" "RTN","BPSECMP2",114,0) . ; If accepted inpatient autoreversal, then close the claim "RTN","BPSECMP2",115,0) . I RXACT="AREV",RESPONSE="ACCEPTED",REQCLAIM,$P($G(^BPSC(REQCLAIM,0)),U,7)=2 D "RTN","BPSECMP2",116,0) .. S CLREAS="OTHER",BPSARRY("CLOSE COMMENT")="INPATIENT PRESCRIPTION" "RTN","BPSECMP2",117,0) . I $D(CLREAS) S BPSARRY("CLOSE REASON")=$O(^IBE(356.8,"B",CLREAS,0)) "RTN","BPSECMP2",118,0) . ; "RTN","BPSECMP2",119,0) . ; Call IB for Reversal Event "RTN","BPSECMP2",120,0) . S BPSARRY("STATUS")="REVERSED",BILLNUM=$$STORESP^IBNCPDP(DFN,.BPSARRY) "RTN","BPSECMP2",121,0) . ; If there is no close reason, quit "RTN","BPSECMP2",122,0) . I '$D(BPSARRY("CLOSE REASON")) Q "RTN","BPSECMP2",123,0) . ; Call IB for CLOSE event "RTN","BPSECMP2",124,0) . ; Note for close, user is always postmaster (.5) "RTN","BPSECMP2",125,0) . S BPSARRY("STATUS")="CLOSED",BPSARRY("USER")=.5 "RTN","BPSECMP2",126,0) . S BILLNUM=$$STORESP^IBNCPDP(DFN,.BPSARRY) "RTN","BPSECMP2",127,0) . ; "RTN","BPSECMP2",128,0) . ; Populate the original claim request with the close reason "RTN","BPSECMP2",129,0) . I REQCLAIM D "RTN","BPSECMP2",130,0) .. S DIE="^BPSC(",DA=REQCLAIM "RTN","BPSECMP2",131,0) .. S DR="901///1;902///"_$$NOW^XLFDT()_";903///.5;904///"_BPSARRY("CLOSE REASON") "RTN","BPSECMP2",132,0) .. D ^DIE "RTN","BPSECMP2",133,0) ; "RTN","BPSECMP2",134,0) ; If we got here, then it is not a reversal "RTN","BPSECMP2",135,0) ; If EVENT is set, send Submit event "RTN","BPSECMP2",136,0) I EVENT="" S BPSARRY("STATUS")="SUBMITTED",BILLNUM=$$STORESP^IBNCPDP(DFN,.BPSARRY) "RTN","BPSECMP2",137,0) ; "RTN","BPSECMP2",138,0) ; Sent Paid (Billable) event is the claim was paid and released or EVENT is BILL "RTN","BPSECMP2",139,0) ; Note: User is always postmaster except for BackBilling (BB) "RTN","BPSECMP2",140,0) I EVENT="BILL"!(RESPONSE="PAYABLE"&(BPSARRY("RELEASE DATE")]"")) D "RTN","BPSECMP2",141,0) . I RXACT'="BB" S BPSARRY("USER")=.5 "RTN","BPSECMP2",142,0) . S BPSARRY("STATUS")="PAID",BILLNUM=$$STORESP^IBNCPDP(DFN,.BPSARRY) "RTN","BPSECMP2",143,0) Q "RTN","BPSECMP2",144,0) ; "RTN","BPSECMP2",145,0) ; Synch DURs between ECME and PSO "RTN","BPSECMP2",146,0) ; Parameters: "RTN","BPSECMP2",147,0) ; IEN59 is the BPS Transaction IEN "RTN","BPSECMP2",148,0) DURSYNC(IEN59) ; "RTN","BPSECMP2",149,0) N RXIEN,RXFILL "RTN","BPSECMP2",150,0) ; "RTN","BPSECMP2",151,0) ; Check Parameter "RTN","BPSECMP2",152,0) I IEN59="" Q "RTN","BPSECMP2",153,0) ; "RTN","BPSECMP2",154,0) ; Get Prescription and Fill number "RTN","BPSECMP2",155,0) S RXIEN=$$GET1^DIQ(9002313.59,IEN59_",",1.11,"I") "RTN","BPSECMP2",156,0) S RXFILL=$$GET1^DIQ(9002313.59902,"1,"_IEN59_",",902.17,"E") "RTN","BPSECMP2",157,0) I RXIEN=""!(RXFILL="") Q "RTN","BPSECMP2",158,0) ; "RTN","BPSECMP2",159,0) ; Call PSO to sync reject codes "RTN","BPSECMP2",160,0) D SYNC^PSOREJUT(RXIEN,RXFILL,"") "RTN","BPSECMP2",161,0) Q "RTN","BPSECMP2",162,0) ; "RTN","BPSECMP2",163,0) PROCOTH ; "RTN","BPSECMP2",164,0) Q:$G(FDATA(TRANSACT,563.01,1))="" "RTN","BPSECMP2",165,0) N NNDX,FILE,ROOT,FDATA3,FLDNUM "RTN","BPSECMP2",166,0) S FILE="9002313.1401" "RTN","BPSECMP2",167,0) S ROOT="FDATA3(9002313.1401)" "RTN","BPSECMP2",168,0) S NNDX="" "RTN","BPSECMP2",169,0) F S NNDX=$O(FDATA(FDAIEN(TRANSACT),563.01,NNDX)) Q:NNDX="" D "RTN","BPSECMP2",170,0) .S FLDNUM=".01" D FDA^DILF(FILE,"+"_NNDX_","_FDAIEN03(TRANSACT)_","_FDAIEN(TRANSACT),FLDNUM,"",FDATA(TRANSACT,563.01,NNDX),ROOT) "RTN","BPSECMP2",171,0) D UPDATE^DIE("S","FDATA3(9002313.1401)") "RTN","BPSECMP2",172,0) Q "RTN","BPSECMP2",173,0) PROCDUR ; "RTN","BPSECMP2",174,0) Q:$G(FDATA(TRANSACT,567,1))="" "RTN","BPSECMP2",175,0) N NNDX,FILE,ROOT,FDAT1101,FLDNUM "RTN","BPSECMP2",176,0) S FILE="9002313.1101" "RTN","BPSECMP2",177,0) S ROOT="FDAT1101(9002313.1101)" "RTN","BPSECMP2",178,0) S NNDX="" "RTN","BPSECMP2",179,0) F S NNDX=$O(FDATA(TRANSACT,567,NNDX)) Q:NNDX="" D "RTN","BPSECMP2",180,0) .S FLDNUM=".01" D FDA^DILF(FILE,"+"_NNDX_","_FDAIEN03(TRANSACT)_","_FDAIEN(TRANSACT),FLDNUM,"",FDATA(TRANSACT,567,NNDX),ROOT) "RTN","BPSECMP2",181,0) .I $D(FDATA(TRANSACT,439,NNDX)) D "RTN","BPSECMP2",182,0) ..S FLDNUM="439" "RTN","BPSECMP2",183,0) ..D FDA^DILF(FILE,"+"_NNDX_","_FDAIEN03(TRANSACT)_","_FDAIEN(TRANSACT),FLDNUM,"",FDATA(TRANSACT,439,NNDX),ROOT) "RTN","BPSECMP2",184,0) .I $D(FDATA(TRANSACT,528,NNDX)) D "RTN","BPSECMP2",185,0) ..S FLDNUM="528" "RTN","BPSECMP2",186,0) ..D FDA^DILF(FILE,"+"_NNDX_","_FDAIEN03(TRANSACT)_","_FDAIEN(TRANSACT),FLDNUM,"",FDATA(TRANSACT,528,NNDX),ROOT) "RTN","BPSECMP2",187,0) .I $D(FDATA(TRANSACT,529,NNDX)) D "RTN","BPSECMP2",188,0) ..S FLDNUM="529" "RTN","BPSECMP2",189,0) ..D FDA^DILF(FILE,"+"_NNDX_","_FDAIEN03(TRANSACT)_","_FDAIEN(TRANSACT),FLDNUM,"",FDATA(TRANSACT,529,NNDX),ROOT) "RTN","BPSECMP2",190,0) .I $D(FDATA(TRANSACT,530,NNDX)) D "RTN","BPSECMP2",191,0) ..S FLDNUM="530" "RTN","BPSECMP2",192,0) ..D FDA^DILF(FILE,"+"_NNDX_","_FDAIEN03(TRANSACT)_","_FDAIEN(TRANSACT),FLDNUM,"",FDATA(TRANSACT,530,NNDX),ROOT) "RTN","BPSECMP2",193,0) .I $D(FDATA(TRANSACT,531,NNDX)) D "RTN","BPSECMP2",194,0) ..S FLDNUM="531" "RTN","BPSECMP2",195,0) ..D FDA^DILF(FILE,"+"_NNDX_","_FDAIEN03(TRANSACT)_","_FDAIEN(TRANSACT),FLDNUM,"",FDATA(TRANSACT,531,NNDX),ROOT) "RTN","BPSECMP2",196,0) .I $D(FDATA(TRANSACT,532,NNDX)) D "RTN","BPSECMP2",197,0) ..S FLDNUM="532" "RTN","BPSECMP2",198,0) ..D FDA^DILF(FILE,"+"_NNDX_","_FDAIEN03(TRANSACT)_","_FDAIEN(TRANSACT),FLDNUM,"",FDATA(TRANSACT,532,NNDX),ROOT) "RTN","BPSECMP2",199,0) .I $D(FDATA(TRANSACT,533,NNDX)) D "RTN","BPSECMP2",200,0) ..S FLDNUM="533" "RTN","BPSECMP2",201,0) ..D FDA^DILF(FILE,"+"_NNDX_","_FDAIEN03(TRANSACT)_","_FDAIEN(TRANSACT),FLDNUM,"",FDATA(TRANSACT,533,NNDX),ROOT) "RTN","BPSECMP2",202,0) .I $D(FDATA(TRANSACT,544,NNDX)) D "RTN","BPSECMP2",203,0) ..S FLDNUM="544" "RTN","BPSECMP2",204,0) ..D FDA^DILF(FILE,"+"_NNDX_","_FDAIEN03(TRANSACT)_","_FDAIEN(TRANSACT),FLDNUM,"",FDATA(TRANSACT,544,NNDX),ROOT) "RTN","BPSECMP2",205,0) D UPDATE^DIE("S","FDAT1101(9002313.1101)") "RTN","BPSECMP2",206,0) Q "RTN","BPSECMPS") 0^1^B69380294^B69163590 "RTN","BPSECMPS",1,0) BPSECMPS ;BHAM ISC/FCS/DRS - Parse Claim Response ;06/15/2004 "RTN","BPSECMPS",2,0) ;;1.0;E CLAIMS MGMT ENGINE;**1,2,5,6**;JUN 2004;Build 10 "RTN","BPSECMPS",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","BPSECMPS",4,0) ; "RTN","BPSECMPS",5,0) PARSE(RREC,CLAIMIEN,RESPIEN) ; "RTN","BPSECMPS",6,0) N GS,FS,SS,FILE,ROOT,TRANSACT,TRANSCNT "RTN","BPSECMPS",7,0) N FDATA,FDAIEN,FDAIEN03 "RTN","BPSECMPS",8,0) ; "RTN","BPSECMPS",9,0) ;Make sure input variables are defined "RTN","BPSECMPS",10,0) Q:$G(RREC)="" "RTN","BPSECMPS",11,0) Q:$G(CLAIMIEN)="" "RTN","BPSECMPS",12,0) ; "RTN","BPSECMPS",13,0) ;group and field separator characters "RTN","BPSECMPS",14,0) S GS="\X1D\",FS="\X1C\",SS="\X1E\" "RTN","BPSECMPS",15,0) S FILE="9002313.03" "RTN","BPSECMPS",16,0) S ROOT="FDATA(9002313.03)" "RTN","BPSECMPS",17,0) D TRANSMSN ;process the transmission level data "RTN","BPSECMPS",18,0) D TRANSACT ;process the transaction level data "RTN","BPSECMPS",19,0) ; "RTN","BPSECMPS",20,0) ; If test system and test active, call the override routine "RTN","BPSECMPS",21,0) ; IEN59 and TRANTYPE are set in BPSECMC2 "RTN","BPSECMPS",22,0) ; "RTN","BPSECMPS",23,0) I $$CHECK^BPSTEST D SETOVER^BPSTEST(IEN59,TRANTYPE,.FDATA) "RTN","BPSECMPS",24,0) D UPDATE^DIE("S","FDATA(9002313.03)","FDAIEN") "RTN","BPSECMPS",25,0) F TRANSACT=1:1:TRANSCNT D "RTN","BPSECMPS",26,0) .D PROCRESP "RTN","BPSECMPS",27,0) .D PROCREJ "RTN","BPSECMPS",28,0) .D PROCAPP "RTN","BPSECMPS",29,0) .D PROCPPR "RTN","BPSECMPS",30,0) .D PROCOTH^BPSECMP2 "RTN","BPSECMPS",31,0) .D PROCDUR^BPSECMP2 "RTN","BPSECMPS",32,0) .S RESPIEN=FDAIEN(TRANSACT) "RTN","BPSECMPS",33,0) .D IBSEND^BPSECMP2(CLAIMIEN,RESPIEN,"","") "RTN","BPSECMPS",34,0) Q "RTN","BPSECMPS",35,0) ; "RTN","BPSECMPS",36,0) TRANSMSN ;This subroutine will work through the transmission level information "RTN","BPSECMPS",37,0) ; "RTN","BPSECMPS",38,0) N RTRANM,RHEADER,SEG,SEGMENT,SEGID "RTN","BPSECMPS",39,0) ; "RTN","BPSECMPS",40,0) ;Parse response transmission level from ascii record "RTN","BPSECMPS",41,0) S RTRANM=$P(RREC,GS,1) "RTN","BPSECMPS",42,0) ; "RTN","BPSECMPS",43,0) ; get just the header segment "RTN","BPSECMPS",44,0) S RHEADER=$P(RTRANM,SS,1) ;header- required/fixed length "RTN","BPSECMPS",45,0) D PARSEH "RTN","BPSECMPS",46,0) ; "RTN","BPSECMPS",47,0) ; There are 2 optional segments on the transmission level - message "RTN","BPSECMPS",48,0) ; and insurance. We'll check for both and parse what we find. "RTN","BPSECMPS",49,0) F SEG=2:1:3 D "RTN","BPSECMPS",50,0) . S SEGMENT=$P(RTRANM,SS,SEG) "RTN","BPSECMPS",51,0) . Q:SEGMENT="" "RTN","BPSECMPS",52,0) . S SEGID=$P(SEGMENT,FS,2) "RTN","BPSECMPS",53,0) . I $E(SEGID,1,2)="AM" D ;segment identification "RTN","BPSECMPS",54,0) .. S SEGFID=$E(SEGID,3,4) "RTN","BPSECMPS",55,0) .. D:(SEGFID=20)!(SEGFID=25) PARSETM "RTN","BPSECMPS",56,0) ; "RTN","BPSECMPS",57,0) Q "RTN","BPSECMPS",58,0) ; "RTN","BPSECMPS",59,0) TRANSACT ;This subroutine will work through the transaction level information "RTN","BPSECMPS",60,0) ; "RTN","BPSECMPS",61,0) N RTRAN,SEG,SEGMENT,MEDN,GRP "RTN","BPSECMPS",62,0) S MEDN=0 "RTN","BPSECMPS",63,0) ; "RTN","BPSECMPS",64,0) F GRP=2:1 D Q:RTRAN="" "RTN","BPSECMPS",65,0) . S RTRAN=$P(RREC,GS,GRP) ;get the next transaction (could be 4) "RTN","BPSECMPS",66,0) . Q:RTRAN="" ;we're done if it's empty "RTN","BPSECMPS",67,0) . S MEDN=MEDN+1 ;transaction counter "RTN","BPSECMPS",68,0) . ; "RTN","BPSECMPS",69,0) . F SEG=2:1 D Q:SEGMENT="" ;break the record down by segments "RTN","BPSECMPS",70,0) .. S SEGMENT=$P(RTRAN,SS,SEG) ;get the segment "RTN","BPSECMPS",71,0) .. Q:SEGMENT="" "RTN","BPSECMPS",72,0) .. D PARSETN ;get the fields "RTN","BPSECMPS",73,0) Q "RTN","BPSECMPS",74,0) ; "RTN","BPSECMPS",75,0) PARSEH ; The header record is required on all responses, and is fixed "RTN","BPSECMPS",76,0) ; length. It is the only record that is fixed length. "RTN","BPSECMPS",77,0) ; "RTN","BPSECMPS",78,0) N FIELD,%,%H,%I "RTN","BPSECMPS",79,0) S FIELD=".01" D FDA^DILF(FILE,"+1",FIELD,"",CLAIMIEN,ROOT) "RTN","BPSECMPS",80,0) D NOW^%DTC "RTN","BPSECMPS",81,0) S FIELD=".02" D FDA^DILF(FILE,"+1",FIELD,"",%,ROOT) "RTN","BPSECMPS",82,0) S FIELD=".03" D FDA^DILF(FILE,"+1",FIELD,"",$H,ROOT) "RTN","BPSECMPS",83,0) S FIELD=102 D FDA^DILF(FILE,"+1",FIELD,"",$E(RHEADER,33,34),ROOT) ;version/release number "RTN","BPSECMPS",84,0) S FIELD=103 D FDA^DILF(FILE,"+1",FIELD,"",$E(RHEADER,35,36),ROOT) ;transaction code "RTN","BPSECMPS",85,0) S FIELD=109 D FDA^DILF(FILE,"+1",FIELD,"",$E(RHEADER,37,37),ROOT) ;transaction count "RTN","BPSECMPS",86,0) S TRANSCNT=$E(RHEADER,37,37) "RTN","BPSECMPS",87,0) S FIELD=501 D FDA^DILF(FILE,"+1",FIELD,"",$E(RHEADER,38,38),ROOT) ;response status header "RTN","BPSECMPS",88,0) S FIELD=202 D FDA^DILF(FILE,"+1",FIELD,"",$E(RHEADER,39,40),ROOT) ;service provider id qualifier "RTN","BPSECMPS",89,0) S FIELD=201 D FDA^DILF(FILE,"+1",FIELD,"",$E(RHEADER,41,55),ROOT) ;service provider id "RTN","BPSECMPS",90,0) S FIELD=401 D FDA^DILF(FILE,"+1",FIELD,"",$E(RHEADER,56,63),ROOT) ;date of service "RTN","BPSECMPS",91,0) Q "RTN","BPSECMPS",92,0) ; "RTN","BPSECMPS",93,0) PARSETM ; This subroutine will parse the variable portions of the transmission "RTN","BPSECMPS",94,0) ; "RTN","BPSECMPS",95,0) N FIELD,PC,FLDNUM "RTN","BPSECMPS",96,0) ; "RTN","BPSECMPS",97,0) F PC=3:1 D Q:FIELD="" ;skip the seg id -already know its value "RTN","BPSECMPS",98,0) . S FIELD=$P(SEGMENT,FS,PC) ;piece through the record "RTN","BPSECMPS",99,0) . Q:FIELD="" ;stop - we hit the end "RTN","BPSECMPS",100,0) . S FLDNUM=$$GETNUM(FIELD) ;get the field number used for storage "RTN","BPSECMPS",101,0) . Q:FLDNUM="" ;shouldn't happen - but lets skip "RTN","BPSECMPS",102,0) . S FIELD=$E(FIELD,3,999) "RTN","BPSECMPS",103,0) . D FDA^DILF(FILE,"+1",FLDNUM,"",FIELD,ROOT) "RTN","BPSECMPS",104,0) Q "RTN","BPSECMPS",105,0) ; "RTN","BPSECMPS",106,0) PARSETN ; This subroutine will parse the transaction level segments. For "RTN","BPSECMPS",107,0) ; "RTN","BPSECMPS",108,0) ; Possible values of the SEGFID field: "RTN","BPSECMPS",109,0) ; 21 = Response Status Segment "RTN","BPSECMPS",110,0) ; 22 = Response Claim Segment "RTN","BPSECMPS",111,0) ; 23 = Response Pricing Segment "RTN","BPSECMPS",112,0) ; 24 = Response DUR/PPS Segment "RTN","BPSECMPS",113,0) ; 26 = Response Prior Authorization Segment "RTN","BPSECMPS",114,0) ; "RTN","BPSECMPS",115,0) N FIELD,PC,FLDNUM,RPTFLD,RCNT,REPEAT "RTN","BPSECMPS",116,0) N SEGID,SEGFID,CKRPT "RTN","BPSECMPS",117,0) ; "RTN","BPSECMPS",118,0) S RPTFLD="" "RTN","BPSECMPS",119,0) S SEGID=$P(SEGMENT,FS,2) ;this should be the segment id "RTN","BPSECMPS",120,0) Q:SEGID="" ;don't process without a Seg id "RTN","BPSECMPS",121,0) Q:$E(SEGID,1,2)'="AM" ;don't know what we have - skip "RTN","BPSECMPS",122,0) ; "RTN","BPSECMPS",123,0) S SEGFID=$E(SEGID,3,4) ;this should be the field ID "RTN","BPSECMPS",124,0) ; "RTN","BPSECMPS",125,0) ; setup the repeating flds based on the segment "RTN","BPSECMPS",126,0) I SEGFID=21 D ;status segment "RTN","BPSECMPS",127,0) . S RPTFLD=",548,511,546," "RTN","BPSECMPS",128,0) . S (RCNT(548),RCNT(511),RCNT(546))=0 "RTN","BPSECMPS",129,0) ; "RTN","BPSECMPS",130,0) I SEGFID=22 D ;claim segment "RTN","BPSECMPS",131,0) . S RPTFLD=",552,553,554,555,556," "RTN","BPSECMPS",132,0) . S (RCNT(552),RCNT(553),RCNT(554),RCNT(555),RCNT(556))=0 "RTN","BPSECMPS",133,0) ; "RTN","BPSECMPS",134,0) I SEGFID=23 D ;pricing segment "RTN","BPSECMPS",135,0) . S RPTFLD=",564,565," "RTN","BPSECMPS",136,0) . S (RCNT(564),RCNT(565))=0 "RTN","BPSECMPS",137,0) ; "RTN","BPSECMPS",138,0) I SEGFID=24 D ;DUR/PPS segment "RTN","BPSECMPS",139,0) . S RPTFLD=",439,528,529,530,531,532,533,9002313,544,567," "RTN","BPSECMPS",140,0) . S (RCNT(439),RCNT(528),RCNT(529),RCNT(530),RCNT(531))=0 "RTN","BPSECMPS",141,0) . S (RCNT(532),RCNT(533),RCNT(9002313),RCNT(567))=0,RCNT(544)=0 "RTN","BPSECMPS",142,0) ; "RTN","BPSECMPS",143,0) ; now lets parse out the fields "RTN","BPSECMPS",144,0) ; "RTN","BPSECMPS",145,0) F PC=3:1 D Q:FIELD="" ;skip the seg id -jump to the other flds "RTN","BPSECMPS",146,0) . S FIELD=$P(SEGMENT,FS,PC) ;piece through the record "RTN","BPSECMPS",147,0) . Q:FIELD="" ;stop - we hit the end "RTN","BPSECMPS",148,0) . S FLDNUM=$$GETNUM(FIELD) ;get the field number used for storage "RTN","BPSECMPS",149,0) . Q:FLDNUM="" ;shouldn't happen - but lets skip "RTN","BPSECMPS",150,0) . S REPEAT=0 ;for this segment, lets figure "RTN","BPSECMPS",151,0) . S CKRPT=","_FLDNUM_"," ;out if the field is a repeating "RTN","BPSECMPS",152,0) . S:RPTFLD[CKRPT REPEAT=1 ;field "RTN","BPSECMPS",153,0) . ; "RTN","BPSECMPS",154,0) . I REPEAT D ;if rptg, store with a counter "RTN","BPSECMPS",155,0) .. S RCNT(FLDNUM)=$G(RCNT(FLDNUM))+1 "RTN","BPSECMPS",156,0) .. S FDATA(MEDN,FLDNUM,RCNT(FLDNUM))=$E(FIELD,3,$L(FIELD)) "RTN","BPSECMPS",157,0) . ; "RTN","BPSECMPS",158,0) . I 'REPEAT D ;not rptg, store without counter "RTN","BPSECMPS",159,0) .. S FDATA(MEDN,FLDNUM)=$E(FIELD,3,$L(FIELD)) "RTN","BPSECMPS",160,0) Q "RTN","BPSECMPS",161,0) ; "RTN","BPSECMPS",162,0) GETNUM(FIELD) ; This routine will translate the field ID into a field number. "RTN","BPSECMPS",163,0) ; We will use the NCPDP field Defs files, cross ref "D" to "RTN","BPSECMPS",164,0) ; perform this translation. (The field number is needed to store "RTN","BPSECMPS",165,0) ; the data in the correct field within the response file.) "RTN","BPSECMPS",166,0) ; "RTN","BPSECMPS",167,0) N FLDID,FLDIEN,FLDNUM "RTN","BPSECMPS",168,0) S (FLDID,FLDNUM)="" "RTN","BPSECMPS",169,0) S FLDIEN=0 "RTN","BPSECMPS",170,0) ; "RTN","BPSECMPS",171,0) S FLDID=$E(FIELD,1,2) ;field identifier "RTN","BPSECMPS",172,0) Q:FLDID="" "RTN","BPSECMPS",173,0) ; "RTN","BPSECMPS",174,0) I FLDID'="" D "RTN","BPSECMPS",175,0) . S FLDIEN=$O(^BPSF(9002313.91,"D",FLDID,FLDIEN)) ;internal fld # "RTN","BPSECMPS",176,0) . S:FLDIEN FLDNUM=$P($G(^BPSF(9002313.91,FLDIEN,0)),U) ;fld number "RTN","BPSECMPS",177,0) Q FLDNUM "RTN","BPSECMPS",178,0) ; "RTN","BPSECMPS",179,0) PROCRESP ; "RTN","BPSECMPS",180,0) N FILE,ROOT,FDATA03,FLDNUM,FIELD "RTN","BPSECMPS",181,0) S FILE="9002313.0301" "RTN","BPSECMPS",182,0) S ROOT="FDATA03(9002313.0301)" "RTN","BPSECMPS",183,0) K FDATA03 "RTN","BPSECMPS",184,0) I '$D(FDATA(TRANSACT,501)) S FDATA(TRANSACT,501)=FDATA(TRANSACT,112) "RTN","BPSECMPS",185,0) I '$D(FDATA(TRANSACT,112)) S FDATA(TRANSACT,112)=FDATA(TRANSACT,501) "RTN","BPSECMPS",186,0) S FLDNUM=".01" D FDA^DILF(FILE,"+1,"_FDAIEN(TRANSACT),FLDNUM,"",TRANSACT,ROOT) "RTN","BPSECMPS",187,0) S FIELD="" "RTN","BPSECMPS",188,0) F S FIELD=$O(FDATA(TRANSACT,FIELD)) Q:FIELD="" D ;set all the non-repeating fields for 9002313.0301 "RTN","BPSECMPS",189,0) .I $G(FDATA(TRANSACT,FIELD))'="" D "RTN","BPSECMPS",190,0) ..I FIELD=402 S FDATA(TRANSACT,FIELD)=$TR(FDATA(TRANSACT,FIELD),"\","") ;REMOVE EXTRANEOUS "\" "RTN","BPSECMPS",191,0) ..D FDA^DILF(FILE,"+"_TRANSACT_","_FDAIEN(TRANSACT),FIELD,"",FDATA(TRANSACT,FIELD),ROOT) "RTN","BPSECMPS",192,0) .E D "RTN","BPSECMPS",193,0) ..; "RTN","BPSECMPS",194,0) D UPDATE^DIE("S","FDATA03(9002313.0301)","FDAIEN03") "RTN","BPSECMPS",195,0) Q "RTN","BPSECMPS",196,0) ; "RTN","BPSECMPS",197,0) PROCREJ ; "RTN","BPSECMPS",198,0) Q:$G(FDATA(TRANSACT,510))="" "RTN","BPSECMPS",199,0) N FILE,ROOT,FLDNUM,FDAT3511,NUMREJS,NNDX "RTN","BPSECMPS",200,0) S FILE="9002313.03511" "RTN","BPSECMPS",201,0) S ROOT="FDAT3511(9002313.03511)" "RTN","BPSECMPS",202,0) S NUMREJS=FDATA(TRANSACT,510) "RTN","BPSECMPS",203,0) S NNDX="" "RTN","BPSECMPS",204,0) F S NNDX=$O(FDATA(TRANSACT,511,NNDX)) Q:NNDX="" D ;set all the non-repeating fields for 9002313.3511 rejections "RTN","BPSECMPS",205,0) .S FDATA(TRANSACT,511,NNDX)=$TR(FDATA(TRANSACT,511,NNDX),"\","") "RTN","BPSECMPS",206,0) .S FLDNUM=".01" D FDA^DILF(FILE,"+"_NNDX_","_FDAIEN03(TRANSACT)_","_FDAIEN(TRANSACT),FLDNUM,"",FDATA(TRANSACT,511,NNDX),ROOT) "RTN","BPSECMPS",207,0) D UPDATE^DIE("S","FDAT3511(9002313.03511)") "RTN","BPSECMPS",208,0) Q "RTN","BPSECMPS",209,0) ; "RTN","BPSECMPS",210,0) PROCAPP ; "RTN","BPSECMPS",211,0) Q:$G(FDATA(TRANSACT,548,1))="" "RTN","BPSECMPS",212,0) N FILE,ROOT,FLDNUM,FDAT1548,NNDX "RTN","BPSECMPS",213,0) S FILE="9002313.301548" "RTN","BPSECMPS",214,0) S ROOT="FDAT1548(9002313.0301548)" "RTN","BPSECMPS",215,0) S NNDX="" "RTN","BPSECMPS",216,0) F S NNDX=$O(FDATA(FDAIEN(TRANSACT),548,NNDX)) Q:NNDX="" D "RTN","BPSECMPS",217,0) .S FLDNUM=".01" D FDA^DILF(FILE,"+"_NNDX_","_FDAIEN03(TRANSACT)_","_FDAIEN(TRANSACT),FLDNUM,"",FDATA(TRANSACT,548,NNDX),ROOT) "RTN","BPSECMPS",218,0) D UPDATE^DIE("S","FDAT1548(9002313.301548)") "RTN","BPSECMPS",219,0) Q "RTN","BPSECMPS",220,0) ; "RTN","BPSECMPS",221,0) PROCPPR ; "RTN","BPSECMPS",222,0) Q:$G(FDATA(TRANSACT,551.01,1))="" "RTN","BPSECMPS",223,0) N FILE,ROOT,FLDNUM,FDAT1301,NNDX "RTN","BPSECMPS",224,0) S FILE="9002313.1301" "RTN","BPSECMPS",225,0) S ROOT="FDAT1301(9002313.1301)" "RTN","BPSECMPS",226,0) S NNDX="" "RTN","BPSECMPS",227,0) F S NNDX=$O(FDATA(FDAIEN(TRANSACT),551.01,NNDX)) Q:NNDX="" D "RTN","BPSECMPS",228,0) .S FLDNUM=".01" D FDA^DILF(FILE,"+"_NNDX_","_FDAIEN03(TRANSACT)_","_FDAIEN(TRANSACT),FLDNUM,"",FDATA(TRANSACT,551.01,NNDX),ROOT) "RTN","BPSECMPS",229,0) D UPDATE^DIE("S","FDAT1301(9002313.1301)") "RTN","BPSECMPS",230,0) Q "RTN","BPSNCPD1") 0^7^B70088175^B40334169 "RTN","BPSNCPD1",1,0) BPSNCPD1 ;BHAM ISC/LJE - Pharmacy API part 2 ;4/16/08 17:07 "RTN","BPSNCPD1",2,0) ;;1.0;E CLAIMS MGMT ENGINE;**1,3,5,6**;JUN 2004;Build 10 "RTN","BPSNCPD1",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","BPSNCPD1",4,0) ; "RTN","BPSNCPD1",5,0) ; External reference to $$NCPDPQTY^PSSBPSUT supported by IA4992 "RTN","BPSNCPD1",6,0) ; "RTN","BPSNCPD1",7,0) ; Due to space considerations, these comments were moved from BPSNPCPD "RTN","BPSNCPD1",8,0) ; to this routine. "RTN","BPSNCPD1",9,0) ; "RTN","BPSNCPD1",10,0) ; ------------------ Beginning of BPSNCPDP comments ------------------ "RTN","BPSNCPD1",11,0) ;Input "RTN","BPSNCPD1",12,0) ; BRXIEN = Prescription IEN "RTN","BPSNCPD1",13,0) ; BFILL = Fill Number "RTN","BPSNCPD1",14,0) ; BFILLDAT = Fill Date of current prescription and fill number "RTN","BPSNCPD1",15,0) ; BWHERE (RX Action) "RTN","BPSNCPD1",16,0) ; ARES = Resubmit for an auto-reversed claim was released while waiting "RTN","BPSNCPD1",17,0) ; for the payer response "RTN","BPSNCPD1",18,0) ; AREV = Auto-Reversal "RTN","BPSNCPD1",19,0) ; BB = Back Billing "RTN","BPSNCPD1",20,0) ; CRLB = CMOP Release & Rebill "RTN","BPSNCPD1",21,0) ; CRLR = CMOP Release & Reverse (successful release) "RTN","BPSNCPD1",22,0) ; CRLX = CMOP unsuccessful release & reverse "RTN","BPSNCPD1",23,0) ; DC = Discontinue - only reverse un-released PAYABLE DC's, release date check "RTN","BPSNCPD1",24,0) ; should be in calling routine. "RTN","BPSNCPD1",25,0) ; DDED = Delete in edit "RTN","BPSNCPD1",26,0) ; DE = Delete "RTN","BPSNCPD1",27,0) ; ED = Edit "RTN","BPSNCPD1",28,0) ; ERES = Resubmit from ECME user screen "RTN","BPSNCPD1",29,0) ; EREV = Reversal from ECME user screen "RTN","BPSNCPD1",30,0) ; HLD = Put prescription on Hold "RTN","BPSNCPD1",31,0) ; OF = Original Fill "RTN","BPSNCPD1",32,0) ; PC = Pull CMOPs "RTN","BPSNCPD1",33,0) ; PE = Pull early from suspense "RTN","BPSNCPD1",34,0) ; PL = Pull local from suspense "RTN","BPSNCPD1",35,0) ; PP = PP from Patient Prescription Processing option "RTN","BPSNCPD1",36,0) ; RF = Refill "RTN","BPSNCPD1",37,0) ; RL = Release Rx NDC check - Rebill if billed NDC doesn't match release NDC "RTN","BPSNCPD1",38,0) ; RN = Renew "RTN","BPSNCPD1",39,0) ; RRL = Original claim rejected, submit another claim, no reversal "RTN","BPSNCPD1",40,0) ; RS = Return-to-Stock "RTN","BPSNCPD1",41,0) ; BILLNDC = Valid NDC# with format 5-4-2 "RTN","BPSNCPD1",42,0) ; REVREAS = Reversal Reason "RTN","BPSNCPD1",43,0) ; DURREC = String of DUR info - Three "^" pieces "RTN","BPSNCPD1",44,0) ; Professional Service Code "RTN","BPSNCPD1",45,0) ; Reason for Service Code "RTN","BPSNCPD1",46,0) ; Result of Service Code "RTN","BPSNCPD1",47,0) ; BPOVRIEN = Pointer to BPS NCPDP OVERIDE file. This parameter will "RTN","BPSNCPD1",48,0) ; only be passed if there are overrides entered by the "RTN","BPSNCPD1",49,0) ; user via the Resubmit with Edits (RED) option in the "RTN","BPSNCPD1",50,0) ; user screen. "RTN","BPSNCPD1",51,0) ; BPSCLARF = Clarification Code (0-9,99), entered by pharmacist and passed "RTN","BPSNCPD1",52,0) ; by Outpatient Pharmacy to ECME to put into the claim "RTN","BPSNCPD1",53,0) ; "RTN","BPSNCPD1",54,0) ;Output (RESPONSE^MESSAGE) "RTN","BPSNCPD1",55,0) ; RESPONSE "RTN","BPSNCPD1",56,0) ; 0 Submitted through ECME "RTN","BPSNCPD1",57,0) ; 1 No submission through ECME "RTN","BPSNCPD1",58,0) ; 2 IB not billable "RTN","BPSNCPD1",59,0) ; 3 Claim was closed, not submitted (RTS/Deletes) "RTN","BPSNCPD1",60,0) ; 4 Unable to queue claim "RTN","BPSNCPD1",61,0) ; 5 Incorrect information supplied to ECME "RTN","BPSNCPD1",62,0) ; 6 Inactive ECME - Primarly used for Tricare to say ok to process rx "RTN","BPSNCPD1",63,0) ; 10 Reversal but no resubmit "RTN","BPSNCPD1",64,0) ; MESSAGE = Message associated with the response (error/submitted) "RTN","BPSNCPD1",65,0) ; ----------------- End of BPSNCPDP comments ---------------------- "RTN","BPSNCPD1",66,0) ; "RTN","BPSNCPD1",67,0) ; Procedure STARRAY - Retrieve information for API call to IB and store in BPSARRY "RTN","BPSNCPD1",68,0) ; Incoming Parameters "RTN","BPSNCPD1",69,0) ; BRXIEN - Prescription IEN "RTN","BPSNCPD1",70,0) ; BFILL - Fill Number "RTN","BPSNCPD1",71,0) ; BWHERE - RX action "RTN","BPSNCPD1",72,0) ; BPSARRY - Array that is built (passed by reference) "RTN","BPSNCPD1",73,0) ; BPSITE - OUTPATIENT SITE file #59 ien "RTN","BPSNCPD1",74,0) STARRAY(BRXIEN,BFILL,BWHERE,BPSARRY,BPSITE) ; "RTN","BPSNCPD1",75,0) N DRUGIEN,BPARR,BPSARR,QTY "RTN","BPSNCPD1",76,0) D RXAPI^BPSUTIL1(BRXIEN,"6;7;8;17;31","BPARR","I") "RTN","BPSNCPD1",77,0) I BFILL>0 D RXSUBF^BPSUTIL1(BRXIEN,52,52.1,BFILL,"1;1.1;1.2;17","BPARR","I") "RTN","BPSNCPD1",78,0) S BPSARRY("DFN")=DFN "RTN","BPSNCPD1",79,0) S BPSARRY("DAYS SUPPLY")=$S(BFILL=0:$G(BPARR(52,BRXIEN,8,"I")),1:$G(BPARR(52.1,BFILL,1.1,"I"))) "RTN","BPSNCPD1",80,0) S BPSARRY("IEN")=BRXIEN "RTN","BPSNCPD1",81,0) S BPSARRY("FILL NUMBER")=BFILL "RTN","BPSNCPD1",82,0) S BPSARRY("NDC")=BILLNDC "RTN","BPSNCPD1",83,0) S (BPSARRY("DRUG"),DRUGIEN)=BPARR(52,BRXIEN,6,"I") "RTN","BPSNCPD1",84,0) S BPSARRY("DEA")=$$DRUGDIE^BPSUTIL1(DRUGIEN,3) "RTN","BPSNCPD1",85,0) S BPSARRY("COST")=$S(BFILL=0:$G(BPARR(52,BRXIEN,17,"I")),1:$G(BPARR(52.1,BFILL,1.2,"I"))) "RTN","BPSNCPD1",86,0) S QTY=$S(BFILL=0:$G(BPARR(52,BRXIEN,7,"I")),1:$G(BPARR(52.1,BFILL,1,"I"))) "RTN","BPSNCPD1",87,0) S QTY=$$NCPDPQTY^PSSBPSUT(DRUGIEN,QTY) "RTN","BPSNCPD1",88,0) S BPSARRY("QTY")=$P(QTY,U,1) "RTN","BPSNCPD1",89,0) S BPSARRY("UNITS")=$P(QTY,U,2) "RTN","BPSNCPD1",90,0) S BPSARRY("FILL DATE")=BFILLDAT "RTN","BPSNCPD1",91,0) S BPSARRY("RELEASE DATE")=$P($S(BFILL=0:$G(BPARR(52,BRXIEN,31,"I")),1:$G(BPARR(52.1,BFILL,17,"I"))),".") "RTN","BPSNCPD1",92,0) S BPSARRY("SC/EI OVR")=0 "RTN","BPSNCPD1",93,0) ;determine BPS PHARMACY "RTN","BPSNCPD1",94,0) I $G(BPSITE)>0 S BPSARRY("EPHARM")=$$GETPHARM^BPSUTIL(BPSITE) "RTN","BPSNCPD1",95,0) ; "RTN","BPSNCPD1",96,0) ; Add user so that it is stored correctly in the IB Event Log "RTN","BPSNCPD1",97,0) ; Note: Auto-Reversals (AREV) and CMOP/OPAI (CR*/PC/RL) use postmaster (.5) "RTN","BPSNCPD1",98,0) I ",AREV,CRLB,CRLX,CRLR,PC,RL,"[(","_BWHERE_",") S BPSARRY("USER")=.5 "RTN","BPSNCPD1",99,0) E S BPSARRY("USER")=DUZ "RTN","BPSNCPD1",100,0) Q "RTN","BPSNCPD1",101,0) ; "RTN","BPSNCPD1",102,0) ; Called by BPSNCPDP to display progress of claim "RTN","BPSNCPD1",103,0) STATUS(BRXIEN,BFILL,REBILL,REVONLY,BPSTART,BWHERE) ; "RTN","BPSNCPD1",104,0) ; Initialization "RTN","BPSNCPD1",105,0) N TRANSIEN,CERTUSER,BPSTO,END,IBSEQ,BPQ "RTN","BPSNCPD1",106,0) N CLMSTAT,OCLMSTAT,RESUB,RESFL "RTN","BPSNCPD1",107,0) S (CLMSTAT,OCLMSTAT)=0 "RTN","BPSNCPD1",108,0) ; "RTN","BPSNCPD1",109,0) ; Set CERTUSER to true if this user is the certifier "RTN","BPSNCPD1",110,0) S CERTUSER=^BPS(9002313.99,1,"CERTIFIER")=DUZ "RTN","BPSNCPD1",111,0) ; "RTN","BPSNCPD1",112,0) ; Build Transaction IEN "RTN","BPSNCPD1",113,0) S TRANSIEN=BRXIEN_"."_$E($TR($J("",4-$L(BFILL))," ","0")_BFILL,1,4)_1 "RTN","BPSNCPD1",114,0) ; "RTN","BPSNCPD1",115,0) ; Write Rebill and Status Messages "RTN","BPSNCPD1",116,0) W !!,"Claim Status: " "RTN","BPSNCPD1",117,0) I REBILL,$G(MOREDATA("REVERSE THEN RESUBMIT"))'=2 W !,"Reversing and Rebilling a previously submitted claim...",!,"Reversing..." "RTN","BPSNCPD1",118,0) ; "RTN","BPSNCPD1",119,0) ; Get the ECME Timeout and set the display timeout "RTN","BPSNCPD1",120,0) S BPSTO=$$GET1^DIQ(9002313.99,"1,",3.01),END=$S(CERTUSER:50,$G(BPSTO)]"":BPSTO,1:5) "RTN","BPSNCPD1",121,0) ; "RTN","BPSNCPD1",122,0) ; For remaining time, loop through and display status "RTN","BPSNCPD1",123,0) S (BPQ,RESFL)=0 "RTN","BPSNCPD1",124,0) F IBSEQ=1:1:END D Q:BPQ=1 "RTN","BPSNCPD1",125,0) . H 1 "RTN","BPSNCPD1",126,0) . ; "RTN","BPSNCPD1",127,0) . ; Get status of resubmit, last update, and claim status "RTN","BPSNCPD1",128,0) . S CLMSTAT=$$STATUS^BPSOSRX(BRXIEN,BFILL,1) "RTN","BPSNCPD1",129,0) . S RESUB=$$GET1^DIQ(9002313.59,TRANSIEN_",",1.12,"I") "RTN","BPSNCPD1",130,0) . ; "RTN","BPSNCPD1",131,0) . ; Format status message "RTN","BPSNCPD1",132,0) . S CLMSTAT=$P(CLMSTAT,"^",1)_$S($P(CLMSTAT,"^",1)["IN PROGRESS":"-"_$P(CLMSTAT,"^",3),1:"") "RTN","BPSNCPD1",133,0) . ; "RTN","BPSNCPD1",134,0) . ; If we are starting the resubmit, display message "RTN","BPSNCPD1",135,0) . I REBILL,RESFL=0,RESUB=1,CLMSTAT["Resubmitting" W !,"Resubmitting..." S RESFL=1 Q "RTN","BPSNCPD1",136,0) . I REBILL,RESFL=0,RESUB=2,CLMSTAT["IN PROGRESS" W !,"Resubmitting..." S RESFL=1 "RTN","BPSNCPD1",137,0) . ; "RTN","BPSNCPD1",138,0) . ; If the status has changed, display the new message "RTN","BPSNCPD1",139,0) . I OCLMSTAT'=CLMSTAT W !,CLMSTAT S OCLMSTAT=CLMSTAT I CLMSTAT="E REJECTED",MOREDATA("ELIG")'="V" D "RTN","BPSNCPD1",140,0) .. N BPSRTEXT,BPSRESP,BPSPOS,X "RTN","BPSNCPD1",141,0) .. S BPSRESP=$P($G(^BPST(IEN59,0)),"^",5) Q:'BPSRESP "RTN","BPSNCPD1",142,0) .. S BPSPOS=+$O(^BPSR(BPSRESP,1000,":"),-1) Q:'BPSPOS "RTN","BPSNCPD1",143,0) .. D REJTEXT^BPSOS03(BPSRESP,BPSPOS,.BPSRTEXT) "RTN","BPSNCPD1",144,0) .. S X=0 F S X=$O(BPSRTEXT(X)) Q:'X W !?4,$P(BPSRTEXT(X),":")," - ",$P(BPSRTEXT(X),":",2) "RTN","BPSNCPD1",145,0) . ; "RTN","BPSNCPD1",146,0) . ; If the status is not IN PROGRESS, then we are done "RTN","BPSNCPD1",147,0) . I CLMSTAT'["IN PROGRESS" S BPQ=1 "RTN","BPSNCPD1",148,0) W ! "RTN","BPSNCPD1",149,0) Q "RTN","BPSNCPD1",150,0) ; "RTN","BPSNCPD1",151,0) ; Bulletin to the OPECC "RTN","BPSNCPD1",152,0) ; BPST=Tricare flag 1 is Tricare Related "RTN","BPSNCPD1",153,0) BULL(RXI,RXR,SITE,DFN,PATNAME,BPST) ; "RTN","BPSNCPD1",154,0) N BTXT,XMSUB,XMY,XMTEXT,XMDUZ "RTN","BPSNCPD1",155,0) N SSN,X,SITENM "RTN","BPSNCPD1",156,0) I $G(SITE) D "RTN","BPSNCPD1",157,0) . K ^TMP($J,"BPSARR") "RTN","BPSNCPD1",158,0) . D PSS^PSO59(SITE,,"BPSARR") "RTN","BPSNCPD1",159,0) . S SITENM=$G(^TMP($J,"BPSARR",SITE,.01)) "RTN","BPSNCPD1",160,0) I $G(DFN) D "RTN","BPSNCPD1",161,0) . S X=$P($G(^DPT(DFN,0)),U,9) "RTN","BPSNCPD1",162,0) . S SSN=$E(X,$L(X)-3,$L(X)) "RTN","BPSNCPD1",163,0) ; "RTN","BPSNCPD1",164,0) ; Need to do in the background "RTN","BPSNCPD1",165,0) ; Mailman calls CMOP which calls EN^BPSNCPDP. "RTN","BPSNCPD1",166,0) ; If BPSNCPDP* (same process) then calls mailman, it gets confused. "RTN","BPSNCPD1",167,0) N ZTIO,ZTRTN,ZTDTH,ZTSAVE,ZTDESC "RTN","BPSNCPD1",168,0) N %,%H,%I,X "RTN","BPSNCPD1",169,0) D NOW^%DTC "RTN","BPSNCPD1",170,0) S ZTIO="",ZTDTH=%,ZTDESC="IN PROGRESS BULLETIN" "RTN","BPSNCPD1",171,0) S (ZTSAVE("RXR"),ZTSAVE("RXI"))="" "RTN","BPSNCPD1",172,0) S (ZTSAVE("SITENM"),ZTSAVE("PATNAME"),ZTSAVE("SSN"),ZTSAVE("BPST"))="" "RTN","BPSNCPD1",173,0) S ZTRTN="BULL1^BPSNCPD1" "RTN","BPSNCPD1",174,0) D ^%ZTLOAD "RTN","BPSNCPD1",175,0) Q "RTN","BPSNCPD1",176,0) ; "RTN","BPSNCPD1",177,0) BULL1 ; "RTN","BPSNCPD1",178,0) N BPSRX,BPSL,XMDUZ,XMY,BPSX,XMZ,XMSUB "RTN","BPSNCPD1",179,0) S BPSL=0,BPSRX=$$RXAPI1^BPSUTIL1(RXI,.01,"E") "RTN","BPSNCPD1",180,0) S XMSUB=$S($G(BPST):"TRICARE ",1:"")_"RX not processed for site "_$G(SITENM) "RTN","BPSNCPD1",181,0) I $G(BPST) D "RTN","BPSNCPD1",182,0) . S BPSL=BPSL+1,BPSX(BPSL)="Prescription "_BPSRX_" for fill number "_(+RXR)_" could not be filled because of a" "RTN","BPSNCPD1",183,0) . S BPSL=BPSL+1,BPSX(BPSL)="delay in processing the third party claim. The Rx was placed on suspense" "RTN","BPSNCPD1",184,0) . S BPSL=BPSL+1,BPSX(BPSL)="because TRICARE Rx's may not be filled unless they have a payable third" "RTN","BPSNCPD1",185,0) . S BPSL=BPSL+1,BPSX(BPSL)="party claim." "RTN","BPSNCPD1",186,0) . S BPSL=BPSL+1,BPSX(BPSL)=" " "RTN","BPSNCPD1",187,0) . S BPSL=BPSL+1,BPSX(BPSL)="Please monitor the progress of the claim. If the claim is eventually" "RTN","BPSNCPD1",188,0) . S BPSL=BPSL+1,BPSX(BPSL)="returned as payable, the Rx label will be printed when Print from Suspense" "RTN","BPSNCPD1",189,0) . S BPSL=BPSL+1,BPSX(BPSL)="occurs or it may be Pulled Early from Suspense. If a reject occurs, the" "RTN","BPSNCPD1",190,0) . S BPSL=BPSL+1,BPSX(BPSL)="Rx will be placed in the REFILL TOO SOON/DUR REJECTS (Third Party) section" "RTN","BPSNCPD1",191,0) . S BPSL=BPSL+1,BPSX(BPSL)="of the medication profile and placed on the Pharmacy Reject Worklist." "RTN","BPSNCPD1",192,0) ; "RTN","BPSNCPD1",193,0) E D "RTN","BPSNCPD1",194,0) . S BPSL=BPSL+1,BPSX(BPSL)="Prescription "_BPSRX_" for fill number "_(+RXR)_" could not be processed because the" "RTN","BPSNCPD1",195,0) . S BPSL=BPSL+1,BPSX(BPSL)="previous request was in progress. There may have been a delay in" "RTN","BPSNCPD1",196,0) . S BPSL=BPSL+1,BPSX(BPSL)="processing of the previous claim or the previous claim may be stranded." "RTN","BPSNCPD1",197,0) ; "RTN","BPSNCPD1",198,0) S BPSL=BPSL+1,BPSX(BPSL)=" " "RTN","BPSNCPD1",199,0) S BPSL=BPSL+1,BPSX(BPSL)="For more information on this prescription's activity, please view the ECME" "RTN","BPSNCPD1",200,0) S BPSL=BPSL+1,BPSX(BPSL)="log within the View Prescription (VP) option on the Further Research (FR)" "RTN","BPSNCPD1",201,0) S BPSL=BPSL+1,BPSX(BPSL)="menu of the ECME user screen." "RTN","BPSNCPD1",202,0) S BPSL=BPSL+1,BPSX(BPSL)=" " "RTN","BPSNCPD1",203,0) S BPSL=BPSL+1,BPSX(BPSL)=$S($G(BPST):"TRICARE ",1:"")_"Patient Name: "_$G(PATNAME)_" ("_$G(SSN)_")" "RTN","BPSNCPD1",204,0) S BPSL=BPSL+1,BPSX(BPSL)="Prescription: "_BPSRX_" Fill: "_(+RXR) "RTN","BPSNCPD1",205,0) S BPSL=BPSL+1,BPSX(BPSL)="Drug Name: "_$$RXAPI1^BPSUTIL1(RXI,6,"E") "RTN","BPSNCPD1",206,0) ; "RTN","BPSNCPD1",207,0) S XMDUZ="BPS PACKAGE",XMTEXT="BPSX(" "RTN","BPSNCPD1",208,0) S XMY("G.BPS OPECC")="" "RTN","BPSNCPD1",209,0) I $G(DUZ)'<1 S XMY(DUZ)="" "RTN","BPSNCPD1",210,0) D ^XMD "RTN","BPSNCPD1",211,0) I $G(BPST) D PRIORITY^XMXEDIT(XMZ) "RTN","BPSNCPD1",212,0) Q "RTN","BPSNCPD2") 0^2^B37690318^B37248829 "RTN","BPSNCPD2",1,0) BPSNCPD2 ;BHAM ISC/LJE - Continuation of BPSNCPDP (IB Billing Determiation) ;11/7/07 16:01 "RTN","BPSNCPD2",2,0) ;;1.0;E CLAIMS MGMT ENGINE;**1,5,6**;JUN 2004;Build 10 "RTN","BPSNCPD2",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","BPSNCPD2",4,0) ;External reference $$RX^IBNCPDP supported by DBIA 4299 "RTN","BPSNCPD2",5,0) ; "RTN","BPSNCPD2",6,0) ; "RTN","BPSNCPD2",7,0) ; EN - Call IB Billing Determination. If good to go, update MOREDATA array "RTN","BPSNCPD2",8,0) ; Notes about variables "RTN","BPSNCPD2",9,0) ;input: "RTN","BPSNCPD2",10,0) ; DFN - PATIENT file #2 ien "RTN","BPSNCPD2",11,0) ; BWHERE - shows where the code is called from and what needs to be done "RTN","BPSNCPD2",12,0) ; the following should be passed by reference: "RTN","BPSNCPD2",13,0) ; MOREDATA - Initialized by BPSNCPDP and more data is added here "RTN","BPSNCPD2",14,0) ; BPSARRY - Created by STARRAY^BPSNCPD1 and used for IB Determination "RTN","BPSNCPD2",15,0) ; IB - Returned to BPSNCPDP "RTN","BPSNCPD2",16,0) ; CERTIEN - BPS Certification IEN - Not passed but newed/set in BPSNCPDP "RTN","BPSNCPD2",17,0) ; "RTN","BPSNCPD2",18,0) EN(DFN,BWHERE,MOREDATA,BPSARRY,IB) ; "RTN","BPSNCPD2",19,0) I '$G(CERTIEN) D I IB=2 Q "RTN","BPSNCPD2",20,0) . ; "RTN","BPSNCPD2",21,0) . ;For NCPDP IB call to see if we need to 3rd Party Bill and if so, get insurance/payer sheet info "RTN","BPSNCPD2",22,0) . S MOREDATA("BILL")=$$RX^IBNCPDP(DFN,.BPSARRY) ;IB CALL "RTN","BPSNCPD2",23,0) . Q:'$D(MOREDATA("BILL")) "RTN","BPSNCPD2",24,0) . ; "RTN","BPSNCPD2",25,0) . ; If calling program is the ECME user screen and we can't bill because of NEEDS SC DETERMINATION "RTN","BPSNCPD2",26,0) . ; or EI, then prompt the user to see if they want to bill "RTN","BPSNCPD2",27,0) . I BWHERE="ERES",$P(MOREDATA("BILL"),U,1)=0,$G(BPSARRY("SC/EI NO ANSW"))]"" D "RTN","BPSNCPD2",28,0) .. N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,I,BPEISC "RTN","BPSNCPD2",29,0) .. F I=1:1:$L($G(BPSARRY("SC/EI NO ANSW")),",") S BPEISC=$P($G(BPSARRY("SC/EI NO ANSW")),",",I) I BPEISC]"" D "RTN","BPSNCPD2",30,0) ... W !,"The prescription is potentially ",BPEISC,"-related and needs ",BPEISC," determination." "RTN","BPSNCPD2",31,0) ... W !,"Prescriptions related to ",BPEISC," cannot be billed to Third Party Insurance.",! "RTN","BPSNCPD2",32,0) .. S DIR(0)="Y",DIR("A")="Are you sure you want to bill this prescription" "RTN","BPSNCPD2",33,0) .. S DIR("B")="NO" "RTN","BPSNCPD2",34,0) .. S DIR("?")="If you want to bill this prescription, enter 'Yes' - otherwise, enter 'No'" "RTN","BPSNCPD2",35,0) .. W ! D ^DIR K DIR "RTN","BPSNCPD2",36,0) .. I '+Y Q "RTN","BPSNCPD2",37,0) .. S BPSARRY("SC/EI OVR")=1 "RTN","BPSNCPD2",38,0) .. S MOREDATA("BILL")=$$RX^IBNCPDP(DFN,.BPSARRY) ;Call IB again "RTN","BPSNCPD2",39,0) . ; "RTN","BPSNCPD2",40,0) . ; Quit if no response from IB call "RTN","BPSNCPD2",41,0) . Q:'$D(MOREDATA("BILL")) "RTN","BPSNCPD2",42,0) . S MOREDATA("ELIG")=$P(MOREDATA("BILL"),"^",3) "RTN","BPSNCPD2",43,0) . I $P(MOREDATA("BILL"),U,1)=0 S IB=2 Q ;IB says not to bill "RTN","BPSNCPD2",44,0) . S IB=1 "RTN","BPSNCPD2",45,0) . M MOREDATA("IBDATA")=BPSARRY("INS") "RTN","BPSNCPD2",46,0) . S $P(MOREDATA("BPSDATA",1),U,1)=BPSARRY("QTY") "RTN","BPSNCPD2",47,0) . S $P(MOREDATA("BPSDATA",1),U,2)=BPSARRY("COST") "RTN","BPSNCPD2",48,0) . S $P(MOREDATA("BPSDATA",1),U,3)=BPSARRY("NDC") "RTN","BPSNCPD2",49,0) . S $P(MOREDATA("BPSDATA",1),U,4)=BFILL "RTN","BPSNCPD2",50,0) . S $P(MOREDATA("BPSDATA",1),U,5)="" ; Certify Mode "RTN","BPSNCPD2",51,0) . S $P(MOREDATA("BPSDATA",1),U,6)="" ; Cert IEN "RTN","BPSNCPD2",52,0) . S $P(MOREDATA("BPSDATA",1),U,7)=BPSARRY("UNITS") "RTN","BPSNCPD2",53,0) ; "RTN","BPSNCPD2",54,0) ; If certification mode on and no IB result (somewhat redundant since IB is not called "RTN","BPSNCPD2",55,0) ; for certification), get data from BPS Certification table "RTN","BPSNCPD2",56,0) I $G(CERTIEN),'$G(IB) D "RTN","BPSNCPD2",57,0) . N NODE,FLD,NFLD,CERTARY "RTN","BPSNCPD2",58,0) . S MOREDATA("BILL")=1 "RTN","BPSNCPD2",59,0) . S MOREDATA("IBDATA",1,1)="",MOREDATA("IBDATA",1,2)="",MOREDATA("BPSDATA",1)="" "RTN","BPSNCPD2",60,0) . S $P(MOREDATA("BPSDATA",1),U,5)=1 ;Certify Mode "RTN","BPSNCPD2",61,0) . S $P(MOREDATA("BPSDATA",1),U,6)=CERTIEN ;Cert IEN "RTN","BPSNCPD2",62,0) . S $P(MOREDATA("IBDATA",1,1),U,1)=1 ;Plan IEN "RTN","BPSNCPD2",63,0) . S $P(MOREDATA("IBDATA",1,1),U,4)=$$GET1^DIQ(9002313.31,CERTIEN,.04,"E") ;Payer Sheet "RTN","BPSNCPD2",64,0) . S $P(MOREDATA("IBDATA",1,1),U,10)="01" ;Home State Plan "RTN","BPSNCPD2",65,0) . S $P(MOREDATA("IBDATA",1,1),U,11)="" ;B2 Payer Sheet (reversal) "RTN","BPSNCPD2",66,0) . S $P(MOREDATA("IBDATA",1,1),U,12)="" ;B3 Payer Sheet (rebill) "RTN","BPSNCPD2",67,0) . S $P(MOREDATA("IBDATA",1,1),U,14)="" ;Plan Name "RTN","BPSNCPD2",68,0) . S $P(MOREDATA("IBDATA",1,2),U,5)=0 ;Admin Fee "RTN","BPSNCPD2",69,0) . ; "RTN","BPSNCPD2",70,0) . ;Get data from non-mulitple fields and add to MOREDATA "RTN","BPSNCPD2",71,0) . K CERTARY D GETS^DIQ(9002313.31,CERTIEN_",","1*","","CERTARY") "RTN","BPSNCPD2",72,0) . S NODE="" F S NODE=$O(CERTARY(9002313.311,NODE)) Q:NODE="" D "RTN","BPSNCPD2",73,0) .. S FLD="" F S FLD=$O(CERTARY(9002313.311,NODE,FLD)) Q:FLD="" D "RTN","BPSNCPD2",74,0) ... I FLD=.01 S NFLD=CERTARY(9002313.311,NODE,FLD) D "RTN","BPSNCPD2",75,0) .... I NFLD=101 S $P(MOREDATA("IBDATA",1,1),U,2)=CERTARY(9002313.311,NODE,.02) ;BIN "RTN","BPSNCPD2",76,0) .... I NFLD=104 S $P(MOREDATA("IBDATA",1,1),U,3)=CERTARY(9002313.311,NODE,.02) ;PCN "RTN","BPSNCPD2",77,0) .... I NFLD=110 S $P(MOREDATA("IBDATA",1,1),U,13)=CERTARY(9002313.311,NODE,.02) ;Certification ID "RTN","BPSNCPD2",78,0) . ; "RTN","BPSNCPD2",79,0) . ;Get data from mulitple fields and add to MOREDATA "RTN","BPSNCPD2",80,0) . K CERTARY D GETS^DIQ(9002313.31,CERTIEN_",","2*","","CERTARY") "RTN","BPSNCPD2",81,0) . S NODE="" F S NODE=$O(CERTARY(9002313.3121,NODE)) Q:NODE="" D "RTN","BPSNCPD2",82,0) .. S FLD="" F S FLD=$O(CERTARY(9002313.3121,NODE,FLD)) Q:FLD="" D "RTN","BPSNCPD2",83,0) ... I FLD=.01 S NFLD=CERTARY(9002313.3121,NODE,FLD) D "RTN","BPSNCPD2",84,0) .... I NFLD=301 S $P(MOREDATA("IBDATA",1,1),U,5)=CERTARY(9002313.3121,NODE,.02) ;Group ID "RTN","BPSNCPD2",85,0) .... I NFLD=302 S $P(MOREDATA("IBDATA",1,1),U,6)=CERTARY(9002313.3121,NODE,.02) ;Cardholder ID "RTN","BPSNCPD2",86,0) .... I NFLD=306 S $P(MOREDATA("IBDATA",1,1),U,7)=CERTARY(9002313.3121,NODE,.02) ;Patient Rel Code "RTN","BPSNCPD2",87,0) .... I NFLD=312 S $P(MOREDATA("IBDATA",1,1),U,8)=CERTARY(9002313.3121,NODE,.02) ;Cardholder First Name "RTN","BPSNCPD2",88,0) .... I NFLD=313 S $P(MOREDATA("IBDATA",1,1),U,9)=CERTARY(9002313.3121,NODE,.02) ;Cardholder Last Name "RTN","BPSNCPD2",89,0) .... I NFLD=412 S $P(MOREDATA("IBDATA",1,2),U,1)=CERTARY(9002313.3121,NODE,.02) ;Dispensing Fee "RTN","BPSNCPD2",90,0) .... I NFLD=423 S $P(MOREDATA("IBDATA",1,2),U,2)=CERTARY(9002313.3121,NODE,.02) ;Basis of Cost Determination "RTN","BPSNCPD2",91,0) .... I NFLD=426 S $P(MOREDATA("IBDATA",1,2),U,3)=CERTARY(9002313.3121,NODE,.02) ;Usual & Customary - Base Price "RTN","BPSNCPD2",92,0) .... I NFLD=430 S $P(MOREDATA("IBDATA",1,2),U,4)=CERTARY(9002313.3121,NODE,.02) ;Gross Amt Due "RTN","BPSNCPD2",93,0) .... I NFLD=442 S $P(MOREDATA("BPSDATA",1),U,1)=CERTARY(9002313.3121,NODE,.02) ;Qty "RTN","BPSNCPD2",94,0) .... I NFLD=409 S $P(MOREDATA("BPSDATA",1),U,2)=CERTARY(9002313.3121,NODE,.02) ;Unit Cost "RTN","BPSNCPD2",95,0) .... I NFLD=407 S $P(MOREDATA("BPSDATA",1),U,3)=CERTARY(9002313.3121,NODE,.02) ;NDC "RTN","BPSNCPD2",96,0) .... I NFLD=403 S $P(MOREDATA("BPSDATA",1),U,4)=CERTARY(9002313.3121,NODE,.02) ;Fill # "RTN","BPSNCPD2",97,0) .... I NFLD=600 S $P(MOREDATA("BPSDATA",1),U,7)=CERTARY(9002313.3121,NODE,.02) ;Unit of Measure "RTN","BPSNCPD2",98,0) . ; "RTN","BPSNCPD2",99,0) . ; If Gross Amt Due is missing, use Usual and Customary "RTN","BPSNCPD2",100,0) . I $P(MOREDATA("IBDATA",1,2),U,4)="" S $P(MOREDATA("IBDATA",1,2),U,4)=$P(MOREDATA("IBDATA",1,2),U,3) "RTN","BPSNCPD2",101,0) ; "RTN","BPSNCPD2",102,0) ; The code below checks if Sequence one is missing and move the next number down if needed. "RTN","BPSNCPD2",103,0) ; DMB - This is existing code so I am not sure if it is needed or not. "RTN","BPSNCPD2",104,0) I '$D(MOREDATA("IBDATA",1)) D "RTN","BPSNCPD2",105,0) . N WW "RTN","BPSNCPD2",106,0) . S WW=$O(MOREDATA("IBDATA","")) "RTN","BPSNCPD2",107,0) . I WW'="" M MOREDATA("IBDATA",1)=MOREDATA("IBDATA",WW) K MOREDATA("IBDATA",WW) "RTN","BPSNCPD2",108,0) ; "RTN","BPSNCPD2",109,0) ; Uppercase the IBDATA "RTN","BPSNCPD2",110,0) ; DMB - Assume this was adding in case any of the BPS Certification data was entered as lowercase "RTN","BPSNCPD2",111,0) S MOREDATA("IBDATA",1,1)=$TR(MOREDATA("IBDATA",1,1),"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ") "RTN","BPSNCPD2",112,0) S MOREDATA("IBDATA",1,2)=$TR(MOREDATA("IBDATA",1,2),"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ") "RTN","BPSNCPD2",113,0) S MOREDATA("BPSDATA",1)=$TR(MOREDATA("BPSDATA",1),"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ") "RTN","BPSNCPD2",114,0) ; "RTN","BPSNCPD2",115,0) Q "RTN","BPSNCPD3") 0^10^B16349234^B20450751 "RTN","BPSNCPD3",1,0) BPSNCPD3 ;BHAM ISC/LJE - Continuation of BPSNCPDP - DUR HANDLING ;06/16/2004 "RTN","BPSNCPD3",2,0) ;;1.0;E CLAIMS MGMT ENGINE;**1,5,6**;JUN 2004;Build 10 "RTN","BPSNCPD3",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","BPSNCPD3",4,0) ; DUR1 is called by PSO to get the reject info so that should NOT be removed "RTN","BPSNCPD3",5,0) ; "RTN","BPSNCPD3",6,0) ; "RTN","BPSNCPD3",7,0) ; IA 4560 "RTN","BPSNCPD3",8,0) ; Function call for DUR INFORMATION "RTN","BPSNCPD3",9,0) ; Parameters: BRXIEN = Prescription IEN "RTN","BPSNCPD3",10,0) ; BFILL = fill number "RTN","BPSNCPD3",11,0) ; DUR = DUR info passed back "RTN","BPSNCPD3",12,0) ; ERROR = error passed back "RTN","BPSNCPD3",13,0) ; Note: "RTN","BPSNCPD3",14,0) ; DUR("BILLED")=0 if ecme off for pharmacy or no transaction in ECME "RTN","BPSNCPD3",15,0) ; DUR(,"BILLED")=1 if billed through ecme "RTN","BPSNCPD3",16,0) DUR1(BRXIEN,BFILL,DUR,ERROR) ; "RTN","BPSNCPD3",17,0) N SITE,DFILL,TRANIEN,JJ,DUR1,DURIEN,I "RTN","BPSNCPD3",18,0) ; "RTN","BPSNCPD3",19,0) ; Get Site info and check is ECME is turned on "RTN","BPSNCPD3",20,0) ; If not, set DUR("BILLED")=0 and quit "RTN","BPSNCPD3",21,0) I '$G(BFILL) S SITE=$$RXAPI1^BPSUTIL1(BRXIEN,20,"I") "RTN","BPSNCPD3",22,0) I $G(BFILL) S SITE=$$RXSUBF1^BPSUTIL1(BRXIEN,52,52.1,BFILL,8,"I") "RTN","BPSNCPD3",23,0) I '$$ECMEON^BPSUTIL(SITE) S DUR("BILLED")=0 Q "RTN","BPSNCPD3",24,0) ; "RTN","BPSNCPD3",25,0) ; Set up the Transaction IEN "RTN","BPSNCPD3",26,0) S DFILL="",DFILL=$E($TR($J("",4-$L(BFILL))," ","0")_BFILL,1,4)_1 "RTN","BPSNCPD3",27,0) S TRANIEN=BRXIEN_"."_DFILL "RTN","BPSNCPD3",28,0) ; "RTN","BPSNCPD3",29,0) ; If the transaction record does not exist, set DUR("BILLED")=0 and quit "RTN","BPSNCPD3",30,0) I '$D(^BPST(TRANIEN)) S DUR("BILLED")=0 Q "RTN","BPSNCPD3",31,0) ; "RTN","BPSNCPD3",32,0) ; Loop through the insurance multiple and set DUR array "RTN","BPSNCPD3",33,0) S JJ=0 "RTN","BPSNCPD3",34,0) F S JJ=$O(^BPST(TRANIEN,10,JJ)) Q:JJ=""!(JJ'?1N.N) D "RTN","BPSNCPD3",35,0) . ; "RTN","BPSNCPD3",36,0) . ; We are good so set Billed "RTN","BPSNCPD3",37,0) . S DUR(JJ,"BILLED")=1 "RTN","BPSNCPD3",38,0) . ; "RTN","BPSNCPD3",39,0) . S DUR(JJ,"ELIGBLT")=$P($G(^BPST(TRANIEN,9)),U,4) "RTN","BPSNCPD3",40,0) . ; Get Insurance Info and set into DUR array "RTN","BPSNCPD3",41,0) . D GETS^DIQ(9002313.59902,JJ_","_TRANIEN_",","902.05;902.06;902.24;902.25;902.26","E","DUR1","ERROR") "RTN","BPSNCPD3",42,0) . S DUR(JJ,"INSURANCE NAME")=$G(DUR1(9002313.59902,JJ_","_TRANIEN_",",902.24,"E")) ; Insurance Company Name "RTN","BPSNCPD3",43,0) . S DUR(JJ,"GROUP NUMBER")=$G(DUR1(9002313.59902,JJ_","_TRANIEN_",",902.05,"E")) ; Insurance Group Number "RTN","BPSNCPD3",44,0) . S DUR(JJ,"GROUP NAME")=$G(DUR1(9002313.59902,JJ_","_TRANIEN_",",902.25,"E")) ; Insurance Group Name "RTN","BPSNCPD3",45,0) . S DUR(JJ,"PLAN CONTACT")=$G(DUR1(9002313.59902,JJ_","_TRANIEN_",",902.26,"E")) ; Insurance Contact Number "RTN","BPSNCPD3",46,0) . S DUR(JJ,"CARDHOLDER ID")=$G(DUR1(9002313.59902,JJ_","_TRANIEN_",",902.06,"E")) ; Cardholder ID "RTN","BPSNCPD3",47,0) . ; "RTN","BPSNCPD3",48,0) . ; Get Response IEN and Data "RTN","BPSNCPD3",49,0) . S DURIEN="",DURIEN=$P(^BPST(TRANIEN,0),"^",5) ;Note: in future will need to store/get DURIEN for each insurance "RTN","BPSNCPD3",50,0) . S DUR(JJ,"RESPONSE IEN")=DURIEN "RTN","BPSNCPD3",51,0) . D GETS^DIQ(9002313.0301,"1,"_DURIEN_",","501;567.01*;526","E","DUR1","ERROR") "RTN","BPSNCPD3",52,0) . S DUR(JJ,"PAYER MESSAGE")=$G(DUR1(9002313.0301,"1,"_DURIEN_",",526,"E")) ;Additional free text message info from payer "RTN","BPSNCPD3",53,0) . S DUR(JJ,"STATUS")=$G(DUR1(9002313.0301,"1,"_DURIEN_",",501,"E")) ;Status of Response "RTN","BPSNCPD3",54,0) . S DUR(JJ,"REASON")=$G(DUR1(9002313.1101,"1,1,"_DURIEN_",",439,"E")) ;Reason of Service Code "RTN","BPSNCPD3",55,0) . S DUR(JJ,"PREV FILL DATE")=$G(DUR1(9002313.1101,"1,1,"_DURIEN_",",530,"E")) ;Previous Date of Fill "RTN","BPSNCPD3",56,0) . S DUR(JJ,"DUR FREE TEXT DESC")=$G(DUR1(9002313.1101,"1,1,"_DURIEN_",",544,"E")) ;DUR Free Text Message from Payer "RTN","BPSNCPD3",57,0) . ; "RTN","BPSNCPD3",58,0) . ; Get DUR reject codes and description and store in DUR "RTN","BPSNCPD3",59,0) . D GETS^DIQ(9002313.0301,"1,"_DURIEN_",","511*","I","DUR1","ERROR") ;get DUR codes and descriptions "RTN","BPSNCPD3",60,0) . S DUR(JJ,"REJ CODE LST")="" "RTN","BPSNCPD3",61,0) . F I=1:1 Q:'$D(DUR1(9002313.03511,I_",1,"_DURIEN_",")) D "RTN","BPSNCPD3",62,0) .. S DUR(JJ,"REJ CODES",I,DUR1(9002313.03511,I_",1,"_DURIEN_",",.01,"I"))=$$GET1^DIQ(9002313.93,DUR1(9002313.03511,I_",1,"_DURIEN_",",.01,"I"),".02") "RTN","BPSNCPD3",63,0) .. S DUR(JJ,"REJ CODE LST")=DUR(JJ,"REJ CODE LST")_","_DUR1(9002313.03511,I_",1,"_DURIEN_",",.01,"I") "RTN","BPSNCPD3",64,0) . S DUR(JJ,"REJ CODE LST")=$E(DUR(JJ,"REJ CODE LST"),2,9999) "RTN","BPSNCPD3",65,0) Q "RTN","BPSNCPD4") 0^12^B4013558^n/a "RTN","BPSNCPD4",1,0) BPSNCPD4 ;OAK/ELZ - Extension of BPSNCPDP ;4/16/08 17:07 "RTN","BPSNCPD4",2,0) ;;1.0;E CLAIMS MGMT ENGINE;**6**;JUN 2004;Build 10 "RTN","BPSNCPD4",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","BPSNCPD4",4,0) ; "RTN","BPSNCPD4",5,0) ; This routine is just an extension of BPSNCPDP which was too long. "RTN","BPSNCPD4",6,0) ; *** ALL VARIABLES ASSUMED TO BE FROM CALLING BPSNCPDP ROUTINE *** "RTN","BPSNCPD4",7,0) ; "RTN","BPSNCPD4",8,0) ; "RTN","BPSNCPD4",9,0) IPSC ; In Progress/Stranded claims check "RTN","BPSNCPD4",10,0) S CLMSTAT="Previous request is IN PROGRESS. It may need to be unstranded.",RESPONSE=4 "RTN","BPSNCPD4",11,0) I WFLG W !,CLMSTAT,! H 2 "RTN","BPSNCPD4",12,0) ; If not OP, then send an email to the OPECC "RTN","BPSNCPD4",13,0) I ",AREV,BB,ERES,EREV,"'[(","_BWHERE_",") D "RTN","BPSNCPD4",14,0) . ; don't send in progress AGAIN for Tricare "RTN","BPSNCPD4",15,0) . I $P($G(^BPST(+$$IEN59^BPSOSRX(BRXIEN,BFILL),9)),"^",4)="T" Q "RTN","BPSNCPD4",16,0) . D BULL^BPSNCPD1(BRXIEN,BFILL,$G(SITE),$G(DFN),$G(PNAME),"") "RTN","BPSNCPD4",17,0) Q "RTN","BPSNCPD4",18,0) ; "RTN","BPSNCPD4",19,0) BBC ; Backbilling check "RTN","BPSNCPD4",20,0) S CLMSTAT="Previously billed through ECME: "_OLDRESP,RESPONSE=1 "RTN","BPSNCPD4",21,0) I WFLG W !,CLMSTAT,! H 2 "RTN","BPSNCPD4",22,0) Q "RTN","BPSNCPD4",23,0) ; "RTN","BPSNCPD4",24,0) NOR ; Do not reverse if the rx was not previously billed through ECME "RTN","BPSNCPD4",25,0) S CLMSTAT="Prescription not previously billed through ECME. Cannot Reverse claim.",RESPONSE=1 "RTN","BPSNCPD4",26,0) I WFLG W !,CLMSTAT,! H 2 "RTN","BPSNCPD4",27,0) Q "RTN","BPSNCPD4",28,0) ; "RTN","BPSNCPD4",29,0) RSNR ; If returning to stock or deleting and the previous claim was not paid, then no reversal is needed "RTN","BPSNCPD4",30,0) ; so close the prescription and quit "RTN","BPSNCPD4",31,0) D CLOSE2^BPSBUTL(BRXIEN,BFILL,BWHERE) "RTN","BPSNCPD4",32,0) S CLMSTAT="Claim was not payable so it has been closed. No ECME claim created.",RESPONSE=3 "RTN","BPSNCPD4",33,0) I WFLG W !,CLMSTAT,! H 2 "RTN","BPSNCPD4",34,0) Q "RTN","BPSNCPD4",35,0) ; "RTN","BPSNCPD4",36,0) DNR ; Do not reverse if the claim is not E PAYABLE "RTN","BPSNCPD4",37,0) S CLMSTAT="Claim has status "_OLDRESP_". Not reversed.",RESPONSE=1 "RTN","BPSNCPD4",38,0) I WFLG W !,CLMSTAT,! H 2 "RTN","BPSNCPD4",39,0) Q "RTN","BPSNCPD4",40,0) ; "RTN","BPSNCPD4",41,0) EREVRR ; EREV can be re-reversed if the previous submission is Payable or Rejected Revesal "RTN","BPSNCPD4",42,0) S CLMSTAT="Claim has status "_OLDRESP_". Not reversed.",RESPONSE=1 "RTN","BPSNCPD4",43,0) I WFLG W !,CLMSTAT,! H 2 "RTN","BPSNCPD4",44,0) Q "RTN","BPSNCPD4",45,0) ; "RTN","BPSNCPDP") 0^5^B71265922^B73597678 "RTN","BPSNCPDP",1,0) BPSNCPDP ;BHAM ISC/LJE - API to submit a claim to ECME ;4/16/08 15:11 "RTN","BPSNCPDP",2,0) ;;1.0;E CLAIMS MGMT ENGINE;**1,3,4,2,5,6**;JUN 2004;Build 10 "RTN","BPSNCPDP",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","BPSNCPDP",4,0) ; "RTN","BPSNCPDP",5,0) ; For comments regarding this API, see routine BPSNCPD1. "RTN","BPSNCPDP",6,0) ; "RTN","BPSNCPDP",7,0) EN(BRXIEN,BFILL,BFILLDAT,BWHERE,BILLNDC,REVREAS,DURREC,BPOVRIEN,BPSCLARF,BPSAUTH) ; "RTN","BPSNCPDP",8,0) EN1 N DFN,PNAME,BRX,BPSARRY,MOREDATA,SITE,WFLG,OLDRESP,IEN59,BPSELIG,%,%I,%H,X,TODAY,QUIT,CERTIEN,REBILL,REVONLY,CLMSTAT,RESPONSE,BPSTART,IB,RESP,BPSSTAT "RTN","BPSNCPDP",9,0) ; "RTN","BPSNCPDP",10,0) ; Default variables "RTN","BPSNCPDP",11,0) S RESPONSE="",CLMSTAT="",BFILL=$S('$G(BFILL):0,1:BFILL) "RTN","BPSNCPDP",12,0) ; "RTN","BPSNCPDP",13,0) ; Check for valid RX and fill "RTN","BPSNCPDP",14,0) I '$G(BRXIEN) S CLMSTAT="Prescription IEN parameter missing",RESPONSE=5 G END "RTN","BPSNCPDP",15,0) ; "RTN","BPSNCPDP",16,0) ; Setup IEN59, and initialize log "RTN","BPSNCPDP",17,0) S IEN59=$$IEN59^BPSOSRX(BRXIEN,BFILL) "RTN","BPSNCPDP",18,0) I IEN59="" S CLMSTAT="BPS Transaction IEN could not be calculated",RESPONSE=1 G END "RTN","BPSNCPDP",19,0) D LOG^BPSOSL(IEN59,$T(+0)_"-Start of claim","DT") "RTN","BPSNCPDP",20,0) ; "RTN","BPSNCPDP",21,0) ; Check for BWHERE parameter "RTN","BPSNCPDP",22,0) I $G(BWHERE)="" S CLMSTAT="RX Action parameter missing",RESPONSE=5 G END "RTN","BPSNCPDP",23,0) ; "RTN","BPSNCPDP",24,0) ; Get rx number "RTN","BPSNCPDP",25,0) S BRX=$$RXAPI1^BPSUTIL1(BRXIEN,.01,"I") "RTN","BPSNCPDP",26,0) ; "RTN","BPSNCPDP",27,0) ; Check that the rx exists "RTN","BPSNCPDP",28,0) I BRX="" S CLMSTAT="Prescription does not exist",RESPONSE=5 G END "RTN","BPSNCPDP",29,0) ; "RTN","BPSNCPDP",30,0) ; Get the NDC if it was not passed in "RTN","BPSNCPDP",31,0) I $G(BILLNDC)="" S BILLNDC=$$GETNDC^PSONDCUT(BRXIEN,BFILL) "RTN","BPSNCPDP",32,0) ; "RTN","BPSNCPDP",33,0) ; Patient Info "RTN","BPSNCPDP",34,0) S DFN=$$RXAPI1^BPSUTIL1(BRXIEN,2,"I"),PNAME=$$GET1^DIQ(2,DFN,.01) "RTN","BPSNCPDP",35,0) ; "RTN","BPSNCPDP",36,0) ; Set write flag "RTN","BPSNCPDP",37,0) S WFLG=1 "RTN","BPSNCPDP",38,0) I ",ARES,AREV,CRLB,CRLR,CRLX,DDED,DE,EREV,HLD,PC,PE,PL,RS,"[(","_BWHERE_",") S WFLG=0 "RTN","BPSNCPDP",39,0) ; "RTN","BPSNCPDP",40,0) ; Get status of previously submitted claim and set rebill/revonly flags "RTN","BPSNCPDP",41,0) S (REBILL,REVONLY)=0 "RTN","BPSNCPDP",42,0) S OLDRESP=$P($$STATUS^BPSOSRX(BRXIEN,BFILL,1),U) "RTN","BPSNCPDP",43,0) I ",AREV,CRLR,CRLX,DC,DDED,DE,EREV,HLD,RS,"[(","_BWHERE_",") S REVONLY=1 "RTN","BPSNCPDP",44,0) E I OLDRESP="E PAYABLE"!(OLDRESP="E DUPLICATE") S REBILL=1 "RTN","BPSNCPDP",45,0) ; "RTN","BPSNCPDP",46,0) ; Get Site info and check if the site has ECME turned on. Note that "RTN","BPSNCPDP",47,0) ; ECMEON will also return false if there is no NPI after the drop "RTN","BPSNCPDP",48,0) ; dead date. Do not do this check for reversals/rebill as these "RTN","BPSNCPDP",49,0) ; need to be processed for the old site "RTN","BPSNCPDP",50,0) I 'BFILL S SITE=$$RXAPI1^BPSUTIL1(BRXIEN,20,"I") "RTN","BPSNCPDP",51,0) I BFILL S SITE=$$RXSUBF1^BPSUTIL1(BRXIEN,52,52.1,+BFILL,8,"I") "RTN","BPSNCPDP",52,0) I 'REVONLY,'REBILL D I RESPONSE=1 G END "RTN","BPSNCPDP",53,0) . I '$G(SITE) S CLMSTAT="No Site Information",RESPONSE=1 Q "RTN","BPSNCPDP",54,0) . I '$$ECMEON^BPSUTIL(SITE) S CLMSTAT="ECME switch is not on for the site",RESPONSE=1 "RTN","BPSNCPDP",55,0) ; "RTN","BPSNCPDP",56,0) ; In Progress/Stranded claims check "RTN","BPSNCPDP",57,0) I OLDRESP["IN PROGRESS" D IPSC^BPSNCPD4 G END "RTN","BPSNCPDP",58,0) ; "RTN","BPSNCPDP",59,0) ; Backbilling check "RTN","BPSNCPDP",60,0) I BWHERE="BB",OLDRESP'="" D BBC^BPSNCPD4 G END "RTN","BPSNCPDP",61,0) ; "RTN","BPSNCPDP",62,0) ; Do not reverse if the rx was not previously billed through ECME "RTN","BPSNCPDP",63,0) I OLDRESP="",(",AREV,CRLR,CRLX,DC,DDED,DE,EREV,HLD,RS,"[(","_BWHERE_",")) D NOR^BPSNCPD4 G END "RTN","BPSNCPDP",64,0) ; "RTN","BPSNCPDP",65,0) ; If returning to stock or deleting and the previous claim was not paid, then no reversal is needed "RTN","BPSNCPDP",66,0) ; so close the prescription and quit "RTN","BPSNCPDP",67,0) I OLDRESP'["E PAYABLE",OLDRESP'["E REVERSAL REJECTED",(",RS,DE,"[(","_BWHERE_",")) D RSNR^BPSNCPD4 G END "RTN","BPSNCPDP",68,0) ; "RTN","BPSNCPDP",69,0) ; Do not reverse if the claim is not E PAYABLE "RTN","BPSNCPDP",70,0) I OLDRESP'["E PAYABLE",OLDRESP'["E DUPLICATE",(",AREV,CRLR,CRLX,DC,DDED,HLD,"[(","_BWHERE_",")) D DNR^BPSNCPD4 G END "RTN","BPSNCPDP",71,0) ; "RTN","BPSNCPDP",72,0) ; EREV can be re-reversed if the previous submission is Payable or Rejected Revesal "RTN","BPSNCPDP",73,0) I BWHERE="EREV",",E PAYABLE,E DUPLICATE,E REVERSAL REJECTED,E REVERSAL STRANDED,"'[(","_OLDRESP_",") D EREVRR^BPSNCPD4 G END "RTN","BPSNCPDP",74,0) ; "RTN","BPSNCPDP",75,0) ; Make sure fill date is not in the future or empty "RTN","BPSNCPDP",76,0) S TODAY=$P($$STTM,".",1) "RTN","BPSNCPDP",77,0) I '$G(BFILLDAT)!($G(BFILLDAT)>TODAY) S BFILLDAT=TODAY "RTN","BPSNCPDP",78,0) ; "RTN","BPSNCPDP",79,0) ; Store needed parameters into MOREDATA "RTN","BPSNCPDP",80,0) S MOREDATA("USER")=$S('DUZ:.5,1:DUZ) "RTN","BPSNCPDP",81,0) S MOREDATA("RX ACTION")=$G(BWHERE) "RTN","BPSNCPDP",82,0) S MOREDATA("DATE OF SERVICE")=$P($G(BFILLDAT),".") "RTN","BPSNCPDP",83,0) S MOREDATA("REVERSAL REASON")=$S($G(REVREAS)="":"UNKNOWN",1:$E($G(REVREAS),1,40)) "RTN","BPSNCPDP",84,0) I $G(DURREC)]"" S MOREDATA("DUR",1,0)=DURREC "RTN","BPSNCPDP",85,0) I $G(BPOVRIEN)]"" S MOREDATA("BPOVRIEN")=BPOVRIEN "RTN","BPSNCPDP",86,0) I $G(BPSCLARF)]"" S MOREDATA("BPSCLARF")=BPSCLARF "RTN","BPSNCPDP",87,0) I $TR($G(BPSAUTH),U)]"" S MOREDATA("BPSAUTH")=BPSAUTH "RTN","BPSNCPDP",88,0) ; "RTN","BPSNCPDP",89,0) ; Do a reversal for the appropriate actions "RTN","BPSNCPDP",90,0) I ",AREV,CRLR,CRLX,DC,DDED,DE,EREV,HLD,RS,"[(","_BWHERE_",") D G STATUS:RESPONSE=0,END:RESPONSE=4 "RTN","BPSNCPDP",91,0) . ; If override flag is set, prompt for override values - TEST ONLY "RTN","BPSNCPDP",92,0) . I $$CHECK^BPSTEST D GETOVER^BPSTEST(BRXIEN,BFILL,OLDRESP,BWHERE,"R") "RTN","BPSNCPDP",93,0) . ; "RTN","BPSNCPDP",94,0) . ; Needed for Turn-Around Stats - Do NOT delete/alter!! "RTN","BPSNCPDP",95,0) . D LOG(IEN59,"Before Submit of Reversal") "RTN","BPSNCPDP",96,0) . S BPSTART=$$STTM() "RTN","BPSNCPDP",97,0) . S RESP=$$UNCLAIM^BPSOSRX(BRXIEN,BFILL,.MOREDATA) "RTN","BPSNCPDP",98,0) . D LOG(IEN59,"After Submit of Reversal. Return Value: "_RESP) "RTN","BPSNCPDP",99,0) . I RESP=1 D "RTN","BPSNCPDP",100,0) .. S RESPONSE=0,CLMSTAT="Reversing prescription "_BRX_"." "RTN","BPSNCPDP",101,0) .. I WFLG W !,CLMSTAT H 2 "RTN","BPSNCPDP",102,0) . I RESP=0 D "RTN","BPSNCPDP",103,0) .. S RESPONSE=4,CLMSTAT="No claim submission made. Unable to queue reversal." "RTN","BPSNCPDP",104,0) .. D LOG(IEN59,CLMSTAT) "RTN","BPSNCPDP",105,0) .. I WFLG W !,CLMSTAT,! H 2 "RTN","BPSNCPDP",106,0) .. L -^BPST "RTN","BPSNCPDP",107,0) ; "RTN","BPSNCPDP",108,0) ; Can not resubmit reversed claims unless they are accepted "RTN","BPSNCPDP",109,0) I OLDRESP]"",OLDRESP["E REVERSAL",OLDRESP'="E REVERSAL ACCEPTED" D G END "RTN","BPSNCPDP",110,0) . S CLMSTAT="Can not resubmit a rejected or stranded reversal",RESPONSE=1 "RTN","BPSNCPDP",111,0) . I WFLG W !,CLMSTAT,! H 2 "RTN","BPSNCPDP",112,0) ; "RTN","BPSNCPDP",113,0) ; Some actions require a paid claim (they will not do a reversal/resubmit) "RTN","BPSNCPDP",114,0) I OLDRESP]"",OLDRESP'="E REVERSAL ACCEPTED",OLDRESP'="E REJECTED",(",CRLB,ED,ERES,RL,RRL,"'[(","_BWHERE_",")) D G END "RTN","BPSNCPDP",115,0) . S CLMSTAT="Previously billed through ECME: "_OLDRESP,RESPONSE=1 "RTN","BPSNCPDP",116,0) . I WFLG W !,CLMSTAT,! H 2 "RTN","BPSNCPDP",117,0) ; "RTN","BPSNCPDP",118,0) ; Certification Testing "RTN","BPSNCPDP",119,0) S QUIT=0,CERTIEN="" "RTN","BPSNCPDP",120,0) I ^BPS(9002313.99,1,"CERTIFIER")=DUZ D I QUIT S CLMSTAT="User exited from certification questions",RESPONSE=1 G END "RTN","BPSNCPDP",121,0) C1 . R !,"ENTER NDC: ",BILLNDC:120 S:BILLNDC=U QUIT=1 Q:QUIT I BILLNDC="" G C1 "RTN","BPSNCPDP",122,0) C3 . R !,"CERTIFICATION ENTRY: ",CERTIEN:120 I '$D(^BPS(9002313.31,CERTIEN)) S:CERTIEN=U QUIT=1 Q:QUIT W !,"INVALID IEN" G C3 "RTN","BPSNCPDP",123,0) I WFLG W !! "RTN","BPSNCPDP",124,0) ; "RTN","BPSNCPDP",125,0) ; Build array BPSARRY with prescription data "RTN","BPSNCPDP",126,0) D STARRAY^BPSNCPD1(BRXIEN,BFILL,BWHERE,.BPSARRY,$G(SITE)) "RTN","BPSNCPDP",127,0) ; "RTN","BPSNCPDP",128,0) ; Do IB billing determination and check response "RTN","BPSNCPDP",129,0) ; If IB=2, then not billable, so write messages "RTN","BPSNCPDP",130,0) S IB=0 "RTN","BPSNCPDP",131,0) D EN^BPSNCPD2(DFN,BWHERE,.MOREDATA,.BPSARRY,.IB) "RTN","BPSNCPDP",132,0) I IB=2,(OLDRESP="E PAYABLE")!(OLDRESP="E DUPLICATE"),(",CRLB,ED,ERES,RL,RRL,"[(","_BWHERE_",")) D "RTN","BPSNCPDP",133,0) .S MOREDATA("REVERSE THEN RESUBMIT")=2 "RTN","BPSNCPDP",134,0) .S CLMSTAT=$P(MOREDATA("BILL"),U,2) "RTN","BPSNCPDP",135,0) .D LOG(IEN59,CLMSTAT_" - Claim Will Be Reversed But Will Not Be Resubmitted") "RTN","BPSNCPDP",136,0) .I WFLG W !,CLMSTAT_" - Claim Will Be Reversed But Will Not Be Resubmitted" H 2 "RTN","BPSNCPDP",137,0) ; need to run with writing on for Tricare "RTN","BPSNCPDP",138,0) I $G(MOREDATA("ELIG"))="T",(",PE,PL,PC,"[(","_BWHERE_",")) S WFLG=1 "RTN","BPSNCPDP",139,0) ; "RTN","BPSNCPDP",140,0) I IB=2,$G(MOREDATA("REVERSE THEN RESUBMIT"))'=2 D G END "RTN","BPSNCPDP",141,0) . S RESPONSE=$S($G(BPSARRY("NO ECME INSURANCE")):6,1:2) "RTN","BPSNCPDP",142,0) . S CLMSTAT=$P(MOREDATA("BILL"),U,2) "RTN","BPSNCPDP",143,0) . I OLDRESP]"" D LOG(IEN59,CLMSTAT) "RTN","BPSNCPDP",144,0) ; "RTN","BPSNCPDP",145,0) ; Check for missing data (Will IB billing determination catch this?) "RTN","BPSNCPDP",146,0) I $D(MOREDATA("IBDATA",1,1)),$P(MOREDATA("IBDATA",1,1),U)="",$G(MOREDATA("REVERSE THEN RESUBMIT"))'=2 D G END "RTN","BPSNCPDP",147,0) . S RESPONSE=$S($G(BPSARRY("NO ECME INSURANCE")):6,1:2),CLMSTAT="Information missing from IB data." "RTN","BPSNCPDP",148,0) . I WFLG W !,CLMSTAT,! H 2 "RTN","BPSNCPDP",149,0) ; "RTN","BPSNCPDP",150,0) ; Check for missing/invalid payer sheets (I think IB billing determination will catch this) "RTN","BPSNCPDP",151,0) I $P($G(MOREDATA("IBDATA",1,1)),U,4)="",$G(MOREDATA("REVERSE THEN RESUBMIT"))'=2 D G END "RTN","BPSNCPDP",152,0) . S RESPONSE=$S($G(BPSARRY("NO ECME INSURANCE")):6,1:2),CLMSTAT="Invalid/missing payer sheet from IB data." "RTN","BPSNCPDP",153,0) . I WFLG W !,CLMSTAT,! H 2 "RTN","BPSNCPDP",154,0) ; "RTN","BPSNCPDP",155,0) ; Check if IB says to bill "RTN","BPSNCPDP",156,0) I '$G(MOREDATA("BILL")),$G(MOREDATA("REVERSE THEN RESUBMIT"))'=2 D G END "RTN","BPSNCPDP",157,0) . S RESPONSE=$S($G(BPSARRY("NO ECME INSURANCE")):6,1:2) "RTN","BPSNCPDP",158,0) . S CLMSTAT="Flagged by IB to not 3rd Party Insurance bill through ECME." "RTN","BPSNCPDP",159,0) . I WFLG W !,CLMSTAT,! H 2 "RTN","BPSNCPDP",160,0) ; "RTN","BPSNCPDP",161,0) ; Log message to ECME log "RTN","BPSNCPDP",162,0) ; Needed for Turn-Around Stats - Do NOT delete/alter!! "RTN","BPSNCPDP",163,0) D LOG(IEN59,"Before submit of claim") "RTN","BPSNCPDP",164,0) ; "RTN","BPSNCPDP",165,0) ; If override flag is set, prompt for override values - TEST ONLY "RTN","BPSNCPDP",166,0) I $$CHECK^BPSTEST D GETOVER^BPSTEST(BRXIEN,BFILL,OLDRESP,BWHERE,"S") "RTN","BPSNCPDP",167,0) ; "RTN","BPSNCPDP",168,0) ; Get require data "RTN","BPSNCPDP",169,0) S BPSTART=$$STTM() "RTN","BPSNCPDP",170,0) ; "RTN","BPSNCPDP",171,0) ; Submit claim and check result "RTN","BPSNCPDP",172,0) S RESP=$$CLAIM^BPSOSRX(BRXIEN,BFILL,.MOREDATA) "RTN","BPSNCPDP",173,0) D LOG(IEN59,"After Submit of Claim. Return Value: "_RESP) "RTN","BPSNCPDP",174,0) I RESP=1 D "RTN","BPSNCPDP",175,0) . S RESPONSE=0 "RTN","BPSNCPDP",176,0) . I $G(MOREDATA("REVERSE THEN RESUBMIT"))=2 S CLMSTAT=$S($G(MOREDATA("ELIG"))="T":"TRICARE ",1:"")_"Prescription "_BRX_$S($G(MOREDATA("ELIG"))="T":"",1:" successfully")_" submitted to ECME for claim reversal." "RTN","BPSNCPDP",177,0) . E S CLMSTAT=$S($G(MOREDATA("ELIG"))="T":"TRICARE ",1:"")_"Prescription "_BRX_$S($G(MOREDATA("ELIG"))="T":"",1:" successfully")_" submitted to ECME for claim generation." "RTN","BPSNCPDP",178,0) . I WFLG W !!,CLMSTAT "RTN","BPSNCPDP",179,0) I RESP=0 D G END "RTN","BPSNCPDP",180,0) . S RESPONSE=4 "RTN","BPSNCPDP",181,0) . S CLMSTAT="No claim submission made. Unable to queue claim submission." "RTN","BPSNCPDP",182,0) . I WFLG W !!,CLMSTAT,! "RTN","BPSNCPDP",183,0) . D LOG(IEN59,CLMSTAT) "RTN","BPSNCPDP",184,0) ; "RTN","BPSNCPDP",185,0) ; Display status "RTN","BPSNCPDP",186,0) STATUS I 'WFLG H 1 "RTN","BPSNCPDP",187,0) E D STATUS^BPSNCPD1(BRXIEN,BFILL,REBILL,REVONLY,BPSTART,BWHERE) "RTN","BPSNCPDP",188,0) ; "RTN","BPSNCPDP",189,0) ;Update Response for Reversal but no Resubmit "RTN","BPSNCPDP",190,0) I $G(MOREDATA("REVERSE THEN RESUBMIT"))=2 S RESPONSE=10,CLMSTAT=$P($G(MOREDATA("BILL")),U,2) "RTN","BPSNCPDP",191,0) ; "RTN","BPSNCPDP",192,0) ; "RTN","BPSNCPDP",193,0) END S BPSELIG=$G(MOREDATA("ELIG")) "RTN","BPSNCPDP",194,0) ; need to look up current status and return (mm if tricare in progress) "RTN","BPSNCPDP",195,0) S BPSSTAT=$S($G(BRXIEN):$P($$STATUS^BPSOSRX(BRXIEN,BFILL),U),1:"") "RTN","BPSNCPDP",196,0) I BPSELIG="T",BPSSTAT="IN PROGRESS",DURREC'="RX RELEASE-NDC CHANGE" D BULL^BPSNCPD1(BRXIEN,BFILL,SITE,DFN,PNAME,1) "RTN","BPSNCPDP",197,0) ; "RTN","BPSNCPDP",198,0) K BRXIEN,BFILL,BFILLDAT,BWHERE,MOREDATA "RTN","BPSNCPDP",199,0) S:'$D(RESPONSE) RESPONSE=1 "RTN","BPSNCPDP",200,0) I $G(IEN59) D "RTN","BPSNCPDP",201,0) . N MSG "RTN","BPSNCPDP",202,0) . S MSG="Foreground Process Complete-RESPONSE="_$G(RESPONSE) "RTN","BPSNCPDP",203,0) . I $G(RESPONSE)'=0 S MSG=MSG_", CLMSTAT="_$G(CLMSTAT) "RTN","BPSNCPDP",204,0) . D LOG(IEN59,MSG) "RTN","BPSNCPDP",205,0) ; "RTN","BPSNCPDP",206,0) Q RESPONSE_U_$G(CLMSTAT)_U_BPSELIG_U_BPSSTAT "RTN","BPSNCPDP",207,0) ; "RTN","BPSNCPDP",208,0) LOG(IEN59,MSG) ; "RTN","BPSNCPDP",209,0) D LOG^BPSOSL(IEN59,$T(+0)_"-"_MSG) "RTN","BPSNCPDP",210,0) Q "RTN","BPSNCPDP",211,0) STTM() ; "RTN","BPSNCPDP",212,0) Q $$NOW^XLFDT "RTN","BPSOSIY") 0^3^B54076368^B52867161 "RTN","BPSOSIY",1,0) BPSOSIY ;BHAM ISC/FCS/DRS/DLF - Updating BPS Transaction record ;11/14/07 13:47 "RTN","BPSOSIY",2,0) ;;1.0;E CLAIMS MGMT ENGINE;**1,3,5,6**;JUN 2004;Build 10 "RTN","BPSOSIY",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","BPSOSIY",4,0) Q "RTN","BPSOSIY",5,0) ; "RTN","BPSOSIY",6,0) ; INIT - Update BPS Transaction "RTN","BPSOSIY",7,0) ; Input "RTN","BPSOSIY",8,0) ; IEN59 - BPS Transaction "RTN","BPSOSIY",9,0) ; MOREDATA is not passed but assumed to exist "RTN","BPSOSIY",10,0) ; Returns "RTN","BPSOSIY",11,0) ; ERROR - 0 or error number "RTN","BPSOSIY",12,0) INIT(IEN59) ;EP - from BPSOSIZ "RTN","BPSOSIY",13,0) ; "RTN","BPSOSIY",14,0) ; Initialize variables "RTN","BPSOSIY",15,0) N FDA,MSG,FN,IENS,REC,B1,X1,X2,X3,ERROR,SEQ "RTN","BPSOSIY",16,0) N RXI,RXR,DIV "RTN","BPSOSIY",17,0) S FN=9002313.59,REC=IEN59_",",ERROR=0 "RTN","BPSOSIY",18,0) S RXI=$P(IEN59,".",1),RXR=+$E($P(IEN59,".",2),1,4) "RTN","BPSOSIY",19,0) I RXI="" Q 11 "RTN","BPSOSIY",20,0) ; "RTN","BPSOSIY",21,0) ; Change status to 0% (Waiting to Start), which will reset START TIME, "RTN","BPSOSIY",22,0) ; and then to 10% (Building transaction) "RTN","BPSOSIY",23,0) D SETSTAT^BPSOSU(IEN59,0) "RTN","BPSOSIY",24,0) D SETSTAT^BPSOSU(IEN59,10) "RTN","BPSOSIY",25,0) ; "RTN","BPSOSIY",26,0) ; Get the Outpatient Site "RTN","BPSOSIY",27,0) S DIV=$$GETDIV^BPSOSQC(RXI,RXR) "RTN","BPSOSIY",28,0) ; "RTN","BPSOSIY",29,0) ; If there are Prior Auth or Sub Clar Code override, create override "RTN","BPSOSIY",30,0) ; record. Note that setting of MOREDATA("BPOVRIEN") in this routine "RTN","BPSOSIY",31,0) ; will not conflict with prior setting of this value of BPOVRIEN "RTN","BPSOSIY",32,0) ; since BPOVRIEN and BPSAUTH/BPSCLARF are mutually exclusive "RTN","BPSOSIY",33,0) I $G(MOREDATA("BPSAUTH"))]""!($G(MOREDATA("BPSCLARF"))]"") S MOREDATA("BPOVRIEN")=$$OVERRIDE(IEN59) "RTN","BPSOSIY",34,0) ; "RTN","BPSOSIY",35,0) ; Set BPSDATA into local variable "RTN","BPSOSIY",36,0) S B1=$G(MOREDATA("BPSDATA",1)) "RTN","BPSOSIY",37,0) ; "RTN","BPSOSIY",38,0) ; Get first record from MOREDATA("IBDATA") as there are some "RTN","BPSOSIY",39,0) ; non-multiple fields that need it "RTN","BPSOSIY",40,0) S X2="",SEQ=$O(MOREDATA("IBDATA","")) "RTN","BPSOSIY",41,0) I SEQ S X2=$G(MOREDATA("IBDATA",SEQ,2)) "RTN","BPSOSIY",42,0) ; "RTN","BPSOSIY",43,0) ; Set non-multiple fields "RTN","BPSOSIY",44,0) S FDA(FN,REC,1.07)=$$GETPHARM^BPSUTIL(DIV) ;BPS Pharmacy "RTN","BPSOSIY",45,0) S FDA(FN,REC,1.08)=1 ;PINS piece "RTN","BPSOSIY",46,0) S FDA(FN,REC,1.11)=RXI ;Prescription "RTN","BPSOSIY",47,0) I $P($G(^BPST(IEN59,1)),U,12)=1 S FDA(FN,REC,1.12)=2 ;Resubmit after reversal "RTN","BPSOSIY",48,0) S FDA(FN,REC,1.13)=$G(MOREDATA("BPOVRIEN")) ;NCPDP Overrides "RTN","BPSOSIY",49,0) S FDA(FN,REC,5)=$$RXAPI1^BPSUTIL1(RXI,2,"I") ;Patient "RTN","BPSOSIY",50,0) I '$P($G(^BPST(IEN59,1)),U,12) S FDA(FN,REC,6)=$G(MOREDATA("SUBMIT TIME")) ;Submit Date/Time "RTN","BPSOSIY",51,0) S FDA(FN,REC,9)=RXR ;Refill "RTN","BPSOSIY",52,0) S FDA(FN,REC,10)=$P(B1,U,3) ;NDC "RTN","BPSOSIY",53,0) S FDA(FN,REC,11)=DIV ;Outpatient Site "RTN","BPSOSIY",54,0) S FDA(FN,REC,13)=$G(MOREDATA("USER")) ;User "RTN","BPSOSIY",55,0) S FDA(FN,REC,501)=$P(B1,U,1) ;Drug Quanity "RTN","BPSOSIY",56,0) S FDA(FN,REC,502)=$P(B1,U,2) ;Ingredient Cost "RTN","BPSOSIY",57,0) S FDA(FN,REC,504)=$P(X2,U,1) ;Dispense Fee "RTN","BPSOSIY",58,0) S FDA(FN,REC,505)=$P(X2,U,3) ;Total Price "RTN","BPSOSIY",59,0) S FDA(FN,REC,507)=$P(X2,U,5) ;Administrative Fee "RTN","BPSOSIY",60,0) S FDA(FN,REC,508)=$E($P(B1,U,7),1,2) ;Dispense Unit "RTN","BPSOSIY",61,0) S FDA(FN,REC,901)=1 ;Current VA Insurer "RTN","BPSOSIY",62,0) S FDA(FN,REC,1201)=$G(MOREDATA("RX ACTION")) ;RX Action "RTN","BPSOSIY",63,0) S FDA(FN,REC,1202)=$G(MOREDATA("DATE OF SERVICE")) ;Date of Service "RTN","BPSOSIY",64,0) S FDA(FN,REC,901.04)=$G(MOREDATA("ELIG")) ;Eligibility info returned from billing determination "RTN","BPSOSIY",65,0) ; "RTN","BPSOSIY",66,0) ; File non-multiple fields - Record is already defined "RTN","BPSOSIY",67,0) D FILE^DIE("","FDA","MSG") "RTN","BPSOSIY",68,0) I $D(MSG) D Q ERROR "RTN","BPSOSIY",69,0) . S ERROR=12 "RTN","BPSOSIY",70,0) . D LOG^BPSOSL(IEN59,$T(+0)_"-Non-multiple fields did not file") "RTN","BPSOSIY",71,0) . D LOG^BPSOSL(IEN59,"MSG Array:") "RTN","BPSOSIY",72,0) . D LOGARRAY^BPSOSL(IEN59,"MSG") "RTN","BPSOSIY",73,0) . D LOG^BPSOSL(IEN59,"FDA Array:") "RTN","BPSOSIY",74,0) . D LOGARRAY^BPSOSL(IEN59,"FDA") "RTN","BPSOSIY",75,0) ; "RTN","BPSOSIY",76,0) ; Build Multiple "RTN","BPSOSIY",77,0) S SEQ="" "RTN","BPSOSIY",78,0) F S SEQ=$O(MOREDATA("IBDATA",SEQ)) Q:SEQ="" D I ERROR Q "RTN","BPSOSIY",79,0) . K FDA,MSG,IENS "RTN","BPSOSIY",80,0) . S FN=9002313.59902,IENS="+1,"_REC,IENS(1)=SEQ "RTN","BPSOSIY",81,0) . S X1=$G(MOREDATA("IBDATA",SEQ,1)),X2=$G(MOREDATA("IBDATA",SEQ,2)),X3=$G(MOREDATA("IBDATA",SEQ,3)) "RTN","BPSOSIY",82,0) . ; "RTN","BPSOSIY",83,0) . ; Update fields "RTN","BPSOSIY",84,0) . S FDA(FN,IENS,.01)=$P(X1,U,1) ;Plan ID "RTN","BPSOSIY",85,0) . S FDA(FN,IENS,902.03)=$P(X1,U,2) ;BIN "RTN","BPSOSIY",86,0) . S FDA(FN,IENS,902.04)=$P(X1,U,3) ;PCN "RTN","BPSOSIY",87,0) . S FDA(FN,IENS,902.05)=$P(X1,U,5) ;Group ID "RTN","BPSOSIY",88,0) . S FDA(FN,IENS,902.06)=$P(X1,U,6) ;Cardholder ID "RTN","BPSOSIY",89,0) . S FDA(FN,IENS,902.07)=$S(+$P(X1,U,7)>4:4,1:+$P(X1,U,7)) ;Patient Relationship Code "RTN","BPSOSIY",90,0) . S FDA(FN,IENS,902.08)=$P($P(X1,U,8)," ") ;Cardholder First Name "RTN","BPSOSIY",91,0) . S FDA(FN,IENS,902.09)=$P(X1,U,9) ;Cardholder Last Name "RTN","BPSOSIY",92,0) . S FDA(FN,IENS,902.11)=$P(X1,U,10) ;Home Plan State "RTN","BPSOSIY",93,0) . S FDA(FN,IENS,902.12)=$P(X2,U,1) ;Dispense Fee "RTN","BPSOSIY",94,0) . S FDA(FN,IENS,902.13)=$P(X2,U,2) ;Basis of Cost Determination "RTN","BPSOSIY",95,0) . S FDA(FN,IENS,902.14)=$P(X2,U,3) ;Usual & Customary Charge "RTN","BPSOSIY",96,0) . S FDA(FN,IENS,902.15)=$P(X2,U,4) ;Gross Amt Due "RTN","BPSOSIY",97,0) . S FDA(FN,IENS,902.16)=$P(X2,U,5) ;Administrative Fee "RTN","BPSOSIY",98,0) . S FDA(FN,IENS,902.17)=$P(B1,U,4) ;VA Fill Number "RTN","BPSOSIY",99,0) . S FDA(FN,IENS,902.18)=$P(X1,U,13) ;Software/Vendor Cert ID "RTN","BPSOSIY",100,0) . S FDA(FN,IENS,902.22)=$P(B1,U,5) ;Certify Mode "RTN","BPSOSIY",101,0) . S FDA(FN,IENS,902.23)=$P(B1,U,6) ;Certification IEN "RTN","BPSOSIY",102,0) . S FDA(FN,IENS,902.24)=$P(X1,U,14) ;Plan Name "RTN","BPSOSIY",103,0) . S FDA(FN,IENS,902.25)=$P(X3,U,1) ;Group Name "RTN","BPSOSIY",104,0) . S FDA(FN,IENS,902.26)=$P(X3,U,2) ;Insurance Co Phone # "RTN","BPSOSIY",105,0) . S FDA(FN,IENS,902.27)=$P(X3,U,3) ;Pharmacy Plan ID "RTN","BPSOSIY",106,0) . ; "RTN","BPSOSIY",107,0) . ; File the data "RTN","BPSOSIY",108,0) . D UPDATE^DIE("","FDA","IENS","MSG") "RTN","BPSOSIY",109,0) . I $D(MSG) D "RTN","BPSOSIY",110,0) .. S ERROR=13 "RTN","BPSOSIY",111,0) .. D LOG^BPSOSL(IEN59,$T(+0)_"-Multiple fields did not file, SEQ="_SEQ) "RTN","BPSOSIY",112,0) .. D LOG^BPSOSL(IEN59,"MSG Array:") "RTN","BPSOSIY",113,0) .. D LOGARRAY^BPSOSL(IEN59,"MSG") "RTN","BPSOSIY",114,0) .. D LOG^BPSOSL(IEN59,"IENS Array:") "RTN","BPSOSIY",115,0) .. D LOGARRAY^BPSOSL(IEN59,"IENS") "RTN","BPSOSIY",116,0) .. D LOG^BPSOSL(IEN59,"FDA Array:") "RTN","BPSOSIY",117,0) .. D LOGARRAY^BPSOSL(IEN59,"FDA") "RTN","BPSOSIY",118,0) . ; "RTN","BPSOSIY",119,0) . ; Payer sheets are in external format "RTN","BPSOSIY",120,0) . K FDA,MSG "RTN","BPSOSIY",121,0) . S FN=9002313.59902,IENS=IENS(1)_","_REC "RTN","BPSOSIY",122,0) . S FDA(FN,IENS,902.02)=$P(X1,U,4) ;Payer Sheet IEN "RTN","BPSOSIY",123,0) . S FDA(FN,IENS,902.19)=$P(X1,U,11) ;B2 Payer Sheet (Reversal) "RTN","BPSOSIY",124,0) . S FDA(FN,IENS,902.21)=$P(X1,U,12) ;B3 Payer Sheet (Rebill) "RTN","BPSOSIY",125,0) . D FILE^DIE("E","FDA","MSG") "RTN","BPSOSIY",126,0) . I $D(MSG) D "RTN","BPSOSIY",127,0) .. S ERROR=14 "RTN","BPSOSIY",128,0) .. D LOG^BPSOSL(IEN59,$T(+0)_"-Payer sheets did not file, SEQ="_SEQ) "RTN","BPSOSIY",129,0) .. D LOG^BPSOSL(IEN59,"MSG Array:") "RTN","BPSOSIY",130,0) .. D LOGARRAY^BPSOSL(IEN59,"MSG") "RTN","BPSOSIY",131,0) .. D LOG^BPSOSL(IEN59,"FDA Array:") "RTN","BPSOSIY",132,0) .. D LOGARRAY^BPSOSL(IEN59,"FDA") "RTN","BPSOSIY",133,0) ; "RTN","BPSOSIY",134,0) ; Store DUR multiple if it exists "RTN","BPSOSIY",135,0) N DUR,DURREC "RTN","BPSOSIY",136,0) S FN=9002313.5913,DUR=0 "RTN","BPSOSIY",137,0) F S DUR=$O(MOREDATA("DUR",DUR)) Q:DUR="" D I ERROR Q "RTN","BPSOSIY",138,0) . K FDA,MSG,IENS "RTN","BPSOSIY",139,0) . S DURREC=$G(MOREDATA("DUR",DUR,0)) "RTN","BPSOSIY",140,0) . S IENS="+1,"_REC,IENS(1)=DUR "RTN","BPSOSIY",141,0) . S FDA(FN,IENS,.01)=DUR ; DUR Counter "RTN","BPSOSIY",142,0) . S FDA(FN,IENS,1)=$P(DURREC,U,1) ; DUR Professional Service Code "RTN","BPSOSIY",143,0) . S FDA(FN,IENS,2)=$P(DURREC,U,2) ; DUR Reason for Service Code "RTN","BPSOSIY",144,0) . S FDA(FN,IENS,3)=$P(DURREC,U,3) ; DUR Result of Service Code "RTN","BPSOSIY",145,0) . D UPDATE^DIE("","FDA","IENS","MSG") "RTN","BPSOSIY",146,0) . I $D(MSG) D "RTN","BPSOSIY",147,0) .. S ERROR=15 "RTN","BPSOSIY",148,0) .. D LOG^BPSOSL(IEN59,$T(+0)_"-DUR fields did not file, DUR="_DUR) "RTN","BPSOSIY",149,0) .. D LOG^BPSOSL(IEN59,"DURREC="_DURREC) "RTN","BPSOSIY",150,0) .. D LOG^BPSOSL(IEN59,"MSG Array:") "RTN","BPSOSIY",151,0) .. D LOGARRAY^BPSOSL(IEN59,"MSG") "RTN","BPSOSIY",152,0) .. D LOG^BPSOSL(IEN59,"IENS Array:") "RTN","BPSOSIY",153,0) .. D LOGARRAY^BPSOSL(IEN59,"IENS") "RTN","BPSOSIY",154,0) .. D LOG^BPSOSL(IEN59,"FDA Array:") "RTN","BPSOSIY",155,0) .. D LOGARRAY^BPSOSL(IEN59,"FDA") "RTN","BPSOSIY",156,0) ; "RTN","BPSOSIY",157,0) Q ERROR "RTN","BPSOSIY",158,0) ; "RTN","BPSOSIY",159,0) ; OVERRIDE - Function to create override record "RTN","BPSOSIY",160,0) OVERRIDE(IEN59) ; "RTN","BPSOSIY",161,0) ;Save values into BPS NCPDP OVERRIDES (#9002313.511) "RTN","BPSOSIY",162,0) N BPSFDA,BPSFLD,BPOVRIEN,BPSMSG,BPSQ "RTN","BPSOSIY",163,0) ; "RTN","BPSOSIY",164,0) ; Set Name (.01) to transaction number "RTN","BPSOSIY",165,0) S BPSFDA(9002313.511,"+1,",.01)=IEN59 "RTN","BPSOSIY",166,0) ; "RTN","BPSOSIY",167,0) ; Set Created On (.02) to current date/time "RTN","BPSOSIY",168,0) S BPSFDA(9002313.511,"+1,",.02)=$$NOW^BPSOSRX() "RTN","BPSOSIY",169,0) ; "RTN","BPSOSIY",170,0) ; Submission Clarification Code "RTN","BPSOSIY",171,0) I $G(MOREDATA("BPSCLARF"))]"" D "RTN","BPSOSIY",172,0) . S BPSFLD=$O(^BPSF(9002313.91,"B",420,"")) "RTN","BPSOSIY",173,0) . I BPSFLD]"" S BPSFDA(9002313.5111,"+2,+1,",.01)=BPSFLD,BPSFDA(9002313.5111,"+2,+1,",.02)=$E(MOREDATA("BPSCLARF"),1,2) "RTN","BPSOSIY",174,0) ; "RTN","BPSOSIY",175,0) ; Prior Auth Fields (Code and Number) "RTN","BPSOSIY",176,0) I $G(MOREDATA("BPSAUTH"))]"" D "RTN","BPSOSIY",177,0) . S BPSFLD=$O(^BPSF(9002313.91,"B",461,"")) "RTN","BPSOSIY",178,0) . I BPSFLD]"" S BPSFDA(9002313.5111,"+3,+1,",.01)=BPSFLD,BPSFDA(9002313.5111,"+3,+1,",.02)=$E($P(MOREDATA("BPSAUTH"),U,1),1,2) "RTN","BPSOSIY",179,0) . S BPSFLD=$O(^BPSF(9002313.91,"B",462,"")) "RTN","BPSOSIY",180,0) . I BPSFLD]"" S BPSFDA(9002313.5111,"+4,+1,",.01)=BPSFLD,BPSFDA(9002313.5111,"+4,+1,",.02)=$E($P(MOREDATA("BPSAUTH"),U,2),1,11) "RTN","BPSOSIY",181,0) ; "RTN","BPSOSIY",182,0) ; Create the record "RTN","BPSOSIY",183,0) D UPDATE^DIE("","BPSFDA","BPOVRIEN","BPMSG") "RTN","BPSOSIY",184,0) ; "RTN","BPSOSIY",185,0) I $G(BPOVRIEN(1))]"" S BPSQ=BPOVRIEN(1) "RTN","BPSOSIY",186,0) E S BPSQ="" "RTN","BPSOSIY",187,0) Q BPSQ "RTN","BPSOSIY",188,0) ; "RTN","BPSOSIY",189,0) ; RXPAID - Check for status of previous claim "RTN","BPSOSIY",190,0) ; INPUT "RTN","BPSOSIY",191,0) ; IEN59 - BPS Transaction "RTN","BPSOSIY",192,0) ; Return "RTN","BPSOSIY",193,0) ; 0 - OK "RTN","BPSOSIY",194,0) ; 1 - Payable "RTN","BPSOSIY",195,0) ; 2 - Reversal not accepted "RTN","BPSOSIY",196,0) ; 3 - Duplicate "RTN","BPSOSIY",197,0) RXPAID(IEN59) ;EP - from BPSOSIZ "RTN","BPSOSIY",198,0) N N57 "RTN","BPSOSIY",199,0) S N57=$$RXPREV(IEN59) "RTN","BPSOSIY",200,0) I 'N57 Q "" ; no ECME record of this "RTN","BPSOSIY",201,0) ; If it's a reversal, then our result depends on the reversal: "RTN","BPSOSIY",202,0) ; Was the reversal accepted? If so, then No, not paid. "RTN","BPSOSIY",203,0) ; Was the reversal rejected? Assume Paid, since we try to "RTN","BPSOSIY",204,0) ; allow reversals only in the case of a paid original. "RTN","BPSOSIY",205,0) I $$ISREVERS^BPSOS57(N57) Q $S($$REVACC^BPSOS57(N57):0,1:2) "RTN","BPSOSIY",206,0) ; "RTN","BPSOSIY",207,0) ; Not a reversal: "RTN","BPSOSIY",208,0) N X S X=$$CATEG^BPSOSUC(N57) "RTN","BPSOSIY",209,0) Q $S(X="E PAYABLE":1,X="E DUPLICATE":3,1:0) "RTN","BPSOSIY",210,0) ; "RTN","BPSOSIY",211,0) ; RXPREV - Has this item previously been through ECME? "RTN","BPSOSIY",212,0) ; Return false if not "RTN","BPSOSIY",213,0) ; Return pointer to BPS Log of Transactions if true "RTN","BPSOSIY",214,0) RXPREV(IEN59) ; "RTN","BPSOSIY",215,0) N RXI,RXR "RTN","BPSOSIY",216,0) S RXI=$P(IEN59,".",1),RXR=+$E($P(IEN59,".",2),1,4) "RTN","BPSOSIY",217,0) Q $O(^BPSTL("NON-FILEMAN","RXIRXR",RXI,RXR,""),-1) "RTN","BPSSCRRV") 0^9^B16310738^B14899182 "RTN","BPSSCRRV",1,0) BPSSCRRV ;BHAM ISC/SS - ECME SCREEN REVERSE CLAIM ;05-APR-05 "RTN","BPSSCRRV",2,0) ;;1.0;E CLAIMS MGMT ENGINE;**1,5,6**;JUN 2004;Build 10 "RTN","BPSSCRRV",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","BPSSCRRV",4,0) Q "RTN","BPSSCRRV",5,0) ;IA 4702 "RTN","BPSSCRRV",6,0) ; "RTN","BPSSCRRV",7,0) REV ;entry point for "Reverse" menu item "RTN","BPSSCRRV",8,0) N BPRET,BPSARR59 "RTN","BPSSCRRV",9,0) I '$D(@(VALMAR)) Q "RTN","BPSSCRRV",10,0) D FULL^VALM1 "RTN","BPSSCRRV",11,0) W !,"Enter the line numbers for the Payable claim(s) to be Reversed." "RTN","BPSSCRRV",12,0) S BPRET=$$ASKLINES^BPSSCRU4("Select item(s)","C",.BPSARR59,VALMAR) "RTN","BPSSCRRV",13,0) I BPRET="^" S VALMBCK="R" Q "RTN","BPSSCRRV",14,0) ;reverse selected lines "RTN","BPSSCRRV",15,0) ;update the content of the screen and display it "RTN","BPSSCRRV",16,0) ;only if at least one reversal was submitted successfully "RTN","BPSSCRRV",17,0) I $$RVLINES(.BPSARR59)>0 D REDRAW^BPSSCRUD("Updating screen for reversed claims...") "RTN","BPSSCRRV",18,0) E S VALMBCK="R" "RTN","BPSSCRRV",19,0) Q "RTN","BPSSCRRV",20,0) ;/** "RTN","BPSSCRRV",21,0) ;Reverse selected lines "RTN","BPSSCRRV",22,0) ;input: "RTN","BPSSCRRV",23,0) ; BP59ARR(BP59)="line# in LM array " "RTN","BPSSCRRV",24,0) ;output: "RTN","BPSSCRRV",25,0) ; REVTOTAL - total number of claims for whose the reversal was submitted sucessfully "RTN","BPSSCRRV",26,0) RVLINES(BP59ARR) ;*/ "RTN","BPSSCRRV",27,0) N BP59,REVTOTAL,BPRVREAS,BPDFN,BPQ "RTN","BPSSCRRV",28,0) N BPIFANY S BPIFANY=0 "RTN","BPSSCRRV",29,0) N BPSTATS "RTN","BPSSCRRV",30,0) S REVTOTAL=0,BPQ="" "RTN","BPSSCRRV",31,0) S BP59="" F S BP59=$O(BP59ARR(BP59)) Q:BP59="" D Q:BPQ="^" "RTN","BPSSCRRV",32,0) . I BPIFANY=0 W @IOF "RTN","BPSSCRRV",33,0) . S BPIFANY=1,BPQ="" "RTN","BPSSCRRV",34,0) . ;can't reverse Tricare claims "RTN","BPSSCRRV",35,0) . I $P($G(^BPST(BP59,9)),U,4)="T" D S BPQ=$$PAUSE() Q "RTN","BPSSCRRV",36,0) . . W !,"The claim: ",!,$G(@VALMAR@(+$G(BP59ARR(BP59)),0)),!,"is Tricare claim and cannot be Reversed." "RTN","BPSSCRRV",37,0) . S BPDFN=+$P($G(^BPST(BP59,0)),U,6) "RTN","BPSSCRRV",38,0) . S BPSTATS=$P($$CLAIMST^BPSSCRU3(BP59),U) "RTN","BPSSCRRV",39,0) . I BPSTATS'["E DUPLICATE",BPSTATS'["E REVERSAL REJECTED",BPSTATS'["E REVERSAL STRANDED",BPSTATS'["E PAYABLE" D S BPQ=$$PAUSE() Q "RTN","BPSSCRRV",40,0) . . W !,"The claim: ",!,$G(@VALMAR@(+$G(BP59ARR(BP59)),0)),!,"is NOT Payable and cannot be Reversed." "RTN","BPSSCRRV",41,0) . ; "RTN","BPSSCRRV",42,0) . W !,"You've chosen to REVERSE the following prescription for "_$E($$PATNAME^BPSSCRU2(BPDFN),1,13) "RTN","BPSSCRRV",43,0) . W !,$G(@VALMAR@(+$G(BP59ARR(BP59)),0)) "RTN","BPSSCRRV",44,0) . F S BPRVREAS=$$COMMENT^BPSSCRCL("Enter REQUIRED REVERSAL REASON",60) Q:BPRVREAS="^" Q:($L(BPRVREAS)>0)&&(BPRVREAS'="^")&&('(BPRVREAS?1" "." ")) D "RTN","BPSSCRRV",45,0) . . W !,"Please provide the reason or enter ^ to abandon the reversal." "RTN","BPSSCRRV",46,0) . I BPRVREAS["^" W !,"The claim: ",!,$G(@VALMAR@(+$G(BP59ARR(BP59)),0)),!,"was NOT reversed!" S BPQ=$$PAUSE() Q "RTN","BPSSCRRV",47,0) . S BPQ=$$YESNO^BPSSCRRS("Are you sure?(Y/N)") "RTN","BPSSCRRV",48,0) . I BPQ=-1 S BPQ="^" Q "RTN","BPSSCRRV",49,0) . I BPQ'=1 Q "RTN","BPSSCRRV",50,0) . I $$REVERSIT(BP59,BPRVREAS)=0 S REVTOTAL=REVTOTAL+1 "RTN","BPSSCRRV",51,0) W:BPIFANY=0 !,"No eligible items selected." "RTN","BPSSCRRV",52,0) W !,REVTOTAL," claim reversal",$S(REVTOTAL'=1:"s",1:"")," in progress.",! "RTN","BPSSCRRV",53,0) D PAUSE^VALM1 "RTN","BPSSCRRV",54,0) Q REVTOTAL "RTN","BPSSCRRV",55,0) ; "RTN","BPSSCRRV",56,0) ; "RTN","BPSSCRRV",57,0) ;the similar to REVERSE "RTN","BPSSCRRV",58,0) ;with some information displayed for the user "RTN","BPSSCRRV",59,0) ;Input: "RTN","BPSSCRRV",60,0) ; BP59 ptr in file #9002313.59 "RTN","BPSSCRRV",61,0) ; BPRVREAS - reversal reason (free text) "RTN","BPSSCRRV",62,0) ;Output: "RTN","BPSSCRRV",63,0) ;-1 Claim is not Payable "RTN","BPSSCRRV",64,0) ;-2 no reversal, it's unreversable "RTN","BPSSCRRV",65,0) ;-3 paper claim "RTN","BPSSCRRV",66,0) ;>0 - IEN of reversal claim if electronic claim submitted for "RTN","BPSSCRRV",67,0) ; reversal. "RTN","BPSSCRRV",68,0) REVERSIT(BP59,BPRVREAS) ; "RTN","BPSSCRRV",69,0) N BPRET "RTN","BPSSCRRV",70,0) N BPRX "RTN","BPSSCRRV",71,0) N BPRXRF "RTN","BPSSCRRV",72,0) S BPRXRF=$$RXREF^BPSSCRU2(BP59) "RTN","BPSSCRRV",73,0) S BPRET=+$$REVERSE(BP59,BPRVREAS,+BPRXRF,+$P(BPRXRF,U,2)) "RTN","BPSSCRRV",74,0) S BPRX=$$RXNUM^BPSSCRU2(+BPRXRF) "RTN","BPSSCRRV",75,0) Q BPRET "RTN","BPSSCRRV",76,0) ; "RTN","BPSSCRRV",77,0) ; "RTN","BPSSCRRV",78,0) ;/** "RTN","BPSSCRRV",79,0) ;Reverse the claim "RTN","BPSSCRRV",80,0) ;Input: "RTN","BPSSCRRV",81,0) ; BP59 ptr in file #9002313.59 "RTN","BPSSCRRV",82,0) ; BPRVREAS - reversal reason (free text) "RTN","BPSSCRRV",83,0) ; BPRX - RX ien (#52) "RTN","BPSSCRRV",84,0) ; BPFIL - refill number "RTN","BPSSCRRV",85,0) ;Output: "RTN","BPSSCRRV",86,0) ; code^message "RTN","BPSSCRRV",87,0) ; where "RTN","BPSSCRRV",88,0) ; code : "RTN","BPSSCRRV",89,0) ; from $$EN^BPSNCPDP "RTN","BPSSCRRV",90,0) ; 0 Prescription/Fill successfully submitted to ECME for claims processing "RTN","BPSSCRRV",91,0) ; 1 ECME did not submit prescription/fill "RTN","BPSSCRRV",92,0) ; 2 IB says prescription/fill is not ECME billable or the data returned from IB is not valid "RTN","BPSSCRRV",93,0) ; 3 ECME closed the claim but did not submit it to the payer "RTN","BPSSCRRV",94,0) ; 4 Unable to queue the ECME claim "RTN","BPSSCRRV",95,0) ; 5 Invalid input "RTN","BPSSCRRV",96,0) ; and additional "RTN","BPSSCRRV",97,0) ; 12 Claim has been deleted in Pharmacy. "RTN","BPSSCRRV",98,0) ; message - whatever $$EN^BPSNCPDP returns "RTN","BPSSCRRV",99,0) ; for 12 - "Claim has been deleted in Pharmacy." "RTN","BPSSCRRV",100,0) ; "RTN","BPSSCRRV",101,0) REVERSE(BP59,BPRVREAS,BPRX,BPFIL) ;*/ "RTN","BPSSCRRV",102,0) N BPDOS S BPDOS=$$DOSDATE^BPSSCRRS(BPRX,BPFIL) "RTN","BPSSCRRV",103,0) N BPNDC S BPNDC=$$NDC^BPSSCRU2(BPRX,BPFIL) "RTN","BPSSCRRV",104,0) N BPRET "RTN","BPSSCRRV",105,0) I $$RXDEL^BPSOS(BPRX,BPFIL) D Q 12_U_"Claim has been deleted in Pharmacy." "RTN","BPSSCRRV",106,0) . W !,"The claim cannot be reversed since it has been deleted in Pharmacy." "RTN","BPSSCRRV",107,0) S BPRET=$$EN^BPSNCPDP(BPRX,BPFIL,BPDOS,"EREV",BPNDC,BPRVREAS) "RTN","BPSSCRRV",108,0) ;print return value message "RTN","BPSSCRRV",109,0) W !! "RTN","BPSSCRRV",110,0) W:+BPRET>0 "Not Processed:",!," " "RTN","BPSSCRRV",111,0) W $P(BPRET,U,2) "RTN","BPSSCRRV",112,0) ;0 Prescription/Fill successfully submitted to ECME for claims processing "RTN","BPSSCRRV",113,0) ;1 ECME did not submit prescription/fill "RTN","BPSSCRRV",114,0) ;2 IB says prescription/fill is not ECME billable or the data returned from IB is not valid "RTN","BPSSCRRV",115,0) ;3 ECME closed the claim but did not submit it to the payer "RTN","BPSSCRRV",116,0) ;4 Unable to queue the ECME claim "RTN","BPSSCRRV",117,0) ;5 Invalid input "RTN","BPSSCRRV",118,0) I +BPRET=0 D ECMEACT^PSOBPSU1(+BPRX,+BPFIL,"Claim reversal sent to 3rd party payer: ECME USER's SCREEN") "RTN","BPSSCRRV",119,0) Q BPRET "RTN","BPSSCRRV",120,0) ; "RTN","BPSSCRRV",121,0) PAUSE() ; "RTN","BPSSCRRV",122,0) N X "RTN","BPSSCRRV",123,0) W ! S DIR(0)="E" D ^DIR K DIR W ! "RTN","BPSSCRRV",124,0) Q X "RTN","BPSSCRRV",125,0) ; "RTN","BPSTEST") 0^4^B48227959^n/a "RTN","BPSTEST",1,0) BPSTEST ;OAK/ELZ - ECME TESTING TOOL ;11/15/07 09:55 "RTN","BPSTEST",2,0) ;;1.0;E CLAIMS MGMT ENGINE;**6**;JUN 2004;Build 10 "RTN","BPSTEST",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","BPSTEST",4,0) ; "RTN","BPSTEST",5,0) ; "RTN","BPSTEST",6,0) GETOVER(BPSRXIEN,BPSFILL,BPSORESP,BPSWHERE,BPSTYPE) ; "RTN","BPSTEST",7,0) ; called by BPSNCPDP to enter overrides for a particular RX "RTN","BPSTEST",8,0) ; INPUT "RTN","BPSTEST",9,0) ; BPSRXIEN - Prescription Number "RTN","BPSTEST",10,0) ; BPSFILL - Fill Number "RTN","BPSTEST",11,0) ; BPSORESP - Previous response when this claim was processed "RTN","BPSTEST",12,0) ; BPSWHERE - RX Action passed into BPSNCPDP "RTN","BPSTEST",13,0) ; BPSTYPE - R (Reversal), S (Submission) "RTN","BPSTEST",14,0) ; OUTPUT "RTN","BPSTEST",15,0) ; None - Table BPS PAYER RESPONSE OVERRIDE entry is created. "RTN","BPSTEST",16,0) ; "RTN","BPSTEST",17,0) N BPSTRANS,BPSTIEN,BPSSRESP,DIC,X,Y,DIR,DIK,DA "RTN","BPSTEST",18,0) ; "RTN","BPSTEST",19,0) ; Check if testing is enabled "RTN","BPSTEST",20,0) I '$$CHECK() Q "RTN","BPSTEST",21,0) ; "RTN","BPSTEST",22,0) ; Option can not be run for Date of Death option as it causes errors "RTN","BPSTEST",23,0) I $G(XQY0)["DG DEATH ENTRY" W !,"The testing tool can not be run from Date of Death option" Q "RTN","BPSTEST",24,0) ; "RTN","BPSTEST",25,0) ; Do not run for background jobs (CMOP (CR*) or ARES/AREV) "RTN","BPSTEST",26,0) I $D(ZTQUEUED)!(",ARES,AREV,CRLB,CRLR,CRLX,PC,PL,"[(","_BPSWHERE_",")) Q "RTN","BPSTEST",27,0) ; "RTN","BPSTEST",28,0) ; Create Transaction Number "RTN","BPSTEST",29,0) S BPSFILL="0000"_+BPSFILL "RTN","BPSTEST",30,0) S BPSTRANS=BPSRXIEN_"."_$E(BPSFILL,$L(BPSFILL)-3,$L(BPSFILL))_"1" "RTN","BPSTEST",31,0) ; "RTN","BPSTEST",32,0) ; Lookup the record in the BPS PAYER RESPONSE OVERRIDE table "RTN","BPSTEST",33,0) S DIC=9002313.32,DIC(0)="",X=BPSTRANS "RTN","BPSTEST",34,0) D ^DIC "RTN","BPSTEST",35,0) S BPSTIEN=+Y "RTN","BPSTEST",36,0) ; "RTN","BPSTEST",37,0) ; Prompt if user wants to do overrides "RTN","BPSTEST",38,0) W !!,"Payer Overrides are enabled at this site. If this is production environment," "RTN","BPSTEST",39,0) W !,"do not enter overrides (enter No at the next prompt) and disable this" "RTN","BPSTEST",40,0) W !,"functionality in the BPS SETUP table." "RTN","BPSTEST",41,0) W !!,"Entering No at the next prompt will delete any current overrides for the" "RTN","BPSTEST",42,0) W !,"prescription, if they exist.",! "RTN","BPSTEST",43,0) S DIR(0)="SA^Y:Yes;N:No" "RTN","BPSTEST",44,0) S DIR("A")="Do you want to enter overrides for this prescription? ",DIR("B")="YES" "RTN","BPSTEST",45,0) D ^DIR "RTN","BPSTEST",46,0) ; "RTN","BPSTEST",47,0) ; If no, delete the transaction (if it exists) and quit "RTN","BPSTEST",48,0) I Y'="Y" D:BPSTIEN'=-1 Q "RTN","BPSTEST",49,0) . S DIK="^BPS(9002313.32,",DA=BPSTIEN "RTN","BPSTEST",50,0) . D ^DIK "RTN","BPSTEST",51,0) ; "RTN","BPSTEST",52,0) ; If the record does not exist, create it "RTN","BPSTEST",53,0) I BPSTIEN=-1 S BPSTIEN=$$CREATE(BPSTRANS) "RTN","BPSTEST",54,0) I BPSTIEN=-1 W !,"Failed to create the BPS PAYER RESPONSE OVERRIDE record",! Q "RTN","BPSTEST",55,0) ; "RTN","BPSTEST",56,0) ; If BPSTYPE is 'S' (submission) and old response is 'E Payable', change BPSTYPE to 'RS' "RTN","BPSTEST",57,0) I BPSTYPE="S",BPSORESP="E PAYABLE"!(BPSORESP="E DUPLICATE") S BPSTYPE="RS" "RTN","BPSTEST",58,0) ; "RTN","BPSTEST",59,0) ; Update with the BPSTYPE "RTN","BPSTEST",60,0) D FILE("^BPS(9002313.32,",BPSTIEN,.02,BPSTYPE) "RTN","BPSTEST",61,0) ; "RTN","BPSTEST",62,0) ; Message for RS "RTN","BPSTEST",63,0) I BPSTYPE="RS" D "RTN","BPSTEST",64,0) . W !!,"This submission may also have a reversal so you will be prompted for the" "RTN","BPSTEST",65,0) . W !,"reversal overrides." "RTN","BPSTEST",66,0) ; "RTN","BPSTEST",67,0) ; If BPSTYPE contains 'R', then prompt for reversal response "RTN","BPSTEST",68,0) I BPSTYPE["R" D "RTN","BPSTEST",69,0) . W !!,"Reversal Questions" "RTN","BPSTEST",70,0) . D PROMPT(BPSTIEN,.05,"A") "RTN","BPSTEST",71,0) ; "RTN","BPSTEST",72,0) ; If BPSTYPE contains 'S', do submission response "RTN","BPSTEST",73,0) I BPSTYPE["S" D "RTN","BPSTEST",74,0) . W !!,"Submission Questions" "RTN","BPSTEST",75,0) . D PROMPT(BPSTIEN,.03,"P") "RTN","BPSTEST",76,0) . S BPSSRESP=$$GET1^DIQ(9002313.32,BPSTIEN_",",.03,"I") "RTN","BPSTEST",77,0) . I BPSSRESP="P"!(BPSSRESP="D") D PROMPT(BPSTIEN,.04,40) "RTN","BPSTEST",78,0) . I BPSSRESP="P"!(BPSSRESP="D") D PROMPT(BPSTIEN,.06,9) "RTN","BPSTEST",79,0) . I BPSSRESP="R" D PROMPT(BPSTIEN,1,"07") "RTN","BPSTEST",80,0) Q "RTN","BPSTEST",81,0) ; "RTN","BPSTEST",82,0) SETOVER(BPSTRANS,BPSTYPE,BPSDATA) ; "RTN","BPSTEST",83,0) ; called by BPSECMPS to set the override data "RTN","BPSTEST",84,0) ; Input "RTN","BPSTEST",85,0) ; BPSTRANS - Transaction IEN "RTN","BPSTEST",86,0) ; BPSTYPE - B1 for submission, B2 for reversals "RTN","BPSTEST",87,0) ; Output "RTN","BPSTEST",88,0) ; BPSDATA - Passed by reference and updated with appropriate overrides "RTN","BPSTEST",89,0) ; "RTN","BPSTEST",90,0) N BPSTIEN,BPSRRESP,BPSSRESP,BPSPAID,BPSRCNT,BPSRIEN,BPSRCODE,BPSRCD,BPSCOPAY,BPSXXXX,BPSUNDEF "RTN","BPSTEST",91,0) ; "RTN","BPSTEST",92,0) ; Check the Test Flag in set in BPS SETUP "RTN","BPSTEST",93,0) I '$$CHECK() Q "RTN","BPSTEST",94,0) ; "RTN","BPSTEST",95,0) ; Check if the Transaction Number is defined in BPS RESPONSE OVERRIDES "RTN","BPSTEST",96,0) S BPSTIEN=$O(^BPS(9002313.32,"B",BPSTRANS,"")) "RTN","BPSTEST",97,0) I BPSTIEN="" Q "RTN","BPSTEST",98,0) ; "RTN","BPSTEST",99,0) ; If a reversal, check for specific reversal overrides and set "RTN","BPSTEST",100,0) I BPSTYPE="B2" D "RTN","BPSTEST",101,0) . S BPSRRESP=$$GET1^DIQ(9002313.32,BPSTIEN_",",.05,"I") "RTN","BPSTEST",102,0) . ; "RTN","BPSTEST",103,0) . ; If the response is Stranded, force an error "RTN","BPSTEST",104,0) . I BPSRRESP="S" S BPSXXXX=BPSUNDEF "RTN","BPSTEST",105,0) . I BPSRRESP]"" S BPSDATA(1,112)=$S(BPSRRESP="D":"S",1:BPSRRESP) "RTN","BPSTEST",106,0) . S BPSDATA(9002313.03,9002313.03,"+1,",501)=$S(BPSRRESP="R":"R",1:"A") "RTN","BPSTEST",107,0) ; "RTN","BPSTEST",108,0) ; If a submission, check for specific submission overrides and set "RTN","BPSTEST",109,0) I BPSTYPE="B1" D "RTN","BPSTEST",110,0) . ; Get submission response "RTN","BPSTEST",111,0) . S BPSSRESP=$$GET1^DIQ(9002313.32,BPSTIEN_",",.03,"I") "RTN","BPSTEST",112,0) . ; "RTN","BPSTEST",113,0) . ; If the response is Stranded, force an error "RTN","BPSTEST",114,0) . I BPSSRESP="S" S BPSXXXX=BPSUNDEF "RTN","BPSTEST",115,0) . ; If it exists, file it "RTN","BPSTEST",116,0) . I BPSSRESP]"" D "RTN","BPSTEST",117,0) .. S BPSDATA(1,112)=BPSSRESP "RTN","BPSTEST",118,0) .. S BPSDATA(9002313.03,9002313.03,"+1,",501)=$S(BPSSRESP="R":"R",1:"A") "RTN","BPSTEST",119,0) .. ; If payable or duplicate, get the BPSPAID amount and file it if it "RTN","BPSTEST",120,0) .. ; exists. Also delete any reject codes "RTN","BPSTEST",121,0) .. I BPSSRESP="P"!(BPSSRESP="D") D "RTN","BPSTEST",122,0) ... S BPSPAID=$$GET1^DIQ(9002313.32,BPSTIEN_",",.04,"I") "RTN","BPSTEST",123,0) ... I BPSPAID]"" D "RTN","BPSTEST",124,0) .... S BPSDATA(1,509)=$$DFF^BPSECFM(BPSPAID,8) "RTN","BPSTEST",125,0) .... K BPSDATA(1,510),BPSDATA(1,511) "RTN","BPSTEST",126,0) .. I BPSSRESP="P"!(BPSSRESP="D") D "RTN","BPSTEST",127,0) ... S BPSCOPAY=$$GET1^DIQ(9002313.32,BPSTIEN_",",.06,"I") "RTN","BPSTEST",128,0) ... I BPSCOPAY]"" D "RTN","BPSTEST",129,0) .... S BPSDATA(1,518)=$$DFF^BPSECFM(BPSCOPAY,8) "RTN","BPSTEST",130,0) .. ; If rejected, get the rejection code and file them "RTN","BPSTEST",131,0) .. ; Also, delete the BPSPAID amount "RTN","BPSTEST",132,0) .. I BPSSRESP="R" D "RTN","BPSTEST",133,0) ... ; Delete old rejections and BPSPAID amount "RTN","BPSTEST",134,0) ... K BPSDATA(1,509),BPSDATA(1,511) "RTN","BPSTEST",135,0) ... ; Loop through rejections and store "RTN","BPSTEST",136,0) ... S BPSRCNT=0 "RTN","BPSTEST",137,0) ... S BPSRIEN=0 F S BPSRIEN=$O(^BPS(9002313.32,BPSTIEN,1,BPSRIEN)) Q:+BPSRIEN=0 D "RTN","BPSTEST",138,0) .... S BPSRCODE=$P($G(^BPS(9002313.32,BPSTIEN,1,BPSRIEN,0)),"^",1) "RTN","BPSTEST",139,0) .... ; Increment counter and store "RTN","BPSTEST",140,0) .... I BPSRCODE]"" D "RTN","BPSTEST",141,0) ..... S BPSRCD=$$GET1^DIQ(9002313.93,BPSRCODE_",",.01,"E") "RTN","BPSTEST",142,0) ..... I BPSRCD]"" S BPSRCNT=BPSRCNT+1,BPSDATA(1,511,BPSRCNT)=BPSRCD "RTN","BPSTEST",143,0) ... ; Store total number of rejections "RTN","BPSTEST",144,0) ... S BPSDATA(1,510)=BPSRCNT "RTN","BPSTEST",145,0) Q "RTN","BPSTEST",146,0) ; "RTN","BPSTEST",147,0) SELOVER ; "RTN","BPSTEST",148,0) ; used to create overrides for prescription that will processed in the "RTN","BPSTEST",149,0) ; background (CMOP, auto-reversals). The user is prompted for the "RTN","BPSTEST",150,0) ; prescription and other information and then calls GETOVER. It is called "RTN","BPSTEST",151,0) ; by option BPS PROVIDER RESPONSE OVERRIDES "RTN","BPSTEST",152,0) ; "RTN","BPSTEST",153,0) N BPSRXIEN,BPSRXNM,BPSRXFL,BPSRFL,BPSORESP,BPSTYPE,BPSRXARR,BPSRARR,DIC,Y,DIR "RTN","BPSTEST",154,0) ; "RTN","BPSTEST",155,0) ; Check if test mode is on "RTN","BPSTEST",156,0) I '$$CHECK() Q "RTN","BPSTEST",157,0) ; "RTN","BPSTEST",158,0) ; Prompt for the Prescription "RTN","BPSTEST",159,0) S BPSRXIEN=$$PROMPTRX^BPSUTIL1 Q:BPSRXIEN<1 "RTN","BPSTEST",160,0) D RXAPI^BPSUTIL1(BPSRXIEN,".01;22","BPSRXARR","IE") "RTN","BPSTEST",161,0) S BPSRXNM=$G(BPSRXARR(52,BPSRXIEN,.01,"E")) "RTN","BPSTEST",162,0) ; "RTN","BPSTEST",163,0) ; Prompt for Fill/Refill "RTN","BPSTEST",164,0) S DIR(0)="S^0:"_$G(BPSRXARR(52,BPSRXIEN,22,"E")) "RTN","BPSTEST",165,0) F BPSRFL=1:1 D RXSUBF^BPSUTIL1(BPSRXIEN,52,52.1,BPSRFL,.01,"BPSRARR","E") Q:$G(BPSRARR(52.1,BPSRFL,.01,"E"))="" D "RTN","BPSTEST",166,0) . S DIR(0)=DIR(0)_";"_BPSRFL_":"_BPSRARR(52.1,BPSRFL,.01,"E") "RTN","BPSTEST",167,0) S DIR("A")="Select fill/refill for prescription "_BPSRXNM,DIR("B")=0 "RTN","BPSTEST",168,0) D ^DIR "RTN","BPSTEST",169,0) I Y'=+Y Q "RTN","BPSTEST",170,0) S BPSRXFL=Y "RTN","BPSTEST",171,0) ; "RTN","BPSTEST",172,0) ; Prompt for BPSTYPE "RTN","BPSTEST",173,0) S DIR(0)="S^R:Reversal;RS:Resubmit with Reversal;S:Submit" "RTN","BPSTEST",174,0) S DIR("A")="Enter BPSTYPE of transaction",DIR("B")="SUBMIT" "RTN","BPSTEST",175,0) D ^DIR "RTN","BPSTEST",176,0) I ",R,RS,S,"'[","_Y_"," Q "RTN","BPSTEST",177,0) S BPSTYPE=Y "RTN","BPSTEST",178,0) ; "RTN","BPSTEST",179,0) ; Set up parameters "RTN","BPSTEST",180,0) S BPSORESP="" "RTN","BPSTEST",181,0) I BPSTYPE="RS" S BPSTYPE="S",BPSORESP="E PAYABLE" "RTN","BPSTEST",182,0) ; "RTN","BPSTEST",183,0) ; Call GETOVER "RTN","BPSTEST",184,0) D GETOVER(BPSRXIEN,BPSRXFL,BPSORESP,"",BPSTYPE) "RTN","BPSTEST",185,0) Q "RTN","BPSTEST",186,0) ; "RTN","BPSTEST",187,0) CHECK() ; "RTN","BPSTEST",188,0) ; Check if Test Mode is ON in the BPS Setup table "RTN","BPSTEST",189,0) ; Also called by BPSNCPDP and BPSEMCPS "RTN","BPSTEST",190,0) ; "RTN","BPSTEST",191,0) ;IA#4440 "RTN","BPSTEST",192,0) Q $S($$PROD^XUPROD:0,1:$P($G(^BPS(9002313.99,1,0)),"^",3)) "RTN","BPSTEST",193,0) ; "RTN","BPSTEST",194,0) CREATE(BPSTRANS) ; "RTN","BPSTEST",195,0) ; Create the Override record "RTN","BPSTEST",196,0) ; "RTN","BPSTEST",197,0) N DIC,X,Y,BPSTIEN,DA "RTN","BPSTEST",198,0) S DIC=9002313.32,DIC(0)="L",X=BPSTRANS "RTN","BPSTEST",199,0) D ^DIC "RTN","BPSTEST",200,0) S BPSTIEN=+Y "RTN","BPSTEST",201,0) Q BPSTIEN "RTN","BPSTEST",202,0) ; "RTN","BPSTEST",203,0) FILE(DIE,DA,BPSFLD,BPSDATA) ; "RTN","BPSTEST",204,0) ; File in the Override record "RTN","BPSTEST",205,0) ; "RTN","BPSTEST",206,0) N DR,X,Y "RTN","BPSTEST",207,0) S DR=BPSFLD_"///"_BPSDATA "RTN","BPSTEST",208,0) L +@(DIE_DA_")"):0 I $T D ^DIE L -@(DIE_DA_")") Q "RTN","BPSTEST",209,0) W !?5,"Another user is editing this entry." "RTN","BPSTEST",210,0) Q "RTN","BPSTEST",211,0) ; "RTN","BPSTEST",212,0) PROMPT(DA,BPSFLD,BPSDFLT) ; "RTN","BPSTEST",213,0) ; Prompt for a specific field and set the data "RTN","BPSTEST",214,0) ; "RTN","BPSTEST",215,0) N DIE,DR,DTOUT,X,Y "RTN","BPSTEST",216,0) S DIE="^BPS(9002313.32,",DR=BPSFLD_"//"_BPSDFLT "RTN","BPSTEST",217,0) L +@(DIE_DA_")"):0 I $T D ^DIE L -@(DIE_DA_")") Q "RTN","BPSTEST",218,0) W !?5,"Another user is editing this entry." "RTN","BPSTEST",219,0) Q "RTN","BPSUTIL") 0^11^B11432819^B11392543 "RTN","BPSUTIL",1,0) BPSUTIL ;BHAM ISC/FLS/SS - General Utility functions ;3/27/08 13:18 "RTN","BPSUTIL",2,0) ;;1.0;E CLAIMS MGMT ENGINE;**1,3,2,5,6**;JUN 2004;Build 10 "RTN","BPSUTIL",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","BPSUTIL",4,0) ; "RTN","BPSUTIL",5,0) ; ECMEON "RTN","BPSUTIL",6,0) ; Input: "RTN","BPSUTIL",7,0) ; SITE - Pointer to Outpatient Site file (#59) "RTN","BPSUTIL",8,0) ; Output "RTN","BPSUTIL",9,0) ; 1 - ECME is turned ON for the Outpatient Site "RTN","BPSUTIL",10,0) ; 0 - ECME is not turned ON for the Outpatient Site. "RTN","BPSUTIL",11,0) ; Note that ON means that the Outpatient site is linked to an active "RTN","BPSUTIL",12,0) ; BPS Pharmacy that has a Pharmacy ID AND IB has ncpdp flagged as "RTN","BPSUTIL",13,0) ; turned on. "RTN","BPSUTIL",14,0) ECMEON(SITE) ; "RTN","BPSUTIL",15,0) I '$$EPHON^IBNCPDPI Q 0 "RTN","BPSUTIL",16,0) I '$G(SITE) Q 0 "RTN","BPSUTIL",17,0) N BPSPHARM,FACID "RTN","BPSUTIL",18,0) S FACID=0 "RTN","BPSUTIL",19,0) S BPSPHARM=$$GETPHARM(SITE) "RTN","BPSUTIL",20,0) I BPSPHARM="" Q 0 "RTN","BPSUTIL",21,0) S FACID=$$GET1^DIQ(9002313.56,BPSPHARM_",",41.01) "RTN","BPSUTIL",22,0) I FACID="",'$$NPIREQ^BPSNPI(DT) S FACID=$$GET1^DIQ(9002313.56,BPSPHARM_",",.02) "RTN","BPSUTIL",23,0) Q $S(FACID:1,1:0) "RTN","BPSUTIL",24,0) ; "RTN","BPSUTIL",25,0) CMOPON(SITE) ; - Returns 1 if CMOP is turned ON for ECME or 0 if not "RTN","BPSUTIL",26,0) ; SITE - Pointer to #59 (OUTPATIENT SITE) "RTN","BPSUTIL",27,0) Q:'$G(SITE) 0 "RTN","BPSUTIL",28,0) N PHRM S PHRM=$O(^BPS(9002313.56,"C",SITE,0)) I 'PHRM Q 0 "RTN","BPSUTIL",29,0) Q $$GET1^DIQ(9002313.56,PHRM,1,"I") "RTN","BPSUTIL",30,0) ; "RTN","BPSUTIL",31,0) ;Function returns STATUS flag from BPS PHARMACIES (file #56) "RTN","BPSUTIL",32,0) ; Returns '1' for active or '0' for inactive BPS Pharmacy "RTN","BPSUTIL",33,0) BPSACTV(BPSPHARM) ; "RTN","BPSUTIL",34,0) Q:'$G(BPSPHARM) 0 "RTN","BPSUTIL",35,0) Q +$P($G(^BPS(9002313.56,BPSPHARM,0)),U,10) "RTN","BPSUTIL",36,0) ; "RTN","BPSUTIL",37,0) BPSPLN(RXI,RXR) ; - Returns the insurance PLAN NAME (902.24) field from BPS TRANSACTION "RTN","BPSUTIL",38,0) ; "RTN","BPSUTIL",39,0) ; Input variables -> RXI - Internal Prescription File IEN "RTN","BPSUTIL",40,0) ; RXR - Refill Number "RTN","BPSUTIL",41,0) ; "RTN","BPSUTIL",42,0) I '$G(RXI) Q "" "RTN","BPSUTIL",43,0) I '$G(RXR) S RXR=0 "RTN","BPSUTIL",44,0) N IEN59 S IEN59=$$IEN59^BPSOSRX(RXI,RXR) Q:IEN59="" "" "RTN","BPSUTIL",45,0) N CINS S CINS=$$GET1^DIQ(9002313.59,IEN59,901) Q:'CINS "" "RTN","BPSUTIL",46,0) Q $$GET1^DIQ(9002313.59902,CINS_","_IEN59,902.24) "RTN","BPSUTIL",47,0) ; "RTN","BPSUTIL",48,0) ;API for IB (IA #4146) to select BPS PHARMACY "RTN","BPSUTIL",49,0) ;returns results as a local array BPPHARM "RTN","BPSUTIL",50,0) ; Select the ECME Pharmacy or Pharmacies "RTN","BPSUTIL",51,0) ; "RTN","BPSUTIL",52,0) ; Input Variable -> BPSPHAR is passed by reference to get the result of user's selection "RTN","BPSUTIL",53,0) ; BPPHARM = 1 One or More Pharmacies Selected "RTN","BPSUTIL",54,0) ; = 0 User Entered 'ALL' "RTN","BPSUTIL",55,0) ; If BPSPHAR = 1 then the BPSPHAR array will be defined where: "RTN","BPSUTIL",56,0) ; BPSPHAR(ptr) = ptr ^ BPS PHARMACY NAME and "RTN","BPSUTIL",57,0) ; ptr = Internal Pointer to BPS PHARMACIES file (#9002313.56) "RTN","BPSUTIL",58,0) ; "RTN","BPSUTIL",59,0) ; Return Value -> "" = Valid Entry or Entries Selected "RTN","BPSUTIL",60,0) ; ^ = Exit "RTN","BPSUTIL",61,0) SELPHARM(BPSPHAR) ; "RTN","BPSUTIL",62,0) N BPRET,BPPHARM "RTN","BPSUTIL",63,0) S BPRET=$$SELPHARM^BPSRPT3() "RTN","BPSUTIL",64,0) M BPSPHAR=BPPHARM "RTN","BPSUTIL",65,0) Q BPRET "RTN","BPSUTIL",66,0) ; "RTN","BPSUTIL",67,0) ; "RTN","BPSUTIL",68,0) ;API for IB (IA #4146) to determine whether is one or more BPS PHARMACIES in the system "RTN","BPSUTIL",69,0) ;Function returns "RTN","BPSUTIL",70,0) ;1 - if the site has more than one record in the file #9002313.56 "RTN","BPSUTIL",71,0) ;0 - if there are no any divisions "RTN","BPSUTIL",72,0) ;0^NAME OF THE EPHARM - if only one division return 0 and its name "RTN","BPSUTIL",73,0) ; to use in the header of the report "RTN","BPSUTIL",74,0) MULTPHRM() ; "RTN","BPSUTIL",75,0) N IBX "RTN","BPSUTIL",76,0) S IBX=+$O(^BPS(9002313.56,0)) "RTN","BPSUTIL",77,0) I IBX=0 Q 0 "RTN","BPSUTIL",78,0) I $O(^BPS(9002313.56,IBX))>0 Q 1 "RTN","BPSUTIL",79,0) Q "0^"_$$GET1^DIQ(9002313.56,IBX,.01,"E") "RTN","BPSUTIL",80,0) ; "RTN","BPSUTIL",81,0) ; Function for IB (IA #4146) to return site linked to pharmacy "RTN","BPSUTIL",82,0) ; Input "RTN","BPSUTIL",83,0) ; BPSDIV - Outpatient Site "RTN","BPSUTIL",84,0) ; Returns "RTN","BPSUTIL",85,0) ; BPSPHARM - BPS Pharmacy IEN "RTN","BPSUTIL",86,0) GETPHARM(BPSDIV) ; "RTN","BPSUTIL",87,0) N BPSPHARM "RTN","BPSUTIL",88,0) I $G(BPSDIV)="" Q "" "RTN","BPSUTIL",89,0) S BPSPHARM=$O(^BPS(9002313.56,"C",BPSDIV,0)) I 'BPSPHARM Q "" "RTN","BPSUTIL",90,0) Q:'$$BPSACTV^BPSUTIL(BPSPHARM) "" "RTN","BPSUTIL",91,0) Q BPSPHARM "RTN","BPSUTIL",92,0) ; "RTN","BPSUTIL",93,0) ;API for the IB package (IA#4146) "RTN","BPSUTIL",94,0) ;Input parameters: "RTN","BPSUTIL",95,0) ; BPSRX - Rx ien (file #52) "RTN","BPSUTIL",96,0) ; BPSREFNO - refill number "RTN","BPSUTIL",97,0) ;Returned value: "RTN","BPSUTIL",98,0) ; 1st piece: "RTN","BPSUTIL",99,0) ; 0 - status "non-payable" OR there is no response from the payer for whatever reason OR wasn't submitted OR invalid parameters "RTN","BPSUTIL",100,0) ; 1- status "payable" "RTN","BPSUTIL",101,0) ; 2nd piece: "RTN","BPSUTIL",102,0) ; amount the payer agreed to pay "RTN","BPSUTIL",103,0) ; 3rd piece: "RTN","BPSUTIL",104,0) ; Date of Service "RTN","BPSUTIL",105,0) ; "RTN","BPSUTIL",106,0) PAIDAMNT(BPSRX,BPSREFNO) ; "RTN","BPSUTIL",107,0) I ($G(BPSRX)="")!($G(BPSREFNO)="") Q "0^" "RTN","BPSUTIL",108,0) N BPSTAT,BPSRET,IEN59,BPSRESP,BPDOS "RTN","BPSUTIL",109,0) S BPSTAT=$$STATUS^BPSOSRX(BPSRX,BPSREFNO) "RTN","BPSUTIL",110,0) ;The status of the claim should be "payable" in order to get amount of the 3rd party payment "RTN","BPSUTIL",111,0) ;If it was an attempt to reverse the payable claim AND reversal was rejected "RTN","BPSUTIL",112,0) ;then the claim still is considered as "payable" and we still can get the amount paid by the 3rd party. "RTN","BPSUTIL",113,0) ;In this case we return 1 (payable) in first piece and the amount paid in the 2nd piece of the returned value. "RTN","BPSUTIL",114,0) ;All other statuses mean that we cannot get amount paid so we return 0 = "non payable" "RTN","BPSUTIL",115,0) I $P(BPSTAT,U)'="E PAYABLE",$P(BPSTAT,U)'="E REVERSAL REJECTED",$P(BPSTAT,U)'="E DUPLICATE" Q "0^" "RTN","BPSUTIL",116,0) ;get ien for BPS TRANSACTION file "RTN","BPSUTIL",117,0) S IEN59=+$$IEN59^BPSOSRX(BPSRX,BPSREFNO) "RTN","BPSUTIL",118,0) I IEN59="" Q "0^" ;BPS Transaction IEN could not be calculated "RTN","BPSUTIL",119,0) S BPSRESP=+$P($G(^BPST(IEN59,0)),U,5) "RTN","BPSUTIL",120,0) ;response from the payer was not found - either claim was never submitted OR there "RTN","BPSUTIL",121,0) ;is no response for some reason - either way - we cannot provide the amount paid, so return "0" "RTN","BPSUTIL",122,0) I BPSRESP=0 Q "0^" "RTN","BPSUTIL",123,0) S BPDOS=+$P($G(^BPST(IEN59,12)),U,2) "RTN","BPSUTIL",124,0) S BPSRET=+$$INSPAID^BPSOS03(BPSRESP) "RTN","BPSUTIL",125,0) Q "1^"_BPSRET_U_BPDOS "RTN","BPSUTIL",126,0) ; "RTN","BPSUTIL",127,0) ; NPIEXTR "RTN","BPSUTIL",128,0) ; This API was written for the NPI extract (XUSNPIX2) and returns "RTN","BPSUTIL",129,0) ; the NCPDP and STATUS of the associated BPS Pharmacy "RTN","BPSUTIL",130,0) ; Input: "RTN","BPSUTIL",131,0) ; SITE - Pointer to Outpatient Site file (#59) "RTN","BPSUTIL",132,0) ; Output "RTN","BPSUTIL",133,0) ; NCPDP^STATUS (0 - inactive, 1 - active) "RTN","BPSUTIL",134,0) ; "" if no SITE passed in or no linkage "RTN","BPSUTIL",135,0) NPIEXTR(SITE) ; "RTN","BPSUTIL",136,0) I '$G(SITE) Q "" "RTN","BPSUTIL",137,0) N BPSPHARM,NCPDP,STATUS "RTN","BPSUTIL",138,0) S BPSPHARM=$O(^BPS(9002313.56,"C",SITE,0)) "RTN","BPSUTIL",139,0) I 'BPSPHARM Q "" "RTN","BPSUTIL",140,0) S STATUS=$$BPSACTV^BPSUTIL(BPSPHARM) "RTN","BPSUTIL",141,0) S NCPDP=$$GET1^DIQ(9002313.56,BPSPHARM_",",.02) "RTN","BPSUTIL",142,0) Q NCPDP_"^"_STATUS "SEC","^DIC",9002313.32,9002313.32,0,"AUDIT") @ "SEC","^DIC",9002313.32,9002313.32,0,"DD") @ "SEC","^DIC",9002313.32,9002313.32,0,"DEL") @ "SEC","^DIC",9002313.32,9002313.32,0,"LAYGO") @ "SEC","^DIC",9002313.32,9002313.32,0,"RD") @ "SEC","^DIC",9002313.32,9002313.32,0,"WR") @ "VER") 8.0^22.0 "^DD",9002313.32,9002313.32,0) FIELD^^.06^8 "^DD",9002313.32,9002313.32,0,"DDA") N "^DD",9002313.32,9002313.32,0,"DT") 3071022 "^DD",9002313.32,9002313.32,0,"IX","B",9002313.32,.01) "^DD",9002313.32,9002313.32,0,"NM","BPS PAYER RESPONSE OVERRIDES") "^DD",9002313.32,9002313.32,.01,0) TRANSACTION NUMBER^RNJ15,5^^0;1^K:+X'=X!(X>999999999.99999)!(X<0)!(X?.E1"."6N.N) X "^DD",9002313.32,9002313.32,.01,1,0) ^.1 "^DD",9002313.32,9002313.32,.01,1,1,0) 9002313.32^B "^DD",9002313.32,9002313.32,.01,1,1,1) S ^BPS(9002313.32,"B",$E(X,1,30),DA)="" "^DD",9002313.32,9002313.32,.01,1,1,2) K ^BPS(9002313.32,"B",$E(X,1,30),DA) "^DD",9002313.32,9002313.32,.01,3) Type a Number between 0 and 999999999.99999, 5 Decimal Digits "^DD",9002313.32,9002313.32,.01,21,0) ^^1^1^3070928^ "^DD",9002313.32,9002313.32,.01,21,1,0) The transaction number of the claim "^DD",9002313.32,9002313.32,.01,"DT") 3070928 "^DD",9002313.32,9002313.32,.02,0) TYPE^S^R:REVERSAL;RS:RESUBMIT WITH REVERSAL;S:SUBMIT;^0;2^Q "^DD",9002313.32,9002313.32,.02,3) Enter the claim submission type "^DD",9002313.32,9002313.32,.02,21,0) ^^2^2^3070928^ "^DD",9002313.32,9002313.32,.02,21,1,0) The type of claims - R is Reversal, RS is a Resubmit with a reversal, and "^DD",9002313.32,9002313.32,.02,21,2,0) S is a Submission "^DD",9002313.32,9002313.32,.02,"DT") 3070928 "^DD",9002313.32,9002313.32,.03,0) SUBMISSION RESPONSE^S^D:DUPLICATE;P:PAID;R:REJECTED;S:STRANDED;^0;3^Q "^DD",9002313.32,9002313.32,.03,3) Enter the override for the payer response status fields "^DD",9002313.32,9002313.32,.03,21,0) ^^3^3^3070928^ "^DD",9002313.32,9002313.32,.03,21,1,0) The payer response for claims submissions (B1 transactions) - 'P' for "^DD",9002313.32,9002313.32,.03,21,2,0) Payable or 'R' for Rejected. This will be used for the 112 (Transaction "^DD",9002313.32,9002313.32,.03,21,3,0) Response Status) and 501 (Response Status) fields or BPS Responses. "^DD",9002313.32,9002313.32,.03,"DT") 3070928 "^DD",9002313.32,9002313.32,.04,0) PAID AMOUNT^NJ8,2^^0;4^S:X["$" X=$P(X,"$",2) K:X'?."-".N.1".".2N!(X>99999.99)!(X<-99999.99)!(X?.E1"."3.N) X "^DD",9002313.32,9002313.32,.04,3) Type a Dollar amount between -99999.99 and 99999.99, 2 Decimal Digits "^DD",9002313.32,9002313.32,.04,21,0) ^^2^2^3070928^ "^DD",9002313.32,9002313.32,.04,21,1,0) This is the override for the 509 (Total Amount Paid) field of BPS "^DD",9002313.32,9002313.32,.04,21,2,0) Responses "^DD",9002313.32,9002313.32,.04,"DT") 3070928 "^DD",9002313.32,9002313.32,.05,0) REVERSAL RESPONSE^S^A:ACCEPTED;D:DUPLICATE;R:REJECTED;S:STRANDED;^0;5^Q "^DD",9002313.32,9002313.32,.05,3) Enter the override for the payer response status fields "^DD",9002313.32,9002313.32,.05,21,0) ^^3^3^3070928^ "^DD",9002313.32,9002313.32,.05,21,1,0) The payer response for claims reversals (B2 transactions) - 'A' for "^DD",9002313.32,9002313.32,.05,21,2,0) Accepted or 'R' for Rejected. This will be used for the 112 (Transaction "^DD",9002313.32,9002313.32,.05,21,3,0) Response Status) and 501 (Response Status) fields or BPS Responses. "^DD",9002313.32,9002313.32,.05,"DT") 3070928 "^DD",9002313.32,9002313.32,.06,0) COPAY AMOUNT^NJ6,2^^0;6^S:X["$" X=$P(X,"$",2) K:X'?.N.1".".2N!(X>999.99)!(X<0)!(X?.E1"."3.N) X "^DD",9002313.32,9002313.32,.06,3) Enter the copay amount returned by the payer "^DD",9002313.32,9002313.32,.06,21,0) ^^2^2^3080228^ "^DD",9002313.32,9002313.32,.06,21,1,0) This is an override copay amount returned by a payer to be sent to "^DD",9002313.32,9002313.32,.06,21,2,0) Integrated Billing for copay creation. "^DD",9002313.32,9002313.32,.06,"DT") 3080228 "^DD",9002313.32,9002313.32,1,0) REJECT CODES^9002313.321P^^1;0 "^DD",9002313.32,9002313.32,1,21,0) ^^2^2^3070928^ "^DD",9002313.32,9002313.32,1,21,1,0) Multiple for reject code overrides, which will be stored in the 511 "^DD",9002313.32,9002313.32,1,21,2,0) (Reject Code multiple) fields of BPS Responses "^DD",9002313.32,9002313.321,0) REJECT CODES SUB-FIELD^^.01^1 "^DD",9002313.32,9002313.321,0,"DT") 3070928 "^DD",9002313.32,9002313.321,0,"IX","B",9002313.321,.01) "^DD",9002313.32,9002313.321,0,"NM","REJECT CODES") "^DD",9002313.32,9002313.321,0,"UP") 9002313.32 "^DD",9002313.32,9002313.321,.01,0) REJECT CODES^MP9002313.93'^BPSF(9002313.93,^0;1^Q "^DD",9002313.32,9002313.321,.01,1,0) ^.1 "^DD",9002313.32,9002313.321,.01,1,1,0) 9002313.321^B "^DD",9002313.32,9002313.321,.01,1,1,1) S ^BPS(9002313.32,DA(1),1,"B",$E(X,1,30),DA)="" "^DD",9002313.32,9002313.321,.01,1,1,2) K ^BPS(9002313.32,DA(1),1,"B",$E(X,1,30),DA) "^DD",9002313.32,9002313.321,.01,3) Enter any reject code overrides "^DD",9002313.32,9002313.321,.01,"DT") 3070928 "^DD",9002313.59,9002313.59,901.04,0) ELIGIBILITY^S^V:VETERAN;T:TRICARE;C:CHAMPVA;^9;4^Q "^DD",9002313.59,9002313.59,901.04,3) Enter (V)eteran, (T)ricare, or (C)hampVA. "^DD",9002313.59,9002313.59,901.04,21,0) ^^1^1^3071024^ "^DD",9002313.59,9002313.59,901.04,21,1,0) The insurance eligibility type of the claim. "^DD",9002313.59,9002313.59,901.04,"DT") 3071024 "^DIC",9002313.32,9002313.32,0) BPS PAYER RESPONSE OVERRIDES^9002313.32 "^DIC",9002313.32,9002313.32,0,"GL") ^BPS(9002313.32, "^DIC",9002313.32,9002313.32,"%",0) ^1.005^^0 "^DIC",9002313.32,9002313.32,"%D",0) ^^5^5^3070928^ "^DIC",9002313.32,9002313.32,"%D",1,0) This file is used to store Payer Response Overrides. This file should "^DIC",9002313.32,9002313.32,"%D",2,0) not be populated on production systems, only on test systems. "^DIC",9002313.32,9002313.32,"%D",3,0) "^DIC",9002313.32,9002313.32,"%D",4,0) "^DIC",9002313.32,9002313.32,"%D",5,0) Per VHA Directive 2004-038, this file definition should not be modified. "^DIC",9002313.32,"B","BPS PAYER RESPONSE OVERRIDES",9002313.32) "BLD",7433,6) ^6 **END** **END**