| 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
|
|---|
