1 | IVMPRECA ;ALB/KCL/BRM/PJR/RGL - DEMOGRAPHICS MESSAGE CONSISTENCY CHECK ; 2/4/04 10:00am
|
---|
2 | ;;2.0; INCOME VERIFICATION MATCH ;**5,6,12,34,58,56**; 21-OCT-94
|
---|
3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
---|
4 | ;
|
---|
5 | ; This routine will perform data validation checks on uploadable
|
---|
6 | ; demographic fields received from the IVM Center to ensure they
|
---|
7 | ; are acurate prior to their upload into DHCP.
|
---|
8 | ;
|
---|
9 | ;
|
---|
10 | ; Called from routine IVMPREC6 before uploadable demographic fields
|
---|
11 | ; are stored in DHCP.
|
---|
12 | ;
|
---|
13 | ;
|
---|
14 | EN ; - Entry point to create temp array and perform msg consistency checks
|
---|
15 | ;
|
---|
16 | N DFN,IVMCNTY,IVMCR,IVMEG,IVMFLAG,IVMFLD,IVMNUM,IVMSTR,IVMSTPTR,X
|
---|
17 | S IVMNUM=IVMDA ; 'current' line in ^HL(772,"IN",...
|
---|
18 | ;
|
---|
19 | ; - check the format of the HL7 demographic message
|
---|
20 | D NEXT I $E(IVMSTR,1,3)'="PID" S HLERR="Missing PID segment" G ENQ
|
---|
21 | S IVMSTR("PID")=$P(IVMSTR,HLFS,2,999)
|
---|
22 | D NEXT I $E(IVMSTR,1,3)'="ZPD" S HLERR="Missing ZPD segment" G ENQ
|
---|
23 | S IVMSTR("ZPD")=$P(IVMSTR,HLFS,2,999)
|
---|
24 | D NEXT I $E(IVMSTR,1,3)="ZEL" S HLERR="ZEL segment should not be sent in Z05 message" G ENQ
|
---|
25 | I $E(IVMSTR,1,3)'="ZGD" S HLERR="Missing ZGD segment" G ENQ
|
---|
26 | S IVMSTR("ZGD")=$P(IVMSTR,HLFS,2,999)
|
---|
27 | ;
|
---|
28 | ; - perform field validation checks for PID segment
|
---|
29 | S DFN=$P($P(IVMSTR("PID"),HLFS,3),$E(HLECH),1)
|
---|
30 | I ('DFN!(DFN'=+DFN)!('$D(^DPT(+DFN,0)))) S HLERR="Invalid DFN" G ENQ
|
---|
31 | I $P(IVMSTR("PID"),HLFS,19)'=$P(^DPT(DFN,0),"^",9) S HLERR="Couldn't match IVM SSN with DHCP SSN" G ENQ
|
---|
32 | ;
|
---|
33 | S X=$P(IVMSTR("PID"),HLFS,7) I X]"",($$FMDATE^HLFNC(X)>DT) S HLERR="Date of Birth greater than current date" G ENQ
|
---|
34 | ;
|
---|
35 | S X=$P(IVMSTR("PID"),HLFS,8) I X]"",X'="M",X'="F" S HLERR="Invalid code sent for Patient sex" G ENQ
|
---|
36 | ;
|
---|
37 | ; - if address - perform validation checks on addr fields
|
---|
38 | S X=$P(IVMSTR("PID"),HLFS,11)
|
---|
39 | S IVMFLAG=0 F IVMFLD=1:1:5 I $P(X,$E(HLECH),IVMFLD)]"" S IVMFLAG=1 Q
|
---|
40 | I IVMFLAG D ADDRCHK
|
---|
41 | G ENQ:$D(HLERR)
|
---|
42 | ;
|
---|
43 | S X=$P(IVMSTR("PID"),HLFS,13) I X]"",(($L(X)>20)!($L(X)<4)) S HLERR="Invalid phone number" G ENQ
|
---|
44 | ;
|
---|
45 | ; - perform field validation check for ZPD and ZGD segment
|
---|
46 | ; - I X]"" was changed to I X below for IVM*2*56
|
---|
47 | S X=$P(IVMSTR("ZPD"),HLFS,9) I X,($$FMDATE^HLFNC(X)<$P($G(^DPT(+DFN,0)),"^",3))!($$FMDATE^HLFNC(X)>$$DT^XLFDT) S HLERR="Invalid date of death" G ENQ
|
---|
48 | S X=$P(IVMSTR("ZGD"),HLFS,2) I X,X'=1 S HLERR="Invalid Guardian Type" G ENQ
|
---|
49 | ;
|
---|
50 | ;
|
---|
51 | ENQ ; - send acknowledgement (ACK) 'AE' msg to the IVM Center
|
---|
52 | I $D(HLERR) D ACK^IVMPREC
|
---|
53 | Q
|
---|
54 | ;
|
---|
55 | ;
|
---|
56 | ADDRCHK ; - validate address fields sent by IVM Center
|
---|
57 | ;
|
---|
58 | I $P(X,$E(HLECH),1)']"" S HLERR="Invalid address - Missing street address [line 1]" Q
|
---|
59 | I $P(X,$E(HLECH),3)']"" S HLERR="Invalid address - Missing city" Q
|
---|
60 | I $P(X,$E(HLECH),4)']"" S HLERR="Invalid address - Missing state abbreviation" Q
|
---|
61 | I $P(X,$E(HLECH),5)']"" S HLERR="Invalid address - Missing zip code" Q
|
---|
62 | S IVMCNTY=$P(IVMSTR("PID"),HLFS,12)
|
---|
63 | I IVMCNTY']"" S HLERR="Invalid address - Missing county code" Q
|
---|
64 | I $L($P(X,$E(HLECH),1))>35!($L($P(X,$E(HLECH),1))<3) S HLERR="Invalid street address [line 1]" Q
|
---|
65 | I $P(X,$E(HLECH),2)]"",(($L($P(X,$E(HLECH),2))>30)!($L($P(X,$E(HLECH),2))<3)) S HLERR="Invalid street address [line 2]" Q
|
---|
66 | I $L($P(X,$E(HLECH),3))>15!($L($P(X,$E(HLECH),3))<2) S HLERR="Invalid city" Q
|
---|
67 | ;
|
---|
68 | ; - save state pointer for county code validation
|
---|
69 | S IVMSTPTR=+$O(^DIC(5,"C",$P(X,$E(HLECH),4),0))
|
---|
70 | I 'IVMSTPTR S HLERR="Invalid state abbreviation" Q
|
---|
71 | I '$O(^DIC(5,IVMSTPTR,1,"C",IVMCNTY,0)) D Q:$G(HLERR)]""
|
---|
72 | .N STFIPS
|
---|
73 | .S STFIPS=IVMSTPTR
|
---|
74 | .S:$L(STFIPS)<2 STFIPS="0"_STFIPS
|
---|
75 | .Q:$$FIPSCHK^XIPUTIL(STFIPS_IVMCNTY) ;county code is valid
|
---|
76 | .S HLERR="Invalid county code"
|
---|
77 | ;
|
---|
78 | S X=$P(X,$E(HLECH),5) D ZIPIN^VAFADDR I $D(X)[0 S HLERR="Invalid zip code" Q
|
---|
79 | Q
|
---|
80 | ;
|
---|
81 | ;
|
---|
82 | NEXT ; - get the next HL7 segment in the message from HL7 Transmission (#772) file
|
---|
83 | S IVMNUM=$O(^TMP($J,IVMRTN,IVMNUM)),IVMSTR=$G(^(+IVMNUM,0))
|
---|
84 | Q
|
---|