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

IBCNERP5.m

Go to the documentation of this file. 
  1. IBCNERP5 ;DAOU/BHS - IBCNE eIV PAYER REPORT COMPILE ;03-JUN-2002
  1.  ;;2.0;INTEGRATED BILLING;**184,271,300,416,668**;21-MAR-94;Build 28
  1.  ;;Per VHA Directive 6402, this routine should not be modified.
  1.  ;
  1.  ; eIV - Insurance Verification Interface
  1.  ;
  1.  ; Input variables from IBCNERP4:
  1.  ;   IBCNERTN = "IBCNERP4"
  1.  ;   IBCNESPC("BEGDT") = Start Date for date range
  1.  ;   IBCNESPC("ENDDT") = End Date for date range
  1.  ;   IBCNESPC("PYR") = Payer IEN for report, if = "", then include all
  1.  ;   IBCNESPC("SORT") = 1 - Payer OR 2 - Total Inquiries
  1.  ;   IBCNESPC("DTL") = 1 - YES OR 0 - NO - include Rejection Detail?
  1.  ; Output variables passed to IBCNERP6:
  1.  ;   ^TMP($J,IBCNERTN,SORT1,SORT2,SORT3)=InqCreatedCount^InqCancelledCt^
  1.  ;                                       InqQueuedCt^1stTransCount^
  1.  ;                                       RetryTransCt^Non-ErrorRespCt^
  1.  ;                                       ErrorRespCount^TotRespTime-days^
  1.  ;                                       CommFailRespCount^PendRespCount^
  1.  ;                                       eIVDeactivatedDt
  1.  ;        IBCNERTN = "IBCNERP4"
  1.  ;        SORT1 = PayerName (SORT=1) or -InquiryCount(SORT=2)
  1.  ;        SORT2 = PayerIEN (SORT=1) or PayerName (SORT=2)
  1.  ;        SORT3 = "*" (SORT=1) or PayerIEN (SORT=2)
  1.  ;   ^TMP($J,IBCNERTN,SORT1,SORT2,SORT3,ERRCD)=RespCount
  1.  ;        (see above)
  1.  ;        ERRCD = Error Condition code (ptr to 365.018) or Error Text
  1.  ;                from the Eligibility Communicator (4.01)
  1.  ;
  1.  ; Must call at EN tag
  1.  Q
  1.  ;
  1. EN(IBCNERTN,IBCNESPC) ; Entry point
  1.  ;
  1.  ; Initialize variables
  1.  NEW IBCNEDT,IBCNEDT1,IBCNEDT2,IBCNEPY,IBCNEPYR,IBCNEPTR
  1.  NEW IBCNETOT,IBCNESRT,IBCNEDTL,RPTDATA,PYRIEN,INQS,IEN
  1.  NEW IBPNM,IBPIEN,ERR,PC,PYR
  1.  ;
  1.  I '$D(ZTQUEUED),$G(IOST)["C-" W !!,"Compiling report data ..."
  1.  ;
  1.  ; Total responses selected
  1.  S IBCNETOT=0
  1.  ;
  1.  ; Kill scratch globals
  1.  KILL ^TMP($J,IBCNERTN),^TMP($J,IBCNERTN_"X")
  1.  ;
  1.  ; Initialize looping variables
  1.  S IBCNEDT2=$G(IBCNESPC("ENDDT"))
  1.  S IBCNEDT1=$G(IBCNESPC("BEGDT"))
  1.  S IBCNEPY=$G(IBCNESPC("PYR"))
  1.  S IBCNESRT=$G(IBCNESPC("SORT"))
  1.  S IBCNEDTL=$G(IBCNESPC("DTL"))
  1.  ;
  1.  ; Loop through the eIV Transmission Queue File (#365.1) 
  1.  ;  by Date/Time Created Cross-Reference
  1.  S IBCNEDT=$O(^IBCN(365.1,"AE",IBCNEDT1),-1)
  1.  F  S IBCNEDT=$O(^IBCN(365.1,"AE",IBCNEDT)) Q:IBCNEDT=""!($P(IBCNEDT,".",1)>IBCNEDT2)  D  Q:$G(ZTSTOP)
  1.  . S IBCNEPTR=0
  1.  . F  S IBCNEPTR=$O(^IBCN(365.1,"AE",IBCNEDT,IBCNEPTR)) Q:'IBCNEPTR  D  Q:$G(ZTSTOP)
  1.  . . ; Update selected count
  1.  . . S IBCNETOT=IBCNETOT+1
  1.  . . I $D(ZTQUEUED),IBCNETOT#100=0,$$S^%ZTLOAD() S ZTSTOP=1 QUIT
  1.  . . ; Determine Payer name from Payer File (#365.12)
  1.  . . S PYRIEN=$P($G(^IBCN(365.1,IBCNEPTR,0)),U,3)
  1.  . . I 'PYRIEN Q
  1.  . . ; Check payer filter
  1.  . . I IBCNEPY'="",PYRIEN'=IBCNEPY Q
  1.  . . S IBCNEPYR=$P($G(^IBE(365.12,PYRIEN,0)),U)
  1.  . . I IBCNEPYR="" Q
  1.  . . ; Now get the data for the report - build RPTDATA
  1.  . . KILL RPTDATA
  1.  . . D GETDATA(IBCNEPTR,.RPTDATA,IBCNEDTL,IBCNEPYR,PYRIEN,IBCNEPY)
  1.  . . ; Loop through results by Payer Name, Payer IEN
  1.  . . S IBPNM=""
  1.  . . F  S IBPNM=$O(RPTDATA(IBPNM)) Q:IBPNM=""  D
  1.  . . . S IBPIEN=0
  1.  . . . F  S IBPIEN=$O(RPTDATA(IBPNM,IBPIEN)) Q:'IBPIEN  D
  1.  . . . . ; Store totals in global
  1.  . . . . F PC=1:1:10 S $P(^TMP($J,IBCNERTN,IBPNM,IBPIEN,"*"),U,PC)=$P($G(^TMP($J,IBCNERTN,IBPNM,IBPIEN,"*")),U,PC)+$P(RPTDATA(IBPNM,IBPIEN),U,PC)
  1.  . . . . ; Store deactivation date/time
  1.  . . . . S $P(^TMP($J,IBCNERTN,IBPNM,IBPIEN,"*"),U,11)=$P(RPTDATA(IBPNM,IBPIEN),U,11)
  1.  . . . . I 'IBCNEDTL Q
  1.  . . . . ; Store rejection detail
  1.  . . . . S ERR=""
  1.  . . . . F  S ERR=$O(RPTDATA(IBPNM,IBPIEN,ERR)) Q:ERR=""  D
  1.  . . . . .  S ^TMP($J,IBCNERTN,IBPNM,IBPIEN,"*",ERR)=$G(^TMP($J,IBCNERTN,IBPNM,IBPIEN,"*",ERR))+$G(RPTDATA(IBPNM,IBPIEN,ERR))
  1.  . . Q
  1.  . Q
  1.  ;
  1.  ; Call tag to find good/bad/rejection detail data from response file
  1.  D DATA^IBCNERP4
  1.  ;
  1.  I $G(ZTSTOP)!(IBCNESRT=1) G EXIT
  1.  ;
  1.  ; Resort if sorted by Total Inquiries
  1.  M ^TMP($J,IBCNERTN_"X")=^TMP($J,IBCNERTN)
  1.  KILL ^TMP($J,IBCNERTN)
  1.  S PYR=""
  1.  F  S PYR=$O(^TMP($J,IBCNERTN_"X",PYR)) Q:PYR=""  D
  1.  .  S IEN=0
  1.  .  F  S IEN=$O(^TMP($J,IBCNERTN_"X",PYR,IEN)) Q:'IEN  D
  1.  .  .  S INQS=-$G(^TMP($J,IBCNERTN_"X",PYR,IEN,"*"))
  1.  .  .  M ^TMP($J,IBCNERTN,INQS,PYR,IEN)=^TMP($J,IBCNERTN_"X",PYR,IEN,"*")
  1.  .  .  QUIT
  1.  .  QUIT
  1.  ; KILL temporary report global - used to resort
  1.  KILL ^TMP($J,IBCNERTN_"X")
  1.  ;
  1. EXIT ; EN Exit point
  1.  Q
  1.  ;
  1.  ;
  1. GETDATA(IEN,RPTDATA,DTL,PYNM,PYIEN,PYR) ; Retrieve data for this inquiry and response(s)
  1.  ; Output: 
  1.  ;  RPTDATA(PayerName,PayerIEN) = Created(1)^Cancelled(0/1)^Queued(0/1)^
  1.  ;   #1stTrans^#Retries^#Non-ErrorResponses^#ErrorResponses^
  1.  ;   #ofDaysforResponses^#Timeouts^#Pending^DeactivationDTM
  1.  ;  RPTDATA(PayerName,PayerIEN,ErrCond OR ErrText) = #ErrorResps subtotal
  1.  ; Initialize variables
  1.  NEW DEACT,HLIEN,HLID,RIEN,RDATA0,RPYIEN,RPYNM,RDATA1,ERRTXT,X1,X2,FIRST
  1.  ;
  1.  S RPTDATA(PYNM,PYIEN)=1
  1.  ;IB*668/TAZ - Call PYRDEACT to get Payer Deactivated from new file location.
  1.  ; Determine Deactivation DTM for eIV application
  1.  S DEACT=$$PYRDEACT^IBCNINSU(PYIEN)
  1.  I +DEACT S $P(RPTDATA(PYNM,PYIEN),U,11)=$P(DEACT,U,2)
  1.  ; Logic by Transmission Status
  1.  ;  Cancelled (7) - Payer deactivated
  1.  I $P($G(^IBCN(365.1,IEN,0)),U,4)=7 S $P(RPTDATA(PYNM,PYIEN),U,2)=1 Q
  1.  ;  Queued - no HL7 messages (# Transmissions = 0) - no multiples exist
  1.  I '$P($G(^IBCN(365.1,IEN,2,0)),U,3) S $P(RPTDATA(PYNM,PYIEN),U,3)=1 Q
  1.  ;  Sent processing - HL7 messages associated (# Transmissions > 0)
  1.  S HLIEN=0,FIRST=1
  1.  F  S HLIEN=$O(^IBCN(365.1,IEN,2,HLIEN)) Q:'HLIEN  D
  1.  .  I 'FIRST S $P(RPTDATA(PYNM,PYIEN),U,5)=$P(RPTDATA(PYNM,PYIEN),U,5)+1
  1.  .  I FIRST S $P(RPTDATA(PYNM,PYIEN),U,4)=$P(RPTDATA(PYNM,PYIEN),U,4)+1,FIRST=0
  1.  .  ; Process response based on HL7 Message ID
  1.  .  S HLID=$P($G(^IBCN(365.1,IEN,2,HLIEN,0)),U,2) I HLID="" Q
  1.  .  ; Lookup responses by HL7 Message ID
  1.  .  S RIEN=0
  1.  .  F  S RIEN=$O(^IBCN(365,"B",HLID,RIEN)) Q:'RIEN  D
  1.  .  .  S RDATA0=$G(^IBCN(365,RIEN,0))
  1.  .  .  S RPYIEN=$P(RDATA0,U,3) I RPYIEN="" Q
  1.  .  .  S RPYNM=$P($G(^IBE(365.12,RPYIEN,0)),U,1) I RPYNM="" Q
  1.  .  .  ; Apply payer filter here, too!
  1.  .  .  ; If there is a Payer filter, check against the IEN
  1.  .  .  I PYR'="",RPYIEN'=PYR Q
  1.  .  .  ;IB*668/TAZ - Call PYRDEACT to get Payer Deactivated from new file location.
  1.  .  .  ; Determine Deactivation DTM for eIV application
  1.  .  .  S DEACT=$$PYRDEACT^IBCNINSU(RPYIEN)
  1.  .  .  I +DEACT S $P(RPTDATA(RPYNM,RPYIEN),U,11)=$P(DEACT,U,2)
  1.  .  .  S RDATA1=$G(^IBCN(365,RIEN,1))
  1.  .  .  S ERRTXT=$G(^IBCN(365,RIEN,4))
  1.  .  .  ; Transmitted (Pending)
  1.  .  .  I $P(RDATA0,U,6)=2 D  Q
  1.  .  .  . ; Increment for response pending 
  1.  .  .  . S $P(RPTDATA(RPYNM,RPYIEN),U,10)=$P($G(RPTDATA(RPYNM,RPYIEN)),U,10)+1
  1.  .  .  ; Timeout (Communication Failure)
  1.  .  .  I $P(RDATA0,U,6)=5 D  Q
  1.  .  .  . ; Increment for response timeout 
  1.  .  .  . S $P(RPTDATA(RPYNM,RPYIEN),U,9)=$P($G(RPTDATA(RPYNM,RPYIEN)),U,9)+1
  1.  .  .  ; Response Received - gather additional information
  1.  .  .  I $P(RDATA0,U,6)=3 D  Q
  1.  .  .  . ; Determine response time (in days) as difference between 
  1.  .  .  . ;  eIV Response File - Date/Time Response Received and
  1.  .  .  . ;                      Date/Time Response Created (based on HL7)
  1.  .  .  . S X1=$P(RDATA0,U,8)
  1.  .  .  . S X2=$P(RDATA0,U,7)
  1.  .  .  . ; Determine date difference in days
  1.  .  .  . S $P(RPTDATA(RPYNM,RPYIEN),U,8)=$P($G(RPTDATA(RPYNM,RPYIEN)),U,8)+$$FMDIFF^XLFDT(X2,X1,1)
  1.  ;
  1. GETDATX ; GETDATA exit point
  1.  Q
  1.  ;
  1.  ;