source: WorldVistAEHR/trunk/r/E_CLAIMS_MGMT_ENGINE-BPS/BPSBUTL.m@ 691

BPSBUTL ;BHAM ISC/MFR/VA/DLF - IB Communication Utilities ;06/01/2004

 ;;1.0;E CLAIMS MGMT ENGINE;**1,3,2,5**;JUN 2004;Build 45

 ;;Per VHA Directive 2004-038, this routine should not be modified.

 ;Reference to STORESP^IBNCPDP supported by DBIA 4299

 Q

 ;

CLOSE(CLAIM,TRNDX,REASON,PAPER,RELCOP,COMMENT,ERROR) ; Send IB an update on the CLAIM status for a Closed Claim

 N DFN,BPSARRY,BILLNUM,CLAIMNFO,FILLNUM,RXIEN,TRANINFO

 ;

 ; - Data gathering

 D GETS^DIQ("9002313.59",TRNDX,"1.11;9","I","TRANINFO")

 S RXIEN=TRANINFO(9002313.59,TRNDX_",",1.11,"I")

 I $$RXAPI1^BPSUTIL1(RXIEN,.01)="" S ERROR="Prescription not found." Q

 S BPSARRY("FILL NUMBER")=TRANINFO(9002313.59,TRNDX_",",9,"I")

 D GETS^DIQ("9002313.02",CLAIM,"400*;401;402;403;426","","CLAIMNFO")

 S BPSARRY("FILL DATE")=$$EXT2FM^BPSOSU1(CLAIMNFO("9002313.0201","1,"_CLAIM_",","401"))

 S FILLNUM=+BPSARRY("FILL NUMBER")

 S DFN=$$RXAPI1^BPSUTIL1(RXIEN,2,"I")

 S BPSARRY("FILLED BY")=$$RXAPI1^BPSUTIL1(RXIEN,16,"I")

 S BPSARRY("PRESCRIPTION")=RXIEN

 S BPSARRY("BILLED")=$$DFF2EXT^BPSECFM($P(CLAIMNFO("9002313.0201","1,"_CLAIM_",","426"),"DQ",2))

 S BPSARRY("CLAIMID")=$P(CLAIMNFO("9002313.0201","1,"_CLAIM_",","402"),"D2",2)

 S BPSARRY("PLAN")=$P(^BPST(TRNDX,10,1,0),"^")

 S BPSARRY("STATUS")="CLOSED"

 S BPSARRY("PAID")=0

 S BPSARRY("RELEASE DATE")=$S(FILLNUM=0:$$RXAPI1^BPSUTIL1(RXIEN,31,"I"),1:$$RXSUBF1^BPSUTIL1(RXIEN,52,52.1,FILLNUM,17,"I"))

 S BPSARRY("USER")=DUZ

 S BPSARRY("EPHARM")=$$GET1^DIQ(9002313.59,TRNDX,1.07,"I")

 I REASON'="" D

 . S BPSARRY("CLOSE REASON")=$O(^IBE(356.8,"B",REASON,0))

 . S BPSARRY("DROP TO PAPER")=+$G(PAPER)

 . S BPSARRY("RELEASE COPAY")=+$G(RELCOP)

 I $G(COMMENT)]"" S BPSARRY("CLOSE COMMENT")=COMMENT

 ;

 ; If dropped to Paper, increment the counter in BPS Statistics

 I BPSARRY("DROP TO PAPER")=1 D INCSTAT^BPSOSUD("R",8)

 ;

 ; Call IB

 S BILLNUM=$$STORESP^IBNCPDP(DFN,.BPSARRY)

 Q

 ; Send IB an update on the CLAIM status for a restocked or deleted prescription

