- BPSOSRX8 ;ALB/SS - ECME REQUESTS ;10-JAN-08
- ;;1.0;E CLAIMS MGMT ENGINE;**7,10,11,20**;JUN 2004;Build 27
- ;;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) ;
- 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
- 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 3904 printed Jan 18, 2025@02:53:19 Page 2
- BPSOSRX8 ;ALB/SS - ECME REQUESTS ;10-JAN-08
- +1 ;;1.0;E CLAIMS MGMT ENGINE;**7,10,11,20**;JUN 2004;Build 27
- +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) ;
- +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 QUIT
- +13 ;====== Prepare ret. value
- +14 ;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 ""