source: WorldVistAEHR/trunk/r/INCOME_VERIFICATION_MATCH-IVM/IVMPRECA.m@ 738

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

initial load of WorldVistAEHR
File size: 3.7 KB
Line 
1IVMPRECA ;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 ;
14EN ; - 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 ;
51ENQ ; - send acknowledgement (ACK) 'AE' msg to the IVM Center
52 I $D(HLERR) D ACK^IVMPREC
53 Q
54 ;
55 ;
56ADDRCHK ; - 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 ;
82NEXT ; - 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
Note: See TracBrowser for help on using the repository browser.