CLOSE2(RXIEN,BFILL,BWHERE) ;

 N IEN59,BPSARRY,DFN,BILLNUM,FILL,REASON

 N CLAIMNFO

 N DIE,DA,DR

 ;

 ; Check parameters

 I '$G(RXIEN) S ERROR="No prescription parameter" Q

 ;

 I $$RXAPI1^BPSUTIL1(RXIEN,.01)="" S ERROR="Prescription not found." Q

 I ",DDED,DE,RS,"'[(","_BWHERE_",") S ERROR="Invalid BWHERE parameter" Q

 ;

 ; Calculate the transaction IEN and see that it exists

 S FILL=".0000"_+BFILL

 S IEN59=RXIEN_"."_$E(FILL,$L(FILL)-3,$L(FILL))_"1"

 I '$D(^BPST(IEN59,0)) Q

 ;

 ; Get claim data

 S CLAIM=$P(^BPST(IEN59,0),"^",4)

 D GETS^DIQ("9002313.02",CLAIM,"400*;401;402;426","","CLAIMNFO")

 S BPSARRY("FILL NUMBER")=+BFILL

 S BPSARRY("FILL DATE")=$$EXT2FM^BPSOSU1(CLAIMNFO("9002313.0201","1,"_CLAIM_",","401"))

 ;

 ; Get prescription data

 S FILLNUM=BPSARRY("FILL NUMBER")

 S DFN=$$RXAPI1^BPSUTIL1(RXIEN,2,"I")

 S BPSARRY("FILLED BY")=$$RXAPI1^BPSUTIL1(RXIEN,16,"I")

 S BPSARRY("PRESCRIPTION")=RXIEN

 S BPSARRY("BILLED")=$$DFF2EXT^BPSECFM($P(CLAIMNFO("9002313.0201","1,"_CLAIM_",","426"),"DQ",2))

 S BPSARRY("CLAIMID")=$P(CLAIMNFO("9002313.0201","1,"_CLAIM_",","402"),"D2",2)

 S BPSARRY("PLAN")=$P(^BPST(IEN59,10,1,0),"^")

 S BPSARRY("STATUS")="CLOSED"

 S BPSARRY("PAID")=0

 S BPSARRY("RELEASE DATE")=$S(FILLNUM=0:$$RXAPI1^BPSUTIL1(RXIEN,31,"I"),1:$$RXSUBF1^BPSUTIL1(RXIEN,52,52.1,FILLNUM,17,"I"))

 S BPSARRY("USER")=.5

 S BPSARRY("EPHARM")=$$GET1^DIQ(9002313.59,IEN59,1.07,"I")

 ;

 ; Determine the reversal reason based on the BWHERE value

 I BWHERE="RS" S REASON="PRESCRIPTION NOT RELEASED"

 I BWHERE="DE"!(BWHERE="DDED") S REASON="PRESCRIPTION DELETED"

 I REASON]"" S BPSARRY("CLOSE REASON")=$O(^IBE(356.8,"B",REASON,0))

 ;

 ;if a refill was deleted while RX is still active (not deleted) then send DELETION OF REFILL comment for CT record

 I BWHERE="DE",$$RXSTATUS^BPSSCRU2(RXIEN)'=13 S BPSARRY("CLOSE COMMENT")="DELETION OF REFILL ONLY - ORIGINAL RX MAY REMAIN ACTIVE"

 ;

 ;

 ; Update IB

 S BILLNUM=$$STORESP^IBNCPDP(DFN,.BPSARRY)

 ;

 ; Update the claim file that the claim is closed and the reason why.

 S DIE="^BPSC(",DA=CLAIM

 S DR="901///1;902///"_$$NOW^XLFDT()_";903///.5;904///"_BPSARRY("CLOSE REASON")

 D ^DIE

 Q

 ;

 ; Function to return Transaction, claim, and response IENs

 ; Parameters:

 ;    RXI: Prescription IEN

 ;    RXR: Fill Number

 ; Returns:

 ;    IEN59^Claim IEN^Response IEN^Reversal Claim IEN^Reversal Response IEN

CLAIM(RXI,RXR) ;

 N IEN59,CLAIMIEN,RESPIEN,REVCLAIM,REVRESP

 I '$G(RXI) Q

 S IEN59=$$IEN59^BPSOSRX(RXI,RXR)

 I '$D(^BPST(IEN59,0)) Q ""

 S CLAIMIEN=$P(^BPST(IEN59,0),"^",4),RESPIEN=$P(^BPST(IEN59,0),"^",5)

 S REVCLAIM=$P($G(^BPST(IEN59,4)),"^",1),REVRESP=$P($G(^BPST(IEN59,4)),"^",2)

 Q IEN59_U_CLAIMIEN_U_RESPIEN_U_REVCLAIM_U_REVRESP

 ;

 ; NABP - Return the value in the Service Provider ID (201-B1) field

 ;   of the claim.  Note that as of the NPI release (BPS*1*2), this

 ;   API may return NPI instead of NABP/NCPDP

