224 lines
9.5 KiB
Mathematica
224 lines
9.5 KiB
Mathematica
DGENUPL4 ;ALB/CJM,RTK,ISA/KWP,ISD/GSN,PHH,RGL,PJR,BRM,TDM,TMK,EG - PROCESS INCOMING (Z11 EVENT TYPE) HL7 MESSAGES ; 09/25/2006
|
|
;;5.3;REGISTRATION;**147,177,232,253,327,367,377,514,451,625,673,708**;Aug 13,1993;Build 7
|
|
;
|
|
UOBJECTS(DFN,DGPAT,DGELG,DGCDIS,DGOEIF,MSGID,ERRCOUNT,MSGS,OLDPAT,OLDELG,OLDCDIS,OLDOEIF) ;
|
|
;Used to update PATIENT, ELIGIBILITY, CATASTROPHIC
|
|
;DISABILITY, and OEF/OIF CONFLICT objects 'in memory'.
|
|
;
|
|
;Input:
|
|
; DFN - ien of record in the PATIENT file
|
|
; DGPAT - PATIENT object array (pass by reference)
|
|
; DGELG - ELIGIBILITY object array (pass by ref)
|
|
; DGCDIS - CATASTROPHIC DISABILITY object array (pass by ref)
|
|
; DGOEIF - OEF/OIF conflict object array (pass by ref)
|
|
; MSGID - message control id of the HL7 message being processed
|
|
; ERRCOUNT - count of errors (pass by ref)
|
|
; MSGS - array of messages for the site (pass by ref)
|
|
;
|
|
;Output:
|
|
; Function Value: 1 if update was successful 'in memory',
|
|
; consistency checks pass and the objects can be stored in
|
|
; the local database, 0 otherwise.
|
|
; DGPAT - PATIENT object array (pass by reference)
|
|
; DGELG - ELIGIBILITY object array (pass by ref)
|
|
; DGCDIS - CATASTROPHIC DISABILITY object array (pass by ref)
|
|
; ERRCOUNT - count of errors (pass by ref)
|
|
; MSGS - array of messages for the site (pass by ref)
|
|
; OLDPAT - patient object array as it currently exists in database before the update (pass by ref)
|
|
; OLDELG - eligibility object array as it currently exists in database before the update (pass by ref)
|
|
; OLDCDIS - catastrophically disability object array as it currently exists in database before the update (pass by ref)
|
|
; OLDOEIF - OEF/OIF conflict data as it currently exists in database before the update (pass by ref)
|
|
;
|
|
N DGPAT3,DGELG3,DGCDIS3,SUCCESS
|
|
S SUCCESS=1
|
|
D
|
|
.;first get local site's current data
|
|
.I ('$$GET^DGENPTA(DFN,.OLDPAT))!('$$GET^DGENELA(DFN,.OLDELG))!('$$GET^DGENCDA(DFN,.OLDCDIS))!('$P($$GET^DGENOEIF(DFN,.OLDOEIF,0),U,2)) D Q
|
|
..D ADDERROR^DGENUPL(MSGID,DGPAT("SSN"),"UNABLE TO ACCESS PATIENT RECORD",.ERRCOUNT)
|
|
..S SUCCESS=0
|
|
.;
|
|
.;Phase II CD Consistency Checks (SRS 6.5.1.4) check VISTA against HEC
|
|
.S SUCCESS=$$CDCHECK^DGENUPL9()
|
|
.Q:'SUCCESS
|
|
.;
|
|
.;now merge with the update
|
|
.D MERGE
|
|
.;
|
|
.;add the assumed values
|
|
.D ADD
|
|
.;
|
|
.;now do the consistency checks
|
|
.S SUCCESS=$$CHECK()
|
|
.Q:'SUCCESS
|
|
.;
|
|
.;replace input arrays with fully updated versions
|
|
.K DGPAT M DGPAT=DGPAT3
|
|
.K DGELG M DGELG=DGELG3
|
|
.K DGCDIS M DGCDIS=DGCDIS3
|
|
;
|
|
I SUCCESS D
|
|
.;
|
|
.;list of required notifications
|
|
.;
|
|
.;change in date of death
|
|
.I DGPAT("DEATH"),$P(OLDPAT("DEATH"),".")'=$P(DGPAT("DEATH"),".") D
|
|
..D ADDMSG^DGENUPL3(.MSGS,"HEC SHOWS DATE OF DEATH = "_$$FMTE^XLFDT(DGPAT("DEATH"),"1"),1)
|
|
..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)
|
|
.;
|
|
.I OLDPAT("DEATH"),'DGPAT("DEATH") D
|
|
..D ADDMSG^DGENUPL3(.MSGS,"HEC SHOWS NO DATE OF DEATH",1)
|
|
..D ADDMSG^DGENUPL3(.MSGS,"SITE HAS DATE OF DEATH = "_$$FMTE^XLFDT(OLDPAT("DEATH"),"1"),1)
|
|
.;
|
|
.;change in POW
|
|
.I OLDELG("POW")="N",DGELG("POW")="Y" D ADDMSG^DGENUPL3(.MSGS,"POW STATUS CHANGED TO YES")
|
|
.I OLDELG("POW")="Y",DGELG("POW")="N" D ADDMSG^DGENUPL3(.MSGS,"POW STATUS CHANGED TO NO")
|
|
.;
|
|
.;SC to NSC
|
|
.I OLDELG("SC")="Y",DGELG("SC")="N" D ADDMSG^DGENUPL3(.MSGS,"VETERAN CHANGED TO NON-SERVICE CONNECTED",1)
|
|
.;
|
|
.; Change from Eligible to Ineligible
|
|
.I 'OLDPAT("INELDATE"),DGPAT("INELDATE") D ADDMSG^DGENUPL3(.MSGS,"VETERAN PREVIOUSLY ELIGIBLE FOR VA HEALTH CARE, NOW INELIGIBLE.",1)
|
|
.;
|
|
.; Check for erroneous CD deletion
|
|
.I OLDCDIS("VCD")="","@"[DGCDIS("VCD") Q ;no notification is needed
|
|
.;
|
|
.; CD Determination Changed
|
|
.I OLDCDIS("VCD")'=DGCDIS("VCD") D ADDMSG^DGENUPL3(.MSGS,"VETERANS CD EVALUATION HAS CHANGED.")
|
|
D EP^DGENUPLB
|
|
Q SUCCESS
|
|
;
|
|
ADD ;
|
|
;Description: adds computed and assumed values to the updated objects
|
|
;
|
|
;Input: DGELG3(),DGPAT3() created in the UOBJECTS procedure.
|
|
;
|
|
N SUB,TYPE,DATA
|
|
S DGELG3("ELIGENTBY")=.5
|
|
S SUB=0 F S SUB=$O(DGELG3("RATEDIS",SUB)) Q:'SUB S DGELG3("RATEDIS",SUB,"RDSC")=1
|
|
;
|
|
; Default Patient Types
|
|
I DGELG3("SC")="N" S DGPAT3("VETERAN")="Y",DGPAT3("PATYPE")=$O(^DG(391,"B","NSC VETERAN",0))
|
|
I DGELG3("SC")="Y" S DGPAT3("VETERAN")="Y",DGPAT3("PATYPE")=$O(^DG(391,"B","SC VETERAN",0))
|
|
;
|
|
; If Ineldate apply business rules
|
|
I DGPAT3("INELDATE"),DGELG3("SC")'="Y" D
|
|
.S DGPAT3("VETERAN")="N",DGPAT3("PATYPE")=$O(^DG(391,"B","NON-VETERAN (OTHER)",0))
|
|
.S DGELG3("POS")=$O(^DIC(21,"B","OTHER NON-VETERANS",0))
|
|
;
|
|
;update/set ELIGIBILITY VERIF. SOURCE field (Ineligible Project):
|
|
I DGELG3("ELIGVERIF")["VIVA" S DATA(.3613)="H"
|
|
E S DATA(.3613)="V"
|
|
;
|
|
; File data fields modified by Ineligible Business Rules
|
|
I $$UPD^DGENDBS(2,DFN,.DATA,.ERROR)
|
|
Q
|
|
;
|
|
MERGE ;
|
|
;Description: merges arrays with current patient data with the updates
|
|
; Merges DGPAT() + OLDPAT() -> DGPAT3()
|
|
; DGELG() + OLDELG() -> DGELG3()
|
|
; overlays catastrophic disability array with data from HEC
|
|
; DGCDIS() is info from HEC
|
|
;
|
|
N SUB,SUB2,LOC,HEC,NATCODE
|
|
M DGPAT3=OLDPAT,DGELG3=OLDELG
|
|
K DGCDIS3 M DGCDIS3=OLDCDIS K DGCDIS3("EXT"),DGCDIS3("PROC"),DGCDIS3("COND"),DGCDIS3("DIAG")
|
|
;nothing on HEC...delete VistA
|
|
I $G(DGCDIS("EXT",1,1))="",$G(DGCDIS("PROC",1))="",$G(DGCDIS("COND",1))="",$G(DGCDIS("DIAG",1))="" D
|
|
. S DGCDIS("VCD")="@"
|
|
. S DGCDIS("BY")="@"
|
|
. S DGCDIS("DATE")="@"
|
|
. S DGCDIS("FACDET")="@"
|
|
. S DGCDIS("METDET")="@"
|
|
. S DGCDIS("REVDTE")="@"
|
|
. Q
|
|
;
|
|
;discard MT status from local database - don't ever want to use it during upload
|
|
S DGELG3("MTSTA")=DGELG("MTSTA")
|
|
;
|
|
;patient array
|
|
S SUB=""
|
|
F S SUB=$O(DGPAT(SUB)) Q:(SUB="") I (DGPAT(SUB)'="") S DGPAT3(SUB)=$S((DGPAT(SUB)="@"):"",1:DGPAT(SUB))
|
|
;
|
|
;Allow Ineligible info deletion (Ineligible Project):
|
|
I $D(DGPAT("INELDEC")),DGPAT("INELDEC")="" S DGPAT("INELDEC")="@"
|
|
I $D(DGPAT("INELREA")),DGPAT("INELREA")="" S DGPAT("INELREA")="@"
|
|
I $D(DGPAT("INELDATE")),DGPAT("INELDATE")="" S DGPAT("INELDATE")="@"
|
|
;
|
|
;catastrophic disability array
|
|
S SUB=""
|
|
F S SUB=$O(DGCDIS(SUB)) Q:(SUB="") D
|
|
.I $D(DGCDIS(SUB))=1 I ($G(DGCDIS(SUB))'="") S DGCDIS3(SUB)=DGCDIS(SUB)
|
|
.I $D(DGCDIS(SUB))=10 D
|
|
..S SUB2=""
|
|
..F S SUB2=$O(DGCDIS(SUB,SUB2)) Q:SUB2="" D
|
|
...I ($G(DGCDIS(SUB,SUB2))'="") S DGCDIS3(SUB,SUB2)=DGCDIS(SUB,SUB2)
|
|
...I SUB="PROC" D
|
|
....N CDPROC,CDEXT,LIEN
|
|
....S CDPROC=$G(DGCDIS("PROC",SUB2))
|
|
....Q:CDPROC=""
|
|
....S CDEXT=$G(DGCDIS("EXT",SUB2,1))
|
|
....Q:CDEXT=""
|
|
....S LIEN=$O(^DGEN(27.17,CDPROC,1,"B",CDEXT,0))
|
|
....Q:LIEN=""
|
|
....S DGCDIS3("EXT",SUB2,LIEN)=CDEXT
|
|
;
|
|
;eligibility array
|
|
F S SUB=$O(DGELG(SUB)) Q:(SUB="") I ($G(DGELG(SUB))'="") S DGELG3(SUB)=$S((DGELG(SUB)="@"):"",1:DGELG(SUB))
|
|
;
|
|
;rated disabilities from HEC should replace local sites
|
|
D
|
|
.K DGELG3("RATEDIS")
|
|
.M DGELG3("RATEDIS")=DGELG("RATEDIS")
|
|
;
|
|
;primary eligibility
|
|
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"))
|
|
;
|
|
;patient eligibilities multiple
|
|
;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
|
|
;first find all local codes already in the patient file and the ones sent from HEC, keep in arrays LOC and HEC
|
|
S NATCODE=$$NATCODE^DGENELA(DGELG("ELIG","CODE")) I NATCODE S HEC(NATCODE)=""
|
|
S SUB=0 F S SUB=$O(DGELG("ELIG","CODE",SUB)) Q:'SUB S NATCODE=$$NATCODE^DGENELA(SUB) I NATCODE S HEC(NATCODE)=""
|
|
S SUB=0 F S SUB=$O(DGELG3("ELIG","CODE",SUB)) Q:'SUB S NATCODE=$$NATCODE^DGENELA(SUB) I NATCODE S LOC(NATCODE)=""
|
|
;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:
|
|
S SUB=0
|
|
F S SUB=$O(DGELG3("ELIG","CODE",SUB)) Q:'SUB D
|
|
.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)
|
|
;now add codes included in the update that the local database does not already contain
|
|
S SUB=0
|
|
F S SUB=$O(DGELG("ELIG","CODE",SUB)) Q:'SUB D
|
|
.I '$D(LOC($$NATCODE^DGENELA(SUB))) S DGELG3("ELIG","CODE",SUB)=SUB
|
|
;Agent Orange Exp. Location, use local database when upload is NULL
|
|
D AO^DGENUPL9
|
|
Q
|
|
;
|
|
CHECK() ;
|
|
;
|
|
N SUCCESS,ALIVE,ERRMSG,DGENR
|
|
S SUCCESS=1
|
|
S ERRMSG=""
|
|
;
|
|
;if upload includes date of death, check for indications that patient is alive
|
|
I DGPAT3("DEATH"),'OLDPAT("DEATH") D S:ALIVE SUCCESS=0
|
|
.;
|
|
.;determine if patient is at the moment being registered
|
|
.S ALIVE=$$IFREG^DGREG(DFN)
|
|
.;
|
|
.;check if an inpatient
|
|
.I 'ALIVE,$$INPAT^DGENPTA(DFN,DT,DT) S ALIVE=1
|
|
.;
|
|
.;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)
|
|
.N CURIEN,CURENR
|
|
.S CURIEN=$$FINDCUR^DGENA(DFN)
|
|
.I CURIEN,$$GET^DGENA(CURIEN,.CURENR),CURENR("DATE")>DGPAT3("DEATH"),CURENR("STATUS")=1!(CURENR("STATUS")=14) S ALIVE=1
|
|
.;there is an indication that he patient may not be dead
|
|
.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)
|
|
;
|
|
;only do consistency checks on this data if it is verified
|
|
I SUCCESS,(DGELG3("ELIGSTA")="V") D
|
|
.I $$CHECK^DGENPTA1(.DGPAT3,.ERRMSG),$$CHECK^DGENELA1(.DGELG3,.DGPAT3,.DGCDIS3,.ERRMSG),$$CHECK^DGENCDA1(.DGCDIS3,.ERRMSG)
|
|
.E D
|
|
..S SUCCESS=0
|
|
..D ADDERROR^DGENUPL(MSGID,DGPAT("SSN"),ERRMSG,.ERRCOUNT)
|
|
Q SUCCESS
|