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

IBCNEHL6.m

Go to the documentation of this file. 
  1. IBCNEHL6 ;EDE/DM - HL7 Process Incoming RPI Continued ; 19-OCT-2017
  1.  ;;2.0;INTEGRATED BILLING;**601,621,737,743,752**;21-MAR-94;Build 20
  1.  ;;Per VA Directive 6402, this routine should not be modified.
  1.  ;
  1.  Q
  1. FIL ; Finish processing the response message - file into insurance buffer
  1.  ;
  1.  ; Input Variables
  1.  ; ERACT, ERFLG, ERROR, IIVSTAT, MAP, RIEN, TRACE, TRKIEN
  1.  ;
  1.  ; If no record IEN, quit
  1.  I $G(RIEN)="" Q
  1.  ;
  1.  N BUFF,CALLEDBY,DFN,FILEIT,IBEICDV,IBFDA,IBIEN,IBINSDTA,IBISMBI,IBQFL
  1.  N RDAT0,RSRVDT,RSTYPE,SYMBOL,TQDATA,TQN,TQSRVDT,TRKDTA
  1.  ; Initialize variables from the Response File
  1.  S RDAT0=$G(^IBCN(365,RIEN,0)),TQN=$P(RDAT0,U,5)
  1.  S TQDATA=$G(^IBCN(365.1,TQN,0))
  1.  S IBQFL=$P(TQDATA,U,11)
  1.  S DFN=$P(RDAT0,U,2),BUFF=$P(RDAT0,U,4)
  1.  S IBISMBI=+$$MBICHK^IBCNEUT7(BUFF) ; IB*2*601/DM
  1.  S IBEICDV=((IBQFL="V")&($P(TQDATA,U,10)="4")) ; IB*2.0*621/DM
  1.  S IBIEN=$P(TQDATA,U,5),RSTYPE=$P(RDAT0,U,10)
  1.  S RSRVDT=$P($G(^IBCN(365,RIEN,1)),U,10)
  1.  ;
  1.  ; If an unknown error action or an error filing the response message,
  1.  ; send a warning email message
  1.  ; Note - A call to UEACT will always set ERFLAG=1
  1.  ;
  1.  ; IB*2.0*506 Removed the following line of code to Treat all AAA Action Codes
  1.  ; as though the Payer/FSC Responded.
  1.  ;I ",W,X,R,P,C,N,Y,S,"'[(","_$G(ERACT)_",")&($G(ERACT)'="")!$D(ERROR) D UEACT^IBCNEHL3
  1.  ;
  1.  ; If an error occurred, processing complete
  1.  I $G(ERFLG)=1 Q
  1.  ;
  1.  ;  For an original response, set the Transmission Queue Status to 'Response Received' &
  1.  ;  update remaining retries to comm failure (5)
  1.  ;IB*743/CKB - called earlier when saving the MSA segment 
  1.  ;I $G(RSTYPE)="O" D SST^IBCNEUT2(TQN,3),RSTA^IBCNEUT7(TQN)
  1.  ;
  1.  ; Update the TQ service date to the date in the response file
  1.  ; if they are different AND the Error Action <>
  1.  ; 'P' for 'Please submit original transaction'
  1.  ;
  1.  ; *** Temporary change to suppress update of service & freshness dates.
  1.  ; *** To reinstate, remove comment (;) from next line.
  1.  ;I TQN'="",$G(RSTYPE)="O" D
  1.  ;. S TQSRVDT=$P($G(^IBCN(365.1,TQN,0)),U,12)
  1.  ;. I RSRVDT'="",TQSRVDT'=RSRVDT,$G(ERACT)'="P" D SAVETQ^IBCNEUT2(TQN,RSRVDT)
  1.  ;. ; update freshness date by same delta
  1.  ;. D SAVFRSH^IBCNEUT5(TQN,+$$FMDIFF^XLFDT(RSRVDT,TQSRVDT,1))
  1.  ;
  1.  ; Moved everything related to CALLEDBY variable higher up in the tag ;IB*752/DJW
  1.  ; ** Very important:  Variable 'CALLEDBY' must be set for this routine so
  1.  ;    that when a payer response is saved to the buffer either as an
  1.  ;    update to an existing buffer entry or as a new buffer entry a new
  1.  ;    eIV inquiry is not automatically triggered and resent to the payer again.
  1.  ;    When certain fields are changed in file #355.33 a trigger calls routine
  1.  ;    ^IBCNERTQ which can create and send a new inquiry in real time to the payer.
  1.  ;    We want this to occur in all cases _EXCEPT_ when it is a payer response.
  1.  ;    Which means _EXCEPT_ when it is triggered as a result of this routine.
  1.  ;
  1.  S CALLEDBY="IBCNEHL1"
  1.  ;
  1.  ;  Check for error action
  1.  ; IB*2*601/DM, IB*2.0*621/DM  If the response is MBI or EICD verification, keep processing after error
  1.  I $G(ERACT)'=""!($G(ERTXT)'="") D  G:('IBISMBI)&('IBEICDV) FILX
  1.  . S ERACT=$$ERRACT^IBCNEHLU(RIEN),ERCON=$P(ERACT,U,2),ERACT=$P(ERACT,U)
  1.  . D ERROR^IBCNEHL3(TQN,ERACT,ERCON,TRACE)
  1.  . I IBEICDV S BUFF=$P($G(^IBCN(365,RIEN,0)),U,4) ;IB*2.0*621/DM reset BUFF
  1.  ;
  1.  I EVENTYP=1 D PROCTRK^IBCNEHL7(TRKIEN) Q  ;IB*621  Process EICD Tracking file #365.18
  1.  ;
  1.  ; Stop processing if identification response and not an active policy
  1.  S FILEIT=1
  1.  I $G(IIVSTAT)=6,TQN]"" D
  1.  . I TQDATA="" Q
  1.  . I IBQFL'="I" Q
  1.  . S FILEIT=0
  1.  I 'FILEIT G FILX
  1.  ;
  1.  ;  If there is an associated buffer entry & one or both of the following
  1.  ;  is true, stop filing (don't update buffer entry)
  1.  ;  1) buffer status is not 'Entered'
  1.  ;  2) the buffer entry is verified (* symbol)  ;IB*737/DTG stop use of '*' verified
  1.  ;I BUFF'="",($P($G(^IBA(355.33,BUFF,0)),U,4)'="E")!($$SYMBOL^IBCNBLL(BUFF)="*") G FILX
  1.  I BUFF'="",($P($G(^IBA(355.33,BUFF,0)),U,4)'="E") G FILX  ;IB*737/DTG stop use of '*' verified
  1.  ;
  1.  ; Set buffer symbol based on value returned from EC
  1.  ; IB*2*601/DM
  1.  ;S SYMBOL=MAP(IIVSTAT)
  1.  I 'IBISMBI S SYMBOL=MAP(IIVSTAT)
  1.  ; if subscriber ID is populated set SYMBOL to '%' otherwise a '#'
  1.  I IBISMBI S SYMBOL=$S($$GET1^DIQ(365,RIEN_",","SUBSCRIBER ID")'="":MAP("MBI%"),1:MAP("MBI#"))
  1.  ;
  1.  ;  If there is an associated buffer entry, update the buffer entry w/
  1.  ;  response data
  1.  ;IB*743/CKB - add the locking of the Buffer
  1.  ;I BUFF'="" D RP^IBCNEBF(RIEN,"",BUFF)
  1.  N BUFDONE,BUFLOCK,BUFSTAT
  1.  S (BUFDONE,BUFLOCK)=0  ; BUFDONE indicates that a user processed the entry already
  1.  I BUFF'="" D
  1.  . ;If STATUS (#355.33,.04) is NOT ENTERED, ABORT - DON'T touch the buffer entry
  1.  . ; (#355.33), and continue normal processing
  1.  . I $$GET1^DIQ(355.33,BUFF_",",.04,"I")'="E" S BUFDONE=1 Q
  1.  . ;BUFSTAT is ENTERED, attempt to Lock buffer entry
  1.  . S BUFLOCK=$$BUFLOCK(BUFF,1)
  1.  . ;Lock acquired
  1.  . I BUFLOCK D  Q
  1.  . . ;Re-evaluate STATUS (#355.33,.04)
  1.  . . S BUFSTAT=$$GET1^DIQ(355.33,BUFF_",",.04,"I")
  1.  . . ;If BUFSTAT is NOT ENTERED, DO NOT modify or touch the buffer entry (#355.33),
  1.  . . ; release lock , and continue normal processing
  1.  . . I BUFSTAT'="E" S BUFDONE=1 Q
  1.  . . ;If BUFSTAT is ENTERED, continue normal processing (modify buffer entry), release lock
  1.  . . I BUFSTAT="E" D RP^IBCNEBF(RIEN,"",BUFF)
  1.  . . ;Unlock buffer
  1.  . . N XX S XX=$$BUFLOCK(BUFF,0)
  1.  . ;
  1.  . ;Lock NOT acquired
  1.  . ;DON'T reevaluate BUFLOCK after calling $$BUFLOCK(BUFF,0)
  1.  . I 'BUFLOCK D
  1.  . . ;Re-evaluate STATUS (#355.33,.04)
  1.  . . S BUFSTAT=$$GET1^DIQ(355.33,BUFF_",",.04,"I")
  1.  . . ;If BUFSTAT is NOT ENTERED, DO NOT modify or touch the buffer entry (#355.33), and
  1.  . . ; continue normal processing
  1.  . . I BUFSTAT'="E" S BUFDONE=1 Q
  1.  . . ;If BUFSTAT is ENTERED, do tag UPDBUF
  1.  . . D UPDBUF(BUFF,SYMBOL)
  1.  I BUFF'="",'BUFLOCK G FILX
  1.  I $G(BUFDONE)=1 G FILX
  1.  ;
  1.  ;  If no associated buffer entry, create one & populate w/ response
  1.  ;  data (routine call sets IBFDA)
  1.  ;IB/743 CKB - the locking of the buffer is done in $$ADDSTF^IBCNEBF
  1.  I BUFF="" D RP^IBCNEBF(RIEN,1) S BUFF=+IBFDA,UP(365,RIEN_",",.04)=BUFF
  1.  ;
  1.  ; IB*2*601/DM for an MBI query, set the patient relationship to insured to "Patient"
  1.  I IBISMBI S UP(355.33,BUFF_",",60.06)="01"
  1.  ;
  1.  ; IB*2*621/DM for EICD verification response with errors, populate PATID, GRPNUM and SUBID in buffer
  1.  I ($G(ERTXT)'=""),IBEICDV D
  1.  . N TRKIEN
  1.  . S TRKIEN=$O(^IBCN(365.18,"C",TQN,""))
  1.  . S TRKDTA=$P(TQDATA,U,21)_","_TRKIEN_","
  1.  . K IBINSDTA D GETS^DIQ(365.185,TRKDTA,".03;.04;.05",,"IBINSDTA") ; grab selected fields (external) 
  1.  . S UP(355.33,BUFF_",",62.01)=IBINSDTA(365.185,TRKDTA,.05) ; Member/Patient ID
  1.  . S UP(355.33,BUFF_",",90.02)=IBINSDTA(365.185,TRKDTA,.03) ; Group Number
  1.  . S UP(355.33,BUFF_",",90.03)=IBINSDTA(365.185,TRKDTA,.04) ; Subscriber ID
  1.  ; Set eIV Processed Date to now
  1.  S UP(355.33,BUFF_",",.15)=$$NOW^XLFDT()
  1.  D FILE^DIE("I","UP","ERROR")
  1. FILX ;
  1.  Q
  1.  ;
  1.  ;IB*743/TAZ&CKB - Buffer Lock/Unlock Function
  1. BUFLOCK(BUFF,ONOFF) ;Get a lock on the Buffer entry associated with this Response IEN
  1.  ; Input:
  1.  ;   BUFF    Buffer IEN file #355.33
  1.  ;   ONOFF   0=unlock / 1=lock
  1.  ; Output:
  1.  ;   OK      0=Not successful / 1=Successful
  1.  N CNT,OK
  1.  S OK=0
  1.  I BUFF="" G LOCKEND
  1.  ;Unlock Buffer
  1.  I 'ONOFF L -^IBA(355.33,BUFF) S OK=1 G LOCKEND
  1.  ;Attempt to Lock for 30 minutes
  1.  F CNT=1:1:30 D  G:OK LOCKEND
  1.  . L +^IBA(355.33,BUFF):DILOCKTM I $T S OK=1 Q
  1.  . H 55
  1. LOCKEND ;
  1.  Q OK
  1.  ;
  1.  ;IB*743/CKB & DJW    UPDBUF tag
  1. UPDBUF(BUFF,SYMBOL) ; Update the IIV PROCESSED DATE (#355.33,.15) and update Buffer eIV Symbol based
  1.  ; on the incoming Response.
  1.  ;
  1.  ; Per eBiz eInsurance 12/2022 - If there is a Buffer entry & the lock is NOT acquired, do the
  1.  ;  following if the buffer status is ENTERED:  Set the eIV Processed Date so that the trace #
  1.  ;  will display, the 'magic sentence' saying the service date and STC the response is based on
  1.  ;  is displayed, the eligibility benefit info associated with the response is displayed and
  1.  ;  available when accepting the buffer entry.  DO NOT set the other fields in the buffer such
  1.  ;  as effective date, group #/name, etc on the buffer entry as eBiz wants to the buffer fields
  1.  ;  set to the values that they were 1 second before the eIV response arrived back at the site.
  1.  ; 
  1.  ;  Therefore, only the eligiblity benefit data from the response will be available when and if
  1.  ;    a user accepts the buffer entry and no other data from the response.  That is why we are
  1.  ;    *NOT* calling RP^IBCNEBF here.  PATCH IB*743// DJW 
  1.  ;
  1.  N BUFERR,BUFUPD
  1.  ; Set eIV Processed Date to Now
  1.  S BUFUPD(355.33,BUFF_",",.15)=$$NOW^XLFDT()
  1.  D FILE^DIE("I","BUFUPD","BUFERR")
  1.  ;
  1.  ; Update insurance buffer with the eIV symbol as returned by EC
  1.  I SYMBOL D BUFF^IBCNEUT2(BUFF,SYMBOL)
  1.  Q