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

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

initial load of WorldVistAEHR

File size: 7.2 KB
Line 
1IVMZ7CCD ;BAJ - HL7 Z07 CONSISTENCY CHECKER -- CATASTROPHIC DISABILITY SUBROUTINE ; 11/9/05 9:30am
2 ;;2.0;INCOME VERIFICATION MATCH;**105**;JUL 8,1996;Build 2
3 ;
4 ; Catastrophic Disability Consistency Checks
5 ; This routine checks the various elements of catastrophic disability information
6 ; prior to building a Z07 record. Any tests which fail consistency check will be
7 ; saved to the ^DGIN(38.6 record for the patient.
8 ;
9 ;
10 ; Must be called from entry point
11 Q
12 ;
13EN(DFN) ; entry point. Patient DFN is sent from calling routine.
14 ; initialize working variables
15 N RULE,Y,DGCDIS,PASS,FILERR
16 ; patient array DGCDIS can be populated by a call to $$GET^DGENCDA(DFN,.DGCDIS) as follows:
17 ;
18 ; S PASS=$$GET^DGENCDA(DFN,.DGCDIS)
19 ;
20 ; and creates an array similar to this:
21 ; DGCDIS("BY")="DR. JOHN"
22 ; DGCDIS("COND",1)="48"
23 ; DGCDIS("DATE")="3050926"
24 ; DGCDIS("DIAG",1)="8"
25 ; DGCDIS("DTFACIRV")=""
26 ; DGCDIS("DTVETNOT")=""
27 ; DGCDIS("FACDET")="16660"
28 ; DGCDIS("METDET")="3"
29 ; DGCDIS("PERM",1)="1"
30 ; DGCDIS("REVDTE")="3050926"
31 ; DGCDIS("SCORE",1)="6"
32 ; DGCDIS("VCD")="Y"
33 ; DGCDIS("VETREQDT")=""
34 ;
35 ; if the patient has no CD data on file, the API will return the following:
36 ; DGCDIS=""
37 ; DGCDIS("BY")=""
38 ; DGCDIS("DATE")=""
39 ; DGCDIS("DTFACIRV")=""
40 ; DGCDIS("DTVETNOT")=""
41 ; DGCDIS("FACDET")=""
42 ; DGCDIS("METDET")=""
43 ; DGCDIS("REVDTE")=""
44 ; DGCDIS("VCD")=""
45 ; DGCDIS("VETREQDT")=""
46 ;
47 S PASS=$$GET^DGENCDA(DFN,.DGCDIS)
48 ;
49 ; In cases where patient is not listed as catastrophically disabled, routine should check to see if patient could potentially
50 ; qualify for CD. If patient qualifies and is not listed as CD, an inconsistency should be filed. Otherwise continue.
51 ; If patient is not listed as CD, regardless of potential, further checks are not necessary as the rest depend on CD="YES"
52 ;
53 I '$$CD(DGCDIS("VCD")="Y") D Q
54 . I $D(FILERR) D FILE
55 ;
56 ; loop through rules in INCONSISTENT DATA ELEMENTS file.
57 ; execute only the rules where CHECK/DON'T CHECK and INCLUDE IN Z07 CHECKS fields are turned ON.
58 ;
59 ; ***NOTE loop boundary (701-726) must be changed if rule numbers are added ***
60 F RULE=701:1:726 I $D(^DGIN(38.6,RULE)) D
61 . S Y=^DGIN(38.6,RULE,0)
62 . I '$P(Y,"^",5),$P(Y,"^",6) D @RULE
63 I $D(FILERR) D FILE
64 Q
65 ;
66CD(VCD) ; Is Patient Catastrophically disabled? If not, we need to examine patient's record to see if qualified for CD
67 ; Whether qualified or not, if patient is listed as NOT CD, the rest of the rules should not be checked. Therefore,
68 ; if DGCDIS("VCD") does not = "Y" system will exit after this rule without checking any further.
69 I VCD Q 1
70 I $$ISCD^DGENCDA1(.DGCDIS) S FILERR(720)=""
71 Q 0
72 ;
73701 ;Catastrophic Disability 'Decided By' Cannot be 'HINQ'
74 I $G(DGCDIS("BY"))="HINQ" S FILERR(RULE)=""
75 Q
76 ;
77702 ;Catastrophic Disability 'Decided By' not valid
78 I ($L(DGCDIS("BY"))<3)!($L(DGCDIS("BY"))>35) S FILERR(RULE)=""
79 Q
80703 ;"Catastrophic Disability 'Decided By' required"
81 I $G(DGCDIS("BY"))="" S FILERR(RULE)=""
82 Q
83 ;
84704 ;"Catastrophic Disability Review Date Required"
85 I $G(DGCDIS("REVDTE"))="" S FILERR(RULE)=""
86 Q
87 ;
88705 ;"Catastrophic Disability Review Date Invalid"
89 N RESULT
90 D CHK^DIE(2,.394,,DGCDIS("REVDTE"),.RESULT)
91 I RESULT="^" S FILERR(RULE)=""
92 Q
93 ;
94706 ;"CD Condition Score not valid"
95 N ITEM,ERR
96 S ITEM="",ERR=0
97 F S ITEM=$O(DGCDIS("COND",ITEM)) Q:ITEM="" D
98 . I '$$VALID^DGENA5(DGCDIS("COND",ITEM),$G(DGCDIS("SCORE",ITEM))) S ERR=1
99 I ERR S FILERR(RULE)=""
100 Q
101 ;
102707 ;"CD Review Date greater than CD Date of Determination"
103 I $G(DGCDIS("REVDTE"))>$G(DGCDIS("DATE")) S FILERR(RULE)=""
104 Q
105 ;
106708 ;"CD Status Affected Extremity' Invalid"
107 N ITEM,EIEN,ERR
108 S ITEM="",ERR=0
109 F S ITEM=$O(DGCDIS("PROC",ITEM)) Q:ITEM="" D
110 . S EIEN="" F S EIEN=$O(DGCDIS("EXT",ITEM,EIEN)) Q:EIEN="" D
111 . . I '$$LIMBOK^DGENA5(DGCDIS("PROC",ITEM),DGCDIS("EXT",ITEM,EIEN)) S ERR=1
112 I ERR S FILERR(RULE)=""
113 Q
114 ;
115709 ;"CD Status Diagnoses' Not Valid"
116 ; .396 CD STATUS DIAGNOSES field (multiple):
117 N ITEM,ERR
118 S ITEM="",ERR=0
119 F S ITEM=$O(DGCDIS("DIAG",ITEM)) Q:ITEM="" D
120 . I $$TYPE^DGENA5(DGCDIS("DIAG",ITEM))'="D" S ERR=1
121 I ERR S FILERR(RULE)=""
122 Q
123 ;
124710 ;"'CD Status Procedure' Not Valid"
125 ; .397 CD STATUS PROCEDURES field (multiple):
126 N ITEM,ERR
127 S ITEM="",ERR=0
128 F S ITEM=$O(DGCDIS("PROC",ITEM)) Q:ITEM="" D
129 . I $$TYPE^DGENA5(DGCDIS("PROC",ITEM))'="P" S ERR=1
130 I ERR S FILERR(RULE)=""
131 Q
132 ;
133711 ;"'CD Status Reason' Not Present"
134 I '($D(DGCDIS("DIAG"))!$D(DGCDIS("PROC"))!$D(DGCDIS("COND"))) S FILERR(RULE)=""
135 Q
136 ;
137712 ;"'Date Of Catastophic Disability Decision' Not Valid"
138 N RESULT,OK,EXTERNAL
139 S OK=0
140 I $G(DGCDIS("DATE"))'="" S OK=1 D
141 . S EXTERNAL=$$EXTERNAL^DILFD(2,.392,"",DGCDIS("DATE"))
142 . I EXTERNAL="" S OK=0 Q
143 . D CHK^DIE(2,.392,,EXTERNAL,.RESULT) I RESULT="^" S OK=0
144 I 'OK S FILERR(RULE)=""
145 Q
146 ;
147713 ;"'Date Of Catastophic Disability Decision' Required"
148 I $G(DGCDIS("DATE"))="" S FILERR(RULE)=""
149 Q
150 ;
151714 ;"'Facility Making Catastrophic Disability Determination' Not Valid"
152 I DGCDIS("VCD")'=""!(DGCDIS("FACDET")'=""),$$EXTERNAL^DILFD(2,.393,"",$G(DGCDIS("FACDET")))="" S FILERR(RULE)=""
153 Q
154 ;
155715 ;"'Method Of Determination' Is A Required Value"
156 I $G(DGCDIS("METDET"))="" S FILERR(RULE)=""
157 Q
158 ;
159716 ;"'Method Of Determination' Not Valid"
160 I ".2.3."'[("."_$G(DGCDIS("METDET"))_".") S FILERR(RULE)=""
161 Q
162 ;
163717 ;"Not Enough Diagnoses/Procedures/Conditions To Qualify For CD Status"
164 I '$$ISCD^DGENCDA1(.DGCDIS) S FILERR(RULE)=""
165 Q
166 ;
167718 ;"Permanent Status Indicator' Not Valid"
168 N ITEM
169 S ITEM="" F S ITEM=$O(DGCDIS("COND",ITEM)) Q:ITEM="" D
170 . I ".1.2.3."'[("."_DGCDIS("PERM",ITEM)_".") S FILERR(RULE)=""
171 Q
172 ;
173719 ;"'Veteran Catastrophically Disabled?' Field Must Have A Response"
174 ; .39 VETERAN CATASTROPHICALLY DISABLED? field.
175 I DGCDIS("VCD")="" S FILERR(RULE)=""
176 Q
177 ;
178720 ;"Veteran Has Enough Diagnoses/Procedures/Conditions To Qualify For CD Status"
179 ; We check this rule at the beginning of the routine. No need to check it here,
180 ; but we need the label as a place holder.
181 Q
182 ;
183723 ;"Catastrophic Disability Review date must be a precise date"
184 N RESULT
185 D CHK^DIE(2,.394,,DGCDIS("REVDTE"),.RESULT)
186 I RESULT="^" S FILERR(RULE)=""
187 Q
188 ;
189724 ;"Catastrophic Disability Date of Decision must be a precise date"
190 N RESULT
191 D CHK^DIE(2,.392,,DGCDIS("DATE"),.RESULT)
192 I RESULT="^" S FILERR(RULE)=""
193 Q
194 ;
195725 ;"Catastrophic Disability Procedure code must be accompanied with an Affected Extremity field"
196 ; Procedure list = DGCDIS("PROC",ITEM)
197 ; Affected Extremity list = DGCDIS("EXT",ITEM)
198 ; This tag makes sure that there is at least one Affected Extremity for each procedure code.
199 N ITEM,ERR
200 S ERR=0,ITEM=""
201 F S ITEM=$O(DGCDIS("PROC",ITEM)) Q:ITEM="" D
202 . I '$D(DGCDIS("EXT",ITEM)) S ERR=1 Q
203 . I $G(DGCDIS("EXT",ITEM))="" S ERR=1
204 I ERR S FILERR(RULE)=""
205 Q
206 ;
207726 ;"Catastrophic Disablity condition code requires a Score field"
208 ; Condition list = DGCDIS("COND",ITEM)
209 ; Score list = DGCDIS("SCORE",ITEM)
210 N ITEM,ERR
211 S ERR=0,ITEM=""
212 F S ITEM=$O(DGCDIS("COND",ITEM)) Q:ITEM="" D
213 . I '$D(DGCDIS("SCORE",ITEM)) S ERR=1 Q
214 . I $G(DGCDIS("SCORE",ITEM))="" S ERR=1
215 I ERR S FILERR(RULE)=""
216 Q
217 ;
218FILE ;file the inconsistencies in a temp global
219 M ^TMP($J,DFN)=FILERR
220 Q
221 ;
Note: See TracBrowser for help on using the repository browser.