1 | IVMPREC3 ;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 | ;
|
---|
15 | EN ; - 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 | ;
|
---|
68 | STORE ; - 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 | ;
|
---|