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

IBCNEHLI.m

Go to the documentation of this file.
  1. IBCNEHLI ;DAOU/ALA - Incoming HL7 messages ;16-JUN-2002
  1. ;;2.0;INTEGRATED BILLING;**184,252,251,271,300,416,550,601,621**;21-MAR-94;Build 14
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. ;**Program Description**
  1. ; This program parses each incoming HL7 message.
  1. ;
  1. EN ; Starting point - put message into a TMP global
  1. ;
  1. N ACK,BUFF,DFN,ERACT,ERCON,ERFLG,ERTXT,EVENT,HCT,HLECH,HLEID
  1. N HLEIDS,HLFS,HLQ,IBPRTCL,IDUZ,MGRP,MSGID,RDAT0,RIEN,SBDEP,SEG
  1. N SEGMT,SEGMT2,TAG,TQN,TRACE,VRFDT,DISYS,IPCT,PAYRID,PIEN,CNT
  1. N ERROR,IRIEN,RSTYPE,SUBID,TQIEN
  1. N DA,EBDA,IBFDA,II,MSGP,SYMBOL,IBSEG,PP,PRIEN,QFL,IBIEN,TQDATA,IBQFL
  1. N DATAMFK,EPHARM
  1. ;
  1. K ^TMP($J,"IBCNEHLI")
  1. F SEGCNT=1:1 X HLNEXT Q:HLQUIT'>0 D
  1. . S CNT=0
  1. . S ^TMP($J,"IBCNEHLI",SEGCNT,CNT)=HLNODE
  1. . F S CNT=$O(HLNODE(CNT)) Q:'CNT D
  1. .. S ^TMP($J,"IBCNEHLI",SEGCNT,CNT)=HLNODE(CNT)
  1. ;
  1. ; Get the eIV user
  1. S IDUZ=$$FIND1^DIC(200,"","X","INTERFACE,IB EIV")
  1. ; Determine which protocol to use
  1. S SEGMT=$G(^TMP($J,"IBCNEHLI",1,0))
  1. I $E(SEGMT,1,3)'="MSH" D D ERR Q
  1. . S MSG(1)="MSH Segment is not the first segment found"
  1. . S MSG(2)="Please call the Help Desk and report this problem."
  1. S HLFS=$E(SEGMT,4)
  1. S EVENT=$P(SEGMT,HLFS,9),IBPRTCL=""
  1. ;
  1. ; The event type determines protocol
  1. ; IB*2.0*601 - Added logic for MFN^M01 event
  1. I EVENT="MFN^M01" S TAG="TBL",IBPRTCL="IBCNE IIV MFN IN"
  1. I EVENT="RPI^I01" S TAG="RSP",IBPRTCL="IBCNE IIV IN" I '$$HL7VAL G XIT
  1. I EVENT="MFK^M01" S TAG="ACK",IBPRTCL="IBCNE IIV REGISTER"
  1. ;IB*2.0*621/TAZ - Added new event
  1. I EVENT="PIN^I07" S TAG="EICD",IBPRTCL="IBCNE EIV PIN-I07 IN"
  1. I IBPRTCL="" S MSG(1)="Unable to find a protocol for Event = "_EVENT D ERR G XIT
  1. ;
  1. ; Initialize the HL7 variables
  1. D INIT^HLFNC2(IBPRTCL,.HL)
  1. ;
  1. ; Call the event tag
  1. D @TAG
  1. ;
  1. XIT K ^TMP($J,"IBCNEHLI"),HL,HLNEXT,HLNODE,HLQUIT,SEGCNT,EVENTYP
  1. Q
  1. ;
  1. TBL ; Table Update Processing
  1. N IBACK
  1. S IBACK="AE"
  1. D ^IBCNEHLT
  1. ;
  1. I ERFLG D ERR
  1. K ERFLG
  1. ;
  1. D ACK^IBCNEHLK
  1. Q
  1. ;
  1. RSP ; Response Processing
  1. D EN^IBCNEHL1(2) ;IB*2.0*621 Added Parameter
  1. ;
  1. K ACK,BUFF,DFN,ERACT,ERCON,ERFLG,ERTXT,EVENT,HCT,HL,HLECH,HLEID
  1. K HLEIDS,HLFS,HLQ,IBPRTCL,IDUZ,MGRP,MSGID,RDAT0,RIEN,SBDEP,SEG
  1. K SEGMT,SEGMT2,TAG,TQN,TRACE,VRFDT,DISYS,IPCT,PAYRID,PIEN
  1. K ERROR,IRIEN,RSTYPE,SUBID,TQIEN
  1. K DA,EBDA,IBFDA,II,MSGP,SYMBOL,IBSEG,PP,PRIEN,QFL
  1. Q
  1. ;
  1. ;IB*2.0*621/TAZ - Added section to process the EICD Inquiry Response.
  1. EICD ; Insurance Discovery Inquiry Response.
  1. D EN^IBCNEHL1(1)
  1. ;
  1. K ACK,BUFF,DFN,ERACT,ERCON,ERFLG,ERTXT,EVENT,HCT,HL,HLECH,HLEID
  1. K HLEIDS,HLFS,HLQ,IBPRTCL,IDUZ,MGRP,MSGID,RDAT0,RIEN,SBDEP,SEG
  1. K SEGMT,SEGMT2,TAG,TQN,TRACE,VRFDT,DISYS,IPCT,PAYRID,PIEN
  1. K ERROR,IRIEN,RSTYPE,SUBID,TQIEN
  1. K DA,EBDA,IBFDA,II,MSGP,SYMBOL,IBSEG,PP,PRIEN,QFL,IBTRACK,TRKIEN
  1. Q
  1. ;
  1. ACK ; Acknowledgement Processing
  1. D ^IBCNEHLK
  1. ;
  1. Q
  1. ;
  1. ERR ; Process an error
  1. S MGRP=$$MGRP^IBCNEUT5()
  1. D MSG^IBCNEUT5(MGRP,"INCOMING eIV HL7 PROBLEM","MSG(")
  1. K MSG,MGRP
  1. Q
  1. ;
  1. HL7VAL() ; Check for valid post 300 response
  1. N X,HCT
  1. S X=0,HCT=0
  1. F S HCT=$O(^TMP($J,"IBCNEHLI",HCT)) Q:HCT="" D SPAR^IBCNEHLU I $G(IBSEG(1))="PRD" S X=1 Q
  1. Q X