source: FOIAVistA/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGENUPL4.m@ 1800

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

initial load of FOIAVistA 6/30/08 version
File size: 9.5 KB
Line 
1DGENUPL4 ;ALB/CJM,RTK,ISA/KWP,ISD/GSN,PHH,RGL,PJR,BRM,TDM,TMK,EG - PROCESS INCOMING (Z11 EVENT TYPE) HL7 MESSAGES ; 09/25/2006
2 ;;5.3;REGISTRATION;**147,177,232,253,327,367,377,514,451,625,673,708**;Aug 13,1993;Build 7
3 ;
4UOBJECTS(DFN,DGPAT,DGELG,DGCDIS,DGOEIF,MSGID,ERRCOUNT,MSGS,OLDPAT,OLDELG,OLDCDIS,OLDOEIF) ;
5 ;Used to update PATIENT, ELIGIBILITY, CATASTROPHIC
6 ;DISABILITY, and OEF/OIF CONFLICT objects 'in memory'.
7 ;
8 ;Input:
9 ; DFN - ien of record in the PATIENT file
10 ; DGPAT - PATIENT object array (pass by reference)
11 ; DGELG - ELIGIBILITY object array (pass by ref)
12 ; DGCDIS - CATASTROPHIC DISABILITY object array (pass by ref)
13 ; DGOEIF - OEF/OIF conflict object array (pass by ref)
14 ; MSGID - message control id of the HL7 message being processed
15 ; ERRCOUNT - count of errors (pass by ref)
16 ; MSGS - array of messages for the site (pass by ref)
17 ;
18 ;Output:
19 ; Function Value: 1 if update was successful 'in memory',
20 ; consistency checks pass and the objects can be stored in
21 ; the local database, 0 otherwise.
22 ; DGPAT - PATIENT object array (pass by reference)
23 ; DGELG - ELIGIBILITY object array (pass by ref)
24 ; DGCDIS - CATASTROPHIC DISABILITY object array (pass by ref)
25 ; ERRCOUNT - count of errors (pass by ref)
26 ; MSGS - array of messages for the site (pass by ref)
27 ; OLDPAT - patient object array as it currently exists in database before the update (pass by ref)
28 ; OLDELG - eligibility object array as it currently exists in database before the update (pass by ref)
29 ; OLDCDIS - catastrophically disability object array as it currently exists in database before the update (pass by ref)
30 ; OLDOEIF - OEF/OIF conflict data as it currently exists in database before the update (pass by ref)
31 ;
32 N DGPAT3,DGELG3,DGCDIS3,SUCCESS
33 S SUCCESS=1
34 D
35 .;first get local site's current data
36 .I ('$$GET^DGENPTA(DFN,.OLDPAT))!('$$GET^DGENELA(DFN,.OLDELG))!('$$GET^DGENCDA(DFN,.OLDCDIS))!('$P($$GET^DGENOEIF(DFN,.OLDOEIF,0),U,2)) D Q
37 ..D ADDERROR^DGENUPL(MSGID,DGPAT("SSN"),"UNABLE TO ACCESS PATIENT RECORD",.ERRCOUNT)
38 ..S SUCCESS=0
39 .;
40 .;Phase II CD Consistency Checks (SRS 6.5.1.4) check VISTA against HEC
41 .S SUCCESS=$$CDCHECK^DGENUPL9()
42 .Q:'SUCCESS
43 .;
44 .;now merge with the update
45 .D MERGE
46 .;
47 .;add the assumed values
48 .D ADD
49 .;
50 .;now do the consistency checks
51 .S SUCCESS=$$CHECK()
52 .Q:'SUCCESS
53 .;
54 .;replace input arrays with fully updated versions
55 .K DGPAT M DGPAT=DGPAT3
56 .K DGELG M DGELG=DGELG3
57 .K DGCDIS M DGCDIS=DGCDIS3
58 ;
59 I SUCCESS D
60 .;
61 .;list of required notifications
62 .;
63 .;change in date of death
64 .I DGPAT("DEATH"),$P(OLDPAT("DEATH"),".")'=$P(DGPAT("DEATH"),".") D
65 ..D ADDMSG^DGENUPL3(.MSGS,"HEC SHOWS DATE OF DEATH = "_$$FMTE^XLFDT(DGPAT("DEATH"),"1"),1)
66 ..D ADDMSG^DGENUPL3(.MSGS,$S('OLDPAT("DEATH"):"SITE DOES NOT HAVE DATE OF DEATH",1:"SITE HAS DATE OF DEATH = "_$$FMTE^XLFDT(OLDPAT("DEATH"),"1")),1)
67 .;
68 .I OLDPAT("DEATH"),'DGPAT("DEATH") D
69 ..D ADDMSG^DGENUPL3(.MSGS,"HEC SHOWS NO DATE OF DEATH",1)
70 ..D ADDMSG^DGENUPL3(.MSGS,"SITE HAS DATE OF DEATH = "_$$FMTE^XLFDT(OLDPAT("DEATH"),"1"),1)
71 .;
72 .;change in POW
73 .I OLDELG("POW")="N",DGELG("POW")="Y" D ADDMSG^DGENUPL3(.MSGS,"POW STATUS CHANGED TO YES")
74 .I OLDELG("POW")="Y",DGELG("POW")="N" D ADDMSG^DGENUPL3(.MSGS,"POW STATUS CHANGED TO NO")
75 .;
76 .;SC to NSC
77 .I OLDELG("SC")="Y",DGELG("SC")="N" D ADDMSG^DGENUPL3(.MSGS,"VETERAN CHANGED TO NON-SERVICE CONNECTED",1)
78 .;
79 .; Change from Eligible to Ineligible
80 .I 'OLDPAT("INELDATE"),DGPAT("INELDATE") D ADDMSG^DGENUPL3(.MSGS,"VETERAN PREVIOUSLY ELIGIBLE FOR VA HEALTH CARE, NOW INELIGIBLE.",1)
81 .;
82 .; Check for erroneous CD deletion
83 .I OLDCDIS("VCD")="","@"[DGCDIS("VCD") Q ;no notification is needed
84 .;
85 .; CD Determination Changed
86 .I OLDCDIS("VCD")'=DGCDIS("VCD") D ADDMSG^DGENUPL3(.MSGS,"VETERANS CD EVALUATION HAS CHANGED.")
87 D EP^DGENUPLB
88 Q SUCCESS
89 ;
90ADD ;
91 ;Description: adds computed and assumed values to the updated objects
92 ;
93 ;Input: DGELG3(),DGPAT3() created in the UOBJECTS procedure.
94 ;
95 N SUB,TYPE,DATA
96 S DGELG3("ELIGENTBY")=.5
97 S SUB=0 F S SUB=$O(DGELG3("RATEDIS",SUB)) Q:'SUB S DGELG3("RATEDIS",SUB,"RDSC")=1
98 ;
99 ; Default Patient Types
100 I DGELG3("SC")="N" S DGPAT3("VETERAN")="Y",DGPAT3("PATYPE")=$O(^DG(391,"B","NSC VETERAN",0))
101 I DGELG3("SC")="Y" S DGPAT3("VETERAN")="Y",DGPAT3("PATYPE")=$O(^DG(391,"B","SC VETERAN",0))
102 ;
103 ; If Ineldate apply business rules
104 I DGPAT3("INELDATE"),DGELG3("SC")'="Y" D
105 .S DGPAT3("VETERAN")="N",DGPAT3("PATYPE")=$O(^DG(391,"B","NON-VETERAN (OTHER)",0))
106 .S DGELG3("POS")=$O(^DIC(21,"B","OTHER NON-VETERANS",0))
107 ;
108 ;update/set ELIGIBILITY VERIF. SOURCE field (Ineligible Project):
109 I DGELG3("ELIGVERIF")["VIVA" S DATA(.3613)="H"
110 E S DATA(.3613)="V"
111 ;
112 ; File data fields modified by Ineligible Business Rules
113 I $$UPD^DGENDBS(2,DFN,.DATA,.ERROR)
114 Q
115 ;
116MERGE ;
117 ;Description: merges arrays with current patient data with the updates
118 ; Merges DGPAT() + OLDPAT() -> DGPAT3()
119 ; DGELG() + OLDELG() -> DGELG3()
120 ; overlays catastrophic disability array with data from HEC
121 ; DGCDIS() is info from HEC
122 ;
123 N SUB,SUB2,LOC,HEC,NATCODE
124 M DGPAT3=OLDPAT,DGELG3=OLDELG
125 K DGCDIS3 M DGCDIS3=OLDCDIS K DGCDIS3("EXT"),DGCDIS3("PROC"),DGCDIS3("COND"),DGCDIS3("DIAG")
126 ;nothing on HEC...delete VistA
127 I $G(DGCDIS("EXT",1,1))="",$G(DGCDIS("PROC",1))="",$G(DGCDIS("COND",1))="",$G(DGCDIS("DIAG",1))="" D
128 . S DGCDIS("VCD")="@"
129 . S DGCDIS("BY")="@"
130 . S DGCDIS("DATE")="@"
131 . S DGCDIS("FACDET")="@"
132 . S DGCDIS("METDET")="@"
133 . S DGCDIS("REVDTE")="@"
134 . Q
135 ;
136 ;discard MT status from local database - don't ever want to use it during upload
137 S DGELG3("MTSTA")=DGELG("MTSTA")
138 ;
139 ;patient array
140 S SUB=""
141 F S SUB=$O(DGPAT(SUB)) Q:(SUB="") I (DGPAT(SUB)'="") S DGPAT3(SUB)=$S((DGPAT(SUB)="@"):"",1:DGPAT(SUB))
142 ;
143 ;Allow Ineligible info deletion (Ineligible Project):
144 I $D(DGPAT("INELDEC")),DGPAT("INELDEC")="" S DGPAT("INELDEC")="@"
145 I $D(DGPAT("INELREA")),DGPAT("INELREA")="" S DGPAT("INELREA")="@"
146 I $D(DGPAT("INELDATE")),DGPAT("INELDATE")="" S DGPAT("INELDATE")="@"
147 ;
148 ;catastrophic disability array
149 S SUB=""
150 F S SUB=$O(DGCDIS(SUB)) Q:(SUB="") D
151 .I $D(DGCDIS(SUB))=1 I ($G(DGCDIS(SUB))'="") S DGCDIS3(SUB)=DGCDIS(SUB)
152 .I $D(DGCDIS(SUB))=10 D
153 ..S SUB2=""
154 ..F S SUB2=$O(DGCDIS(SUB,SUB2)) Q:SUB2="" D
155 ...I ($G(DGCDIS(SUB,SUB2))'="") S DGCDIS3(SUB,SUB2)=DGCDIS(SUB,SUB2)
156 ...I SUB="PROC" D
157 ....N CDPROC,CDEXT,LIEN
158 ....S CDPROC=$G(DGCDIS("PROC",SUB2))
159 ....Q:CDPROC=""
160 ....S CDEXT=$G(DGCDIS("EXT",SUB2,1))
161 ....Q:CDEXT=""
162 ....S LIEN=$O(^DGEN(27.17,CDPROC,1,"B",CDEXT,0))
163 ....Q:LIEN=""
164 ....S DGCDIS3("EXT",SUB2,LIEN)=CDEXT
165 ;
166 ;eligibility array
167 F S SUB=$O(DGELG(SUB)) Q:(SUB="") I ($G(DGELG(SUB))'="") S DGELG3(SUB)=$S((DGELG(SUB)="@"):"",1:DGELG(SUB))
168 ;
169 ;rated disabilities from HEC should replace local sites
170 D
171 .K DGELG3("RATEDIS")
172 .M DGELG3("RATEDIS")=DGELG("RATEDIS")
173 ;
174 ;primary eligibility
175 I (DGELG("ELIG","CODE")'="") S DGELG3("ELIG","CODE")=$S((DGELG("ELIG","CODE")="@"):"",($$NATCODE^DGENELA(DGELG("ELIG","CODE"))=$$NATCODE^DGENELA(DGELG3("ELIG","CODE"))):DGELG3("ELIG","CODE"),1:DGELG("ELIG","CODE"))
176 ;
177 ;patient eligibilities multiple
178 ;delete veteran type codes not mapped to national codes sent by HEC, but leave non-veteran types and the codes where there is a match
179 ;first find all local codes already in the patient file and the ones sent from HEC, keep in arrays LOC and HEC
180 S NATCODE=$$NATCODE^DGENELA(DGELG("ELIG","CODE")) I NATCODE S HEC(NATCODE)=""
181 S SUB=0 F S SUB=$O(DGELG("ELIG","CODE",SUB)) Q:'SUB S NATCODE=$$NATCODE^DGENELA(SUB) I NATCODE S HEC(NATCODE)=""
182 S SUB=0 F S SUB=$O(DGELG3("ELIG","CODE",SUB)) Q:'SUB S NATCODE=$$NATCODE^DGENELA(SUB) I NATCODE S LOC(NATCODE)=""
183 ;Now discard the codes in the local patient database that don't map to a national code sent by HEC, as well as HUMANIARIAN EMERGENCY code if not sent by HEC:
184 S SUB=0
185 F S SUB=$O(DGELG3("ELIG","CODE",SUB)) Q:'SUB D
186 .I $P($G(^DIC(8,SUB,0)),"^",5)="Y"!($P($G(^DIC(8,SUB,0)),"^")["HUMANITARIAN EMERGENCY"),'$D(HEC($$NATCODE^DGENELA(SUB))) K DGELG3("ELIG","CODE",SUB)
187 ;now add codes included in the update that the local database does not already contain
188 S SUB=0
189 F S SUB=$O(DGELG("ELIG","CODE",SUB)) Q:'SUB D
190 .I '$D(LOC($$NATCODE^DGENELA(SUB))) S DGELG3("ELIG","CODE",SUB)=SUB
191 ;Agent Orange Exp. Location, use local database when upload is NULL
192 D AO^DGENUPL9
193 Q
194 ;
195CHECK() ;
196 ;
197 N SUCCESS,ALIVE,ERRMSG,DGENR
198 S SUCCESS=1
199 S ERRMSG=""
200 ;
201 ;if upload includes date of death, check for indications that patient is alive
202 I DGPAT3("DEATH"),'OLDPAT("DEATH") D S:ALIVE SUCCESS=0
203 .;
204 .;determine if patient is at the moment being registered
205 .S ALIVE=$$IFREG^DGREG(DFN)
206 .;
207 .;check if an inpatient
208 .I 'ALIVE,$$INPAT^DGENPTA(DFN,DT,DT) S ALIVE=1
209 .;
210 .;Phase II locally enrolled with enrollment date after death date and status of unverified and rejected-initial application by vamc (SRS 6.5.1.2 e)
211 .N CURIEN,CURENR
212 .S CURIEN=$$FINDCUR^DGENA(DFN)
213 .I CURIEN,$$GET^DGENA(CURIEN,.CURENR),CURENR("DATE")>DGPAT3("DEATH"),CURENR("STATUS")=1!(CURENR("STATUS")=14) S ALIVE=1
214 .;there is an indication that he patient may not be dead
215 .D:ALIVE ADDERROR^DGENUPL(MSGID,DGPAT("SSN"),"LOCAL SITE VERIFY PATIENT DEATH",.ERRCOUNT),ADDMSG^DGENUPL3(.MSGS,"ELIBILITY UPLOAD CONTAINED DATE OF DEATH AND WAS REJECTED, PLEASE VERIFY PATIENT DEATH",1),NOTIFY^DGENUPL3(.DGPAT,.MSGS)
216 ;
217 ;only do consistency checks on this data if it is verified
218 I SUCCESS,(DGELG3("ELIGSTA")="V") D
219 .I $$CHECK^DGENPTA1(.DGPAT3,.ERRMSG),$$CHECK^DGENELA1(.DGELG3,.DGPAT3,.DGCDIS3,.ERRMSG),$$CHECK^DGENCDA1(.DGCDIS3,.ERRMSG)
220 .E D
221 ..S SUCCESS=0
222 ..D ADDERROR^DGENUPL(MSGID,DGPAT("SSN"),ERRMSG,.ERRCOUNT)
223 Q SUCCESS
Note: See TracBrowser for help on using the repository browser.