source: FOIAVistA/trunk/r/E_CLAIMS_MGMT_ENGINE-BPS/BPSBUTL.m@ 767

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