BPSJHLI ;BHAM ISC/LJF - Incoming HL7 E-PHARM messages ;21-NOV-2003
;;1.0;E CLAIMS MGMT ENGINE;**1,20**;JUN 2004;Build 27
;;Per VA Directive 6402, this routine should not be modified.
;
;**Program Description**
; This program processes incoming HL7 message.
;
EN ; Starting point - put message into a TMP global
N SEGCNT,CNT,SEGMT,EVENT,MSG,MCT,FSHLI
N HCT,ERRFLAG,BPSJSEG,BPSFILE1,BPSFLN1,IDUZ,APP,HLECH,HLFS,HLQ,SEG
;
K ^TMP($J,"BPSJHLI") S MCT=0
F SEGCNT=1:1 X HLNEXT Q:HLQUIT'>0 D
. S CNT=0,^TMP($J,"BPSJHLI",SEGCNT,CNT)=HLNODE
. F S CNT=$O(HLNODE(CNT)) Q:'CNT D
.. S ^TMP($J,"BPSJHLI",SEGCNT,CNT)=HLNODE(CNT)
;
; Check MSH seg
S SEGMT=$G(^TMP($J,"BPSJHLI",1,0))
S FSHLI=$G(HL("FS")) I FSHLI="" S (FS,FSHLI)=$E(SEGMT,4)
;
I $E(SEGMT,1,3)'="MSH" D D MSG^BPSJUTL(.MSG,"BPSJHLI") G EXIT
. S MCT=MCT+1,MSG(MCT)="MSH Segment is not the first segment found"
;
S EVENT=$P(SEGMT,FSHLI,9)
;
S HLECH=$$GET1^DIQ(771,$$GET1^DIQ(101,$G(HL("EID")),770.1,"I"),101)
I HLECH="" S HLECH=$G(HL("ECH"))
S HLFS=$G(HL("FS"),"|"),HLQ=$G(HL("Q"),""),HCT=1,ERRFLAG=0,APP=""
F D Q:'HCT I ERRFLAG Q
. K BPSJSEG S HCT=$O(^TMP($J,"BPSJHLI",HCT))
. D SPAR^BPSJUTL(.HL,.BPSJSEG,HCT) S SEG=$G(BPSJSEG(1))
. ;
. I SEG="MFI" D Q
.. S BPSFILE1=$G(BPSJSEG(2))
.. S BPSFLN1=$P(BPSFILE1,"^")
.. I ",366.01,366.02,366.03,"[(","_BPSFLN1_",") D Q
... S APP="TABLE"
... ;
... ; Set non-human user to POSTMASTER
... S IDUZ=.5
;
I EVENT="MFK^M01",APP="TABLE" G EXIT
;
; Acknowledgement Processing
I EVENT="MFK^M01" D EN^BPSJACK(.HL) G EXIT
;
; Table Update Processing for Payer Sheets
I EVENT="MFN^M01" D
. S HL("HLMTIENS")=$G(HLMTIENS)
. D EN^BPSJHLT(.HL)
;
EXIT ;
K ^TMP($J,"BPSJHLI"),SEGCNT,CNT,HL,HLREC,HLNEXT,HLNODE
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HBPSJHLI 1802 printed Oct 16, 2024@17:51:48 Page 2
BPSJHLI ;BHAM ISC/LJF - Incoming HL7 E-PHARM messages ;21-NOV-2003
+1 ;;1.0;E CLAIMS MGMT ENGINE;**1,20**;JUN 2004;Build 27
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ;**Program Description**
+5 ; This program processes incoming HL7 message.
+6 ;
EN ; Starting point - put message into a TMP global
+1 NEW SEGCNT,CNT,SEGMT,EVENT,MSG,MCT,FSHLI
+2 NEW HCT,ERRFLAG,BPSJSEG,BPSFILE1,BPSFLN1,IDUZ,APP,HLECH,HLFS,HLQ,SEG
+3 ;
+4 KILL ^TMP($JOB,"BPSJHLI")
SET MCT=0
+5 FOR SEGCNT=1:1
XECUTE HLNEXT
if HLQUIT'>0
QUIT
Begin DoDot:1
+6 SET CNT=0
SET ^TMP($JOB,"BPSJHLI",SEGCNT,CNT)=HLNODE
+7 FOR
SET CNT=$ORDER(HLNODE(CNT))
if 'CNT
QUIT
Begin DoDot:2
+8 SET ^TMP($JOB,"BPSJHLI",SEGCNT,CNT)=HLNODE(CNT)
End DoDot:2
End DoDot:1
+9 ;
+10 ; Check MSH seg
+11 SET SEGMT=$GET(^TMP($JOB,"BPSJHLI",1,0))
+12 SET FSHLI=$GET(HL("FS"))
IF FSHLI=""
SET (FS,FSHLI)=$EXTRACT(SEGMT,4)
+13 ;
+14 IF $EXTRACT(SEGMT,1,3)'="MSH"
Begin DoDot:1
+15 SET MCT=MCT+1
SET MSG(MCT)="MSH Segment is not the first segment found"
End DoDot:1
DO MSG^BPSJUTL(.MSG,"BPSJHLI")
GOTO EXIT
+16 ;
+17 SET EVENT=$PIECE(SEGMT,FSHLI,9)
+18 ;
+19 SET HLECH=$$GET1^DIQ(771,$$GET1^DIQ(101,$GET(HL("EID")),770.1,"I"),101)
+20 IF HLECH=""
SET HLECH=$GET(HL("ECH"))
+21 SET HLFS=$GET(HL("FS"),"|")
SET HLQ=$GET(HL("Q"),"")
SET HCT=1
SET ERRFLAG=0
SET APP=""
+22 FOR
Begin DoDot:1
+23 KILL BPSJSEG
SET HCT=$ORDER(^TMP($JOB,"BPSJHLI",HCT))
+24 DO SPAR^BPSJUTL(.HL,.BPSJSEG,HCT)
SET SEG=$GET(BPSJSEG(1))
+25 ;
+26 IF SEG="MFI"
Begin DoDot:2
+27 SET BPSFILE1=$GET(BPSJSEG(2))
+28 SET BPSFLN1=$PIECE(BPSFILE1,"^")
+29 IF ",366.01,366.02,366.03,"[(","_BPSFLN1_",")
Begin DoDot:3
+30 SET APP="TABLE"
+31 ;
+32 ; Set non-human user to POSTMASTER
+33 SET IDUZ=.5
End DoDot:3
QUIT
End DoDot:2
QUIT
End DoDot:1
if 'HCT
QUIT
IF ERRFLAG
QUIT
+34 ;
+35 IF EVENT="MFK^M01"
IF APP="TABLE"
GOTO EXIT
+36 ;
+37 ; Acknowledgement Processing
+38 IF EVENT="MFK^M01"
DO EN^BPSJACK(.HL)
GOTO EXIT
+39 ;
+40 ; Table Update Processing for Payer Sheets
+41 IF EVENT="MFN^M01"
Begin DoDot:1
+42 SET HL("HLMTIENS")=$GET(HLMTIENS)
+43 DO EN^BPSJHLT(.HL)
End DoDot:1
+44 ;
EXIT ;
+1 KILL ^TMP($JOB,"BPSJHLI"),SEGCNT,CNT,HL,HLREC,HLNEXT,HLNODE
+2 QUIT
