Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBCNEDEQ

IBCNEDEQ.m

Go to the documentation of this file. 
  1. 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
  1.  ;;Per VA Directive 6402, this routine should not be modified.
  1.  ;
  1.  ;**Program Description**
  1.  ;  This program contains some subroutines for processing a transmission
  1.  ;
  1. HLER ;  HL7 Creation error message
  1.  ;
  1.  ;  Called from IBCNEDEP
  1.  ;
  1.  ;  Parameters
  1.  ;    HLRESLT = Error from GENERATE^HLMA call
  1.  ;    DFN = Patient IEN
  1.  ;    PAYR = Payer IEN
  1.  ;    MGRP = Mail group
  1.  ;    XMSUB = Subject line
  1.  ;    MSG = Message array
  1.  ;
  1.  S HLRESLT="Error - "_$P(HLRESLT,U,2,99)
  1.  S MSG(1)=HLRESLT
  1.  S MSG(2)="occurred when trying to create the outgoing HL7 message for"
  1.  S MSG(3)="Patient: "_$P($G(^DPT(DFN,0)),U,1)_$$SSN(DFN)_" and Payer: "_$P($G(^IBE(365.12,PAYR,0)),U,1)_"."
  1.  S MSG(4)="Please contact the Help Desk and report this problem."
  1.  D TXT^IBCNEUT7("MSG")
  1.  S XMSUB="eIV HL7 Creation Error"
  1.  D MSG^IBCNEUT5(MGRP,XMSUB,"MSG(")
  1.  K XMSUB,MSG,HLRESLT
  1.  Q
  1.  ;
  1. CERR ;  Communication Error Mail Message - No Retries defined
  1.  ;
  1.  ;  Called from IBCNEDEP
  1.  ;
  1.  ;  Parameters
  1.  ;    DFN = Patient IEN
  1.  ;    PAYR = Payer IEN
  1.  ;    FMSG = Failure message flag
  1.  ;    MGRP = Mail group
  1.  ;    XMSUB = Subject line
  1.  ;    MSG = Message array
  1.  ;
  1.  I 'FMSG G CERRQ
  1.  S XMSUB="eIV Communication Error"
  1.  S MSG(1)="VistA was unable to electronically confirm insurance for"
  1.  S MSG(2)="Patient: "_$P($G(^DPT(DFN,0)),U)_$$SSN(DFN)_" and Payer: "_$P($G(^IBE(365.12,PAYR,0)),U)_"."
  1.  S MSG(3)="A single attempt was made to electronically confirm the insurance"
  1.  S MSG(4)="with this payer."
  1.  ;
  1.  D TXT^IBCNEUT7("MSG")
  1.  ;
  1.  D MSG^IBCNEUT5(MGRP,XMSUB,"MSG(")
  1.  K MSG,XMSUB
  1. CERRQ Q
  1.  ;
  1. CERE ;  Communication Error Mail Message - Exceeds Retries
  1.  ;
  1.  ;  Called from IBCNEDEP
  1.  ;
  1.  ;  Parameters
  1.  ;    DFN = Patient IEN
  1.  ;    PAYR = Payer IEN
  1.  ;    FMSG = Failure message flag
  1.  ;    MGRP = Mail group
  1.  ;    XMSUB = Subject line
  1.  ;    MSG = Message array
  1.  ;
  1.  I 'FMSG G CEREQ
  1.  S XMSUB="eIV Communication Error"
  1.  S MSG(1)="VistA was unable to electronically confirm insurance for"
  1.  S MSG(2)="Patient: "_$P($G(^DPT(DFN,0)),U)_$$SSN(DFN)_" and Payer: "_$P($G(^IBE(365.12,PAYR,0)),U)_"."
  1.  ;
  1.  D TXT^IBCNEUT7("MSG")
  1.  ;
  1.  D MSG^IBCNEUT5(MGRP,XMSUB,"MSG(")
  1.  K MSG,XMSUB
  1. CEREQ Q
  1.  ;
  1. SUB ;  Create HL7 subrecord in TQ file
  1.  ;
  1.  ;  Called from tag SCC within this routine
  1.  ;
  1.  ;  Input Parameters
  1.  ;    IEN = the transmission IEN
  1.  ;    RSIEN = the response IEN
  1.  ;    MDTM = the date/time message was created
  1.  ;    MSGID = the HL7 message ID
  1.  ;
  1.  NEW DIC,DIE,X,DA,DLAYGO,Y
  1.  S DIC="^IBCN(365.1,"_IEN_",2,",DIE=DIC,X=MDTM,DA(1)=IEN
  1.  S DLAYGO=365.16,DIC(0)="L",DIC("P")=DLAYGO
  1.  I '$D(^IBCN(365.1,IEN,2,0)) S ^IBCN(365.1,IEN,2,0)="^365.16D^^"
  1.  K DD,DO
  1.  D FILE^DICN
  1.  K DO
  1.  S HIEN=+Y
  1.  S DR=".02////^S X=MSGID;.03////^S X=RSIEN" D ^DIE
  1.  S DA=HIEN D ^DIE
  1.  ;
  1.  K HIEN,RSIEN,DR,MDTM
  1.  Q
  1.  ;
  1. RESP ;  Create Response Record
  1.  ;
  1.  ;  Called from IBCNEHL3 tag SCC within this routine
  1.  ;
  1.  ;  Input Parameters
  1.  ;    MSGID = Message Control ID (required)
  1.  ;    MDTM = Message date/time created (optional)
  1.  ;    DFN = Patient IEN (optional)
  1.  ;    PAYR = Payer IEN (optional)
  1.  ;    BUFF = Buffer IEN (optional)
  1.  ;    IEN = Transmission IEN (optional)
  1.  ;    RSTYPE = Response Type (O=Original, U=Unsolicited)
  1.  ;
  1.  NEW DIC,DIE,X,DA,DLAYGO,Y,RARRAY,ERR
  1.  ;
  1.  S DIC="^IBCN(365,",X=MSGID,DLAYGO=365,DIC(0)="L",DIC("P")=DLAYGO
  1.  K DD,DO
  1.  D FILE^DICN
  1.  K DO
  1.  S RSIEN=+Y
  1.  S RARRAY(365,RSIEN_",",.02)=$G(DFN),RARRAY(365,RSIEN_",",.03)=$G(PAYR)
  1.  I $G(IEN)'="" D
  1.  . I $P(^IBCN(365.1,IEN,0),U,18)=1 S RARRAY(365,RSIEN_",",.04)=$G(BUFF)
  1.  . ; IB*702/TAZ,CKB - set Req Service Date (.14) and Req Service Type Code (.15)
  1.  . S RARRAY(365,RSIEN_",",.14)=$$GET1^DIQ(365.1,IEN_",",.12,"I")
  1.  . S RARRAY(365,RSIEN_",",.15)=$$GET1^DIQ(365.1,IEN_",",.2,"I")
  1.  S RARRAY(365,RSIEN_",",.05)=$G(IEN)
  1.  S RARRAY(365,RSIEN_",",.06)=2,RARRAY(365,RSIEN_",",.08)=$G(MDTM)
  1.  ;
  1.  I $G(RSTYPE)="" S RSTYPE="U"
  1.  S RARRAY(365,RSIEN_",",.1)=RSTYPE
  1.  ;
  1.  K DIERR ; IB*2*601/DM we've seen this previously set elsewhere  
  1.  D FILE^DIE("I","RARRAY","ERR")
  1.  I $D(ERR("DIERR",1,"TEXT",1)) D
  1.  . S ERFLG=1,MCT=0,VEN=0
  1.  . F  S VEN=$O(ERR("DIERR",VEN)) Q:'VEN  D
  1.  .. S MCT=MCT+1,MSG(MCT)=$G(ERR("DIERR",VEN,"TEXT",1))
  1.  . ;
  1.  . S MCT=MCT+1,MSG(MCT)="Please contact the Help Desk and report this problem."
  1.  . S XMSUB="Error creating Response"
  1.  . D MSG^IBCNEUT5(MGRP,XMSUB,"MSG(")
  1.  . K ERR,VEN,MCT
  1.  Q
  1.  ;
  1. TMRR ;  Communication Timeout message
  1.  I 'TMSG Q
  1.  S XMSUB="eIV Communication Timeout"
  1.  S MSG(1)="No Response has been received within the defined failure days of "_FAIL_" for "
  1.  S MSG(3)="Patient: "_$P($G(^DPT(DFN,0)),U,1)_$$SSN(DFN)_" and Payer: "_$P($G(^IBE(365.12,PAYR,0)),U,1)
  1.  ;
  1.  D TXT^IBCNEUT7("MSG")
  1.  ;
  1.  D MSG^IBCNEUT5(MGRP,XMSUB,"MSG(")
  1.  K MSG,XMSUB
  1.  Q
  1.  ;
  1. SSN(DFN) ; Retrieve patient's ssn and return last 4 digits
  1.  ; Subsequently added Date of Birth to display as well
  1.  Q:'$G(DFN) ""
  1.  N SSN,DOB
  1.  S SSN=$$GETSSN^IBCNEDE5(DFN)
  1.  S DOB=$$GETDOB(DFN)
  1.  I SSN="",DOB="" Q ""
  1.  I SSN="" Q " (DOB: "_DOB_")"
  1.  S SSN=" (SSN: xxx-xx-"_$E(SSN,6,9)
  1.  I DOB'="" S DOB="  DOB: "_DOB
  1.  Q SSN_DOB_")"
  1.  ;
  1. GETDOB(DFN) ;
  1.  Q:'$G(DFN) "Unknown"
  1.  N DOB
  1.  S DOB=$P($G(^DPT(DFN,0)),U,3)
  1.  S DOB=$S('DOB:"Unknown",1:$$FMTE^XLFDT(DOB,"5Z"))
  1.  Q DOB
  1.  ;
  1. SCC ;  If successfully creates an HL7 msg
  1.  S MSGID=$P(HLRESLT,U,1),NTRAN=NTRAN+1,MDTM=$$NOW^XLFDT(),IHCNT=IHCNT+1
  1.  I NTRAN>1 S NRETR=NRETR+1
  1.  D SST^IBCNEUT2(IEN,2)
  1.  S DA=IEN,DIE="^IBCN(365.1,",DR=".07////^S X=NTRAN;.08////^S X=NRETR"
  1.  D ^DIE
  1.  ;
  1.  ;  Create Response Record
  1.  S RSTYPE="O" D RESP
  1.  ;
  1.  ;  Create HL7 subrecord
  1.  D SUB
  1.  ;
  1.  ; If a buffer entry exists, set the buffer symbol to a '?'
  1.  I BUFF'="" D BUFF^IBCNEUT2(BUFF,10)
  1.  Q