Routine: IBCNEQU1

IBCNEQU1 ;AITC/TAZ - eIV REQUEST ELECTRONIC INSURANCE INQUIRY CONT'D; 20-MAY-2021

 ;;2.0;INTEGRATED BILLING;**702,778**;21-MAR-94;Build 28

 ;;Per VA Directive 6402, this routine should not be modified.

 ; eIV - Insurance Verification Interface

 ; Continuation of IBCNEQU

EICDREQ ; User requested an EICD Discovery

 N DATA1,DATA2,DATA5,DIRUT,DUOUT,EACTIVE,ELG,FRESHDT,IBCNETOT,IBCSIEN,IBFREQ,IBMSG

 N IBTQIEN,IBTQSTAT,IHCNT,MSG,OK,PIEN,PRIORITY,SVDFN,VNUM,Y

 D FULL^VALM1

 S VALMBCK="Q"

 K DIR

 K ^TMP("IBQUERY",$J)

 S MSG=1

 S MSG(1)="Sorry the patient does not qualify for this action."

 S MSG(2)="An EICD request was submitted recently. It is too soon to submit another one."

 S MSG(3)="Sorry, but you do not have the required key for an EICD Request."

 S MSG(4)="An EICD request has been sent. If active insurance is found for this patient"

 S MSG(5)="results will be displayed in the buffer within 30 days."

 I '$D(^XUSEC("IBCNE EICD REQUEST",DUZ)) S MSG=3 G EICDREQX

 S EACTIVE=$$SETTINGS^IBCNEDE7(4)

 I 'EACTIVE G EICDREQX ; not active, or required fields missing

 S IBFREQ=$P(EACTIVE,U,8) ; frequency

 S FRESHDT=$$FMADD^XLFDT(DT,-IBFREQ) ;Fresh Date

 ;Check Payer

 S PIEN=$$EPAYR^IBCNEUT5() I 'PIEN G EICDREQX  ;Invalid EICD Payer

 ;Patient Eligibility requirements

 I '$$EPAT^IBCNEUT5(.MSG) G EICDREQX

 S ELG=$$GET1^DIQ(2,DFN_",",.361) ; "PRIMARY ELIGIBILITY CODE"

 ; IB*778/TAZ - Redirected call to IBCNEDE6

 ;D ELG^IBCNEDE2 I 'OK G EICDREQX  ;Eligibility Exclusion

 D ELG^IBCNEDE6 I 'OK G EICDREQX  ;Eligibility Exclusion

 ; Cannot have Active Insurance

 I $$EACTPOL^IBCNEUT5() G EICDREQX

 ; there should be no TQ entry for this DFN, consider it a safety check

 I '$$ADDTQ^IBCNEUT5(DFN,PIEN,DT,IBFREQ,1) G EICDREQX

 S DIR(0)="Y"

 S DIR("A")="Are you sure you want to request a search for this patient's insurance"

 S DIR("B")="YES"

 S DIR("?",1)="  If yes, a EICD request will be initiated immediately."

 S DIR("?")="  If no, the EICD request will be cancelled."

 D ^DIR K DIR

 I $D(DIRUT)!$D(DUOUT)!('Y) S MSG=0 G EICDX

 ;Note:  We need to preserve the DFN.  It is getting killed somewhere in the message creation.

 S MSG=4,SVDFN=DFN

 ;Set up variables needed to send the request.

 ; SET prepare and file the TQ

 ; DFN:Patient IEN

 ; PIEN: EICD payer IEN

 ; IBTQSTAT: TQ STATUS IEN - Ready to Transmit

 ; FRESHDT: Freshness date

 ; 4: EICD data extract (#4)

 ; I: Identification

 ; DT: Todays date

 ; IBCSIEN: Source of Information IEN - Contract Services

 S IBCSIEN=$$FIND1^DIC(355.12,,"X","CONTRACT SERVICES","C")

 S IBTQSTAT=$$FIND1^DIC(365.14,,"X","Ready to Transmit","B")

 S DATA1=DFN_U_PIEN_U_IBTQSTAT_U_""_U_""_U_FRESHDT

 S DATA2=4_U_"I"_U_DT

 S DATA5=IBCSIEN

 S IBTQIEN=$$SETTQ^IBCNEDE7(DATA1,DATA2,,,DATA5) ; Sets in TQ

 I IBTQIEN="" G EICDREQX   ; didn't file

 ; place a stub into EIV EICD TRACKING (#365.18)

 K IBFDA,IBERR

 ; EIV EICD TRACKING, .01:TRANSMISSION .02:DATE CREATED .03:PAYER .05:PATIENT

 S IBFDA(365.18,"+1,",.01)=IBTQIEN

 S IBFDA(365.18,"+1,",.02)=DT

 S IBFDA(365.18,"+1,",.03)=PIEN

 S IBFDA(365.18,"+1,",.05)=DFN

 D UPDATE^DIE(,"IBFDA",,"IBERR")

 I $G(IBERR("DIERR",1,"TEXT",1))'="" D  Q

 . S IBMSG=""

 . D MSG002^IBCNEMS1(.IBMSG,.IBERR,IBTQIEN)

 . D MSG^IBCNEUT5($$MGRP^IBCNEUT5(),"eIV Problem: Error writing EIV EICD TRACKING (#365.18)","IBMSG(")

 ; Note:  VNUM is required by the downstream code.  We must keep it until such time as

 ; VNUM is changed to PRIORITY throughout the system.

 S (PRIORITY,VNUM)=4,(IBCNETOT,IHCNT)=0   ;Priority is determined by FIN^IBCNEDEP which uses variable "VNUM"

 S ^TMP("IBQUERY",$J,PRIORITY,DFN,IBTQIEN)=""

 D ID^IBCNEDEP

 S DFN=SVDFN

 K ^TMP("IBQUERY",$J)

EICDREQX ;

 I MSG D

 . W !!,*7,MSG(MSG)

 . I MSG=4 W !,MSG(5)

 . K DIR

 . D PAUSE^VALM1

 S VALMBCK="Q"

EICDX ; Return user to the screen, curser is at the Select Action prompt (like MBI action)

 S VALMBCK="R"

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNEQU1   4024     printed  Mar 13, 2025@21:19:46                                                                                                                                                                                                    Page 2

IBCNEQU1  ;AITC/TAZ - eIV REQUEST ELECTRONIC INSURANCE INQUIRY CONT'D; 20-MAY-2021

 +1       ;;2.0;INTEGRATED BILLING;**702,778**;21-MAR-94;Build 28

 +2       ;;Per VA Directive 6402, this routine should not be modified.

 +3       ;

 +4       ; eIV - Insurance Verification Interface

 +5       ;

 +6       ; Continuation of IBCNEQU

 +7        QUIT

 +8       ;

EICDREQ   ; User requested an EICD Discovery

 +1       ;

 +2        NEW DATA1,DATA2,DATA5,DIRUT,DUOUT,EACTIVE,ELG,FRESHDT,IBCNETOT,IBCSIEN,IBFREQ,IBMSG

 +3        NEW IBTQIEN,IBTQSTAT,IHCNT,MSG,OK,PIEN,PRIORITY,SVDFN,VNUM,Y

 +4        DO FULL^VALM1

 +5        SET VALMBCK="Q"

 +6        KILL DIR

 +7       ;

 +8        KILL ^TMP("IBQUERY",$JOB)

 +9       ;

 +10       SET MSG=1

 +11       SET MSG(1)="Sorry the patient does not qualify for this action."

 +12       SET MSG(2)="An EICD request was submitted recently. It is too soon to submit another one."

 +13       SET MSG(3)="Sorry, but you do not have the required key for an EICD Request."

 +14       SET MSG(4)="An EICD request has been sent. If active insurance is found for this patient"

 +15       SET MSG(5)="results will be displayed in the buffer within 30 days."

 +16      ;

 +17       IF '$DATA(^XUSEC("IBCNE EICD REQUEST",DUZ))

               SET MSG=3

               GOTO EICDREQX

 +18      ;

 +19       SET EACTIVE=$$SETTINGS^IBCNEDE7(4)

 +20      ; not active, or required fields missing

           IF 'EACTIVE

               GOTO EICDREQX

 +21      ; frequency

           SET IBFREQ=$PIECE(EACTIVE,U,8)

 +22      ;Fresh Date

           SET FRESHDT=$$FMADD^XLFDT(DT,-IBFREQ)

 +23      ;

 +24      ;Check Payer

 +25      ;Invalid EICD Payer

           SET PIEN=$$EPAYR^IBCNEUT5()

           IF 'PIEN

               GOTO EICDREQX

 +26      ;

 +27      ;Patient Eligibility requirements

 +28       IF '$$EPAT^IBCNEUT5(.MSG)

               GOTO EICDREQX

 +29      ; "PRIMARY ELIGIBILITY CODE"

           SET ELG=$$GET1^DIQ(2,DFN_",",.361)

 +30      ; IB*778/TAZ - Redirected call to IBCNEDE6

 +31      ;D ELG^IBCNEDE2 I 'OK G EICDREQX  ;Eligibility Exclusion

 +32      ;Eligibility Exclusion

           DO ELG^IBCNEDE6

           IF 'OK

               GOTO EICDREQX

 +33      ;

 +34      ; Cannot have Active Insurance

 +35       IF $$EACTPOL^IBCNEUT5()

               GOTO EICDREQX

 +36      ;

 +37      ; there should be no TQ entry for this DFN, consider it a safety check

 +38       IF '$$ADDTQ^IBCNEUT5(DFN,PIEN,DT,IBFREQ,1)

               GOTO EICDREQX

 +39      ;

 +40       SET DIR(0)="Y"

 +41       SET DIR("A")="Are you sure you want to request a search for this patient's insurance"

 +42       SET DIR("B")="YES"

 +43       SET DIR("?",1)="  If yes, a EICD request will be initiated immediately."

 +44       SET DIR("?")="  If no, the EICD request will be cancelled."

 +45       DO ^DIR

           KILL DIR

 +46       IF $DATA(DIRUT)!$DATA(DUOUT)!('Y)

               SET MSG=0

               GOTO EICDX

 +47      ;

 +48      ;Note:  We need to preserve the DFN.  It is getting killed somewhere in the message creation.

 +49       SET MSG=4

           SET SVDFN=DFN

 +50      ;

 +51      ;Set up variables needed to send the request.

 +52      ; SET prepare and file the TQ

 +53      ; DFN:Patient IEN

 +54      ; PIEN: EICD payer IEN

 +55      ; IBTQSTAT: TQ STATUS IEN - Ready to Transmit

 +56      ; FRESHDT: Freshness date

 +57      ; 4: EICD data extract (#4)

 +58      ; I: Identification

 +59      ; DT: Todays date

 +60      ; IBCSIEN: Source of Information IEN - Contract Services

 +61       SET IBCSIEN=$$FIND1^DIC(355.12,,"X","CONTRACT SERVICES","C")

 +62       SET IBTQSTAT=$$FIND1^DIC(365.14,,"X","Ready to Transmit","B")

 +63       SET DATA1=DFN_U_PIEN_U_IBTQSTAT_U_""_U_""_U_FRESHDT

 +64       SET DATA2=4_U_"I"_U_DT

 +65       SET DATA5=IBCSIEN

 +66      ; Sets in TQ

           SET IBTQIEN=$$SETTQ^IBCNEDE7(DATA1,DATA2,,,DATA5)

 +67      ; didn't file

           IF IBTQIEN=""

               GOTO EICDREQX

 +68      ;

 +69      ; place a stub into EIV EICD TRACKING (#365.18)

 +70       KILL IBFDA,IBERR

 +71      ; EIV EICD TRACKING, .01:TRANSMISSION .02:DATE CREATED .03:PAYER .05:PATIENT

 +72       SET IBFDA(365.18,"+1,",.01)=IBTQIEN

 +73       SET IBFDA(365.18,"+1,",.02)=DT

 +74       SET IBFDA(365.18,"+1,",.03)=PIEN

 +75       SET IBFDA(365.18,"+1,",.05)=DFN

 +76       DO UPDATE^DIE(,"IBFDA",,"IBERR")

 +77       IF $GET(IBERR("DIERR",1,"TEXT",1))'=""

               Begin DoDot:1

 +78               SET IBMSG=""

 +79               DO MSG002^IBCNEMS1(.IBMSG,.IBERR,IBTQIEN)

 +80               DO MSG^IBCNEUT5($$MGRP^IBCNEUT5(),"eIV Problem: Error writing EIV EICD TRACKING (#365.18)","IBMSG(")

               End DoDot:1

               QUIT

 +81      ; Note:  VNUM is required by the downstream code.  We must keep it until such time as

 +82      ; VNUM is changed to PRIORITY throughout the system.

 +83      ;Priority is determined by FIN^IBCNEDEP which uses variable "VNUM"

           SET (PRIORITY,VNUM)=4

           SET (IBCNETOT,IHCNT)=0

 +84       SET ^TMP("IBQUERY",$JOB,PRIORITY,DFN,IBTQIEN)=""

 +85       DO ID^IBCNEDEP

 +86       SET DFN=SVDFN

 +87       KILL ^TMP("IBQUERY",$JOB)

 +88      ;

EICDREQX  ;

 +1        IF MSG

               Begin DoDot:1

 +2                WRITE !!,*7,MSG(MSG)

 +3                IF MSG=4

                       WRITE !,MSG(5)

 +4                KILL DIR

 +5                DO PAUSE^VALM1

               End DoDot:1

 +6        SET VALMBCK="Q"

 +7        QUIT

 +8       ;

EICDX     ; Return user to the screen, curser is at the Select Action prompt (like MBI action)

 +1        SET VALMBCK="R"

 +2        QUIT

IBCNEQU1.m