NABP(RXP,BFILL) ;

 I '$G(RXP) Q ""

 I $G(BFILL)="" S BFILL=0

 N BPSTIEN,BPSCIEN,DFILL,NABP

 S DFILL=$E($TR($J("",4-$L(BFILL))," ","0")_BFILL,1,4)

 S BPSTIEN=RXP_"."_DFILL_"1"

 I 'BPSTIEN Q ""

 S BPSCIEN=$P($G(^BPST(BPSTIEN,0)),U,4)

 I 'BPSCIEN Q ""

 S NABP=$P($G(^BPSC(BPSCIEN,200)),U)

 Q NABP

 ;

 ; DIVNCPDP - For a specific outpatient site, return the NPI & NCPDP.

 ; Note that the procedure name is misleading but when originally

 ;   coded, this procedure only returned NCPDP.

 ;

 ; Input

 ;   BPSDIV - Outpatient Site (#59)

 ; Output

 ;   "" - No BPSDIV passed in

 ;   NCPDP and NPI separated by a caret

DIVNCPDP(BPSDIV) ;

 N BPSPHARM,NPI,NCPDP

 I '$G(BPSDIV) Q "^"

 ;

 ; Get the NCPDP

 S NCPDP=""

 S BPSPHARM=$$GETPHARM^BPSUTIL(BPSDIV)

 I BPSPHARM S NCPDP=$$GET1^DIQ(9002313.56,BPSPHARM_",",.02)

 ;

 ; Get the NPI and validate it

 S NPI=+$$NPI^BPSNPI("Pharmacy_ID",BPSDIV)

 I NPI=-1 S NPI=""

 ;

 Q NCPDP_"^"_NPI

 ;

 ;ADDCOMM - Add a comment to a ECME claim

 ;Input:

 ; BPRX - ien in file #52 

 ; BPREF - refill number (0,1,2,...)

 ; BPRCMNT - comment text 

 ;Output:

 ;  1 - okay

 ; -1 - failed

ADDCOMM(BPRX,BPREF,BPRCMNT) ;

 N BP59,BPNOW,BPLCK,BPREC,BPDA,BPERR

 N %,%H,%I,X

 I $L(BPRX)<1 Q -1

 I $G(BPRCMNT)="" Q -1

 S BP59=BPRX_$S($L(+BPREF)=1:".000",1:".00")_+BPREF_"1" ;borrowed from CLOSE2 above

 D NOW^%DTC

 S BPNOW=%

 L +^BPST(9002313.59111,+BP59):10

 S BPLCK=$T

 I 'BPLCK Q -1  ;quit

 D INSITEM^BPSCMT01(9002313.59111,+BP59,BPNOW)

 S BPREC=$O(^BPST(BP59,11,"B",BPNOW,0))

 I BPREC>0 D

 . S BPDA(9002313.59111,BPREC_","_BP59_",",.02)=+$G(DUZ)

 . S BPDA(9002313.59111,BPREC_","_BP59_",",.03)=$E($G(BPRCMNT),1,63)

 . D FILE^DIE("","BPDA","BPERR")

 I BPLCK L -^BPST(9002313.59111,+BP59)

 I BPREC>0,'$D(BPERR) Q 1

 Q -1

 ;

 ;REOPEN - Reopen closed claim

 ;Input:

 ; BP59 - ien in BPS TRANSACTION file

 ; BP02 - ien in BPS CLAIMS file

 ; BPREOPDT - reopen date/time 

 ; BPDUZ - user DUZ (#200 ien)

 ; BPCOMM - reopen comment text

 ;Output:

 ; 0^message_error - error

 ; 1 - success

REOPEN(BP59,BP02,BPREOPDT,BPDUZ,BPCOMM) ;

 N RECIENS,BPDA,ERRARR,BPREFNO,BPRXIEN,BPFILLDT,BPCLMID,BPZ,BPSARRY,BPDFN,BPRETVAL,BPZ1

 S BPDFN=$P($G(^BPST(BP59,0)),U,6)

 S BPREFNO=$P($G(^BPST(BP59,1)),U)

 I BPREFNO="" Q "0^Null Fill Number"

 S BPRXIEN=$P($G(^BPST(BP59,1)),U,11)

 I BPRXIEN="" Q "0^Null RX ien Number"

 ;in VA there is only one med/claim but in some cases it can different than "1"

 ;so take the latest one

 S BPZ=$O(^BPSC(BP02,400,9999999),-1)

 I BPRXIEN="" Q "0^Database Error"

 S BPFILLDT=$$YMD2FM^BPSSCRU6(+$P($G(^BPSC(BP02,400,+BPZ,400)),U))

 S BPCLMID=$$CONVCLID^BPSSCRU6($P($G(^BPSC(BP02,400,+BPZ,400)),U,2))

 ;============

 ;Now update ECME database

 S BPRETVAL=$$UPDREOP^BPSREOP1(BP02,0,BPREOPDT,BPDUZ,BPCOMM)

 I +BPRETVAL=0 D  Q BPRETVAL

 . ;try to reverse it in case it was done partially

 . I $$UPDREOP^BPSREOP1(BP02,1,"@",+BPDUZ,"@")

 ;============

 ;Now call IB API for "REOPEN" event

 S BPSARRY("STATUS")="REOPEN"

 S BPSARRY("FILL DATE")=BPFILLDT

 S BPSARRY("FILL NUMBER")=BPREFNO

 S BPSARRY("PRESCRIPTION")=BPRXIEN

 S BPSARRY("CLAIMID")=BPCLMID

 S BPSARRY("DRUG")=$$DRUGIEN^BPSSCRU6(BPRXIEN,BPDFN)

 S BPSARRY("PLAN")=$P($G(^BPST(BP59,10,1,0)),"^")

 S BPSARRY("USER")=BPDUZ

 S BPSARRY("REOPEN COMMENT")=BPCOMM

 S BPSARRY("EPHARM")=$$GET1^DIQ(9002313.59,BP59,1.07,"I")

 S BPRETVAL=$$STORESP^IBNCPDP(BPDFN,.BPSARRY)

 ;if successful

 I +BPRETVAL>0 Q "1^ReOpening Claim: "_$P($G(^BPSC(BP02,0)),U)_" ... OK"

 ;===========

 ;if it was unsuccessful

 ;reverse ECME database (keep the user who made the attempt)

 I $$UPDREOP^BPSREOP1(BP02,1,"@",+BPDUZ,"@")

 ;return IB error message

 Q BPRETVAL