BPSOSRX8 ;ALB/SS - ECME REQUESTS ;10-JAN-08
;;1.0;E CLAIMS MGMT ENGINE;**7,10,11,20,40**;JUN 2004;Build 25
;;Per VA Directive 6402, this routine should not be modified.
;
;check parameters for EN^BPSNCPDP
;BRXIEN - Rx ien
;BRX - rx refil no
;BWHERE - RX action
;DFN - patient's ien
;PNAME - patient name
;return
;1 - passed
;0^message - failed
CHCKPAR(BRXIEN,BRX,BWHERE,DFN,PNAME) ;
I '$G(BRXIEN) Q "0^Prescription IEN parameter missing"
I $G(BWHERE)="" Q "0^RX Action parameter missing"
I $G(BRX)="" Q "0^Prescription does not exist"
I $G(DFN)="" Q "0^Patient's IEN does not exist"
I $G(PNAME)="" Q "0^Patient name missing"
Q 1
;
;===== check if we need to print the messages to the screen =======
PRINTSCR(BWHER) ;
I ",AREV,CRLB,CRLR,CRLX,CRRL,PC,PL,"[(","_BWHER_",") Q 0
Q 1 ;print messages to the screen
;check if any IB DATA is missing
;returns
; 0 - passed
; or
; RESPONSE code^CLMSTAT message^D(display message)^number of seconds to hang if display
IBDATAOK(MOREDATA,BPSARRY) ;
N BPRESP S BPRESP=2
I $G(BPSARRY("NO ECME INSURANCE")) S BPRESP=6
; Check for missing data (Will IB billing determination catch this?)
I $D(MOREDATA("IBDATA",1,1)),$P(MOREDATA("IBDATA",1,1),"^",1)="" Q BPRESP_U_"Information missing from IB data.^D^2"
; Check for missing/invalid payer sheets (I think IB billing determination will catch this)
I $P($G(MOREDATA("IBDATA",1,1)),"^",4)="" Q BPRESP_U_"Invalid/missing payer sheet from IB data.^D^2"
; Check if IB says to bill
I '$G(MOREDATA("BILL")) Q BPRESP_U_"Flagged by IB to not 3rd Party Insurance bill through ECME.^D^2"
Q 0
;Get Site
GETSITE(BRXIEN,BFILL) ;
I '$G(BRXIEN) Q ""
I '$G(BFILL) Q $$RXAPI1^BPSUTIL1(BRXIEN,20,"I")
Q $$RXSUBF1^BPSUTIL1(BRXIEN,52,52.1,+BFILL,8,"I")
;
; Store general information/parameters into MOREDATA
; In instances where duz is null set it equal to .5 (postmaster)
BASICMOR(BWHERE,DOS,BPSITE,REVREAS,DURREC,BPOVRIEN,BPSCLARF,BPSAUTH,BPSDELAY,MOREDATA,BPSDX) ;
N I
S MOREDATA("USER")=$S('DUZ:.5,1:DUZ)
S MOREDATA("RX ACTION")=$G(BWHERE)
S MOREDATA("DATE OF SERVICE")=$P($G(DOS),".",1)
S MOREDATA("REVERSAL REASON")=$S($G(REVREAS)="":"UNKNOWN",1:$E($G(REVREAS),1,40))
S MOREDATA("DIVISION")=$G(BPSITE)
I $G(DURREC)]"" F I=1:1:3 I $P(DURREC,"~",I)]"" S MOREDATA("DUR",I,0)=$P(DURREC,"~",I)
I $G(BPOVRIEN)]"" S MOREDATA("BPOVRIEN")=BPOVRIEN
I $G(BPSCLARF)]"" S MOREDATA("BPSCLARF")=BPSCLARF
I $TR($G(BPSAUTH),"^")]"" S MOREDATA("BPSAUTH")=BPSAUTH
I $G(BPSDELAY)]"" S MOREDATA("BPSDELAY")=BPSDELAY
I $G(BPSDX)]"" S MOREDATA("BPSDX")=BPSDX
Q
;====== Prepare ret. value
;return RESPONSE ^ CLMSTAT ^ Display= D ^ seconds to HANG
RSPCLMS(BPREQTYP,RESPONSE,MOREDATA,BPADDINF) ;
N ELIG
S ELIG=$G(MOREDATA("ELIG"))
I BPREQTYP="C",RESPONSE=0 Q RESPONSE_U_$S(ELIG="T":"TRICARE ",ELIG="C":"CHAMPVA ",ELIG="V":"Veteran ",1:"")_"Prescription "_BRX_$S(ELIG="T":"",ELIG="C":"",1:" successfully")_" submitted to ECME for claim generation.^D^"
I BPREQTYP="C",RESPONSE>0 Q RESPONSE_U_"No claim submission made: "_$S($G(BPADDINF)'="":BPADDINF,1:"Unable to queue claim submission.")_"^D"
I BPREQTYP="U",RESPONSE=0 Q RESPONSE_U_"Reversing prescription "_BRX_".^D^2"
I BPREQTYP="U",RESPONSE>0 Q RESPONSE_U_"No claim submission made. Unable to queue reversal.^D^2"
I BPREQTYP="UC",RESPONSE=10 Q RESPONSE_U_$S(ELIG="T":"TRICARE ",ELIG="C":"CHAMPVA ",ELIG="V":"Veteran ",1:"")_"Prescription "_BRX_$S(ELIG="T":"",ELIG="C":"",1:" successfully")_" submitted to ECME for claim reversal.^D^"
I BPREQTYP="UC",RESPONSE=0 Q RESPONSE_U_$S(ELIG="T":"TRICARE ",ELIG="C":"CHAMPVA ",ELIG="V":"Veteran ",1:"")_"Prescription "_BRX_$S(ELIG="T":"",ELIG="C":"",1:" successfully")_" submitted to ECME for claim generation.^D^"
I BPREQTYP="UC",RESPONSE>0,RESPONSE'=10 Q RESPONSE_U_"No claim submission made: "_$S($G(BPADDINF)'="":BPADDINF,1:"Unable to queue claim submission.")_"^D"
Q ""
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HBPSOSRX8 3956 printed Sep 23, 2025@19:28:19 Page 2
BPSOSRX8 ;ALB/SS - ECME REQUESTS ;10-JAN-08
+1 ;;1.0;E CLAIMS MGMT ENGINE;**7,10,11,20,40**;JUN 2004;Build 25
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ;check parameters for EN^BPSNCPDP
+5 ;BRXIEN - Rx ien
+6 ;BRX - rx refil no
+7 ;BWHERE - RX action
+8 ;DFN - patient's ien
+9 ;PNAME - patient name
+10 ;return
+11 ;1 - passed
+12 ;0^message - failed
CHCKPAR(BRXIEN,BRX,BWHERE,DFN,PNAME) ;
+1 IF '$GET(BRXIEN)
QUIT "0^Prescription IEN parameter missing"
+2 IF $GET(BWHERE)=""
QUIT "0^RX Action parameter missing"
+3 IF $GET(BRX)=""
QUIT "0^Prescription does not exist"
+4 IF $GET(DFN)=""
QUIT "0^Patient's IEN does not exist"
+5 IF $GET(PNAME)=""
QUIT "0^Patient name missing"
+6 QUIT 1
+7 ;
+8 ;===== check if we need to print the messages to the screen =======
PRINTSCR(BWHER) ;
+1 IF ",AREV,CRLB,CRLR,CRLX,CRRL,PC,PL,"[(","_BWHER_",")
QUIT 0
+2 ;print messages to the screen
QUIT 1
+3 ;check if any IB DATA is missing
+4 ;returns
+5 ; 0 - passed
+6 ; or
+7 ; RESPONSE code^CLMSTAT message^D(display message)^number of seconds to hang if display
IBDATAOK(MOREDATA,BPSARRY) ;
+1 NEW BPRESP
SET BPRESP=2
+2 IF $GET(BPSARRY("NO ECME INSURANCE"))
SET BPRESP=6
+3 ; Check for missing data (Will IB billing determination catch this?)
+4 IF $DATA(MOREDATA("IBDATA",1,1))
IF $PIECE(MOREDATA("IBDATA",1,1),"^",1)=""
QUIT BPRESP_U_"Information missing from IB data.^D^2"
+5 ; Check for missing/invalid payer sheets (I think IB billing determination will catch this)
+6 IF $PIECE($GET(MOREDATA("IBDATA",1,1)),"^",4)=""
QUIT BPRESP_U_"Invalid/missing payer sheet from IB data.^D^2"
+7 ; Check if IB says to bill
+8 IF '$GET(MOREDATA("BILL"))
QUIT BPRESP_U_"Flagged by IB to not 3rd Party Insurance bill through ECME.^D^2"
+9 QUIT 0
+10 ;Get Site
GETSITE(BRXIEN,BFILL) ;
+1 IF '$GET(BRXIEN)
QUIT ""
+2 IF '$GET(BFILL)
QUIT $$RXAPI1^BPSUTIL1(BRXIEN,20,"I")
+3 QUIT $$RXSUBF1^BPSUTIL1(BRXIEN,52,52.1,+BFILL,8,"I")
+4 ;
+5 ; Store general information/parameters into MOREDATA
+6 ; In instances where duz is null set it equal to .5 (postmaster)
BASICMOR(BWHERE,DOS,BPSITE,REVREAS,DURREC,BPOVRIEN,BPSCLARF,BPSAUTH,BPSDELAY,MOREDATA,BPSDX) ;
+1 NEW I
+2 SET MOREDATA("USER")=$SELECT('DUZ:.5,1:DUZ)
+3 SET MOREDATA("RX ACTION")=$GET(BWHERE)
+4 SET MOREDATA("DATE OF SERVICE")=$PIECE($GET(DOS),".",1)
+5 SET MOREDATA("REVERSAL REASON")=$SELECT($GET(REVREAS)="":"UNKNOWN",1:$EXTRACT($GET(REVREAS),1,40))
+6 SET MOREDATA("DIVISION")=$GET(BPSITE)
+7 IF $GET(DURREC)]""
FOR I=1:1:3
IF $PIECE(DURREC,"~",I)]""
SET MOREDATA("DUR",I,0)=$PIECE(DURREC,"~",I)
+8 IF $GET(BPOVRIEN)]""
SET MOREDATA("BPOVRIEN")=BPOVRIEN
+9 IF $GET(BPSCLARF)]""
SET MOREDATA("BPSCLARF")=BPSCLARF
+10 IF $TRANSLATE($GET(BPSAUTH),"^")]""
SET MOREDATA("BPSAUTH")=BPSAUTH
+11 IF $GET(BPSDELAY)]""
SET MOREDATA("BPSDELAY")=BPSDELAY
+12 IF $GET(BPSDX)]""
SET MOREDATA("BPSDX")=BPSDX
+13 QUIT
+14 ;====== Prepare ret. value
+15 ;return RESPONSE ^ CLMSTAT ^ Display= D ^ seconds to HANG
RSPCLMS(BPREQTYP,RESPONSE,MOREDATA,BPADDINF) ;
+1 NEW ELIG
+2 SET ELIG=$GET(MOREDATA("ELIG"))
+3 IF BPREQTYP="C"
IF RESPONSE=0
QUIT RESPONSE_U_$SELECT(ELIG="T":"TRICARE ",ELIG="C":"CHAMPVA ",ELIG="V":"Veteran ",1:"")_"Prescription "_BRX_$SELECT(ELIG="T":"",ELIG="C":"",1:" successfully")_" submitted to ECME for claim generation.^D^"
+4 IF BPREQTYP="C"
IF RESPONSE>0
QUIT RESPONSE_U_"No claim submission made: "_$SELECT($GET(BPADDINF)'="":BPADDINF,1:"Unable to queue claim submission.")_"^D"
+5 IF BPREQTYP="U"
IF RESPONSE=0
QUIT RESPONSE_U_"Reversing prescription "_BRX_".^D^2"
+6 IF BPREQTYP="U"
IF RESPONSE>0
QUIT RESPONSE_U_"No claim submission made. Unable to queue reversal.^D^2"
+7 IF BPREQTYP="UC"
IF RESPONSE=10
QUIT RESPONSE_U_$SELECT(ELIG="T":"TRICARE ",ELIG="C":"CHAMPVA ",ELIG="V":"Veteran ",1:"")_"Prescription "_BRX_$SELECT(ELIG="T":"",ELIG="C":"",1:" successfully")_" submitted to ECME for claim reversal.^D^"
+8 IF BPREQTYP="UC"
IF RESPONSE=0
QUIT RESPONSE_U_$SELECT(ELIG="T":"TRICARE ",ELIG="C":"CHAMPVA ",ELIG="V":"Veteran ",1:"")_"Prescription "_BRX_$SELECT(ELIG="T":"",ELIG="C":"",1:" successfully")_" submitted to ECME for claim generation.^D^"
+9 IF BPREQTYP="UC"
IF RESPONSE>0
IF RESPONSE'=10
QUIT RESPONSE_U_"No claim submission made: "_$SELECT($GET(BPADDINF)'="":BPADDINF,1:"Unable to queue claim submission.")_"^D"
+10 QUIT ""
