IBCNEDEQ ;DAOU/ALA - Process eIV Transactions continued ; 21-AUG-2002
;;2.0;INTEGRATED BILLING;**184,271,300,416,438,601,702**;21-MAR-94;Build 53
;;Per VA Directive 6402, this routine should not be modified.
;
;**Program Description**
; This program contains some subroutines for processing a transmission
;
HLER ; HL7 Creation error message
;
; Called from IBCNEDEP
;
; Parameters
; HLRESLT = Error from GENERATE^HLMA call
; DFN = Patient IEN
; PAYR = Payer IEN
; MGRP = Mail group
; XMSUB = Subject line
; MSG = Message array
;
S HLRESLT="Error - "_$P(HLRESLT,U,2,99)
S MSG(1)=HLRESLT
S MSG(2)="occurred when trying to create the outgoing HL7 message for"
S MSG(3)="Patient: "_$P($G(^DPT(DFN,0)),U,1)_$$SSN(DFN)_" and Payer: "_$P($G(^IBE(365.12,PAYR,0)),U,1)_"."
S MSG(4)="Please contact the Help Desk and report this problem."
D TXT^IBCNEUT7("MSG")
S XMSUB="eIV HL7 Creation Error"
D MSG^IBCNEUT5(MGRP,XMSUB,"MSG(")
K XMSUB,MSG,HLRESLT
Q
;
CERR ; Communication Error Mail Message - No Retries defined
;
; Called from IBCNEDEP
;
; Parameters
; DFN = Patient IEN
; PAYR = Payer IEN
; FMSG = Failure message flag
; MGRP = Mail group
; XMSUB = Subject line
; MSG = Message array
;
I 'FMSG G CERRQ
S XMSUB="eIV Communication Error"
S MSG(1)="VistA was unable to electronically confirm insurance for"
S MSG(2)="Patient: "_$P($G(^DPT(DFN,0)),U)_$$SSN(DFN)_" and Payer: "_$P($G(^IBE(365.12,PAYR,0)),U)_"."
S MSG(3)="A single attempt was made to electronically confirm the insurance"
S MSG(4)="with this payer."
;
D TXT^IBCNEUT7("MSG")
;
D MSG^IBCNEUT5(MGRP,XMSUB,"MSG(")
K MSG,XMSUB
CERRQ Q
;
CERE ; Communication Error Mail Message - Exceeds Retries
;
; Called from IBCNEDEP
;
; Parameters
; DFN = Patient IEN
; PAYR = Payer IEN
; FMSG = Failure message flag
; MGRP = Mail group
; XMSUB = Subject line
; MSG = Message array
;
I 'FMSG G CEREQ
S XMSUB="eIV Communication Error"
S MSG(1)="VistA was unable to electronically confirm insurance for"
S MSG(2)="Patient: "_$P($G(^DPT(DFN,0)),U)_$$SSN(DFN)_" and Payer: "_$P($G(^IBE(365.12,PAYR,0)),U)_"."
;
D TXT^IBCNEUT7("MSG")
;
D MSG^IBCNEUT5(MGRP,XMSUB,"MSG(")
K MSG,XMSUB
CEREQ Q
;
SUB ; Create HL7 subrecord in TQ file
;
; Called from tag SCC within this routine
;
; Input Parameters
; IEN = the transmission IEN
; RSIEN = the response IEN
; MDTM = the date/time message was created
; MSGID = the HL7 message ID
;
NEW DIC,DIE,X,DA,DLAYGO,Y
S DIC="^IBCN(365.1,"_IEN_",2,",DIE=DIC,X=MDTM,DA(1)=IEN
S DLAYGO=365.16,DIC(0)="L",DIC("P")=DLAYGO
I '$D(^IBCN(365.1,IEN,2,0)) S ^IBCN(365.1,IEN,2,0)="^365.16D^^"
K DD,DO
D FILE^DICN
K DO
S HIEN=+Y
S DR=".02////^S X=MSGID;.03////^S X=RSIEN" D ^DIE
S DA=HIEN D ^DIE
;
K HIEN,RSIEN,DR,MDTM
Q
;
RESP ; Create Response Record
;
; Called from IBCNEHL3 tag SCC within this routine
;
; Input Parameters
; MSGID = Message Control ID (required)
; MDTM = Message date/time created (optional)
; DFN = Patient IEN (optional)
; PAYR = Payer IEN (optional)
; BUFF = Buffer IEN (optional)
; IEN = Transmission IEN (optional)
; RSTYPE = Response Type (O=Original, U=Unsolicited)
;
NEW DIC,DIE,X,DA,DLAYGO,Y,RARRAY,ERR
;
S DIC="^IBCN(365,",X=MSGID,DLAYGO=365,DIC(0)="L",DIC("P")=DLAYGO
K DD,DO
D FILE^DICN
K DO
S RSIEN=+Y
S RARRAY(365,RSIEN_",",.02)=$G(DFN),RARRAY(365,RSIEN_",",.03)=$G(PAYR)
I $G(IEN)'="" D
. I $P(^IBCN(365.1,IEN,0),U,18)=1 S RARRAY(365,RSIEN_",",.04)=$G(BUFF)
. ; IB*702/TAZ,CKB - set Req Service Date (.14) and Req Service Type Code (.15)
. S RARRAY(365,RSIEN_",",.14)=$$GET1^DIQ(365.1,IEN_",",.12,"I")
. S RARRAY(365,RSIEN_",",.15)=$$GET1^DIQ(365.1,IEN_",",.2,"I")
S RARRAY(365,RSIEN_",",.05)=$G(IEN)
S RARRAY(365,RSIEN_",",.06)=2,RARRAY(365,RSIEN_",",.08)=$G(MDTM)
;
I $G(RSTYPE)="" S RSTYPE="U"
S RARRAY(365,RSIEN_",",.1)=RSTYPE
;
K DIERR ; IB*2*601/DM we've seen this previously set elsewhere
D FILE^DIE("I","RARRAY","ERR")
I $D(ERR("DIERR",1,"TEXT",1)) D
. S ERFLG=1,MCT=0,VEN=0
. F S VEN=$O(ERR("DIERR",VEN)) Q:'VEN D
.. S MCT=MCT+1,MSG(MCT)=$G(ERR("DIERR",VEN,"TEXT",1))
. ;
. S MCT=MCT+1,MSG(MCT)="Please contact the Help Desk and report this problem."
. S XMSUB="Error creating Response"
. D MSG^IBCNEUT5(MGRP,XMSUB,"MSG(")
. K ERR,VEN,MCT
Q
;
TMRR ; Communication Timeout message
I 'TMSG Q
S XMSUB="eIV Communication Timeout"
S MSG(1)="No Response has been received within the defined failure days of "_FAIL_" for "
S MSG(3)="Patient: "_$P($G(^DPT(DFN,0)),U,1)_$$SSN(DFN)_" and Payer: "_$P($G(^IBE(365.12,PAYR,0)),U,1)
;
D TXT^IBCNEUT7("MSG")
;
D MSG^IBCNEUT5(MGRP,XMSUB,"MSG(")
K MSG,XMSUB
Q
;
SSN(DFN) ; Retrieve patient's ssn and return last 4 digits
; Subsequently added Date of Birth to display as well
Q:'$G(DFN) ""
N SSN,DOB
S SSN=$$GETSSN^IBCNEDE5(DFN)
S DOB=$$GETDOB(DFN)
I SSN="",DOB="" Q ""
I SSN="" Q " (DOB: "_DOB_")"
S SSN=" (SSN: xxx-xx-"_$E(SSN,6,9)
I DOB'="" S DOB=" DOB: "_DOB
Q SSN_DOB_")"
;
GETDOB(DFN) ;
Q:'$G(DFN) "Unknown"
N DOB
S DOB=$P($G(^DPT(DFN,0)),U,3)
S DOB=$S('DOB:"Unknown",1:$$FMTE^XLFDT(DOB,"5Z"))
Q DOB
;
SCC ; If successfully creates an HL7 msg
S MSGID=$P(HLRESLT,U,1),NTRAN=NTRAN+1,MDTM=$$NOW^XLFDT(),IHCNT=IHCNT+1
I NTRAN>1 S NRETR=NRETR+1
D SST^IBCNEUT2(IEN,2)
S DA=IEN,DIE="^IBCN(365.1,",DR=".07////^S X=NTRAN;.08////^S X=NRETR"
D ^DIE
;
; Create Response Record
S RSTYPE="O" D RESP
;
; Create HL7 subrecord
D SUB
;
; If a buffer entry exists, set the buffer symbol to a '?'
I BUFF'="" D BUFF^IBCNEUT2(BUFF,10)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNEDEQ 5839 printed Sep 23, 2025@19:50:46 Page 2
IBCNEDEQ ;DAOU/ALA - Process eIV Transactions continued ; 21-AUG-2002
+1 ;;2.0;INTEGRATED BILLING;**184,271,300,416,438,601,702**;21-MAR-94;Build 53
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ;**Program Description**
+5 ; This program contains some subroutines for processing a transmission
+6 ;
HLER ; HL7 Creation error message
+1 ;
+2 ; Called from IBCNEDEP
+3 ;
+4 ; Parameters
+5 ; HLRESLT = Error from GENERATE^HLMA call
+6 ; DFN = Patient IEN
+7 ; PAYR = Payer IEN
+8 ; MGRP = Mail group
+9 ; XMSUB = Subject line
+10 ; MSG = Message array
+11 ;
+12 SET HLRESLT="Error - "_$PIECE(HLRESLT,U,2,99)
+13 SET MSG(1)=HLRESLT
+14 SET MSG(2)="occurred when trying to create the outgoing HL7 message for"
+15 SET MSG(3)="Patient: "_$PIECE($GET(^DPT(DFN,0)),U,1)_$$SSN(DFN)_" and Payer: "_$PIECE($GET(^IBE(365.12,PAYR,0)),U,1)_"."
+16 SET MSG(4)="Please contact the Help Desk and report this problem."
+17 DO TXT^IBCNEUT7("MSG")
+18 SET XMSUB="eIV HL7 Creation Error"
+19 DO MSG^IBCNEUT5(MGRP,XMSUB,"MSG(")
+20 KILL XMSUB,MSG,HLRESLT
+21 QUIT
+22 ;
CERR ; Communication Error Mail Message - No Retries defined
+1 ;
+2 ; Called from IBCNEDEP
+3 ;
+4 ; Parameters
+5 ; DFN = Patient IEN
+6 ; PAYR = Payer IEN
+7 ; FMSG = Failure message flag
+8 ; MGRP = Mail group
+9 ; XMSUB = Subject line
+10 ; MSG = Message array
+11 ;
+12 IF 'FMSG
GOTO CERRQ
+13 SET XMSUB="eIV Communication Error"
+14 SET MSG(1)="VistA was unable to electronically confirm insurance for"
+15 SET MSG(2)="Patient: "_$PIECE($GET(^DPT(DFN,0)),U)_$$SSN(DFN)_" and Payer: "_$PIECE($GET(^IBE(365.12,PAYR,0)),U)_"."
+16 SET MSG(3)="A single attempt was made to electronically confirm the insurance"
+17 SET MSG(4)="with this payer."
+18 ;
+19 DO TXT^IBCNEUT7("MSG")
+20 ;
+21 DO MSG^IBCNEUT5(MGRP,XMSUB,"MSG(")
+22 KILL MSG,XMSUB
CERRQ QUIT
+1 ;
CERE ; Communication Error Mail Message - Exceeds Retries
+1 ;
+2 ; Called from IBCNEDEP
+3 ;
+4 ; Parameters
+5 ; DFN = Patient IEN
+6 ; PAYR = Payer IEN
+7 ; FMSG = Failure message flag
+8 ; MGRP = Mail group
+9 ; XMSUB = Subject line
+10 ; MSG = Message array
+11 ;
+12 IF 'FMSG
GOTO CEREQ
+13 SET XMSUB="eIV Communication Error"
+14 SET MSG(1)="VistA was unable to electronically confirm insurance for"
+15 SET MSG(2)="Patient: "_$PIECE($GET(^DPT(DFN,0)),U)_$$SSN(DFN)_" and Payer: "_$PIECE($GET(^IBE(365.12,PAYR,0)),U)_"."
+16 ;
+17 DO TXT^IBCNEUT7("MSG")
+18 ;
+19 DO MSG^IBCNEUT5(MGRP,XMSUB,"MSG(")
+20 KILL MSG,XMSUB
CEREQ QUIT
+1 ;
SUB ; Create HL7 subrecord in TQ file
+1 ;
+2 ; Called from tag SCC within this routine
+3 ;
+4 ; Input Parameters
+5 ; IEN = the transmission IEN
+6 ; RSIEN = the response IEN
+7 ; MDTM = the date/time message was created
+8 ; MSGID = the HL7 message ID
+9 ;
+10 NEW DIC,DIE,X,DA,DLAYGO,Y
+11 SET DIC="^IBCN(365.1,"_IEN_",2,"
SET DIE=DIC
SET X=MDTM
SET DA(1)=IEN
+12 SET DLAYGO=365.16
SET DIC(0)="L"
SET DIC("P")=DLAYGO
+13 IF '$DATA(^IBCN(365.1,IEN,2,0))
SET ^IBCN(365.1,IEN,2,0)="^365.16D^^"
+14 KILL DD,DO
+15 DO FILE^DICN
+16 KILL DO
+17 SET HIEN=+Y
+18 SET DR=".02////^S X=MSGID;.03////^S X=RSIEN"
DO ^DIE
+19 SET DA=HIEN
DO ^DIE
+20 ;
+21 KILL HIEN,RSIEN,DR,MDTM
+22 QUIT
+23 ;
RESP ; Create Response Record
+1 ;
+2 ; Called from IBCNEHL3 tag SCC within this routine
+3 ;
+4 ; Input Parameters
+5 ; MSGID = Message Control ID (required)
+6 ; MDTM = Message date/time created (optional)
+7 ; DFN = Patient IEN (optional)
+8 ; PAYR = Payer IEN (optional)
+9 ; BUFF = Buffer IEN (optional)
+10 ; IEN = Transmission IEN (optional)
+11 ; RSTYPE = Response Type (O=Original, U=Unsolicited)
+12 ;
+13 NEW DIC,DIE,X,DA,DLAYGO,Y,RARRAY,ERR
+14 ;
+15 SET DIC="^IBCN(365,"
SET X=MSGID
SET DLAYGO=365
SET DIC(0)="L"
SET DIC("P")=DLAYGO
+16 KILL DD,DO
+17 DO FILE^DICN
+18 KILL DO
+19 SET RSIEN=+Y
+20 SET RARRAY(365,RSIEN_",",.02)=$GET(DFN)
SET RARRAY(365,RSIEN_",",.03)=$GET(PAYR)
+21 IF $GET(IEN)'=""
Begin DoDot:1
+22 IF $PIECE(^IBCN(365.1,IEN,0),U,18)=1
SET RARRAY(365,RSIEN_",",.04)=$GET(BUFF)
+23 ; IB*702/TAZ,CKB - set Req Service Date (.14) and Req Service Type Code (.15)
+24 SET RARRAY(365,RSIEN_",",.14)=$$GET1^DIQ(365.1,IEN_",",.12,"I")
+25 SET RARRAY(365,RSIEN_",",.15)=$$GET1^DIQ(365.1,IEN_",",.2,"I")
End DoDot:1
+26 SET RARRAY(365,RSIEN_",",.05)=$GET(IEN)
+27 SET RARRAY(365,RSIEN_",",.06)=2
SET RARRAY(365,RSIEN_",",.08)=$GET(MDTM)
+28 ;
+29 IF $GET(RSTYPE)=""
SET RSTYPE="U"
+30 SET RARRAY(365,RSIEN_",",.1)=RSTYPE
+31 ;
+32 ; IB*2*601/DM we've seen this previously set elsewhere
KILL DIERR
+33 DO FILE^DIE("I","RARRAY","ERR")
+34 IF $DATA(ERR("DIERR",1,"TEXT",1))
Begin DoDot:1
+35 SET ERFLG=1
SET MCT=0
SET VEN=0
+36 FOR
SET VEN=$ORDER(ERR("DIERR",VEN))
if 'VEN
QUIT
Begin DoDot:2
+37 SET MCT=MCT+1
SET MSG(MCT)=$GET(ERR("DIERR",VEN,"TEXT",1))
End DoDot:2
+38 ;
+39 SET MCT=MCT+1
SET MSG(MCT)="Please contact the Help Desk and report this problem."
+40 SET XMSUB="Error creating Response"
+41 DO MSG^IBCNEUT5(MGRP,XMSUB,"MSG(")
+42 KILL ERR,VEN,MCT
End DoDot:1
+43 QUIT
+44 ;
TMRR ; Communication Timeout message
+1 IF 'TMSG
QUIT
+2 SET XMSUB="eIV Communication Timeout"
+3 SET MSG(1)="No Response has been received within the defined failure days of "_FAIL_" for "
+4 SET MSG(3)="Patient: "_$PIECE($GET(^DPT(DFN,0)),U,1)_$$SSN(DFN)_" and Payer: "_$PIECE($GET(^IBE(365.12,PAYR,0)),U,1)
+5 ;
+6 DO TXT^IBCNEUT7("MSG")
+7 ;
+8 DO MSG^IBCNEUT5(MGRP,XMSUB,"MSG(")
+9 KILL MSG,XMSUB
+10 QUIT
+11 ;
SSN(DFN) ; Retrieve patient's ssn and return last 4 digits
+1 ; Subsequently added Date of Birth to display as well
+2 if '$GET(DFN)
QUIT ""
+3 NEW SSN,DOB
+4 SET SSN=$$GETSSN^IBCNEDE5(DFN)
+5 SET DOB=$$GETDOB(DFN)
+6 IF SSN=""
IF DOB=""
QUIT ""
+7 IF SSN=""
QUIT " (DOB: "_DOB_")"
+8 SET SSN=" (SSN: xxx-xx-"_$EXTRACT(SSN,6,9)
+9 IF DOB'=""
SET DOB=" DOB: "_DOB
+10 QUIT SSN_DOB_")"
+11 ;
GETDOB(DFN) ;
+1 if '$GET(DFN)
QUIT "Unknown"
+2 NEW DOB
+3 SET DOB=$PIECE($GET(^DPT(DFN,0)),U,3)
+4 SET DOB=$SELECT('DOB:"Unknown",1:$$FMTE^XLFDT(DOB,"5Z"))
+5 QUIT DOB
+6 ;
SCC ; If successfully creates an HL7 msg
+1 SET MSGID=$PIECE(HLRESLT,U,1)
SET NTRAN=NTRAN+1
SET MDTM=$$NOW^XLFDT()
SET IHCNT=IHCNT+1
+2 IF NTRAN>1
SET NRETR=NRETR+1
+3 DO SST^IBCNEUT2(IEN,2)
+4 SET DA=IEN
SET DIE="^IBCN(365.1,"
SET DR=".07////^S X=NTRAN;.08////^S X=NRETR"
+5 DO ^DIE
+6 ;
+7 ; Create Response Record
+8 SET RSTYPE="O"
DO RESP
+9 ;
+10 ; Create HL7 subrecord
+11 DO SUB
+12 ;
+13 ; If a buffer entry exists, set the buffer symbol to a '?'
+14 IF BUFF'=""
DO BUFF^IBCNEUT2(BUFF,10)
+15 QUIT
