source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCNEDEQ.m@ 1464

IBCNEDEQ ;DAOU/ALA - Process Transactions continued ;21-AUG-2002

 ;;2.0;INTEGRATED BILLING;**184,271,300**;21-MAR-94

 ;;Per VHA Directive 10-93-142, 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 log a NOIS for this problem."

 D TXT^IBCNEUT7("MSG")

 S XMSUB="IIV 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="IIV 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="IIV 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

 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)

 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

 ;

 D FILE^DIE("I","RARRAY","ERR")

 I $D(ERR) D

 . S ERFLG=1,MCT=0,VEN=0

 . F  S VEN=$O(ERR("DIERR",VEN)) Q:'VEN  D

 .. S MCT=MCT+1,MSG(MCT)=ERR("DIERR",VEN,"TEXT",1)

 . ;

 . S MCT=MCT+1,MSG(MCT)="Please log a NOIS for 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="IIV 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