IBRFIHLI ;TDM/DAL - Incoming HL7 messages ; 12/30/15 11:45am
;;2.0;INTEGRATED BILLING;**547**;21-MAR-94;Build 119
;;Per VA Directive 6402, this routine should not be modified.
;
;**Program Description**
; This program parses each incoming HL7 message.
;
EN ; Starting point - put message into a TMP global
;
N ACK,BUFF,DFN,ERACT,ERCON,ERFLG,ERTXT,EVENT,HCT,HLECH,HLEID
N HLEIDS,HLFS,HLQ,IBPRTCL,IDUZ,MGRP,MSGID,RDAT0,RIEN,SBDEP,SEG
N SEGMT,SEGMT2,TAG,TQN,TRACE,VRFDT,DISYS,IPCT,PAYRID,PIEN,CNT
N ERROR,IRIEN,RSTYPE,SUBID,TQIEN
N DA,EBDA,IBFDA,II,MSGP,SYMBOL,IBSEG,PP,PRIEN,QFL,IBIEN,TQDATA,IBQFL
N DATA,OBXDATA,PSLDATA,HLQUIT,HLNODE,HLNEXT
;
S HLQUIT=0,HLNODE="",HLNEXT="D HLNEXT^HLCSUTL"
K ^TMP($J,"IBRFIHLI")
F SEGCNT=1:1 X HLNEXT Q:HLQUIT'>0 D
.S CNT=0
.S ^TMP($J,"IBRFIHLI",SEGCNT,CNT)=HLNODE
.F S CNT=$O(HLNODE(CNT)) Q:'CNT D
..S ^TMP($J,"IBRFIHLI",SEGCNT,CNT)=HLNODE(CNT)
;
; Get the interface user
S IDUZ=$$FIND1^DIC(200,"","X","INTERFACE,IB RFI")
; Determine which protocol to use
S SEGMT=$G(^TMP($J,"IBRFIHLI",1,0))
Q:$E(SEGMT,1,3)'="MSH"
S HLFS=$E(SEGMT,4)
S EVENT=$P(SEGMT,HLFS,9),IBPRTCL=""
;
; The event type determines protocol
I EVENT="EHC^E12" S IBPRTCL="IBRFI 277 IN"
;
; Initialize the HL7 variables
D INIT^HLFNC2(IBPRTCL,.HL)
;
; Call the event tag
D PROC
;
XIT K ^TMP($J,"IBRFIHLI"),HL,HLNEXT,HLNODE,HLQUIT,SEGCNT
Q
;
PROC ; Process message
D ^IBRFIHL1
;
K ACK,BUFF,DFN,ERACT,ERCON,ERFLG,ERTXT,EVENT,HCT,HL,HLECH,HLEID
K HLEIDS,HLFS,HLQ,IBPRTCL,IDUZ,MGRP,MSGID,RDAT0,RIEN,SBDEP,SEG
K SEGMT,SEGMT2,TAG,TQN,TRACE,VRFDT,DISYS,IPCT,PAYRID,PIEN
K ERROR,IRIEN,RSTYPE,SUBID,TQIEN
K DA,EBDA,IBFDA,II,MSGP,SYMBOL,IBSEG,PP,PRIEN,QFL
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBRFIHLI 1758 printed Dec 13, 2024@02:26:47 Page 2
IBRFIHLI ;TDM/DAL - Incoming HL7 messages ; 12/30/15 11:45am
+1 ;;2.0;INTEGRATED BILLING;**547**;21-MAR-94;Build 119
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ;**Program Description**
+5 ; This program parses each incoming HL7 message.
+6 ;
EN ; Starting point - put message into a TMP global
+1 ;
+2 NEW ACK,BUFF,DFN,ERACT,ERCON,ERFLG,ERTXT,EVENT,HCT,HLECH,HLEID
+3 NEW HLEIDS,HLFS,HLQ,IBPRTCL,IDUZ,MGRP,MSGID,RDAT0,RIEN,SBDEP,SEG
+4 NEW SEGMT,SEGMT2,TAG,TQN,TRACE,VRFDT,DISYS,IPCT,PAYRID,PIEN,CNT
+5 NEW ERROR,IRIEN,RSTYPE,SUBID,TQIEN
+6 NEW DA,EBDA,IBFDA,II,MSGP,SYMBOL,IBSEG,PP,PRIEN,QFL,IBIEN,TQDATA,IBQFL
+7 NEW DATA,OBXDATA,PSLDATA,HLQUIT,HLNODE,HLNEXT
+8 ;
+9 SET HLQUIT=0
SET HLNODE=""
SET HLNEXT="D HLNEXT^HLCSUTL"
+10 KILL ^TMP($JOB,"IBRFIHLI")
+11 FOR SEGCNT=1:1
XECUTE HLNEXT
if HLQUIT'>0
QUIT
Begin DoDot:1
+12 SET CNT=0
+13 SET ^TMP($JOB,"IBRFIHLI",SEGCNT,CNT)=HLNODE
+14 FOR
SET CNT=$ORDER(HLNODE(CNT))
if 'CNT
QUIT
Begin DoDot:2
+15 SET ^TMP($JOB,"IBRFIHLI",SEGCNT,CNT)=HLNODE(CNT)
End DoDot:2
End DoDot:1
+16 ;
+17 ; Get the interface user
+18 SET IDUZ=$$FIND1^DIC(200,"","X","INTERFACE,IB RFI")
+19 ; Determine which protocol to use
+20 SET SEGMT=$GET(^TMP($JOB,"IBRFIHLI",1,0))
+21 if $EXTRACT(SEGMT,1,3)'="MSH"
QUIT
+22 SET HLFS=$EXTRACT(SEGMT,4)
+23 SET EVENT=$PIECE(SEGMT,HLFS,9)
SET IBPRTCL=""
+24 ;
+25 ; The event type determines protocol
+26 IF EVENT="EHC^E12"
SET IBPRTCL="IBRFI 277 IN"
+27 ;
+28 ; Initialize the HL7 variables
+29 DO INIT^HLFNC2(IBPRTCL,.HL)
+30 ;
+31 ; Call the event tag
+32 DO PROC
+33 ;
XIT KILL ^TMP($JOB,"IBRFIHLI"),HL,HLNEXT,HLNODE,HLQUIT,SEGCNT
+1 QUIT
+2 ;
PROC ; Process message
+1 DO ^IBRFIHL1
+2 ;
+3 KILL ACK,BUFF,DFN,ERACT,ERCON,ERFLG,ERTXT,EVENT,HCT,HL,HLECH,HLEID
+4 KILL HLEIDS,HLFS,HLQ,IBPRTCL,IDUZ,MGRP,MSGID,RDAT0,RIEN,SBDEP,SEG
+5 KILL SEGMT,SEGMT2,TAG,TQN,TRACE,VRFDT,DISYS,IPCT,PAYRID,PIEN
+6 KILL ERROR,IRIEN,RSTYPE,SUBID,TQIEN
+7 KILL DA,EBDA,IBFDA,II,MSGP,SYMBOL,IBSEG,PP,PRIEN,QFL
+8 QUIT
