IVMPREC1 ;ALB/SEK/BRM - PROCESS INCOMING HL7 (ACK) MESSAGES ; 07/28/2003
;;2.0;INCOME VERIFICATION MATCH;**9,17,26,52,34,72,82,129**; 21-OCT-94;Build 4
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
; This routine will process ACK HL7 messages received from the
; IVM center.
;
ACK ; - Receive ACK Message from IVM Center stored in ^TMP("HLR".
; If 1st segment is BHS then set(s) of MSH, MSA(AE) will follow
; indicating error(s) in transmission received by IVM Center
; If 1st segment is MSH than MSA (AA) indicating batch or individual
; query was received ok. MSA (AE) indicates error in transmission of
; individual query.
;
; - When acknowledgment code = "AA" (application accept)
; Stuff 1 into STATUS field (.03) of ^IVM(301.6 indicating IVM Center
; has received transmission.
;
K HLNODE,IVMRTN,SEGCNT,CNT
S IVMRTN="IVMPREC1"
S HLFS=HL("FS"),HLQ=HL("Q"),HLECH=HL("ECH")
K ^TMP($J,IVMRTN)
F SEGCNT=1:1 X HLNEXT Q:HLQUIT'>0 D
. S CNT=0,^TMP($J,IVMRTN,SEGCNT,CNT)=HLNODE
. F S CNT=$O(HLNODE(CNT)) Q:'CNT D
. . S ^TMP($J,IVMRTN,SEGCNT,CNT)=HLNODE(CNT)
S HLDA=HLMTIEN
K HLNODE,SEGCNT,CNT
;
S IVMSEG=$G(^TMP($J,IVMRTN,1,0))
I IVMSEG="" G ACKQ
I $P(IVMSEG,HLFS)'="BHS",$P(IVMSEG,HLFS)'="MSH" G ACKQ
;
; - process batches of acknowledges
I $P(IVMSEG,HLFS)="BHS" D AE G ACKQ
;
; - process MSH MSA message
S IVMSEG=$G(^TMP($J,IVMRTN,2,0))
I $P(IVMSEG,HLFS)'="MSA" G ACKQ
S IVMADDT=$P(IVMSEG,HLFS,3)
I $P(IVMSEG,HLFS,2)="AA" D G ACKQ
.F IVMDA=0:0 S IVMDA=$O(^IVM(301.6,"AE",IVMADDT,IVMDA)) Q:'IVMDA I $$SETSTAT^IVMTLOG(IVMDA,1)
;
I $P(IVMSEG,HLFS,2)="AE" D G ACKQ
.S IVMMCI=$P(IVMSEG,HLFS,3)
.S IVMEM=$P(IVMSEG,HLFS,4)
.S IVMDA=$O(^IVM(301.6,"AE",IVMADDT,"")) I 'IVMDA D OTH Q
.I $$SETSTAT^IVMTLOG(IVMDA,3,IVMEM)
;
ACKQ ;
K ^TMP($J,IVMRTN)
K DA,DIE,DR,IVMADDT,IVMI,IVMCT,IVMDA,IVMMCI,IVMEM,IVMNAME,IVMPAT,IVMRTN,IVMSEG,IVMSSN,IVMTEXT,XMSUB
;
Q
;
AE ; - When acknowledgment code = "AE" (application error)
; Stuff 3 into STATUS field(.03), error message into ERROR MESSAGE
; field(.04), and 1 (NEW) into the ERROR PROCESSING STATUS field.
; Stuff 1 into STATUS field(.03) for transmissions (no 'AE' code
; received) received by IVM Center.
;
N Z07FLG,Z07RET
S IVMI=0 F S IVMI=$O(^TMP($J,IVMRTN,IVMI)) Q:'IVMI S IVMSEG=$G(^(IVMI,0)) D
.D:$E(IVMSEG,1,3)="MSH"
..S Z07RET=0
..I $P(IVMSEG,HLFS,9)["ORU~Z07" S Z07FLG=1 Q
..K Z07FLG
.Q:IVMSEG']""!($E(IVMSEG,1,3)'="MSA")!($P(IVMSEG,HLFS,2)'="AE")
.S IVMMCI=$P(IVMSEG,HLFS,3)
.S IVMEM=$P(IVMSEG,HLFS,4)
.S IVMDA=$O(^IVM(301.6,"ADS",IVMMCI,"")) I 'IVMDA D Q:'Z07RET
..I $D(Z07FLG) D Q
...S Z07RET=$$Z07CHK(IVMI,IVMMCI,IVMEM)
...S:Z07RET IVMDA=$O(^IVM(301.6,"ADS",IVMMCI,""))
..D OTH
.I $$SETSTAT^IVMTLOG(IVMDA,3,IVMEM)
;
; - update messages in batch with no error
F IVMDA=0:0 S IVMDA=$O(^IVM(301.6,"AE",+$G(IVMMCI),IVMDA)) Q:'IVMDA I $$SETSTAT^IVMTLOG(IVMDA,1)
Q
;
OTH ; Generate message for errors other than Full/Initial Transmissions.
N IVMRMM,IVMNAM,IVMPID,IVMMCID,IVMTMP,HLDA,HLDAT,HLSEG,DIC,DR,DA,DIQ
S (IVMNAM,IVMPID,HLDA,IVMTMP)=""
S HLDA=$O(^HL(772,"C",$P($G(IVMMCI),"-"),0))
Q:+$G(HLDA)'>0
Q:'$D(^HL(772,+HLDA,0))
S DIC="^HL(772,",DR=200,DA=HLDA,DR(200.02)=.01,DA(200.02)=17,DIQ="HLDAT"
D EN^DIQ1
F S IVMTMP=$O(HLDAT(772,HLDA,200,IVMTMP)) Q:((IVMTMP="")!($G(HLSEG)="PID")) D
.S HLSEG=$P($G(HLDAT(772,HLDA,200,IVMTMP)),"^")
.I HLSEG="MSH" S IVMMCID=$P($G(HLDAT(772,HLDA,200,IVMTMP)),"^",10)
.D:HLSEG="PID"
..;Find PID segment for the same message control ID only
..I IVMMCID'=IVMMCI S HLSEG="NOT CORRECT PID" Q
..; If PID segment was split, reconnect records
..I $L($G(HLDAT(772,HLDA,200,IVMTMP)))=245,$L($G(HLDAT(772,HLDA,200,IVMTMP)),U)<20 S HLDAT(772,HLDA,200,IVMTMP)=$$REBLDPID("HLDAT(772,"_HLDA_",200)",IVMTMP)
..S IVMNAM=$P($G(HLDAT(772,HLDA,200,IVMTMP)),"^",6) ;PATIENT NAME
..S IVMNAM=$P(IVMNAM,"~")_", "_$P(IVMNAM,"~",2)
..S IVMPID=$P($G(HLDAT(772,HLDA,200,IVMTMP)),"^",20) ;SSN
..;S IVMPID=$P(IVMPID,"~")
..S IVMPID=$E(IVMPID,1,3)_"-"_$E(IVMPID,4,5)_"-"_$E(IVMPID,6,9)
..S XMSUB="ERROR MESSAGE FROM THE HEC"
..S IVMTEXT(1)="An Insurance Confirmation message or a Billing/Collections Transmission"
..S IVMTEXT(2)="was rejected by the Health Eligibility Center with the following error:"
..S IVMTEXT(3)=" ",IVMTEXT(4)=IVMEM,IVMTEXT(5)=" "
..S IVMTEXT(6)="NAME: "_IVMNAM
..S IVMTEXT(7)="PID : "_IVMPID,IVMTEXT(8)=" "
..S IVMRMM=$$MMN^IVMPTRN4($P(IVMMCI,"-"))
..S IVMTEXT(9)="Mailman Message # of Acknowledged Transmission: "_$S(IVMRMM:IVMRMM,1:"<unknown>")
..S IVMTEXT(10)=" "
..S IVMTEXT(11)="If you are unable to find the source of this problem,"
..S IVMTEXT(12)="please contact your ISC Support Group or the HEC."
..D MAIL^IVMUFNC()
Q
;
Z07CHK(CURSEQ,CURMCI,CUREM) ; Function ;
; INPUT
; CURSEQ : Current Sequence # reviewing in batch
; CURMCI : Current Message Control ID reviewing in batch
; CUREM : Current Error Message reviewing in batch
;
; Check for duplicate ACK sequence on the same batch
N SEQ,CHKSEG,CHKSEGN,DUP
S (SEQ,DUP)=0
F S SEQ=$O(^TMP($J,IVMRTN,SEQ)) Q:SEQ="" D
. S CHKSEG=^TMP($J,IVMRTN,SEQ,0),CHKSEGN=$E(CHKSEG,1,3)
. Q:CHKSEGN'="MSA"
. Q:SEQ=CURSEQ
. S:$P(CHKSEG,"^",3)=CURMCI DUP=1
I DUP Q "0^DUPLICATE SEQUENCE ON ACK BATCH"
;
; Check to see if ADS x-ref missing in last 1000 entries
N END,IEN,MCI,FND,LOG,RET,TMPCTR
S FND=0,RET="",IEN=" "
F TMPCTR=1:1:1000 S IEN=$O(^IVM(301.6,IEN),-1) Q:+IEN=0 D Q:FND
. S MCI=$P(^IVM(301.6,IEN,0),"^",5)
. I MCI=CURMCI S FND=1 D Q
. . S LOG=^IVM(301.6,IEN,0)
. . I $P(LOG,"^",3)=3&($P(LOG,"^",4)=CUREM) S RET="0^ACK TO THIS SEQUENCE HAS ALREADY BEEN PROCESSED" Q
. . S ^IVM(301.6,"ADS",CURMCI,IEN)="" S RET="1^ADS X-REF MISSING. X-REF HAS BEEN RESET."
Q RET
;
REBLDPID(ARRAY,SEQ) ; Reconnect the pieces of the PID segment
; ARRAY contains the HL7 message reference to be accessed indirectly
; It should look similar in structure to the HL7 message text in
; file 772
; @ARRAY@(SEQ) should = the first 'PID' segment record text and should
; be 245 characters long
N PID,SEQX
S PID=$G(@ARRAY@(SEQ)),SEQX=SEQ
G:$L(PID)'=245 PIDQ
F S SEQX=$O(@ARRAY@(SEQX)) Q:SEQX="" I $G(@ARRAY@(SEQX))'="" S PID=PID_$G(@ARRAY@(SEQX)) Q
PIDQ Q PID
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIVMPREC1 6438 printed Oct 16, 2024@18:02:56 Page 2
IVMPREC1 ;ALB/SEK/BRM - PROCESS INCOMING HL7 (ACK) MESSAGES ; 07/28/2003
+1 ;;2.0;INCOME VERIFICATION MATCH;**9,17,26,52,34,72,82,129**; 21-OCT-94;Build 4
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
+4 ; This routine will process ACK HL7 messages received from the
+5 ; IVM center.
+6 ;
ACK ; - Receive ACK Message from IVM Center stored in ^TMP("HLR".
+1 ; If 1st segment is BHS then set(s) of MSH, MSA(AE) will follow
+2 ; indicating error(s) in transmission received by IVM Center
+3 ; If 1st segment is MSH than MSA (AA) indicating batch or individual
+4 ; query was received ok. MSA (AE) indicates error in transmission of
+5 ; individual query.
+6 ;
+7 ; - When acknowledgment code = "AA" (application accept)
+8 ; Stuff 1 into STATUS field (.03) of ^IVM(301.6 indicating IVM Center
+9 ; has received transmission.
+10 ;
+11 KILL HLNODE,IVMRTN,SEGCNT,CNT
+12 SET IVMRTN="IVMPREC1"
+13 SET HLFS=HL("FS")
SET HLQ=HL("Q")
SET HLECH=HL("ECH")
+14 KILL ^TMP($JOB,IVMRTN)
+15 FOR SEGCNT=1:1
XECUTE HLNEXT
if HLQUIT'>0
QUIT
Begin DoDot:1
+16 SET CNT=0
SET ^TMP($JOB,IVMRTN,SEGCNT,CNT)=HLNODE
+17 FOR
SET CNT=$ORDER(HLNODE(CNT))
if 'CNT
QUIT
Begin DoDot:2
+18 SET ^TMP($JOB,IVMRTN,SEGCNT,CNT)=HLNODE(CNT)
End DoDot:2
End DoDot:1
+19 SET HLDA=HLMTIEN
+20 KILL HLNODE,SEGCNT,CNT
+21 ;
+22 SET IVMSEG=$GET(^TMP($JOB,IVMRTN,1,0))
+23 IF IVMSEG=""
GOTO ACKQ
+24 IF $PIECE(IVMSEG,HLFS)'="BHS"
IF $PIECE(IVMSEG,HLFS)'="MSH"
GOTO ACKQ
+25 ;
+26 ; - process batches of acknowledges
+27 IF $PIECE(IVMSEG,HLFS)="BHS"
DO AE
GOTO ACKQ
+28 ;
+29 ; - process MSH MSA message
+30 SET IVMSEG=$GET(^TMP($JOB,IVMRTN,2,0))
+31 IF $PIECE(IVMSEG,HLFS)'="MSA"
GOTO ACKQ
+32 SET IVMADDT=$PIECE(IVMSEG,HLFS,3)
+33 IF $PIECE(IVMSEG,HLFS,2)="AA"
Begin DoDot:1
+34 FOR IVMDA=0:0
SET IVMDA=$ORDER(^IVM(301.6,"AE",IVMADDT,IVMDA))
if 'IVMDA
QUIT
IF $$SETSTAT^IVMTLOG(IVMDA,1)
End DoDot:1
GOTO ACKQ
+35 ;
+36 IF $PIECE(IVMSEG,HLFS,2)="AE"
Begin DoDot:1
+37 SET IVMMCI=$PIECE(IVMSEG,HLFS,3)
+38 SET IVMEM=$PIECE(IVMSEG,HLFS,4)
+39 SET IVMDA=$ORDER(^IVM(301.6,"AE",IVMADDT,""))
IF 'IVMDA
DO OTH
QUIT
+40 IF $$SETSTAT^IVMTLOG(IVMDA,3,IVMEM)
End DoDot:1
GOTO ACKQ
+41 ;
ACKQ ;
+1 KILL ^TMP($JOB,IVMRTN)
+2 KILL DA,DIE,DR,IVMADDT,IVMI,IVMCT,IVMDA,IVMMCI,IVMEM,IVMNAME,IVMPAT,IVMRTN,IVMSEG,IVMSSN,IVMTEXT,XMSUB
+3 ;
+4 QUIT
+5 ;
AE ; - When acknowledgment code = "AE" (application error)
+1 ; Stuff 3 into STATUS field(.03), error message into ERROR MESSAGE
+2 ; field(.04), and 1 (NEW) into the ERROR PROCESSING STATUS field.
+3 ; Stuff 1 into STATUS field(.03) for transmissions (no 'AE' code
+4 ; received) received by IVM Center.
+5 ;
+6 NEW Z07FLG,Z07RET
+7 SET IVMI=0
FOR
SET IVMI=$ORDER(^TMP($JOB,IVMRTN,IVMI))
if 'IVMI
QUIT
SET IVMSEG=$GET(^(IVMI,0))
Begin DoDot:1
+8 if $EXTRACT(IVMSEG,1,3)="MSH"
Begin DoDot:2
+9 SET Z07RET=0
+10 IF $PIECE(IVMSEG,HLFS,9)["ORU~Z07"
SET Z07FLG=1
QUIT
+11 KILL Z07FLG
End DoDot:2
+12 if IVMSEG']""!($EXTRACT(IVMSEG,1,3)'="MSA")!($PIECE(IVMSEG,HLFS,2)'="AE")
QUIT
+13 SET IVMMCI=$PIECE(IVMSEG,HLFS,3)
+14 SET IVMEM=$PIECE(IVMSEG,HLFS,4)
+15 SET IVMDA=$ORDER(^IVM(301.6,"ADS",IVMMCI,""))
IF 'IVMDA
Begin DoDot:2
+16 IF $DATA(Z07FLG)
Begin DoDot:3
+17 SET Z07RET=$$Z07CHK(IVMI,IVMMCI,IVMEM)
+18 if Z07RET
SET IVMDA=$ORDER(^IVM(301.6,"ADS",IVMMCI,""))
End DoDot:3
QUIT
+19 DO OTH
End DoDot:2
if 'Z07RET
QUIT
+20 IF $$SETSTAT^IVMTLOG(IVMDA,3,IVMEM)
End DoDot:1
+21 ;
+22 ; - update messages in batch with no error
+23 FOR IVMDA=0:0
SET IVMDA=$ORDER(^IVM(301.6,"AE",+$GET(IVMMCI),IVMDA))
if 'IVMDA
QUIT
IF $$SETSTAT^IVMTLOG(IVMDA,1)
+24 QUIT
+25 ;
OTH ; Generate message for errors other than Full/Initial Transmissions.
+1 NEW IVMRMM,IVMNAM,IVMPID,IVMMCID,IVMTMP,HLDA,HLDAT,HLSEG,DIC,DR,DA,DIQ
+2 SET (IVMNAM,IVMPID,HLDA,IVMTMP)=""
+3 SET HLDA=$ORDER(^HL(772,"C",$PIECE($GET(IVMMCI),"-"),0))
+4 if +$GET(HLDA)'>0
QUIT
+5 if '$DATA(^HL(772,+HLDA,0))
QUIT
+6 SET DIC="^HL(772,"
SET DR=200
SET DA=HLDA
SET DR(200.02)=.01
SET DA(200.02)=17
SET DIQ="HLDAT"
+7 DO EN^DIQ1
+8 FOR
SET IVMTMP=$ORDER(HLDAT(772,HLDA,200,IVMTMP))
if ((IVMTMP="")!($GET(HLSEG)="PID"))
QUIT
Begin DoDot:1
+9 SET HLSEG=$PIECE($GET(HLDAT(772,HLDA,200,IVMTMP)),"^")
+10 IF HLSEG="MSH"
SET IVMMCID=$PIECE($GET(HLDAT(772,HLDA,200,IVMTMP)),"^",10)
+11 if HLSEG="PID"
Begin DoDot:2
+12 ;Find PID segment for the same message control ID only
+13 IF IVMMCID'=IVMMCI
SET HLSEG="NOT CORRECT PID"
QUIT
+14 ; If PID segment was split, reconnect records
+15 IF $LENGTH($GET(HLDAT(772,HLDA,200,IVMTMP)))=245
IF $LENGTH($GET(HLDAT(772,HLDA,200,IVMTMP)),U)<20
SET HLDAT(772,HLDA,200,IVMTMP)=$$REBLDPID("HLDAT(772,"_HLDA_",200)",IVMTMP)
+16 ;PATIENT NAME
SET IVMNAM=$PIECE($GET(HLDAT(772,HLDA,200,IVMTMP)),"^",6)
+17 SET IVMNAM=$PIECE(IVMNAM,"~")_", "_$PIECE(IVMNAM,"~",2)
+18 ;SSN
SET IVMPID=$PIECE($GET(HLDAT(772,HLDA,200,IVMTMP)),"^",20)
+19 ;S IVMPID=$P(IVMPID,"~")
+20 SET IVMPID=$EXTRACT(IVMPID,1,3)_"-"_$EXTRACT(IVMPID,4,5)_"-"_$EXTRACT(IVMPID,6,9)
+21 SET XMSUB="ERROR MESSAGE FROM THE HEC"
+22 SET IVMTEXT(1)="An Insurance Confirmation message or a Billing/Collections Transmission"
+23 SET IVMTEXT(2)="was rejected by the Health Eligibility Center with the following error:"
+24 SET IVMTEXT(3)=" "
SET IVMTEXT(4)=IVMEM
SET IVMTEXT(5)=" "
+25 SET IVMTEXT(6)="NAME: "_IVMNAM
+26 SET IVMTEXT(7)="PID : "_IVMPID
SET IVMTEXT(8)=" "
+27 SET IVMRMM=$$MMN^IVMPTRN4($PIECE(IVMMCI,"-"))
+28 SET IVMTEXT(9)="Mailman Message # of Acknowledged Transmission: "_$SELECT(IVMRMM:IVMRMM,1:"<unknown>")
+29 SET IVMTEXT(10)=" "
+30 SET IVMTEXT(11)="If you are unable to find the source of this problem,"
+31 SET IVMTEXT(12)="please contact your ISC Support Group or the HEC."
+32 DO MAIL^IVMUFNC()
End DoDot:2
End DoDot:1
+33 QUIT
+34 ;
Z07CHK(CURSEQ,CURMCI,CUREM) ; Function ;
+1 ; INPUT
+2 ; CURSEQ : Current Sequence # reviewing in batch
+3 ; CURMCI : Current Message Control ID reviewing in batch
+4 ; CUREM : Current Error Message reviewing in batch
+5 ;
+6 ; Check for duplicate ACK sequence on the same batch
+7 NEW SEQ,CHKSEG,CHKSEGN,DUP
+8 SET (SEQ,DUP)=0
+9 FOR
SET SEQ=$ORDER(^TMP($JOB,IVMRTN,SEQ))
if SEQ=""
QUIT
Begin DoDot:1
+10 SET CHKSEG=^TMP($JOB,IVMRTN,SEQ,0)
SET CHKSEGN=$EXTRACT(CHKSEG,1,3)
+11 if CHKSEGN'="MSA"
QUIT
+12 if SEQ=CURSEQ
QUIT
+13 if $PIECE(CHKSEG,"^",3)=CURMCI
SET DUP=1
End DoDot:1
+14 IF DUP
QUIT "0^DUPLICATE SEQUENCE ON ACK BATCH"
+15 ;
+16 ; Check to see if ADS x-ref missing in last 1000 entries
+17 NEW END,IEN,MCI,FND,LOG,RET,TMPCTR
+18 SET FND=0
SET RET=""
SET IEN=" "
+19 FOR TMPCTR=1:1:1000
SET IEN=$ORDER(^IVM(301.6,IEN),-1)
if +IEN=0
QUIT
Begin DoDot:1
+20 SET MCI=$PIECE(^IVM(301.6,IEN,0),"^",5)
+21 IF MCI=CURMCI
SET FND=1
Begin DoDot:2
+22 SET LOG=^IVM(301.6,IEN,0)
+23 IF $PIECE(LOG,"^",3)=3&($PIECE(LOG,"^",4)=CUREM)
SET RET="0^ACK TO THIS SEQUENCE HAS ALREADY BEEN PROCESSED"
QUIT
+24 SET ^IVM(301.6,"ADS",CURMCI,IEN)=""
SET RET="1^ADS X-REF MISSING. X-REF HAS BEEN RESET."
End DoDot:2
QUIT
End DoDot:1
if FND
QUIT
+25 QUIT RET
+26 ;
REBLDPID(ARRAY,SEQ) ; Reconnect the pieces of the PID segment
+1 ; ARRAY contains the HL7 message reference to be accessed indirectly
+2 ; It should look similar in structure to the HL7 message text in
+3 ; file 772
+4 ; @ARRAY@(SEQ) should = the first 'PID' segment record text and should
+5 ; be 245 characters long
+6 NEW PID,SEQX
+7 SET PID=$GET(@ARRAY@(SEQ))
SET SEQX=SEQ
+8 if $LENGTH(PID)'=245
GOTO PIDQ
+9 FOR
SET SEQX=$ORDER(@ARRAY@(SEQX))
if SEQX=""
QUIT
IF $GET(@ARRAY@(SEQX))'=""
SET PID=PID_$GET(@ARRAY@(SEQX))
QUIT
PIDQ QUIT PID
+1 ;
