| 1 | IBCNEHLI ;DAOU/ALA - Incoming HL7 messages ;16-JUN-2002
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**184,252,251,271,300**;21-MAR-94
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | ;**Program Description**
|
|---|
| 6 | ; This program parses each incoming HL7 message.
|
|---|
| 7 | ;
|
|---|
| 8 | EN ; Starting point - put message into a TMP global
|
|---|
| 9 | ;
|
|---|
| 10 | N ACK,BUFF,DFN,ERACT,ERCON,ERFLG,ERTXT,EVENT,HCT,HLECH,HLEID
|
|---|
| 11 | N HLEIDS,HLFS,HLQ,IBPRTCL,IDUZ,MGRP,MSGID,RDAT0,RIEN,SBDEP,SEG
|
|---|
| 12 | N SEGMT,SEGMT2,TAG,TQN,TRACE,VRFDT,DISYS,IPCT,PAYRID,PIEN,CNT
|
|---|
| 13 | N ERROR,IRIEN,RSTYPE,SUBID,TQIEN
|
|---|
| 14 | N DA,EBDA,IBFDA,II,MSGP,SYMBOL,IBSEG,PP,PRIEN,QFL,IBIEN,TQDATA,IBQFL
|
|---|
| 15 | N DATAMFK,EPHARM
|
|---|
| 16 | ;
|
|---|
| 17 | K ^TMP($J,"IBCNEHLI")
|
|---|
| 18 | F SEGCNT=1:1 X HLNEXT Q:HLQUIT'>0 D
|
|---|
| 19 | . S CNT=0
|
|---|
| 20 | . S ^TMP($J,"IBCNEHLI",SEGCNT,CNT)=HLNODE
|
|---|
| 21 | . F S CNT=$O(HLNODE(CNT)) Q:'CNT D
|
|---|
| 22 | .. S ^TMP($J,"IBCNEHLI",SEGCNT,CNT)=HLNODE(CNT)
|
|---|
| 23 | ;
|
|---|
| 24 | ; Get the IIV user
|
|---|
| 25 | S IDUZ=$$FIND1^DIC(200,"","X","INTERFACE,IB IIV")
|
|---|
| 26 | ; Determine which protocol to use
|
|---|
| 27 | S SEGMT=$G(^TMP($J,"IBCNEHLI",1,0))
|
|---|
| 28 | I $E(SEGMT,1,3)'="MSH" D D ERR Q
|
|---|
| 29 | . S MSG(1)="MSH Segment is not the first segment found"
|
|---|
| 30 | . S MSG(2)="Please log a NOIS for this problem."
|
|---|
| 31 | S HLFS=$E(SEGMT,4)
|
|---|
| 32 | S EVENT=$P(SEGMT,HLFS,9),IBPRTCL=""
|
|---|
| 33 | ;
|
|---|
| 34 | ; The event type determines protocol
|
|---|
| 35 | I EVENT="MFN^M01" S TAG="TBL",IBPRTCL="IBCNE IIV MFN IN"
|
|---|
| 36 | I EVENT="RPI^I01" S TAG="RSP",IBPRTCL="IBCNE IIV IN" I '$$HL7VAL G XIT
|
|---|
| 37 | I EVENT="MFK^M01" S TAG="ACK",IBPRTCL="IBCNE IIV REGISTER"
|
|---|
| 38 | I IBPRTCL="" S MSG(1)="Unable to find a protocol for Event = "_EVENT D ERR G XIT
|
|---|
| 39 | ; S HLEID=$$HLP^IBCNEHLU(IBPRTCL)
|
|---|
| 40 | ;
|
|---|
| 41 | ; Initialize the HL7 variables
|
|---|
| 42 | D INIT^HLFNC2(IBPRTCL,.HL)
|
|---|
| 43 | ; S HLEIDS=$O(^ORD(101,HLEID,775,"B",0))
|
|---|
| 44 | ;
|
|---|
| 45 | ; Call the event tag
|
|---|
| 46 | D @TAG
|
|---|
| 47 | ;
|
|---|
| 48 | XIT K ^TMP($J,"IBCNEHLI"),HL,HLNEXT,HLNODE,HLQUIT,SEGCNT
|
|---|
| 49 | Q
|
|---|
| 50 | ;
|
|---|
| 51 | TBL ; Table Update Processing
|
|---|
| 52 | D ^IBCNEHLT
|
|---|
| 53 | ;
|
|---|
| 54 | I ERFLG D ERR
|
|---|
| 55 | K ERFLG
|
|---|
| 56 | ;
|
|---|
| 57 | ; Send MFK Message (Application Acknowledgement)?
|
|---|
| 58 | I HL("APAT")="AL",$G(EPHARM) D ^IBCNRMFK
|
|---|
| 59 | Q
|
|---|
| 60 | ;
|
|---|
| 61 | RSP ; Response Processing
|
|---|
| 62 | D ^IBCNEHL1
|
|---|
| 63 | ;
|
|---|
| 64 | K ACK,BUFF,DFN,ERACT,ERCON,ERFLG,ERTXT,EVENT,HCT,HL,HLECH,HLEID
|
|---|
| 65 | K HLEIDS,HLFS,HLQ,IBPRTCL,IDUZ,MGRP,MSGID,RDAT0,RIEN,SBDEP,SEG
|
|---|
| 66 | K SEGMT,SEGMT2,TAG,TQN,TRACE,VRFDT,DISYS,IPCT,PAYRID,PIEN
|
|---|
| 67 | K ERROR,IRIEN,RSTYPE,SUBID,TQIEN
|
|---|
| 68 | K DA,EBDA,IBFDA,II,MSGP,SYMBOL,IBSEG,PP,PRIEN,QFL
|
|---|
| 69 | Q
|
|---|
| 70 | ;
|
|---|
| 71 | ACK ; Acknowledgement Processing
|
|---|
| 72 | D ^IBCNEHLK
|
|---|
| 73 | ;
|
|---|
| 74 | Q
|
|---|
| 75 | ;
|
|---|
| 76 | ERR ; Process an error
|
|---|
| 77 | S MGRP=$$MGRP^IBCNEUT5()
|
|---|
| 78 | D MSG^IBCNEUT5(MGRP,"INCOMING IIV HL7 PROBLEM","MSG(")
|
|---|
| 79 | K MSG,MGRP
|
|---|
| 80 | Q
|
|---|
| 81 | ;
|
|---|
| 82 | HL7VAL() ; Check for valid post 300 response
|
|---|
| 83 | N X,HCT
|
|---|
| 84 | S X=0,HCT=0
|
|---|
| 85 | F S HCT=$O(^TMP($J,"IBCNEHLI",HCT)) Q:HCT="" D SPAR^IBCNEHLU I $G(IBSEG(1))="PRD" S X=1 Q
|
|---|
| 86 | Q X
|
|---|
