IBCNEUT2 ;DAOU/DAC - eIV MISC. UTILITIES ;06-JUN-2002
;;2.0;INTEGRATED BILLING;**184,416,435,713,737,806**;21-MAR-94;Build 19
;;Per VA Directive 6402, this routine should not be modified.
;
; Can't be called from the top
Q
;
SAVETQ(IEN,TDT) ; Update service date in TQ record
;
N DIE,DA,DR,D,D0,DI,DIC,DQ,X
S DIE="^IBCN(365.1,",DA=IEN,DR=".12////"_TDT
D ^DIE
Q
;
;
SST(IEN,STAT) ; Set the Transmission Queue Status
; Input parameters
; IEN = Internal entry number for the record
; STAT= Status IEN
;
NEW DIE,DA,DR,D,D0,DI,DIC,DQ,X
;
I IEN="" Q
;
S DIE="^IBCN(365.1,",DA=IEN,DR=".04////^S X=STAT;.15////^S X=$$NOW^XLFDT()"
D ^DIE
Q
;
RSP(IEN,STAT) ; Set the Response File Status
; Input parameters
; IEN = Internal entry number for the record
; STAT= Status IEN
;
NEW DIE,DA,DR,D,D0,DI,DIC,DQ,X
S DIE="^IBCN(365,",DA=IEN,DR=".06////^S X=STAT"
D ^DIE
Q
;
BUFF(BUFF,BNG) ; Set error symbol into Buffer File
; Input Parameter
; BUFF = Buffer internal entry number
; BNG = Buffer Symbol IEN
I 'BUFF!'BNG Q
I +$P($G(^IBA(355.33,BUFF,0)),U,17) Q ; .12 field not for ePharmacy IB*2*435
NEW DIE,DA,DR,D,D0,DI,DIC,DQ,X,DISYS
S DIE="^IBA(355.33,",DA=BUFF,DR=".12////^S X=BNG"
D ^DIE
Q
;
BADMSG(EXT,QUERY) ; Checks to see if the msg is allowed
; IB*713 Introduced this tag, checks for foreign characters as defined
; in FOREIGN^IBCNINSU. If foreign characters are encountered, some
; times the msg can't be created/sent via HL7. Other times, if you
; clear out the field with the foreign character you can still send
; the message. (Watch for the STOP variable.)
; This could be expanded in the future to check other scenarios that
; should stop the transmissions.
;
;INPUT:
; EXT = WHICH EXTRACT (#365.1,.1)
; QUERY = QUERY FLAG(#365.1,.11)
; PID, IN1, HLFS, HLECH - existing global variables
; GT1 global variable that may or may not exist
;
;OUTPUT: 0 - Continue with creating and sending HL7 msg
; 1 - Do not send this TQ entry out as a HL7 msg
; * NOTE: If Abort, this function sets the
; TRANSMISSION QUEUE (#365.1,.04) to "Cancelled"
;
N FLD,HCT,SEG,STOP,TMP
S HCT="",STOP=0
F S HCT=$O(^TMP("HLS",$J,HCT)) Q:'HCT S SEG=$P(^(HCT),HLFS,1),TMP(SEG)=HCT
;
; Regular 270 Messages
I (EXT=1)!(EXT=2)!(EXT=5)!(EXT=6) D G BADMSGX
. I $$FOREIGN^IBCNINSU($P(PID,HLFS,6),"1;2;3;4;5;6") S STOP=1 Q ;PID-5 PATIENT NAME
. I $$FOREIGN^IBCNINSU($P(IN1,HLFS,3)) S STOP=1 Q ;IN1-2 PATIENT/SUBSCRIBER ID
. I $D(GT1) D I STOP Q
.. I $$FOREIGN^IBCNINSU($P(GT1,HLFS,3)) S STOP=1 Q ;GT1-2 SUBSCRIBER ID
.. I $$FOREIGN^IBCNINSU($P(GT1,HLFS,4),"1;2;3;4;5;6") S STOP=1 Q ;GT1-3 SUBSCRIBER NAME
. ;
. ;If foreign chars encountered clear field and continue with msg
. ;
. ; PID-11 Addr (street,ignore,city,state,zip)
. S FLD=$P(PID,HLFS,12) I $$FOREIGN^IBCNINSU(.FLD,"1;3;4;5",1) S $P(PID,HLFS,12)=FLD ;PID-11
. S FLD=$P(IN1,HLFS,9) I $$FOREIGN^IBCNINSU(.FLD,1,1) S $P(IN1,HLFS,9)=FLD ;IN1-8 GROUP NUMBER
. S FLD=$P(IN1,HLFS,10) I $$FOREIGN^IBCNINSU(.FLD,1,1) S $P(IN1,HLFS,10)=FLD ;IN1-9 GROUP NAME
. ;
. I $D(GT1) D
.. ; GT1-6 Addr (street,ignore,city,state,zip)
.. S FLD=$P(GT1,HLFS,7) I $$FOREIGN^IBCNINSU(.FLD,"1;3;4;5",1) S $P(GT1,HLFS,7)=FLD ;GT1-6
;
; EICD-Identifications (aka A1 msgs)
; [Asking clearinghouse if they know insurance for this patient]
I (EXT=4),(QUERY="I") D G BADMSGX
. I $$FOREIGN^IBCNINSU($P(PID,HLFS,6),"1;2;3;4;5;6") S STOP=1 Q ;PID-5 PATIENT NAME
. ; PID-11 Addr (ignore,ignore,city,state,zip)
. I $$FOREIGN^IBCNINSU($P(PID,HLFS,12),"3;4;5") S STOP=1 Q ;PID-11
. ;
. ;If foreign chars encountered clear field and continue with msg
. ;
. S FLD=$P(PID,HLFS,12) I $$FOREIGN^IBCNINSU(.FLD,1,1) S $P(PID,HLFS,12)=FLD ;PID-11-1 ADDR STREET
;
; EICD-Verification (aka A2 msgs)
; [Confirming policies clearinghouse found for VA]
I (EXT=4),(QUERY="V") D G BADMSGX
. I $$FOREIGN^IBCNINSU($P(PID,HLFS,6),"1;2;3;4;5;6") S STOP=1 Q ;PID-5 PATIENT NAME
. I $$FOREIGN^IBCNINSU($P(IN1,HLFS,3)) S STOP=1 Q ;IN1-2 PATIENT/SUBSCRIBER ID
. I $D(GT1) D I STOP Q
.. I $$FOREIGN^IBCNINSU($P(GT1,HLFS,3)) S STOP=1 Q ;GT1-2 SUBSCRIBER ID
.. I $$FOREIGN^IBCNINSU($P(GT1,HLFS,4),"1;2;3;4;5;6") S STOP=1 Q ;GT1-3 SUBSCRIBER NAME
. ;
. ;If foreign chars encountered clear field and continue with msg
. ;
. ; PID-11 Addr (street,ignore,city,state,zip)
. S FLD=$P(PID,HLFS,12) I $$FOREIGN^IBCNINSU(.FLD,"1;3;4;5",1) S $P(PID,HLFS,12)=FLD ;PID-11
. S FLD=$P(IN1,HLFS,9) I $$FOREIGN^IBCNINSU(.FLD,1,1) S $P(IN1,HLFS,9)=FLD ;IN1-8 GROUP NUMBER
. S FLD=$P(IN1,HLFS,10) I $$FOREIGN^IBCNINSU(.FLD,1,1) S $P(IN1,HLFS,10)=FLD ;IN1-9 GROUP NAME
. I $D(GT1) D
.. ; GT1-6 Addr (street,ignore,city,state,zip)
.. S FLD=$P(GT1,HLFS,7) I $$FOREIGN^IBCNINSU(.FLD,"1;3;4;5",1) S $P(GT1,HLFS,7)=FLD ;GT1-6
;
; MBI REQUEST
I EXT=7 D G BADMSGX
. I $$FOREIGN^IBCNINSU($P(PID,HLFS,6),"1;2;3;4;5;6") S STOP=1 Q ;PID-5 SUBSCRIBER NAME
. ;
. ;If foreign chars encountered clear field and continue with msg
. ;
. ; PID-11 Addr (street,ignore,city,state,zip)
. S FLD=$P(PID,HLFS,12) I $$FOREIGN^IBCNINSU(.FLD,"1;3;4;5",1) S $P(PID,HLFS,12)=FLD ;PID-11
;
BADMSGX ;Exit BADMSG
I 'STOP D
. S HCT=$G(TMP("PID")) I HCT S ^TMP("HLS",$J,HCT)=PID
. S HCT=$G(TMP("IN1")) I HCT S ^TMP("HLS",$J,HCT)=IN1
. S HCT=$G(TMP("GT1")) I HCT S ^TMP("HLS",$J,HCT)=GT1
Q STOP
;
EBSUMMARY(DFN,RIEN,SOI,ARRAY) ; Added IB*806
;
; ***********************
; DO NOT change this code without careful consideration !!!
; It is called by IBCNEHL5A to Auto-load policies as eIV Responses are processed
; Also, it is called by IBCNES for the ELIG. Benefits (from both file #2 and #365 perspectives)
; ***********************
;
; Example:
; Insurance Type: Medicare Part A Elig/Ben Info: Active Coverage
; Date/Time Qual: Plan D/T Period: 05/01/2019
;
; Returns ARRAY(EBCNT,"Medicare Part A")=DFN^"Medicare Part A"^3190501^SOI^"Active Coverage"
; - if Other Potential Insurance - ARRAY("OHI)=1
; - if the Effective Date for an Active policy is missing - ARRAY("MISSING_EFFDT")=1
;
; How to determine effective date:
; 1st attempt to pull from EB loop
; Loop must have:(INSTYP'="") & ELGBENINFO="Active Coverage" or "Inactive"
; If Medicare pull the 1st date where qualifier = "PLAN"
; If not Medicare pull 1st date where qualifier ="PLAN" or "PLAN BEGIN"
; check all dates as "PLAN BEGIN" trumps "PLAN"
; if no eff dt then continue other attempts
; 2nd attempt - If not Medicare pull from Subscriber dates (#365.28,.02)
; pull 1st date where qualifier ="PLAN" or "PLAN BEGIN"
; check all dates as "PLAN BEGIN" trumps "PLAN"
; if no eff dt then continue other attempts
; LAST attempt - pull from Effective date (#365,1.11)
; applies to both Medicare and non Medicare
; Otherwise effective date is "Unknown"
;
;
N DTQUAL,EBCNT,ELGBENINFO,EXTELIG,FSCSTAT,HLDT,HLDNDT
N IBA,IBBERR,IBCHK,IBEFFDT,IBEINFO,IBELGINF,IBNOTCOV,IBNOTDT,IBNOTTYP,IBPEDT,IBSPDT,IBSUSCT
N IBVIENS,INSTYP,MWNRTYP,TMP,XXDT,ZIEN
K ARRAY,^TMP("EBSUMEUT2",$J)
;
I '$D(^IBCN(365,RIEN,2)) G XEBSUM ; NO Benefits received
;
S (IBSPDT,IBSUSCT,IBPEDT,IBELGINF)=""
; determine the default date if the HLDT is not there
;use the subscriber date plan date if it is a plan, or the Effective date, Unknown if still not found
; this is to calculate the default eff date if it can't be determined by the EB loops from the response
K IBCHK,IBBERR D GETS^DIQ(365,RIEN_",","7*","IEN","IBCHK","IBBERR")
I $D(IBCHK(365.07)) D ; loop through for Subscribers collect the 'plan' and 'plan begin' dates
. N DQUAL,DTYP,IBA,IBB,IBL,IBOK,IBP,IBPB,IBTDT,IBTDT1
. K IBP,IBPB
. S IBB="",(IBOK,IBP,IBPB)=0
. F S IBB=$O(IBCHK(365.07,IBB)) Q:IBB="" D Q:IBOK
. . S DTYP=$G(IBCHK(365.07,IBB,.04,"E")) Q:DTYP'["C" ; C is for Subscriber
. . S DQUAL=$G(IBCHK(365.07,IBB,.03,"I")) Q:'DQUAL S IBA=$$X12^IBCNERP2(365.026,DQUAL)
. . I IBA'="Plan"&(IBA'="Plan Begin") Q ; Must be Plan or Plan Begin
. . S IBTDT=$G(IBCHK(365.07,IBB,.02,"I")),IBTDT=$P(IBTDT,"-",1),IBTDT=$TR(IBTDT," ","")
. . I IBTDT="" Q ; must have a date
. . S IBTDT1=$$HL7TFM^XLFDT(IBTDT)
. . I IBTDT1=""!(IBTDT1="-1") Q ;must be valid date
. . I IBA="Plan" I IBSPDT="" S IBSPDT=IBTDT1
. . I IBA="Plan Begin" S IBSPDT=IBTDT1,IBOK=1
;
I IBSPDT="" S IBSPDT=$$GET1^DIQ(365,RIEN,"1.11","I") ; get Effective dt from top display as 2nd default (from IN1 segment)
I IBSPDT="" S IBSPDT="Unknown" ; eff dt default to use for non medicare policies if not found in EB loops
;
S IBEFFDT="",IBEFFDT=$$GET1^DIQ(365,RIEN,"1.11","I") S:'IBEFFDT IBEFFDT="Unknown"
;
S MWNRTYP=$$ISMCARE(RIEN) ; is the payer medicare
;
S EBCNT=0 F S EBCNT=$O(^IBCN(365,RIEN,2,EBCNT)) Q:'EBCNT D
. S IBVIENS=EBCNT_","_RIEN_","
. K EB,ERROR
. D GETS^DIQ(365.02,IBVIENS,".02;.03;.04;.05;.06;8*","IEN","EB","EBERR")
. ;
. I (EBCNT=1),($G(EB(365.02,IBVIENS,.06,"E"))="eIV Eligibility Determination") D Q ; use EB loop 1 only to pull FSC's determination and nothing else
. . S FSCSTAT=$G(EB(365.02,IBVIENS,.02,"E"))
. . S FSCSTAT=$S((FSCSTAT'=1&(FSCSTAT'=6)):"Unknown",1:FSCSTAT) ; this is what FSC said (Active, Inactive, Ambiguous)
. . S IBELGINF=$S(FSCSTAT=1:"ACTIVE Coverage",FSCSTAT=6:"INACTIVE Coverage",1:"Unknown")
. ;
. S INSTYP=$P($G(^IBE(365.014,+$G(EB(365.02,IBVIENS,.05,"I")),0)),U,2)
. ;
. ; X12 271 ELIGIBILITY/BENEFIT file #365.011 - this tag only uses the following codes below:
. ; 1="Active coverage"
. ; 2="Active - Full Risk Capitation"
. ; 3="Active - Services Capitated"
. ; 4="Active - Services Capitated to Primary Care Physician"
. ; 6="Inactive"
. ; R="Other or Additional Payor"
. ; U="Contract Following Entity for Eligibility or Benefit Information"
. S EXTELIG=$G(EB(365.02,IBVIENS,.02,"E"))
. ;
. ; Indicates potential Other Health Insurance (OHI) do OHI checks before quits
. I (EXTELIG=2)!(EXTELIG=3)!(EXTELIG=4)!(EXTELIG="R")!(EXTELIG="U") S ARRAY("OHI")=1
. ;
. I INSTYP="" Q ; moved quit to after the OHI check
. ;
. I (EXTELIG'=1)&(EXTELIG'=6)&(EXTELIG'=2)&(EXTELIG'=3)&(EXTELIG'=4)&(EXTELIG'="R")&(EXTELIG'="U") Q
. ;
. S ELGBENINFO=$P($G(^IBE(365.011,+$G(EB(365.02,IBVIENS,.02,"I")),0)),U,2)
. I ELGBENINFO'="Active Coverage"&(ELGBENINFO'="Inactive") Q
. ;
. S HLDT=""
. S ZIEN="0,"_IBVIENS,IBOK=0
. F S ZIEN=$O(EB(365.28,ZIEN)) Q:ZIEN="" D Q:IBOK=1
. . S DTQUAL=$P($G(^IBE(365.026,+$G(EB(365.28,ZIEN,.03,"I")),0)),U,2)
. . I (MWNRTYP),(DTQUAL'="Plan") Q ; Medicare policies are only looking for "Plan"
. . I ('MWNRTYP),((DTQUAL'="Plan")&(DTQUAL'="Plan Begin")) Q ; Non Medicare policies look for "Plan" & "Plan Begin"
. . S XXDT=$$HL7TFM^XLFDT($G(EB(365.28,ZIEN,.02,"E")))
. . I MWNRTYP S HLDT=XXDT,IBOK=1 Q ;Medicare will not have multiple plan dates in same EB loop
. . I DTQUAL="Plan" I HLDT="" S HLDT=XXDT
. . I DTQUAL="Plan Begin" S HLDT=XXDT,IBOK=1
. ;
. I HLDT="",ELGBENINFO'="Inactive" S ARRAY("MISSING_EFFDT")=1
. ;
. I HLDT=""&('MWNRTYP) D ; Non Medicare and no eff dt found in EB loop use default from above
. . S HLDT=IBSPDT
. ;
. S HLDNDT=$S('HLDT:IBEFFDT,1:HLDT)
. ;
. ; TMP array used to avoid repeating duplicate data in summary section (payers repeat themselves)
. I $D(^TMP("EBSUMEUT2",$J,$S(INSTYP="":" ",1:INSTYP),$S(ELGBENINFO="":" ",1:ELGBENINFO),HLDNDT)) Q
. ;
. S ARRAY(EBCNT,INSTYP)=DFN_U_INSTYP_U_HLDT_U_SOI_U_ELGBENINFO
. ;
. S ^TMP("EBSUMEUT2",$J,$S(INSTYP="":" ",1:INSTYP),$S(ELGBENINFO="":" ",1:ELGBENINFO),HLDNDT)=""
;
;
I '$O(ARRAY(0))&('MWNRTYP) D ; not for medicare payer
. S ARRAY(1,"Unknown")=$G(DFN)_U_"Unknown"_U_$G(IBSPDT)_U_$G(SOI)_U_$G(IBELGINF)
;
XEBSUM ;
;
K ^TMP("EBSUMEUT2",$J)
Q
;
ISMCARE(RIEN) ;check if response is from eIV Medicare Payer defined in file 350.9
; new tag with IB*806
N IB3650,IBPIEN,MWNRIEN,MWNRTYPA
S IB3650=$G(^IBCN(365,RIEN,0)),IBPIEN=$P(IB3650,U,3)
S MWNRIEN=$P($G(^IBE(350.9,1,51)),U,25),MWNRTYPA=0
I IBPIEN=MWNRIEN S MWNRTYPA=1
Q MWNRTYPA
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNEUT2 12451 printed Jan 29, 2026@15:14:25 Page 2
IBCNEUT2 ;DAOU/DAC - eIV MISC. UTILITIES ;06-JUN-2002
+1 ;;2.0;INTEGRATED BILLING;**184,416,435,713,737,806**;21-MAR-94;Build 19
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; Can't be called from the top
+5 QUIT
+6 ;
SAVETQ(IEN,TDT) ; Update service date in TQ record
+1 ;
+2 NEW DIE,DA,DR,D,D0,DI,DIC,DQ,X
+3 SET DIE="^IBCN(365.1,"
SET DA=IEN
SET DR=".12////"_TDT
+4 DO ^DIE
+5 QUIT
+6 ;
+7 ;
SST(IEN,STAT) ; Set the Transmission Queue Status
+1 ; Input parameters
+2 ; IEN = Internal entry number for the record
+3 ; STAT= Status IEN
+4 ;
+5 NEW DIE,DA,DR,D,D0,DI,DIC,DQ,X
+6 ;
+7 IF IEN=""
QUIT
+8 ;
+9 SET DIE="^IBCN(365.1,"
SET DA=IEN
SET DR=".04////^S X=STAT;.15////^S X=$$NOW^XLFDT()"
+10 DO ^DIE
+11 QUIT
+12 ;
RSP(IEN,STAT) ; Set the Response File Status
+1 ; Input parameters
+2 ; IEN = Internal entry number for the record
+3 ; STAT= Status IEN
+4 ;
+5 NEW DIE,DA,DR,D,D0,DI,DIC,DQ,X
+6 SET DIE="^IBCN(365,"
SET DA=IEN
SET DR=".06////^S X=STAT"
+7 DO ^DIE
+8 QUIT
+9 ;
BUFF(BUFF,BNG) ; Set error symbol into Buffer File
+1 ; Input Parameter
+2 ; BUFF = Buffer internal entry number
+3 ; BNG = Buffer Symbol IEN
+4 IF 'BUFF!'BNG
QUIT
+5 ; .12 field not for ePharmacy IB*2*435
IF +$PIECE($GET(^IBA(355.33,BUFF,0)),U,17)
QUIT
+6 NEW DIE,DA,DR,D,D0,DI,DIC,DQ,X,DISYS
+7 SET DIE="^IBA(355.33,"
SET DA=BUFF
SET DR=".12////^S X=BNG"
+8 DO ^DIE
+9 QUIT
+10 ;
BADMSG(EXT,QUERY) ; Checks to see if the msg is allowed
+1 ; IB*713 Introduced this tag, checks for foreign characters as defined
+2 ; in FOREIGN^IBCNINSU. If foreign characters are encountered, some
+3 ; times the msg can't be created/sent via HL7. Other times, if you
+4 ; clear out the field with the foreign character you can still send
+5 ; the message. (Watch for the STOP variable.)
+6 ; This could be expanded in the future to check other scenarios that
+7 ; should stop the transmissions.
+8 ;
+9 ;INPUT:
+10 ; EXT = WHICH EXTRACT (#365.1,.1)
+11 ; QUERY = QUERY FLAG(#365.1,.11)
+12 ; PID, IN1, HLFS, HLECH - existing global variables
+13 ; GT1 global variable that may or may not exist
+14 ;
+15 ;OUTPUT: 0 - Continue with creating and sending HL7 msg
+16 ; 1 - Do not send this TQ entry out as a HL7 msg
+17 ; * NOTE: If Abort, this function sets the
+18 ; TRANSMISSION QUEUE (#365.1,.04) to "Cancelled"
+19 ;
+20 NEW FLD,HCT,SEG,STOP,TMP
+21 SET HCT=""
SET STOP=0
+22 FOR
SET HCT=$ORDER(^TMP("HLS",$JOB,HCT))
if 'HCT
QUIT
SET SEG=$PIECE(^(HCT),HLFS,1)
SET TMP(SEG)=HCT
+23 ;
+24 ; Regular 270 Messages
+25 IF (EXT=1)!(EXT=2)!(EXT=5)!(EXT=6)
Begin DoDot:1
+26 ;PID-5 PATIENT NAME
IF $$FOREIGN^IBCNINSU($PIECE(PID,HLFS,6),"1;2;3;4;5;6")
SET STOP=1
QUIT
+27 ;IN1-2 PATIENT/SUBSCRIBER ID
IF $$FOREIGN^IBCNINSU($PIECE(IN1,HLFS,3))
SET STOP=1
QUIT
+28 IF $DATA(GT1)
Begin DoDot:2
+29 ;GT1-2 SUBSCRIBER ID
IF $$FOREIGN^IBCNINSU($PIECE(GT1,HLFS,3))
SET STOP=1
QUIT
+30 ;GT1-3 SUBSCRIBER NAME
IF $$FOREIGN^IBCNINSU($PIECE(GT1,HLFS,4),"1;2;3;4;5;6")
SET STOP=1
QUIT
End DoDot:2
IF STOP
QUIT
+31 ;
+32 ;If foreign chars encountered clear field and continue with msg
+33 ;
+34 ; PID-11 Addr (street,ignore,city,state,zip)
+35 ;PID-11
SET FLD=$PIECE(PID,HLFS,12)
IF $$FOREIGN^IBCNINSU(.FLD,"1;3;4;5",1)
SET $PIECE(PID,HLFS,12)=FLD
+36 ;IN1-8 GROUP NUMBER
SET FLD=$PIECE(IN1,HLFS,9)
IF $$FOREIGN^IBCNINSU(.FLD,1,1)
SET $PIECE(IN1,HLFS,9)=FLD
+37 ;IN1-9 GROUP NAME
SET FLD=$PIECE(IN1,HLFS,10)
IF $$FOREIGN^IBCNINSU(.FLD,1,1)
SET $PIECE(IN1,HLFS,10)=FLD
+38 ;
+39 IF $DATA(GT1)
Begin DoDot:2
+40 ; GT1-6 Addr (street,ignore,city,state,zip)
+41 ;GT1-6
SET FLD=$PIECE(GT1,HLFS,7)
IF $$FOREIGN^IBCNINSU(.FLD,"1;3;4;5",1)
SET $PIECE(GT1,HLFS,7)=FLD
End DoDot:2
End DoDot:1
GOTO BADMSGX
+42 ;
+43 ; EICD-Identifications (aka A1 msgs)
+44 ; [Asking clearinghouse if they know insurance for this patient]
+45 IF (EXT=4)
IF (QUERY="I")
Begin DoDot:1
+46 ;PID-5 PATIENT NAME
IF $$FOREIGN^IBCNINSU($PIECE(PID,HLFS,6),"1;2;3;4;5;6")
SET STOP=1
QUIT
+47 ; PID-11 Addr (ignore,ignore,city,state,zip)
+48 ;PID-11
IF $$FOREIGN^IBCNINSU($PIECE(PID,HLFS,12),"3;4;5")
SET STOP=1
QUIT
+49 ;
+50 ;If foreign chars encountered clear field and continue with msg
+51 ;
+52 ;PID-11-1 ADDR STREET
SET FLD=$PIECE(PID,HLFS,12)
IF $$FOREIGN^IBCNINSU(.FLD,1,1)
SET $PIECE(PID,HLFS,12)=FLD
End DoDot:1
GOTO BADMSGX
+53 ;
+54 ; EICD-Verification (aka A2 msgs)
+55 ; [Confirming policies clearinghouse found for VA]
+56 IF (EXT=4)
IF (QUERY="V")
Begin DoDot:1
+57 ;PID-5 PATIENT NAME
IF $$FOREIGN^IBCNINSU($PIECE(PID,HLFS,6),"1;2;3;4;5;6")
SET STOP=1
QUIT
+58 ;IN1-2 PATIENT/SUBSCRIBER ID
IF $$FOREIGN^IBCNINSU($PIECE(IN1,HLFS,3))
SET STOP=1
QUIT
+59 IF $DATA(GT1)
Begin DoDot:2
+60 ;GT1-2 SUBSCRIBER ID
IF $$FOREIGN^IBCNINSU($PIECE(GT1,HLFS,3))
SET STOP=1
QUIT
+61 ;GT1-3 SUBSCRIBER NAME
IF $$FOREIGN^IBCNINSU($PIECE(GT1,HLFS,4),"1;2;3;4;5;6")
SET STOP=1
QUIT
End DoDot:2
IF STOP
QUIT
+62 ;
+63 ;If foreign chars encountered clear field and continue with msg
+64 ;
+65 ; PID-11 Addr (street,ignore,city,state,zip)
+66 ;PID-11
SET FLD=$PIECE(PID,HLFS,12)
IF $$FOREIGN^IBCNINSU(.FLD,"1;3;4;5",1)
SET $PIECE(PID,HLFS,12)=FLD
+67 ;IN1-8 GROUP NUMBER
SET FLD=$PIECE(IN1,HLFS,9)
IF $$FOREIGN^IBCNINSU(.FLD,1,1)
SET $PIECE(IN1,HLFS,9)=FLD
+68 ;IN1-9 GROUP NAME
SET FLD=$PIECE(IN1,HLFS,10)
IF $$FOREIGN^IBCNINSU(.FLD,1,1)
SET $PIECE(IN1,HLFS,10)=FLD
+69 IF $DATA(GT1)
Begin DoDot:2
+70 ; GT1-6 Addr (street,ignore,city,state,zip)
+71 ;GT1-6
SET FLD=$PIECE(GT1,HLFS,7)
IF $$FOREIGN^IBCNINSU(.FLD,"1;3;4;5",1)
SET $PIECE(GT1,HLFS,7)=FLD
End DoDot:2
End DoDot:1
GOTO BADMSGX
+72 ;
+73 ; MBI REQUEST
+74 IF EXT=7
Begin DoDot:1
+75 ;PID-5 SUBSCRIBER NAME
IF $$FOREIGN^IBCNINSU($PIECE(PID,HLFS,6),"1;2;3;4;5;6")
SET STOP=1
QUIT
+76 ;
+77 ;If foreign chars encountered clear field and continue with msg
+78 ;
+79 ; PID-11 Addr (street,ignore,city,state,zip)
+80 ;PID-11
SET FLD=$PIECE(PID,HLFS,12)
IF $$FOREIGN^IBCNINSU(.FLD,"1;3;4;5",1)
SET $PIECE(PID,HLFS,12)=FLD
End DoDot:1
GOTO BADMSGX
+81 ;
BADMSGX ;Exit BADMSG
+1 IF 'STOP
Begin DoDot:1
+2 SET HCT=$GET(TMP("PID"))
IF HCT
SET ^TMP("HLS",$JOB,HCT)=PID
+3 SET HCT=$GET(TMP("IN1"))
IF HCT
SET ^TMP("HLS",$JOB,HCT)=IN1
+4 SET HCT=$GET(TMP("GT1"))
IF HCT
SET ^TMP("HLS",$JOB,HCT)=GT1
End DoDot:1
+5 QUIT STOP
+6 ;
EBSUMMARY(DFN,RIEN,SOI,ARRAY) ; Added IB*806
+1 ;
+2 ; ***********************
+3 ; DO NOT change this code without careful consideration !!!
+4 ; It is called by IBCNEHL5A to Auto-load policies as eIV Responses are processed
+5 ; Also, it is called by IBCNES for the ELIG. Benefits (from both file #2 and #365 perspectives)
+6 ; ***********************
+7 ;
+8 ; Example:
+9 ; Insurance Type: Medicare Part A Elig/Ben Info: Active Coverage
+10 ; Date/Time Qual: Plan D/T Period: 05/01/2019
+11 ;
+12 ; Returns ARRAY(EBCNT,"Medicare Part A")=DFN^"Medicare Part A"^3190501^SOI^"Active Coverage"
+13 ; - if Other Potential Insurance - ARRAY("OHI)=1
+14 ; - if the Effective Date for an Active policy is missing - ARRAY("MISSING_EFFDT")=1
+15 ;
+16 ; How to determine effective date:
+17 ; 1st attempt to pull from EB loop
+18 ; Loop must have:(INSTYP'="") & ELGBENINFO="Active Coverage" or "Inactive"
+19 ; If Medicare pull the 1st date where qualifier = "PLAN"
+20 ; If not Medicare pull 1st date where qualifier ="PLAN" or "PLAN BEGIN"
+21 ; check all dates as "PLAN BEGIN" trumps "PLAN"
+22 ; if no eff dt then continue other attempts
+23 ; 2nd attempt - If not Medicare pull from Subscriber dates (#365.28,.02)
+24 ; pull 1st date where qualifier ="PLAN" or "PLAN BEGIN"
+25 ; check all dates as "PLAN BEGIN" trumps "PLAN"
+26 ; if no eff dt then continue other attempts
+27 ; LAST attempt - pull from Effective date (#365,1.11)
+28 ; applies to both Medicare and non Medicare
+29 ; Otherwise effective date is "Unknown"
+30 ;
+31 ;
+32 NEW DTQUAL,EBCNT,ELGBENINFO,EXTELIG,FSCSTAT,HLDT,HLDNDT
+33 NEW IBA,IBBERR,IBCHK,IBEFFDT,IBEINFO,IBELGINF,IBNOTCOV,IBNOTDT,IBNOTTYP,IBPEDT,IBSPDT,IBSUSCT
+34 NEW IBVIENS,INSTYP,MWNRTYP,TMP,XXDT,ZIEN
+35 KILL ARRAY,^TMP("EBSUMEUT2",$JOB)
+36 ;
+37 ; NO Benefits received
IF '$DATA(^IBCN(365,RIEN,2))
GOTO XEBSUM
+38 ;
+39 SET (IBSPDT,IBSUSCT,IBPEDT,IBELGINF)=""
+40 ; determine the default date if the HLDT is not there
+41 ;use the subscriber date plan date if it is a plan, or the Effective date, Unknown if still not found
+42 ; this is to calculate the default eff date if it can't be determined by the EB loops from the response
+43 KILL IBCHK,IBBERR
DO GETS^DIQ(365,RIEN_",","7*","IEN","IBCHK","IBBERR")
+44 ; loop through for Subscribers collect the 'plan' and 'plan begin' dates
IF $DATA(IBCHK(365.07))
Begin DoDot:1
+45 NEW DQUAL,DTYP,IBA,IBB,IBL,IBOK,IBP,IBPB,IBTDT,IBTDT1
+46 KILL IBP,IBPB
+47 SET IBB=""
SET (IBOK,IBP,IBPB)=0
+48 FOR
SET IBB=$ORDER(IBCHK(365.07,IBB))
if IBB=""
QUIT
Begin DoDot:2
+49 ; C is for Subscriber
SET DTYP=$GET(IBCHK(365.07,IBB,.04,"E"))
if DTYP'["C"
QUIT
+50 SET DQUAL=$GET(IBCHK(365.07,IBB,.03,"I"))
if 'DQUAL
QUIT
SET IBA=$$X12^IBCNERP2(365.026,DQUAL)
+51 ; Must be Plan or Plan Begin
IF IBA'="Plan"&(IBA'="Plan Begin")
QUIT
+52 SET IBTDT=$GET(IBCHK(365.07,IBB,.02,"I"))
SET IBTDT=$PIECE(IBTDT,"-",1)
SET IBTDT=$TRANSLATE(IBTDT," ","")
+53 ; must have a date
IF IBTDT=""
QUIT
+54 SET IBTDT1=$$HL7TFM^XLFDT(IBTDT)
+55 ;must be valid date
IF IBTDT1=""!(IBTDT1="-1")
QUIT
+56 IF IBA="Plan"
IF IBSPDT=""
SET IBSPDT=IBTDT1
+57 IF IBA="Plan Begin"
SET IBSPDT=IBTDT1
SET IBOK=1
End DoDot:2
if IBOK
QUIT
End DoDot:1
+58 ;
+59 ; get Effective dt from top display as 2nd default (from IN1 segment)
IF IBSPDT=""
SET IBSPDT=$$GET1^DIQ(365,RIEN,"1.11","I")
+60 ; eff dt default to use for non medicare policies if not found in EB loops
IF IBSPDT=""
SET IBSPDT="Unknown"
+61 ;
+62 SET IBEFFDT=""
SET IBEFFDT=$$GET1^DIQ(365,RIEN,"1.11","I")
if 'IBEFFDT
SET IBEFFDT="Unknown"
+63 ;
+64 ; is the payer medicare
SET MWNRTYP=$$ISMCARE(RIEN)
+65 ;
+66 SET EBCNT=0
FOR
SET EBCNT=$ORDER(^IBCN(365,RIEN,2,EBCNT))
if 'EBCNT
QUIT
Begin DoDot:1
+67 SET IBVIENS=EBCNT_","_RIEN_","
+68 KILL EB,ERROR
+69 DO GETS^DIQ(365.02,IBVIENS,".02;.03;.04;.05;.06;8*","IEN","EB","EBERR")
+70 ;
+71 ; use EB loop 1 only to pull FSC's determination and nothing else
IF (EBCNT=1)
IF ($GET(EB(365.02,IBVIENS,.06,"E"))="eIV Eligibility Determination")
Begin DoDot:2
+72 SET FSCSTAT=$GET(EB(365.02,IBVIENS,.02,"E"))
+73 ; this is what FSC said (Active, Inactive, Ambiguous)
SET FSCSTAT=$SELECT((FSCSTAT'=1&(FSCSTAT'=6)):"Unknown",1:FSCSTAT)
+74 SET IBELGINF=$SELECT(FSCSTAT=1:"ACTIVE Coverage",FSCSTAT=6:"INACTIVE Coverage",1:"Unknown")
End DoDot:2
QUIT
+75 ;
+76 SET INSTYP=$PIECE($GET(^IBE(365.014,+$GET(EB(365.02,IBVIENS,.05,"I")),0)),U,2)
+77 ;
+78 ; X12 271 ELIGIBILITY/BENEFIT file #365.011 - this tag only uses the following codes below:
+79 ; 1="Active coverage"
+80 ; 2="Active - Full Risk Capitation"
+81 ; 3="Active - Services Capitated"
+82 ; 4="Active - Services Capitated to Primary Care Physician"
+83 ; 6="Inactive"
+84 ; R="Other or Additional Payor"
+85 ; U="Contract Following Entity for Eligibility or Benefit Information"
+86 SET EXTELIG=$GET(EB(365.02,IBVIENS,.02,"E"))
+87 ;
+88 ; Indicates potential Other Health Insurance (OHI) do OHI checks before quits
+89 IF (EXTELIG=2)!(EXTELIG=3)!(EXTELIG=4)!(EXTELIG="R")!(EXTELIG="U")
SET ARRAY("OHI")=1
+90 ;
+91 ; moved quit to after the OHI check
IF INSTYP=""
QUIT
+92 ;
+93 IF (EXTELIG'=1)&(EXTELIG'=6)&(EXTELIG'=2)&(EXTELIG'=3)&(EXTELIG'=4)&(EXTELIG'="R")&(EXTELIG'="U")
QUIT
+94 ;
+95 SET ELGBENINFO=$PIECE($GET(^IBE(365.011,+$GET(EB(365.02,IBVIENS,.02,"I")),0)),U,2)
+96 IF ELGBENINFO'="Active Coverage"&(ELGBENINFO'="Inactive")
QUIT
+97 ;
+98 SET HLDT=""
+99 SET ZIEN="0,"_IBVIENS
SET IBOK=0
+100 FOR
SET ZIEN=$ORDER(EB(365.28,ZIEN))
if ZIEN=""
QUIT
Begin DoDot:2
+101 SET DTQUAL=$PIECE($GET(^IBE(365.026,+$GET(EB(365.28,ZIEN,.03,"I")),0)),U,2)
+102 ; Medicare policies are only looking for "Plan"
IF (MWNRTYP)
IF (DTQUAL'="Plan")
QUIT
+103 ; Non Medicare policies look for "Plan" & "Plan Begin"
IF ('MWNRTYP)
IF ((DTQUAL'="Plan")&(DTQUAL'="Plan Begin"))
QUIT
+104 SET XXDT=$$HL7TFM^XLFDT($GET(EB(365.28,ZIEN,.02,"E")))
+105 ;Medicare will not have multiple plan dates in same EB loop
IF MWNRTYP
SET HLDT=XXDT
SET IBOK=1
QUIT
+106 IF DTQUAL="Plan"
IF HLDT=""
SET HLDT=XXDT
+107 IF DTQUAL="Plan Begin"
SET HLDT=XXDT
SET IBOK=1
End DoDot:2
if IBOK=1
QUIT
+108 ;
+109 IF HLDT=""
IF ELGBENINFO'="Inactive"
SET ARRAY("MISSING_EFFDT")=1
+110 ;
+111 ; Non Medicare and no eff dt found in EB loop use default from above
IF HLDT=""&('MWNRTYP)
Begin DoDot:2
+112 SET HLDT=IBSPDT
End DoDot:2
+113 ;
+114 SET HLDNDT=$SELECT('HLDT:IBEFFDT,1:HLDT)
+115 ;
+116 ; TMP array used to avoid repeating duplicate data in summary section (payers repeat themselves)
+117 IF $DATA(^TMP("EBSUMEUT2",$JOB,$SELECT(INSTYP="":" ",1:INSTYP),$SELECT(ELGBENINFO="":" ",1:ELGBENINFO),HLDNDT))
QUIT
+118 ;
+119 SET ARRAY(EBCNT,INSTYP)=DFN_U_INSTYP_U_HLDT_U_SOI_U_ELGBENINFO
+120 ;
+121 SET ^TMP("EBSUMEUT2",$JOB,$SELECT(INSTYP="":" ",1:INSTYP),$SELECT(ELGBENINFO="":" ",1:ELGBENINFO),HLDNDT)=""
End DoDot:1
+122 ;
+123 ;
+124 ; not for medicare payer
IF '$ORDER(ARRAY(0))&('MWNRTYP)
Begin DoDot:1
+125 SET ARRAY(1,"Unknown")=$GET(DFN)_U_"Unknown"_U_$GET(IBSPDT)_U_$GET(SOI)_U_$GET(IBELGINF)
End DoDot:1
+126 ;
XEBSUM ;
+1 ;
+2 KILL ^TMP("EBSUMEUT2",$JOB)
+3 QUIT
+4 ;
ISMCARE(RIEN) ;check if response is from eIV Medicare Payer defined in file 350.9
+1 ; new tag with IB*806
+2 NEW IB3650,IBPIEN,MWNRIEN,MWNRTYPA
+3 SET IB3650=$GET(^IBCN(365,RIEN,0))
SET IBPIEN=$PIECE(IB3650,U,3)
+4 SET MWNRIEN=$PIECE($GET(^IBE(350.9,1,51)),U,25)
SET MWNRTYPA=0
+5 IF IBPIEN=MWNRIEN
SET MWNRTYPA=1
+6 QUIT MWNRTYPA
+7 ;
