source: WorldVistAEHR/trunk/r/INCOME_VERIFICATION_MATCH-IVM/IVMPREC3.m

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

initial load of WorldVistAEHR

File size: 3.6 KB
Line 
1IVMPREC3 ;ALB/KCL - PROCESS INCOMING (Z04 EVENT TYPE) HL7 MESSAGES ; 3/6/01 4:33pm
2 ;;2.0;INCOME VERIFICATION MATCH;**3,17,34,111**;21-OCT-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ; This routine will process batch ORU insurance(event type Z04) HL7
6 ; messages received from the IVM center. Format of batch:
7 ; BHS
8 ; {MSH
9 ; PID
10 ; IN1 could be a continuation of IN1
11 ; ZIV
12 ; }
13 ; BTS
14 ;
15EN ; - entry point to process insurance messages
16 ;
17 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
18 .K HLERR
19 .;
20 .; - message control id from MSH segment
21 .S MSGID=$P(IVMSEG,HLFS,10)
22 .;
23 .; - get message segments from (#772) file
24 .S IVMDA=$O(^TMP($J,IVMRTN,IVMDA)),IVMSEG=$G(^(+IVMDA,0)) I $E(IVMSEG,1,3)'="PID" D Q
25 ..S HLERR="Missing PID segment" D ACK^IVMPREC
26 .S DFN=$P($P(IVMSEG,HLFS,4),$E(HLECH),1)
27 .I ('DFN!(DFN'=+DFN)!('$D(^DPT(+DFN,0)))) D Q
28 ..S HLERR="Invalid DFN" D ACK^IVMPREC
29 .I $P(IVMSEG,HLFS,20)'=$P(^DPT(DFN,0),"^",9) D Q
30 ..S HLERR="Couldn't match IVM SSN with DHCP SSN" D ACK^IVMPREC
31 .S IVMDA=$O(^TMP($J,IVMRTN,IVMDA)),IVMSEG=$G(^(+IVMDA,0)) I $E(IVMSEG,1,3)'="IN1" D Q
32 ..S HLERR="Missing IN1 segment" D ACK^IVMPREC
33 .S IVMSEG1=$P(IVMSEG,HLFS,2,999)
34 .I $P(IVMSEG1,HLFS,4)']"" D Q
35 ..S HLERR="Missing insurance company name" D ACK^IVMPREC
36 .I $P(IVMSEG1,HLFS,8)']"",($P(IVMSEG1,HLFS,9)']"") D Q
37 ..S HLERR=$S($P(IVMSEG1,HLFS,7)']"":"Missing group number",1:"Missing group name") D ACK^IVMPREC
38 .I $P(IVMSEG1,HLFS,17)']"" D Q
39 ..S HLERR="Missing insured's relation to patient" D ACK^IVMPREC
40 .I $P(IVMSEG1,HLFS,17)'="v",($P(IVMSEG1,HLFS,16)']"") D Q
41 ..S HLERR="Missing name of insured" D ACK^IVMPREC
42 .S IVMDA=$O(^TMP($J,IVMRTN,IVMDA)),IVMSEG=$G(^(+IVMDA,0)) I $E(IVMSEG,1,3)'="ZIV",$L(IVMSEG1)'=241 D Q
43 ..S HLERR="Missing ZIV segment" D ACK^IVMPREC
44 .I $P(IVMSEG,HLFS,10)']"" D Q
45 ..S HLERR="Missing IVM internal entry number" D ACK^IVMPREC
46 .I $L(IVMSEG1)=241 D Q:$D(IVMERR)
47 ..K IVMERR
48 ..S IVMSEG3=IVMSEG
49 ..S IVMDA=$O(^TMP($J,IVMRTN,IVMDA)),IVMSEG=$G(^(+IVMDA,0))
50 ..I $E(IVMSEG,1,3)'="ZIV" S HLERR="Missing ZIV segment",IVMERR="" D ACK^IVMPREC
51 .;S IVMSEG2=$P(IVMSEG,"^",10)
52 .;
53 .; - check for date of death from IVM
54 .I $P(IVMSEG,"^",13)]"" S $P(IVMSEG,"^",13)=$$FMDATE^HLFNC($P(IVMSEG,"^",13))
55 .;
56 .; - ivm ien/fm date of death
57 .S IVMSEG2=$S($P(IVMSEG,"^",13)']"":$P(IVMSEG,"^",10),1:$P(IVMSEG,"^",10)_"/"_$P(IVMSEG,"^",13))
58 .S IVMDOD=IVMSEG2
59 .;
60 .; - if no error encountered - store insurance fields in VistA
61 .I '$D(HLERR) D
62 ..N IVMRTN,IVMDA
63 ..D STORE
64 ;
65 Q
66 ;
67 ;
68STORE ; - store IN1 segment fields in (#301.5) file and in buffer file
69 ; (remove data from 301.5 'ASEG' xref on successful buffer file filing)
70 ;
71 N IVMI,IVMJ,IVMIN1,IVMADD
72 S DA(1)=$O(^IVM(301.5,"B",DFN,0)),X=$$IEN^IVMUFNC4("IN1")
73 I DA(1)']"" S HLERR="patient missing from IVM PATIENT file" D ACK^IVMPREC Q
74 I X<0 S HLERR="IN1 segment not in HL7 SEGMENT NAME file" D ACK^IVMPREC Q
75 I $G(^IVM(301.5,DA(1),"IN",0))']"" S ^(0)="^301.501PA^^"
76 S DIC="^IVM(301.5,"_DA(1)_",""IN"",",DIC(0)="L"
77 S DIC("DR")=".03///NOW;.07////^S X=IVMSEG2;10////^S X=IVMSEG1",DLAYGO=301.501
78 S:$D(IVMSEG3) DIC("DR")=".03///NOW;.07////^S X=IVMSEG2;10////^S X=IVMSEG1;11////^S X=IVMSEG3"
79 K DD,DO D FILE^DICN K DIC,DLAYGO
80 Q:Y'>0
81 S IVMI=DA(1),IVMJ=+Y
82 ; Patch IVMB*2*111 automatically files the record into the buffer file
83 ; and removes the notification bulletin to IVM and the segment from
84 ; file 301.501
85 K DA,X,Y
86 S IVMIN1=$$GETIN1^IVMLINS1(IVMI,IVMJ),IVMADD=$P(IVMIN1,U,5)
87 D TRANSFER^IVMLINS3(1),IVMQ^IVMLINS1
88 Q
89 ;
Note: See TracBrowser for help on using the repository browser.