BPSNCPD9 ;ALB/DMB - Eligibility Verification Entry Point ;09/21/2010
;;1.0;E CLAIMS MGMT ENGINE;**10,11**;JUN 2004;Build 27
;;Per VHA Directive 2004-038, this routine should not be modified.
;
Q
; Main entry point for eligibility verification claims
; Input Parameters:
; DFN - Patient
; BPSARRY - Array of values
; "PLAN" - IEN to the GROUP INSURANCE PLAN (#355.3) file
; "DOS" - Date of Service
; "IEN" - Prescription IEN
; "FILL NUMBER" - Fill Number
; "REL CODE" - Relationship Code
; "PERSON CODE" - Person Code
; Output
; RESULT
; Piece 1 - 0: Not submitted or 1: Submitted
; Piece 2 - Message
;
EN(DFN,BPSARRY) ;
; Validate Incoming Parameters
I '$G(DFN) Q "0^Invalid Patient IEN"
I '$G(BPSARRY("PLAN")) Q "0^Invalid Plan"
I '$G(BPSARRY("DOS")) Q "0^Invalid Date of Service"
S BPSARRY("IEN")=$G(BPSARRY("IEN"))
S BPSARRY("FILL NUMBER")=$G(BPSARRY("FILL NUMBER"))
S BPSARRY("REL CODE")=$G(BPSARRY("REL CODE"))
S BPSARRY("PERSON CODE")=$G(BPSARRY("PERSON CODE"))
;
N PHARM,SITE,ERR,MOREDATA,IEN59,RXACT,POLICY,RETV,NEWREQ,IB
N PREVREQ,REQLIST,MSG,CERTIEN
S ERR=""
;
; Get division
; If there is an RX/Fill, get the division from the Rx
I BPSARRY("IEN"),BPSARRY("FILL NUMBER")]"" D I 'SITE Q 0_U_"The RX is missing the Division"
. S SITE=$$GETSITE^BPSOSRX8(BPSARRY("IEN"),BPSARRY("FILL NUMBER"))
;
; If no RX/Fill, get the default pharmacy from the ECME SETUP file and then
; the associated division
I 'BPSARRY("IEN")!(BPSARRY("FILL NUMBER")="") D I ERR]"" Q 0_U_ERR
. S PHARM=$$GET1^DIQ(9002313.99,1,.08,"I")
. I 'PHARM S ERR="Default Pharmacy not defined in ECME Setup" Q
. I '$$BPSACTV^BPSUTIL(PHARM) S ERR="Default Pharmacy not active" Q
. S SITE=$O(^BPS(9002313.56,PHARM,"OPSITE",0))
. I 'SITE S ERR="No division associated with the default Pharmacy" Q
. S SITE=$P($G(^BPS(9002313.56,PHARM,"OPSITE",SITE,0)),U,1)
. I 'SITE S ERR="No division associated with the default Pharmacy" Q
;
; Check that the division is active
I '$$ECMEON^BPSUTIL(SITE) Q 0_U_"ECME switch is not on for the site"
;
; Call billing determination
K MOREDATA
S RXACT="ELIG"
D BASICMOR^BPSOSRX8(RXACT,BPSARRY("DOS"),SITE,"","","","","","",.MOREDATA)
S BPSARRY("DFN")=DFN
S BPSARRY("EPHARM")=$$GETPHARM^BPSUTIL(SITE)
S BPSARRY("USER")=DUZ
S BPSARRY("RX ACTION")=RXACT
S BPSARRY("DIVISION")=SITE
I +$$CERTTEST^BPSNCPD4(.CERTIEN)=1 Q 0_U_"Certification question not answered"
D EN^BPSNCPD2(DFN,RXACT,.MOREDATA,.BPSARRY,.IB)
I +MOREDATA("BILL")'=1 Q 0_U_"Not submittable: "_$P(MOREDATA("BILL"),U,2)
I '$P($G(MOREDATA("IBDATA",1,3)),U,7) Q 0_U_"Not submittable: No Policy Information returned"
;
; Create the IEN for the BPS Transaction record and initialize the log
S POLICY=9000+$P($G(MOREDATA("IBDATA",1,3)),U,7)
S IEN59=$$IEN59^BPSOSRX(DFN,POLICY,1)
D LOG^BPSOSL(IEN59,$T(+0)_"-Start of eligibility verification","DT")
;
; If override flag is set, prompt for override values - TEST ONLY
I $$CHECK^BPSTEST D GETOVER^BPSTEST(DFN,POLICY,"",RXACT,"E",1) W !
;
; If there is a person code or relationship code, create the Override record for the Person Code and Relationship code
; Quit if error occurs
S ERR=""
I BPSARRY("REL CODE")!BPSARRY("PERSON CODE") D I ERR]"" Q ERR
. N BPFLD,BPOVRIEN,BPFDA,BPSMSG
. S BPFDA(9002313.511,"+1,",.01)=IEN59
. S BPFDA(9002313.511,"+1,",.02)=$$NOW^BPSOSRX()
. S BPFLD=$O(^BPSF(9002313.91,"B",303,"")) I BPFLD]"" S BPFDA(9002313.5111,"+2,+1,",.01)=BPFLD,BPFDA(9002313.5111,"+2,+1,",.02)=BPSARRY("PERSON CODE")
. S BPFLD=$O(^BPSF(9002313.91,"B",306,"")) I BPFLD]"" S BPFDA(9002313.5111,"+3,+1,",.01)=BPFLD,BPFDA(9002313.5111,"+3,+1,",.02)=BPSARRY("REL CODE")
. D UPDATE^DIE("","BPFDA","BPOVRIEN","BPSMSG")
. I $D(BPSMSG("DIERR"))!($G(BPOVRIEN(1))="") D Q
.. D LOG^BPSOSL(IEN59,$T(+0)_"-Override Record could not be created")
.. D LOG^BPSOSL(IEN59,"BPOVRIEN Array:")
.. D LOGARRAY^BPSOSL(IEN59,"BPOVRIEN")
.. D LOG^BPSOSL(IEN59,"BPSMSG Array:")
.. D LOGARRAY^BPSOSL(IEN59,"BPSMSG")
.. S ERR=0_U_"Could Not Save Person Code or Relationship Code"
. S MOREDATA("BPOVRIEN")=BPOVRIEN(1)
;
; Call CHKREQST^BPSOSRX7 to see if there are other requests on the queue.
; If the return value is negative, quit with error.
S PREVREQ=$$CHKREQST^BPSOSRX7(DFN,POLICY,.REQLIST)
I PREVREQ<-1 D Q 0_U_"There was a queueing issue and the request could not be submitted"
. D LOG^BPSOSL(IEN59,$T(+0)_"-CHKREQST~BPSOSRX7 returned an error: "_PREVREQ_". Request not submitted.")
;
; Create the request
S RETV=$$REQST^BPSOSRX("E",DFN,POLICY,.MOREDATA,1,IEN59)
S NEWREQ=+$P(RETV,U,2)
;
; If error, log error and quit
I +RETV=0 D Q 0_U_ERR
. D LOG^BPSOSL(IEN59,$T(+0)_"-Create request error: "_RETV_". Request Will Not Be submitted.")
. S ERR="Eligibility Request not created - "_$P(RETV,U,2)
;
; Update log with successful request
D LOG^BPSOSL(IEN59,$T(+0)_"-BPS REQUEST "_NEWREQ_" has been created")
;
; The rest of processing is based on the return value of the call to CHKREQST above.
; If positive, need to link the current request to the previous request on the queue.
; Check the result of trying to link the requests
I PREVREQ>1 D Q +RETV_U_MSG
. S RETV=$$NXTREQST^BPSOSRX6(PREVREQ,NEWREQ)
. ; If 1 is returned, all is good, log message and quit
. I +RETV=1 D Q
.. D LOG^BPSOSL(IEN59,$T(+0)_"-Request "_NEWREQ_" linked to "_PREVREQ)
.. S MSG="Request submitted but will not be processed until previous request finishes"
. ;
. ; If we got here, we were not able to link the request
. D LOG^BPSOSL(IEN59,$T(+0)_"-NXTREQST~BPSOSRX6 returned an error: "_RETV_". Request not submitted.")
. S MSG="There was a queueing issue and the request could not be created"
;
; If we got to here, CHKREQST returned 0 so we need to activate the request
S RETV=$$ACTIVATE^BPSNCPD4(NEWREQ,"E")
;
; If error, log error and quit
I RETV'=0 D Q 0_U_ERR
. D LOG^BPSOSL(IEN59,$T(+0)_"-Activation error: "_RETV_". Request Will Not Be submitted.")
. S ERR="Eligibility Request not submitted - "_$P(RETV,U,2)
;
; Log activation
D LOG^BPSOSL(IEN59,$T(+0)_"-BPS REQUEST: "_NEWREQ_" has been activated")
;
; Start filer to process queue requests
D LOG^BPSOSL(IEN59,$T(+0)_"-Start RUNNING^BPSOSRX")
D RUNNING^BPSOSRX()
;
Q 1_U_"Request successfully submitted to ECME"
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HBPSNCPD9 6501 printed Apr 09, 2024@20:58:35 Page 2
BPSNCPD9 ;ALB/DMB - Eligibility Verification Entry Point ;09/21/2010
+1 ;;1.0;E CLAIMS MGMT ENGINE;**10,11**;JUN 2004;Build 27
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 QUIT
+5 ; Main entry point for eligibility verification claims
+6 ; Input Parameters:
+7 ; DFN - Patient
+8 ; BPSARRY - Array of values
+9 ; "PLAN" - IEN to the GROUP INSURANCE PLAN (#355.3) file
+10 ; "DOS" - Date of Service
+11 ; "IEN" - Prescription IEN
+12 ; "FILL NUMBER" - Fill Number
+13 ; "REL CODE" - Relationship Code
+14 ; "PERSON CODE" - Person Code
+15 ; Output
+16 ; RESULT
+17 ; Piece 1 - 0: Not submitted or 1: Submitted
+18 ; Piece 2 - Message
+19 ;
EN(DFN,BPSARRY) ;
+1 ; Validate Incoming Parameters
+2 IF '$GET(DFN)
QUIT "0^Invalid Patient IEN"
+3 IF '$GET(BPSARRY("PLAN"))
QUIT "0^Invalid Plan"
+4 IF '$GET(BPSARRY("DOS"))
QUIT "0^Invalid Date of Service"
+5 SET BPSARRY("IEN")=$GET(BPSARRY("IEN"))
+6 SET BPSARRY("FILL NUMBER")=$GET(BPSARRY("FILL NUMBER"))
+7 SET BPSARRY("REL CODE")=$GET(BPSARRY("REL CODE"))
+8 SET BPSARRY("PERSON CODE")=$GET(BPSARRY("PERSON CODE"))
+9 ;
+10 NEW PHARM,SITE,ERR,MOREDATA,IEN59,RXACT,POLICY,RETV,NEWREQ,IB
+11 NEW PREVREQ,REQLIST,MSG,CERTIEN
+12 SET ERR=""
+13 ;
+14 ; Get division
+15 ; If there is an RX/Fill, get the division from the Rx
+16 IF BPSARRY("IEN")
IF BPSARRY("FILL NUMBER")]""
Begin DoDot:1
+17 SET SITE=$$GETSITE^BPSOSRX8(BPSARRY("IEN"),BPSARRY("FILL NUMBER"))
End DoDot:1
IF 'SITE
QUIT 0_U_"The RX is missing the Division"
+18 ;
+19 ; If no RX/Fill, get the default pharmacy from the ECME SETUP file and then
+20 ; the associated division
+21 IF 'BPSARRY("IEN")!(BPSARRY("FILL NUMBER")="")
Begin DoDot:1
+22 SET PHARM=$$GET1^DIQ(9002313.99,1,.08,"I")
+23 IF 'PHARM
SET ERR="Default Pharmacy not defined in ECME Setup"
QUIT
+24 IF '$$BPSACTV^BPSUTIL(PHARM)
SET ERR="Default Pharmacy not active"
QUIT
+25 SET SITE=$ORDER(^BPS(9002313.56,PHARM,"OPSITE",0))
+26 IF 'SITE
SET ERR="No division associated with the default Pharmacy"
QUIT
+27 SET SITE=$PIECE($GET(^BPS(9002313.56,PHARM,"OPSITE",SITE,0)),U,1)
+28 IF 'SITE
SET ERR="No division associated with the default Pharmacy"
QUIT
End DoDot:1
IF ERR]""
QUIT 0_U_ERR
+29 ;
+30 ; Check that the division is active
+31 IF '$$ECMEON^BPSUTIL(SITE)
QUIT 0_U_"ECME switch is not on for the site"
+32 ;
+33 ; Call billing determination
+34 KILL MOREDATA
+35 SET RXACT="ELIG"
+36 DO BASICMOR^BPSOSRX8(RXACT,BPSARRY("DOS"),SITE,"","","","","","",.MOREDATA)
+37 SET BPSARRY("DFN")=DFN
+38 SET BPSARRY("EPHARM")=$$GETPHARM^BPSUTIL(SITE)
+39 SET BPSARRY("USER")=DUZ
+40 SET BPSARRY("RX ACTION")=RXACT
+41 SET BPSARRY("DIVISION")=SITE
+42 IF +$$CERTTEST^BPSNCPD4(.CERTIEN)=1
QUIT 0_U_"Certification question not answered"
+43 DO EN^BPSNCPD2(DFN,RXACT,.MOREDATA,.BPSARRY,.IB)
+44 IF +MOREDATA("BILL")'=1
QUIT 0_U_"Not submittable: "_$PIECE(MOREDATA("BILL"),U,2)
+45 IF '$PIECE($GET(MOREDATA("IBDATA",1,3)),U,7)
QUIT 0_U_"Not submittable: No Policy Information returned"
+46 ;
+47 ; Create the IEN for the BPS Transaction record and initialize the log
+48 SET POLICY=9000+$PIECE($GET(MOREDATA("IBDATA",1,3)),U,7)
+49 SET IEN59=$$IEN59^BPSOSRX(DFN,POLICY,1)
+50 DO LOG^BPSOSL(IEN59,$TEXT(+0)_"-Start of eligibility verification","DT")
+51 ;
+52 ; If override flag is set, prompt for override values - TEST ONLY
+53 IF $$CHECK^BPSTEST
DO GETOVER^BPSTEST(DFN,POLICY,"",RXACT,"E",1)
WRITE !
+54 ;
+55 ; If there is a person code or relationship code, create the Override record for the Person Code and Relationship code
+56 ; Quit if error occurs
+57 SET ERR=""
+58 IF BPSARRY("REL CODE")!BPSARRY("PERSON CODE")
Begin DoDot:1
+59 NEW BPFLD,BPOVRIEN,BPFDA,BPSMSG
+60 SET BPFDA(9002313.511,"+1,",.01)=IEN59
+61 SET BPFDA(9002313.511,"+1,",.02)=$$NOW^BPSOSRX()
+62 SET BPFLD=$ORDER(^BPSF(9002313.91,"B",303,""))
IF BPFLD]""
SET BPFDA(9002313.5111,"+2,+1,",.01)=BPFLD
SET BPFDA(9002313.5111,"+2,+1,",.02)=BPSARRY("PERSON CODE")
+63 SET BPFLD=$ORDER(^BPSF(9002313.91,"B",306,""))
IF BPFLD]""
SET BPFDA(9002313.5111,"+3,+1,",.01)=BPFLD
SET BPFDA(9002313.5111,"+3,+1,",.02)=BPSARRY("REL CODE")
+64 DO UPDATE^DIE("","BPFDA","BPOVRIEN","BPSMSG")
+65 IF $DATA(BPSMSG("DIERR"))!($GET(BPOVRIEN(1))="")
Begin DoDot:2
+66 DO LOG^BPSOSL(IEN59,$TEXT(+0)_"-Override Record could not be created")
+67 DO LOG^BPSOSL(IEN59,"BPOVRIEN Array:")
+68 DO LOGARRAY^BPSOSL(IEN59,"BPOVRIEN")
+69 DO LOG^BPSOSL(IEN59,"BPSMSG Array:")
+70 DO LOGARRAY^BPSOSL(IEN59,"BPSMSG")
+71 SET ERR=0_U_"Could Not Save Person Code or Relationship Code"
End DoDot:2
QUIT
+72 SET MOREDATA("BPOVRIEN")=BPOVRIEN(1)
End DoDot:1
IF ERR]""
QUIT ERR
+73 ;
+74 ; Call CHKREQST^BPSOSRX7 to see if there are other requests on the queue.
+75 ; If the return value is negative, quit with error.
+76 SET PREVREQ=$$CHKREQST^BPSOSRX7(DFN,POLICY,.REQLIST)
+77 IF PREVREQ<-1
Begin DoDot:1
+78 DO LOG^BPSOSL(IEN59,$TEXT(+0)_"-CHKREQST~BPSOSRX7 returned an error: "_PREVREQ_". Request not submitted.")
End DoDot:1
QUIT 0_U_"There was a queueing issue and the request could not be submitted"
+79 ;
+80 ; Create the request
+81 SET RETV=$$REQST^BPSOSRX("E",DFN,POLICY,.MOREDATA,1,IEN59)
+82 SET NEWREQ=+$PIECE(RETV,U,2)
+83 ;
+84 ; If error, log error and quit
+85 IF +RETV=0
Begin DoDot:1
+86 DO LOG^BPSOSL(IEN59,$TEXT(+0)_"-Create request error: "_RETV_". Request Will Not Be submitted.")
+87 SET ERR="Eligibility Request not created - "_$PIECE(RETV,U,2)
End DoDot:1
QUIT 0_U_ERR
+88 ;
+89 ; Update log with successful request
+90 DO LOG^BPSOSL(IEN59,$TEXT(+0)_"-BPS REQUEST "_NEWREQ_" has been created")
+91 ;
+92 ; The rest of processing is based on the return value of the call to CHKREQST above.
+93 ; If positive, need to link the current request to the previous request on the queue.
+94 ; Check the result of trying to link the requests
+95 IF PREVREQ>1
Begin DoDot:1
+96 SET RETV=$$NXTREQST^BPSOSRX6(PREVREQ,NEWREQ)
+97 ; If 1 is returned, all is good, log message and quit
+98 IF +RETV=1
Begin DoDot:2
+99 DO LOG^BPSOSL(IEN59,$TEXT(+0)_"-Request "_NEWREQ_" linked to "_PREVREQ)
+100 SET MSG="Request submitted but will not be processed until previous request finishes"
End DoDot:2
QUIT
+101 ;
+102 ; If we got here, we were not able to link the request
+103 DO LOG^BPSOSL(IEN59,$TEXT(+0)_"-NXTREQST~BPSOSRX6 returned an error: "_RETV_". Request not submitted.")
+104 SET MSG="There was a queueing issue and the request could not be created"
End DoDot:1
QUIT +RETV_U_MSG
+105 ;
+106 ; If we got to here, CHKREQST returned 0 so we need to activate the request
+107 SET RETV=$$ACTIVATE^BPSNCPD4(NEWREQ,"E")
+108 ;
+109 ; If error, log error and quit
+110 IF RETV'=0
Begin DoDot:1
+111 DO LOG^BPSOSL(IEN59,$TEXT(+0)_"-Activation error: "_RETV_". Request Will Not Be submitted.")
+112 SET ERR="Eligibility Request not submitted - "_$PIECE(RETV,U,2)
End DoDot:1
QUIT 0_U_ERR
+113 ;
+114 ; Log activation
+115 DO LOG^BPSOSL(IEN59,$TEXT(+0)_"-BPS REQUEST: "_NEWREQ_" has been activated")
+116 ;
+117 ; Start filer to process queue requests
+118 DO LOG^BPSOSL(IEN59,$TEXT(+0)_"-Start RUNNING^BPSOSRX")
+119 DO RUNNING^BPSOSRX()
+120 ;
+121 QUIT 1_U_"Request successfully submitted to ECME"
+122 ;
