source: WorldVistAEHR/trunk/r/INCOME_VERIFICATION_MATCH-IVM/IVMPREC4.m@ 623

Last change on this file since 623 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.4 KB
Line 
1IVMPREC4 ;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 ;
14EN ; 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
Note: See TracBrowser for help on using the repository browser.