1 | IVMPREC4 ;ALB/KCL - PROCESS INCOMING (Z08 EVENT TYPE) HL7 MESSAGES ; 3/6/01 4:38pm
|
---|
2 | ;;2.0;INCOME VERIFICATION MATCH;**34**;21-OCT-94
|
---|
3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
---|
4 | ;
|
---|
5 | ; This routine will process batch ORU Case Status(event type Z08) HL7
|
---|
6 | ; messages received from the IVM center. Format of batch:
|
---|
7 | ; BHS
|
---|
8 | ; {MSH
|
---|
9 | ; PID
|
---|
10 | ; ZIV
|
---|
11 | ; }
|
---|
12 | ; BTS
|
---|
13 | ;
|
---|
14 | EN ; entry point to process case status messages
|
---|
15 | ;
|
---|
16 | 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
|
---|
17 | .K HLERR
|
---|
18 | .S HLMID=$P(IVMSEG,HLFS,10) ; message control id from MSH
|
---|
19 | .S IVMDA=$O(^TMP($J,IVMRTN,IVMDA)),IVMSEG=$G(^(+IVMDA,0)) I $E(IVMSEG,1,3)'="PID" D Q
|
---|
20 | ..S HLERR="Missing PID segment" D ACK^IVMPREC
|
---|
21 | .S DFN=$P($P(IVMSEG,HLFS,4),$E(HLECH),1)
|
---|
22 | .I ('DFN!(DFN'=+DFN)!('$D(^DPT(+DFN,0)))) D Q
|
---|
23 | ..S HLERR="Invalid DFN" D ACK^IVMPREC
|
---|
24 | .I $P(IVMSEG,HLFS,20)'=$P(^DPT(DFN,0),"^",9) D Q
|
---|
25 | ..S HLERR="Couldn't match IVM SSN with DHCP SSN" D ACK^IVMPREC
|
---|
26 | .S IVMDA=$O(^TMP($J,IVMRTN,IVMDA)),IVMSEG=$G(^(+IVMDA,0)) I $E(IVMSEG,1,3)'="ZIV" D Q
|
---|
27 | ..S HLERR="Missing ZIV segment" D ACK^IVMPREC
|
---|
28 | .S IVMSEG=$P(IVMSEG,HLFS,2,999),IVMIY=$P(IVMSEG,HLFS,2)
|
---|
29 | .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
|
---|
30 | .I $P(IVMSEG,HLFS,8)'=1 D Q
|
---|
31 | ..S HLERR="Case Status not 1" D ACK^IVMPREC
|
---|
32 | .D CLOSE^IVMPTRN1(IVMIY,DFN,1,4)
|
---|
33 | Q
|
---|