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

IBCNERTQ.m

Go to the documentation of this file. 
  1. IBCNERTQ ;ALB/BI - Real-time Insurance Verification ;15-OCT-2015
  1.  ;;2.0;INTEGRATED BILLING;**438,467,497,549,582,593,601,631,659,664,668,713**;21-MAR-94;Build 12
  1.  ;;Per VA Directive 6402, this routine should not be modified.
  1.  Q
  1.  ;
  1. TRIG(N2) ; Called by triggers in the INSURANCE BUFFER FILE Dictionary (355.33)
  1.  ; Fields:  20.01 - INSURANCE COMPANY NAME
  1.  ;          90.01 - GROUP NAME
  1.  ;          90.02 - GROUP NUMBER
  1.  ;          60.01 - PATIENT NAME
  1.  ;          90.03 - SUBSCRIBER ID
  1.  ;          60.08 - INSURED'S DOB
  1.  ;          62.01 - PATIENT ID
  1.  ;
  1.  ; To make a request for Real Time Verification
  1.  ; The following fields must contain data.
  1.  ;          20.01 - INSURANCE COMPANY NAME
  1.  ;          60.01 - PATIENT NAME
  1.  ;          90.03 - SUBSCRIBER ID (if patient is the subscriber)
  1.  ;          60.08 - INSURED'S DOB (if patient is not the subscriber)
  1.  ;          62.01 - PATIENT ID (if patient is not the subscriber)
  1.  ;
  1.  ;
  1.  N TQIEN,TQN0,NODE20,NODE60,NODE90,QF,N4,PTID,SUBID,MGRP,DFN,PREL
  1.  N RESPONSE S RESPONSE=0
  1.  ; Protect the FileMan variables.
  1.  N DA,DB,DC,DH,DI,DK,DL,DM,DP,DQ,DR,INI,MR,NX,UP
  1.  ;
  1.  I N2="" Q RESPONSE
  1.  ;IB*582/HAN - Do not allow entries to process if the user is INTERFACE,IB EIV
  1.  N EIVDUZ S EIVDUZ=$$FIND1^DIC(200,"","X","INTERFACE,IB EIV")
  1.  ;IB*2.0*593/HN - Added to allow nightly extract entries to go out immediately.
  1.  I $G(IDUZ)'="",IDUZ=EIVDUZ,$G(CALLEDBY)'="",CALLEDBY="IBCNEHL1" Q RESPONSE
  1.  ;IB*582 - End
  1.  S MGRP=$$MGRP^IBCNEUT5()
  1.  S NODE20=$G(^IBA(355.33,N2,20))
  1.  S NODE60=$G(^IBA(355.33,N2,60))
  1.  S NODE90=$G(^IBA(355.33,N2,90))
  1.  S PREL=$P(NODE60,U,14)
  1.  I $P(NODE20,U,1)="" Q RESPONSE                       ;INSURANCE COMPANY NAME
  1.  I $P(NODE60,U,1)="" Q RESPONSE                       ;PATIENT NAME
  1.  I $P(NODE90,U,3)="" Q RESPONSE                       ;SUBSCRIBER ID
  1.  ; exclude dependent inquiries w/o patient id or DOB
  1.  I PREL'=18,PREL'="",($P($G(^IBA(355.33,N2,62)),U)=""!($P(NODE60,U,8)="")) Q RESPONSE
  1.  ; exclude ePharmacy buffer entries
  1.  I $G(IBNCPDPELIG) Q RESPONSE  ; variable set in ^IBNCPDP3
  1.  I $P($G(^IBA(355.33,N2,0)),U,17)'="" Q RESPONSE
  1.  ;
  1.  ; ** Prevent creating inquiries based on Source of Information (SOI) **
  1.  N PTR S PTR=+$P($G(^IBA(355.33,N2,0)),U,3)
  1.  I PTR,$P($G(^IBE(355.12,PTR,0)),U,2)="HMS",PREL="" Q RESPONSE
  1.  I PTR,$$GET1^DIQ(355.12,PTR_",",.03)="EHR" Q RESPONSE    ;/vd-IB*2*664
  1.  I PTR,$$GET1^DIQ(355.12,PTR_",",.03)="AMCMS" Q RESPONSE  ;IB*668/DW
  1.  ;
  1.  ; Quit if a waiting transaction exists in file #365.1
  1.  S PTID=$P(NODE60,U,1)
  1.  S SUBID=$P(NODE90,U,3)
  1.  S QF=0,N4=""
  1.  F  S N4=$O(^IBCN(365.1,"E",PTID,N4)) Q:N4=""  Q:QF=1  D
  1.  .S TQN0=$G(^IBCN(365.1,N4,0))
  1.  .; don't send again if there's an entry in the queue with the same subscriber id, same buffer entry, and
  1.  .; transmission status other than "response received" or "cancelled" 
  1.  .I $P(TQN0,U,5)=N2,".3.7."'[("."_$P(TQN0,U,4)_"."),$P(TQN0,U,16)=SUBID S QF=1 Q
  1.  .Q
  1.  I QF=1 Q RESPONSE                                    ; DON'T SEND AGAIN.
  1.  ;
  1.  ; Quit if there is a lock on patient and policy in file #355.33
  1.  L +^IBA(355.33,N2):1 I '$T Q RESPONSE                ; RECORD LOCKED By Another Process
  1.  ;
  1.  ;Store Service Type Code in BUFFER file #355.33 just before sending to EIV TRANSMISSION QUEUE
  1.  I +$G(^IBA(355.33,N2,80))'>0 D SETSTC(N2)
  1.  ;
  1.  ; Save and clear the dictionary 355.33 temporary error global, ^TMP("DIERR",$J)
  1.  K ^TMP("IBCNERTQ","DIERR",$J)
  1.  M ^TMP("IBCNERTQ","DIERR",$J)=^TMP("DIERR",$J)
  1.  K ^TMP("DIERR",$J)
  1.  ;
  1.  ; if buffer entry is currently being edited, set the flag and quit
  1.  I $G(^TMP("IBCNERTQ",$J,N2,"LOCK"))=1 S ^TMP("IBCNERTQ",$J,N2,"TRIGGER")=1 G ENDTRIG
  1.  ;
  1.  ; Sending to the EIV TRANSMISION QUEUE.
  1.  S TQIEN=$$IBE(N2) I 'TQIEN G ENDTRIG
  1.  ; Load and Send HL7 Message
  1.  S RESPONSE=$$PROCSEND(TQIEN)
  1.  ;
  1. ENDTRIG ; Final Clean Up.
  1.  ;
  1.  ; Restore the dictionary 355.33 temporary error global, ^TMP("DIERR",$J)
  1.  K ^TMP("DIERR",$J)
  1.  M ^TMP("DIERR",$J)=^TMP("IBCNERTQ","DIERR",$J)
  1.  K ^TMP("IBCNERTQ","DIERR",$J)
  1.  ;
  1.  ; Remove Dictionary Entry Lock.
  1.  L -^IBA(355.33,N2)
  1.  Q RESPONSE
  1.  ;
  1. IBE(IEN) ; Insurance Buffer Extract
  1.  N FRESHDAY,FRESHDT,INSNAME,ISMBI,ISYMBOL,MCAREFLG,OVRFRESH,PAYERID,PAYERSTR
  1.  N PDOD,PIEN,QUEUED,SRVICEDT,STATIEN,SYMBOL,TQDT,TQIENS,TQOK
  1.  ;
  1.  S QUEUED=0
  1.  S FRESHDAY=$P($G(^IBE(350.9,1,51)),U,1)          ;System freshness days
  1.  ;
  1.  ; Get symbol, if symbol'=" " OR "!" OR "#" then quit
  1.  S ISYMBOL=$$SYMBOL^IBCNBLL(IEN)                  ;Insurance buffer symbol
  1.  I (ISYMBOL'=" ")&(ISYMBOL'="!")&(ISYMBOL'="#") Q QUEUED
  1.  ;
  1.  ;/vd-IB*2.0*659 - Quit if VAMC Site is MANILA (#358) & EIV is disabled for MANILA.
  1.  I $P($$SITE^VASITE,U,3)=358,$$GET1^DIQ(350.9,"1,",51.33,"I")="N" Q 0
  1.  ;
  1.  ; IB*2.0*549 -  Quit if Realtime  Extract Master switch is off
  1.  ; Note: Checking here instead of the top of TRIG to check for above error conditions first
  1.  Q:$$GET1^DIQ(350.9,"1,",51.27,"I")="N" 0
  1.  ;
  1.  ; Get the eIV STATUS IEN and quit for response related errors
  1.  S STATIEN=+$P($G(^IBA(355.33,IEN,0)),U,12)
  1.  I ",11,12,15,"[(","_STATIEN_",") Q QUEUED        ;Prevent update for response errors
  1.  ;
  1.  S OVRFRESH=$P($G(^IBA(355.33,IEN,0)),U,13)       ;Freshness OvrRd flag
  1.  S DFN=$P($G(^IBA(355.33,IEN,60)),U,1)            ;Patient DFN
  1.  Q:DFN="" QUEUED
  1.  I $P($G(^DPT(DFN,0)),U,21) Q QUEUED              ;Exclude if test patient
  1.  ;
  1.  S PDOD=$P($G(^DPT(DFN,.35)),U,1)\1               ;Patient's date of death
  1.  S SRVICEDT=+$P($G(^IBA(355.33,IEN,0)),U,18) S:'SRVICEDT SRVICEDT=DT ; Service Date
  1.  ;
  1.  ; IB*2.0*549 Removed following line
  1.  ;I PDOD,PDOD<SRVICEDT S SRVICEDT=PDOD
  1.  S FRESHDT=$$FMADD^XLFDT(SRVICEDT,-FRESHDAY)
  1.  S PAYERSTR=$$INSERROR^IBCNEUT3("B",IEN)          ;Payer String
  1.  S PAYERID=$P(PAYERSTR,U,3),PIEN=$P(PAYERSTR,U,2) ;Payer ID
  1.  S SYMBOL=+PAYERSTR                               ;Payer Symbol
  1.  I '$$PYRACTV^IBCNEDE7(PIEN) Q QUEUED             ;Payer is not nationally active
  1.  ;
  1.  ; If payer symbol is returned set symbol in Ins. Buffer and quit
  1.  I SYMBOL D BUFF^IBCNEUT2(IEN,SYMBOL) Q QUEUED
  1.  ;
  1.  D CLEAR^IBCNEUT4(IEN)                            ;Remove any existing symbol
  1.  ;
  1.  ; If no payer ID or no payer IEN is returned quit
  1.  I (PAYERID="")!('PIEN) Q QUEUED
  1.  ;
  1.  ; Update service date and freshness date based on payer's allowed
  1.  ;  date range
  1.  D UPDDTS^IBCNEDE6(PIEN,.SRVICEDT,.FRESHDT)
  1.  ;
  1.  ; Update service dates for inquiries to be transmitted
  1.  D TQUPDSV^IBCNEUT5(DFN,PIEN,SRVICEDT)
  1.  ;
  1.  ; Allow only one MEDICARE transmission per patient
  1.  ; IB*2*601/DM 
  1.  ;S INSNAME=$P($G(^IBA(355.33,IEN,20)),U)
  1.  ;I INSNAME["MEDICARE",$G(MCAREFLG(DFN)) Q QUEUED
  1.  S INSNAME=$$GET1^DIQ(355.33,IEN_",","INSURANCE COMPANY NAME")
  1.  S ISMBI=$$MBICHK^IBCNEUT7(IEN) ;IB*2.0*631/TAZ - Set the MBI Check into a variable since it is used in multiple places.
  1.  I 'ISMBI,INSNAME["MEDICARE",$G(MCAREFLG(DFN)) Q QUEUED
  1.  ; make sure that entries have pat. relationship set to "self"
  1.  D SETREL^IBCNEDE1(IEN)
  1.  ;
  1.  ; If freshness override flag is set, file to TQ and quit
  1.  I OVRFRESH=1!ISMBI D  Q $G(TQIEN)
  1.  . ;IB*2.0*631/TAZ - Changed logic to call new TQ
  1.  . ;N DIE,DISYS,SUBID,WHICH,X,Y
  1.  . ;S SUBID=$$GET1^DIQ(365.1,TQIEN_",",.16,"I"),WHICH=$S(SUBID="MBIRequest":7,1:5)
  1.  . N DIE,DISYS,WHICH,X,Y
  1.  . S WHICH=$S(ISMBI:7,1:5)
  1.  . S FDA(355.33,IEN_",",.13)="" D FILE^DIE("","FDA") K FDA
  1.  . S:INSNAME["MEDICARE" MCAREFLG(DFN)=1 D TQ^IBCNERTU(WHICH,IEN,FRESHDT,DFN,PIEN,OVRFRESH,SRVICEDT)
  1.  ; Check the existing TQ entries to confirm that this buffer IEN is
  1.  ; not included
  1.  S (TQDT,TQIENS)="",TQOK=1
  1.  I ISYMBOL'="#" F  S TQDT=$O(^IBCN(365.1,"AD",DFN,PIEN,TQDT)) Q:'TQDT!'TQOK  D
  1.  . F  S TQIENS=$O(^IBCN(365.1,"AD",DFN,PIEN,TQDT,TQIENS)) Q:'TQIENS!'TQOK  D
  1.  .. I $P($G(^IBCN(365.1,TQIENS,0)),U,5)=IEN S TQOK=0 Q
  1.  I TQOK S:INSNAME["MEDICARE" MCAREFLG(DFN)=1 D TQ^IBCNERTU(6,IEN,FRESHDT,DFN,PIEN,OVRFRESH,SRVICEDT) ;IB*2.0*631/TAZ
  1.  Q $G(TQIEN)
  1.  ;
  1. PROCSEND(TQIEN) ; Make call to PROC^IBCNEDEP to build the HL7 message.  Then send the Message.
  1.  N BUFF,CNT,D,D0,DFN,DIC,DIE,DILOCKTM,DISYS,EXT
  1.  N FRDT,GT1,HCT,HL,HLCDOM,HLCINS,HLCS,HLCSTCP,HLDOM,HLECH
  1.  N HLFS,HLHDR,HLINST,HLIP,HLN,HLP,HLPARAM,HLPROD,HLQ,HLRESLT
  1.  N HLSAN,HLTYPE,HLX,IBCNHLP,IEN,IHCNT,IN1,IRIEN,MSGID,TOT
  1.  N NRETR,NTRAN,OVRIDE,PATID,PAYR,PID,QUERY,RSTYPE,SRVDT,STA
  1.  N SUB4,SUBID,TRANSR,U,VACNTRY,VNUM,X,ZMID
  1.  ;
  1.  K ^TMP("HLS",$J)
  1.  S IEN=TQIEN
  1.  I $D(DT)=0 N DT S DT=$$DT^XLFDT
  1.  S U="^",CNT=0,TOT=0,IHCNT=0
  1.  S QUERY=$P($G(^IBCN(365.1,IEN,0)),U,11)
  1.  I QUERY="V" S VNUM=3
  1.  I $D(VNUM)=0 Q 0
  1.  ;
  1.  ; IB*2.0*549 - quit if test site and not a valid test case
  1.  Q:'$$XMITOK^IBCNETST(IEN) 0
  1.  ;
  1.  ;  Initialize HL7 variables protocol for Verifications
  1.  S IBCNHLP="IBCNE IIV RQV OUT"
  1.  D INIT^IBCNEHLO
  1.  ;
  1.  ;IB*713/TAZ - Change to function call and quit if 0 is returned.
  1.  I '$$PROC^IBCNEDEP Q 0
  1.  ;
  1.  D GENERATE^HLMA(IBCNHLP,"GM",1,.HLRESLT,"",.HLP)
  1.  ;  If not successful
  1.  I $P(HLRESLT,U,2)]"" D HLER^IBCNEDEQ Q 0
  1.  ;  If successful
  1.  D SCC^IBCNEDEQ
  1.  K ^TMP("HLS",$J)
  1.  ;
  1.  I $G(^TMP("IBCNEQUDTS",$J)) D
  1.  . S DA=IEN,DIE="^IBCN(365.1,",DR="3.01////^S X=$$NOW^XLFDT" D ^DIE
  1.  ;
  1.  Q 1
  1.  ;
  1. SETSTC(BUFF) ; set service type code
  1.  N DIE,DA,DR,X,Y
  1.  I '+$G(BUFF) Q
  1.  ; Define Service Type Code (STC) to be sent with Insurance Inquiry
  1.  S DIE="^IBA(355.33,",DA=BUFF
  1.  S DR="80.01////"_$P($G(^IBE(350.9,1,60)),U)
  1.  D ^DIE
  1.  Q