IVMPREC4 ;ALB/KCL - PROCESS INCOMING (Z08 EVENT TYPE) HL7 MESSAGES ; 3/6/01 4:38pm
;;2.0;INCOME VERIFICATION MATCH;**34**;21-OCT-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
; This routine will process batch ORU Case Status(event type Z08) HL7
; messages received from the IVM center. Format of batch:
; BHS
; {MSH
; PID
; ZIV
; }
; BTS
;
EN ; entry point to process case status messages
;
F IVMDA=1:0 S IVMDA=$O(^TMP($J,IVMRTN,IVMDA)) Q:'IVMDA S IVMSEG=$G(^(IVMDA,0)) I $E(IVMSEG,1,3)="MSH" D
.K HLERR
.S HLMID=$P(IVMSEG,HLFS,10) ; message control id from MSH
.S IVMDA=$O(^TMP($J,IVMRTN,IVMDA)),IVMSEG=$G(^(+IVMDA,0)) I $E(IVMSEG,1,3)'="PID" D Q
..S HLERR="Missing PID segment" D ACK^IVMPREC
.S DFN=$P($P(IVMSEG,HLFS,4),$E(HLECH),1)
.I ('DFN!(DFN'=+DFN)!('$D(^DPT(+DFN,0)))) D Q
..S HLERR="Invalid DFN" D ACK^IVMPREC
.I $P(IVMSEG,HLFS,20)'=$P(^DPT(DFN,0),"^",9) D Q
..S HLERR="Couldn't match IVM SSN with DHCP SSN" D ACK^IVMPREC
.S IVMDA=$O(^TMP($J,IVMRTN,IVMDA)),IVMSEG=$G(^(+IVMDA,0)) I $E(IVMSEG,1,3)'="ZIV" D Q
..S HLERR="Missing ZIV segment" D ACK^IVMPREC
.S IVMSEG=$P(IVMSEG,HLFS,2,999),IVMIY=$P(IVMSEG,HLFS,2)
.S IVMIY=$$FMDATE^HLFNC(IVMIY) I $E(IVMIY,4,7)'="0000"!($E(IVMIY,1,3)<292) S HLERR="Invalid Income Year" D ACK^IVMPREC Q
.I $P(IVMSEG,HLFS,8)'=1 D Q
..S HLERR="Case Status not 1" D ACK^IVMPREC
.D CLOSE^IVMPTRN1(IVMIY,DFN,1,4)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIVMPREC4 1484 printed Apr 09, 2024@21:03:43 Page 2
IVMPREC4 ;ALB/KCL - PROCESS INCOMING (Z08 EVENT TYPE) HL7 MESSAGES ; 3/6/01 4:38pm
+1 ;;2.0;INCOME VERIFICATION MATCH;**34**;21-OCT-94
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
+4 ; This routine will process batch ORU Case Status(event type Z08) HL7
+5 ; messages received from the IVM center. Format of batch:
+6 ; BHS
+7 ; {MSH
+8 ; PID
+9 ; ZIV
+10 ; }
+11 ; BTS
+12 ;
EN ; entry point to process case status messages
+1 ;
+2 FOR IVMDA=1:0
SET IVMDA=$ORDER(^TMP($JOB,IVMRTN,IVMDA))
if 'IVMDA
QUIT
SET IVMSEG=$GET(^(IVMDA,0))
IF $EXTRACT(IVMSEG,1,3)="MSH"
Begin DoDot:1
+3 KILL HLERR
+4 ; message control id from MSH
SET HLMID=$PIECE(IVMSEG,HLFS,10)
+5 SET IVMDA=$ORDER(^TMP($JOB,IVMRTN,IVMDA))
SET IVMSEG=$GET(^(+IVMDA,0))
IF $EXTRACT(IVMSEG,1,3)'="PID"
Begin DoDot:2
+6 SET HLERR="Missing PID segment"
DO ACK^IVMPREC
End DoDot:2
QUIT
+7 SET DFN=$PIECE($PIECE(IVMSEG,HLFS,4),$EXTRACT(HLECH),1)
+8 IF ('DFN!(DFN'=+DFN)!('$DATA(^DPT(+DFN,0))))
Begin DoDot:2
+9 SET HLERR="Invalid DFN"
DO ACK^IVMPREC
End DoDot:2
QUIT
+10 IF $PIECE(IVMSEG,HLFS,20)'=$PIECE(^DPT(DFN,0),"^",9)
Begin DoDot:2
+11 SET HLERR="Couldn't match IVM SSN with DHCP SSN"
DO ACK^IVMPREC
End DoDot:2
QUIT
+12 SET IVMDA=$ORDER(^TMP($JOB,IVMRTN,IVMDA))
SET IVMSEG=$GET(^(+IVMDA,0))
IF $EXTRACT(IVMSEG,1,3)'="ZIV"
Begin DoDot:2
+13 SET HLERR="Missing ZIV segment"
DO ACK^IVMPREC
End DoDot:2
QUIT
+14 SET IVMSEG=$PIECE(IVMSEG,HLFS,2,999)
SET IVMIY=$PIECE(IVMSEG,HLFS,2)
+15 SET IVMIY=$$FMDATE^HLFNC(IVMIY)
IF $EXTRACT(IVMIY,4,7)'="0000"!($EXTRACT(IVMIY,1,3)<292)
SET HLERR="Invalid Income Year"
DO ACK^IVMPREC
QUIT
+16 IF $PIECE(IVMSEG,HLFS,8)'=1
Begin DoDot:2
+17 SET HLERR="Case Status not 1"
DO ACK^IVMPREC
End DoDot:2
QUIT
+18 DO CLOSE^IVMPTRN1(IVMIY,DFN,1,4)
End DoDot:1
+19 QUIT
