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

Last change on this file since 1259 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.5 KB
Line 
1IBCNEHLI ;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 ;
8EN ; 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 ;
48XIT K ^TMP($J,"IBCNEHLI"),HL,HLNEXT,HLNODE,HLQUIT,SEGCNT
49 Q
50 ;
51TBL ; 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 ;
61RSP ; 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 ;
71ACK ; Acknowledgement Processing
72 D ^IBCNEHLK
73 ;
74 Q
75 ;
76ERR ; 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 ;
82HL7VAL() ; 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
Note: See TracBrowser for help on using the repository browser.