- 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 Mar 13, 2025@21:31: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
