1 | IVMZ7CS ;TDM - HL7 Z07 CONSISTENCY CHECKER -- SERVICE SUBROUTINE ; 07/21/06 7:32am
|
---|
2 | ;;2.0;INCOME VERIFICATION MATCH;**105**;JUL 8,1996;Build 2
|
---|
3 | ;
|
---|
4 | ; Service Consistency Checks
|
---|
5 | ; This routine checks the various elements of service information
|
---|
6 | ; prior to building a Z07 record. Any tests which fail consistency
|
---|
7 | ; check will be saved to the ^DGIN(38.6 record for the patient.
|
---|
8 | ;
|
---|
9 | ; Must be called from entry point
|
---|
10 | Q
|
---|
11 | ;
|
---|
12 | EN(DFN,DGP) ; entry point. Patient DFN is sent from calling routine.
|
---|
13 | ; initialize working variables
|
---|
14 | N RULE,Y,X,FILERR
|
---|
15 | ;
|
---|
16 | ; loop through rules in INCONSISTENT DATA ELEMENTS file.
|
---|
17 | ; execute only the rules where CHECK/DON'T CHECK and INCLUDE IN Z07
|
---|
18 | ; CHECKS fields are turned ON.
|
---|
19 | ;
|
---|
20 | ; ***NOTE loop boundary (501-517) must be changed if rule numbers
|
---|
21 | ; are added ***
|
---|
22 | F RULE=501:1:517 I $D(^DGIN(38.6,RULE)) D
|
---|
23 | . S Y=^DGIN(38.6,RULE,0)
|
---|
24 | . I '$P(Y,U,5),$P(Y,U,6) D @RULE
|
---|
25 | I $D(FILERR) M ^TMP($J,DFN)=FILERR
|
---|
26 | Q
|
---|
27 | ;
|
---|
28 | 501 ; POW STATUS INVALID
|
---|
29 | S X=$P(DGP("PAT",.52),U,5) I (X'="")&(X'="Y")&(X'="N")&(X'="U") S FILERR(RULE)=""
|
---|
30 | Q
|
---|
31 | ;
|
---|
32 | 502 ; MIL DIS RETIREMENT INVALID
|
---|
33 | S X=$P(DGP("PAT",.36),U,12) I (X'="")&(X'=0)&(X'=1) S FILERR(RULE)=""
|
---|
34 | Q
|
---|
35 | ;
|
---|
36 | 503 ; DISCHARGE DUE TO DISAB INVALID
|
---|
37 | S X=$P(DGP("PAT",.36),U,13) I (X'="")&(X'=0)&(X'=1) S FILERR(RULE)=""
|
---|
38 | Q
|
---|
39 | ;
|
---|
40 | 504 ; AGENT ORANGE EXPOSURE INVALID
|
---|
41 | S X=$P(DGP("PAT",.321),U,2) I (X'="")&(X'="Y")&(X'="N")&(X'="U") S FILERR(RULE)=""
|
---|
42 | Q
|
---|
43 | ;
|
---|
44 | 505 ; RADIATION EXPOSURE INVALID
|
---|
45 | S X=$P(DGP("PAT",.321),U,3) I (X'="")&(X'="Y")&(X'="N")&(X'="U") S FILERR(RULE)=""
|
---|
46 | Q
|
---|
47 | ;
|
---|
48 | 506 ; ENV CONTAMINANTS EXP INVALID
|
---|
49 | S X=$P(DGP("PAT",.322),U,13) I (X'="")&(X'="Y")&(X'="N")&(X'="U") S FILERR(RULE)=""
|
---|
50 | Q
|
---|
51 | ;
|
---|
52 | 507 ; RAD EXPOSURE METHOD INVALID
|
---|
53 | I $P(DGP("PAT",.321),U,3)="Y" S X=$P(DGP("PAT",.321),U,12) I X'?1N!(X<2)!(X>7) S FILERR(RULE)=""
|
---|
54 | Q
|
---|
55 | ;
|
---|
56 | 508 ; MST STATUS INVALID
|
---|
57 | S X=$P($G(DGP("MST",0)),U,3) I (X'="")&(X'="Y")&(X'="N")&(X'="D")&(X'="U") S FILERR(RULE)=""
|
---|
58 | Q
|
---|
59 | ;
|
---|
60 | 509 ; MST STATUS CHANGE DATE MISSING
|
---|
61 | S X=$P($G(DGP("MST",0)),U,3) I ((X="Y")!(X="N")!(X="D")!(X="U")),$P(DGP("MST",0),U)<1 S FILERR(RULE)=""
|
---|
62 | Q
|
---|
63 | ;
|
---|
64 | 510 ; MST STATUS SITE REQUIRED
|
---|
65 | S X=$P($G(DGP("MST",0)),U,3) I ((X="Y")!(X="N")!(X="D")!(X="U")),$P(DGP("MST",0),U,6)="" S FILERR(RULE)=""
|
---|
66 | Q
|
---|
67 | ;
|
---|
68 | 511 ; MST STATUS SITE INVALID
|
---|
69 | S X=$P($G(DGP("MST",0)),U,6) I X'="",'$$TF^XUAF4(X) S FILERR(RULE)=""
|
---|
70 | Q
|
---|
71 | ;
|
---|
72 | 512 ; AO EXPOSURE LOCATION MISSING
|
---|
73 | ; Note: RULE #60 in IVMZ7CR is a duplicate of this rule
|
---|
74 | Q
|
---|
75 | ;
|
---|
76 | 513 ; MS ENTRY DATE REQUIRED
|
---|
77 | ; Note: RULE #72 in IVMZ7CR is a duplicate of this rule
|
---|
78 | Q
|
---|
79 | ;
|
---|
80 | 514 ; MS SEPARATION DATE REQUIRED
|
---|
81 | ; Note: RULE #72 in IVMZ7CR is a duplicate of this rule
|
---|
82 | Q
|
---|
83 | ;
|
---|
84 | 515 ; CONFLICT FROM/TO DATE REQUIRED
|
---|
85 | ; Note: RULE #74 in IVMZ7CR is a duplicate of this rule
|
---|
86 | Q
|
---|
87 | ;
|
---|
88 | 516 ; DOB INVALID-MEXICAN BORDER WAR
|
---|
89 | N MBW
|
---|
90 | I $D(^DPT(DFN,"E")) D
|
---|
91 | . S MBW=$O(^DIC(8,"B","MEXICAN BORDER WAR","")) Q:MBW=""
|
---|
92 | . S X=0 F S X=$O(^DPT(DFN,"E",X)) Q:(X<1)!$D(FILERR(RULE)) D
|
---|
93 | . . I $P(^DPT(DFN,"E",X,0),U)=MBW,$P(DGP("PAT",0),U,3)>2061231 S FILERR(RULE)=""
|
---|
94 | Q
|
---|
95 | ;
|
---|
96 | 517 ; DOB INVALID-WORLD WAR I
|
---|
97 | N WWI
|
---|
98 | I $D(^DPT(DFN,"E")) D
|
---|
99 | . S WWI=$O(^DIC(8,"B","WORLD WAR I","")) Q:WWI=""
|
---|
100 | . S X=0 F S X=$O(^DPT(DFN,"E",X)) Q:(X<1)!$D(FILERR(RULE)) D
|
---|
101 | . . I $P(^DPT(DFN,"E",X,0),U)=WWI,$P(DGP("PAT",0),U,3)>2071231 S FILERR(RULE)=""
|
---|
102 | Q
|
---|
103 | YM(X) ; Returns whether date has year & month values: 1=yes, 0=no
|
---|
104 | Q ($E(X,1,3)>0)&($E(X,4,5)>0)
|
---|
105 | ;
|
---|
106 | YY(X) ; Returns whether date has year a value: 1=yes, 0=no
|
---|
107 | Q ($E(X,1,3)>0)
|
---|