IBCNEQU1 ;AITC/TAZ - eIV REQUEST ELECTRONIC INSURANCE INQUIRY CONT'D; 20-MAY-2021
;;2.0;INTEGRATED BILLING;**702**;21-MAR-94;Build 53
;;Per VA Directive 6402, this routine should not be modified.
;
; eIV - Insurance Verification Interface
;
; Continuation of IBCNEQU
Q
;
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"
D ELG^IBCNEDE2 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"
Q
;
EICDX ; Return user to the screen, curser is at the Select Action prompt (like MBI action)
S VALMBCK="R"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNEQU1 3916 printed Apr 09, 2024@21:29:50 Page 2
IBCNEQU1 ;AITC/TAZ - eIV REQUEST ELECTRONIC INSURANCE INQUIRY CONT'D; 20-MAY-2021
+1 ;;2.0;INTEGRATED BILLING;**702**;21-MAR-94;Build 53
+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 ;Eligibility Exclusion
DO ELG^IBCNEDE2
IF 'OK
GOTO EICDREQX
+31 ;
+32 ; Cannot have Active Insurance
+33 IF $$EACTPOL^IBCNEUT5()
GOTO EICDREQX
+34 ;
+35 ; there should be no TQ entry for this DFN, consider it a safety check
+36 IF '$$ADDTQ^IBCNEUT5(DFN,PIEN,DT,IBFREQ,1)
GOTO EICDREQX
+37 ;
+38 SET DIR(0)="Y"
+39 SET DIR("A")="Are you sure you want to request a search for this patient's insurance"
+40 SET DIR("B")="YES"
+41 SET DIR("?",1)=" If yes, a EICD request will be initiated immediately."
+42 SET DIR("?")=" If no, the EICD request will be cancelled."
+43 DO ^DIR
KILL DIR
+44 IF $DATA(DIRUT)!$DATA(DUOUT)!('Y)
SET MSG=0
GOTO EICDX
+45 ;
+46 ;Note: We need to preserve the DFN. It is getting killed somewhere in the message creation.
+47 SET MSG=4
SET SVDFN=DFN
+48 ;
+49 ;Set up variables needed to send the request.
+50 ; SET prepare and file the TQ
+51 ; DFN:Patient IEN
+52 ; PIEN: EICD payer IEN
+53 ; IBTQSTAT: TQ STATUS IEN - Ready to Transmit
+54 ; FRESHDT: Freshness date
+55 ; 4: EICD data extract (#4)
+56 ; I: Identification
+57 ; DT: Todays date
+58 ; IBCSIEN: Source of Information IEN - Contract Services
+59 SET IBCSIEN=$$FIND1^DIC(355.12,,"X","CONTRACT SERVICES","C")
+60 SET IBTQSTAT=$$FIND1^DIC(365.14,,"X","Ready to Transmit","B")
+61 SET DATA1=DFN_U_PIEN_U_IBTQSTAT_U_""_U_""_U_FRESHDT
+62 SET DATA2=4_U_"I"_U_DT
+63 SET DATA5=IBCSIEN
+64 ; Sets in TQ
SET IBTQIEN=$$SETTQ^IBCNEDE7(DATA1,DATA2,,,DATA5)
+65 ; didn't file
IF IBTQIEN=""
GOTO EICDREQX
+66 ;
+67 ; place a stub into EIV EICD TRACKING (#365.18)
+68 KILL IBFDA,IBERR
+69 ; EIV EICD TRACKING, .01:TRANSMISSION .02:DATE CREATED .03:PAYER .05:PATIENT
+70 SET IBFDA(365.18,"+1,",.01)=IBTQIEN
+71 SET IBFDA(365.18,"+1,",.02)=DT
+72 SET IBFDA(365.18,"+1,",.03)=PIEN
+73 SET IBFDA(365.18,"+1,",.05)=DFN
+74 DO UPDATE^DIE(,"IBFDA",,"IBERR")
+75 IF $GET(IBERR("DIERR",1,"TEXT",1))'=""
Begin DoDot:1
+76 SET IBMSG=""
+77 DO MSG002^IBCNEMS1(.IBMSG,.IBERR,IBTQIEN)
+78 DO MSG^IBCNEUT5($$MGRP^IBCNEUT5(),"eIV Problem: Error writing EIV EICD TRACKING (#365.18)","IBMSG(")
End DoDot:1
QUIT
+79 ; Note: VNUM is required by the downstream code. We must keep it until such time as
+80 ; VNUM is changed to PRIORITY throughout the system.
+81 ;Priority is determined by FIN^IBCNEDEP which uses variable "VNUM"
SET (PRIORITY,VNUM)=4
SET (IBCNETOT,IHCNT)=0
+82 SET ^TMP("IBQUERY",$JOB,PRIORITY,DFN,IBTQIEN)=""
+83 DO ID^IBCNEDEP
+84 SET DFN=SVDFN
+85 KILL ^TMP("IBQUERY",$JOB)
+86 ;
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
