Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BPSNCPD9

BPSNCPD9.m

Go to the documentation of this file. 
  1. BPSNCPD9 ;ALB/DMB - Eligibility Verification Entry Point ;09/21/2010
  1.  ;;1.0;E CLAIMS MGMT ENGINE;**10,11**;JUN 2004;Build 27
  1.  ;;Per VHA Directive 2004-038, this routine should not be modified.
  1.  ;
  1.  Q
  1.  ; Main entry point for eligibility verification claims
  1.  ; Input Parameters:
  1.  ;   DFN - Patient
  1.  ;   BPSARRY - Array of values
  1.  ;      "PLAN"        - IEN to the GROUP INSURANCE PLAN (#355.3) file 
  1.  ;      "DOS"         - Date of Service
  1.  ;      "IEN"         - Prescription IEN
  1.  ;      "FILL NUMBER" - Fill Number
  1.  ;      "REL CODE"    - Relationship Code
  1.  ;      "PERSON CODE" - Person Code
  1.  ; Output
  1.  ;   RESULT
  1.  ;       Piece 1 - 0: Not submitted or 1: Submitted
  1.  ;       Piece 2 - Message   
  1.  ;
  1. EN(DFN,BPSARRY) ;
  1.  ; Validate Incoming Parameters
  1.  I '$G(DFN) Q "0^Invalid Patient IEN"
  1.  I '$G(BPSARRY("PLAN")) Q "0^Invalid Plan"
  1.  I '$G(BPSARRY("DOS")) Q "0^Invalid Date of Service"
  1.  S BPSARRY("IEN")=$G(BPSARRY("IEN"))
  1.  S BPSARRY("FILL NUMBER")=$G(BPSARRY("FILL NUMBER"))
  1.  S BPSARRY("REL CODE")=$G(BPSARRY("REL CODE"))
  1.  S BPSARRY("PERSON CODE")=$G(BPSARRY("PERSON CODE"))
  1.  ;
  1.  N PHARM,SITE,ERR,MOREDATA,IEN59,RXACT,POLICY,RETV,NEWREQ,IB
  1.  N PREVREQ,REQLIST,MSG,CERTIEN
  1.  S ERR=""
  1.  ;
  1.  ; Get division
  1.  ; If there is an RX/Fill, get the division from the Rx
  1.  I BPSARRY("IEN"),BPSARRY("FILL NUMBER")]"" D  I 'SITE Q 0_U_"The RX is missing the Division"
  1.  . S SITE=$$GETSITE^BPSOSRX8(BPSARRY("IEN"),BPSARRY("FILL NUMBER"))
  1.  ;
  1.  ; If no RX/Fill, get the default pharmacy from the ECME SETUP file and then 
  1.  ;   the associated division
  1.  I 'BPSARRY("IEN")!(BPSARRY("FILL NUMBER")="") D  I ERR]"" Q 0_U_ERR
  1.  . S PHARM=$$GET1^DIQ(9002313.99,1,.08,"I")
  1.  . I 'PHARM S ERR="Default Pharmacy not defined in ECME Setup" Q
  1.  . I '$$BPSACTV^BPSUTIL(PHARM) S ERR="Default Pharmacy not active" Q
  1.  . S SITE=$O(^BPS(9002313.56,PHARM,"OPSITE",0))
  1.  . I 'SITE S ERR="No division associated with the default Pharmacy" Q
  1.  . S SITE=$P($G(^BPS(9002313.56,PHARM,"OPSITE",SITE,0)),U,1)
  1.  . I 'SITE S ERR="No division associated with the default Pharmacy" Q
  1.  ;
  1.  ; Check that the division is active
  1.  I '$$ECMEON^BPSUTIL(SITE) Q 0_U_"ECME switch is not on for the site"
  1.  ;
  1.  ; Call billing determination
  1.  K MOREDATA
  1.  S RXACT="ELIG"
  1.  D BASICMOR^BPSOSRX8(RXACT,BPSARRY("DOS"),SITE,"","","","","","",.MOREDATA)
  1.  S BPSARRY("DFN")=DFN
  1.  S BPSARRY("EPHARM")=$$GETPHARM^BPSUTIL(SITE)
  1.  S BPSARRY("USER")=DUZ
  1.  S BPSARRY("RX ACTION")=RXACT
  1.  S BPSARRY("DIVISION")=SITE
  1.  I +$$CERTTEST^BPSNCPD4(.CERTIEN)=1 Q 0_U_"Certification question not answered"
  1.  D EN^BPSNCPD2(DFN,RXACT,.MOREDATA,.BPSARRY,.IB)
  1.  I +MOREDATA("BILL")'=1 Q 0_U_"Not submittable: "_$P(MOREDATA("BILL"),U,2)
  1.  I '$P($G(MOREDATA("IBDATA",1,3)),U,7) Q 0_U_"Not submittable: No Policy Information returned"
  1.  ;
  1.  ; Create the IEN for the BPS Transaction record and initialize the log
  1.  S POLICY=9000+$P($G(MOREDATA("IBDATA",1,3)),U,7)
  1.  S IEN59=$$IEN59^BPSOSRX(DFN,POLICY,1)
  1.  D LOG^BPSOSL(IEN59,$T(+0)_"-Start of eligibility verification","DT")
  1.  ;
  1.  ; If override flag is set, prompt for override values - TEST ONLY
  1.  I $$CHECK^BPSTEST D GETOVER^BPSTEST(DFN,POLICY,"",RXACT,"E",1) W !
  1.  ;
  1.  ; If there is a person code or relationship code, create the Override record for the Person Code and Relationship code
  1.  ; Quit if error occurs
  1.  S ERR=""
  1.  I BPSARRY("REL CODE")!BPSARRY("PERSON CODE") D  I ERR]"" Q ERR
  1.  . N BPFLD,BPOVRIEN,BPFDA,BPSMSG
  1.  . S BPFDA(9002313.511,"+1,",.01)=IEN59
  1.  . S BPFDA(9002313.511,"+1,",.02)=$$NOW^BPSOSRX()
  1.  . 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")
  1.  . 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")
  1.  . D UPDATE^DIE("","BPFDA","BPOVRIEN","BPSMSG")
  1.  . I $D(BPSMSG("DIERR"))!($G(BPOVRIEN(1))="") D  Q
  1.  .. D LOG^BPSOSL(IEN59,$T(+0)_"-Override Record could not be created")
  1.  .. D LOG^BPSOSL(IEN59,"BPOVRIEN Array:")
  1.  .. D LOGARRAY^BPSOSL(IEN59,"BPOVRIEN")
  1.  .. D LOG^BPSOSL(IEN59,"BPSMSG Array:")
  1.  .. D LOGARRAY^BPSOSL(IEN59,"BPSMSG")
  1.  .. S ERR=0_U_"Could Not Save Person Code or Relationship Code"
  1.  . S MOREDATA("BPOVRIEN")=BPOVRIEN(1)
  1.  ;
  1.  ; Call CHKREQST^BPSOSRX7 to see if there are other requests on the queue. 
  1.  ; If the return value is negative, quit with error.
  1.  S PREVREQ=$$CHKREQST^BPSOSRX7(DFN,POLICY,.REQLIST)
  1.  I PREVREQ<-1 D  Q 0_U_"There was a queueing issue and the request could not be submitted"
  1.  . D LOG^BPSOSL(IEN59,$T(+0)_"-CHKREQST~BPSOSRX7 returned an error: "_PREVREQ_". Request not submitted.")
  1.  ;
  1.  ; Create the request
  1.  S RETV=$$REQST^BPSOSRX("E",DFN,POLICY,.MOREDATA,1,IEN59)
  1.  S NEWREQ=+$P(RETV,U,2)
  1.  ;
  1.  ; If error, log error and quit
  1.  I +RETV=0 D  Q 0_U_ERR
  1.  . D LOG^BPSOSL(IEN59,$T(+0)_"-Create request error: "_RETV_". Request Will Not Be submitted.")
  1.  . S ERR="Eligibility Request not created - "_$P(RETV,U,2)
  1.  ;
  1.  ; Update log with successful request
  1.  D LOG^BPSOSL(IEN59,$T(+0)_"-BPS REQUEST "_NEWREQ_" has been created")
  1.  ;
  1.  ; The rest of processing is based on the return value of the call to CHKREQST above.
  1.  ; If positive, need to link the current request to the previous request on the queue.
  1.  ; Check the result of trying to link the requests
  1.  I PREVREQ>1 D  Q +RETV_U_MSG
  1.  . S RETV=$$NXTREQST^BPSOSRX6(PREVREQ,NEWREQ)
  1.  . ; If 1 is  returned, all is good, log message and quit
  1.  . I +RETV=1 D  Q
  1.  .. D LOG^BPSOSL(IEN59,$T(+0)_"-Request "_NEWREQ_" linked to "_PREVREQ)
  1.  .. S MSG="Request submitted but will not be processed until previous request finishes"
  1.  . ;
  1.  . ; If we got here, we were not able to link the request
  1.  . D LOG^BPSOSL(IEN59,$T(+0)_"-NXTREQST~BPSOSRX6 returned an error: "_RETV_". Request not submitted.")
  1.  . S MSG="There was a queueing issue and the request could not be created"
  1.  ;
  1.  ; If we got to here, CHKREQST returned 0 so we need to activate the request
  1.  S RETV=$$ACTIVATE^BPSNCPD4(NEWREQ,"E")
  1.  ;
  1.  ; If error, log error and quit
  1.  I RETV'=0 D  Q 0_U_ERR
  1.  . D LOG^BPSOSL(IEN59,$T(+0)_"-Activation error: "_RETV_". Request Will Not Be submitted.")
  1.  . S ERR="Eligibility Request not submitted - "_$P(RETV,U,2)
  1.  ;
  1.  ; Log activation
  1.  D LOG^BPSOSL(IEN59,$T(+0)_"-BPS REQUEST: "_NEWREQ_" has been activated")
  1.  ;
  1.  ; Start filer to process queue requests
  1.  D LOG^BPSOSL(IEN59,$T(+0)_"-Start RUNNING^BPSOSRX")
  1.  D RUNNING^BPSOSRX()
  1.  ;
  1.  Q 1_U_"Request successfully submitted to ECME"
  1.  ;