DGENUPL4 ;ALB/CJM,RTK,ISA/KWP,ISD/GSN,PHH,RGL,PJR,BRM,TDM,TMK,EG,BAJ - PROCESS INCOMING (Z11 EVENT TYPE) HL7 MESSAGES ; 01/05/07
;;5.3;PIMS;**1016**;JUN 30, 2012;Build 20
;
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
D SCVET^DGENUPL3
;
; 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):
S DATA(.3613)=$S(DGELG3("ELIGVERIF")["VBA":"H",DGELG3("ELIGVERIF")["CEV":"H",DGELG3("ELIGVERIF")["VIVA":"H",1:"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
;Replace POW in VistA with HEC data
I '$D(DGPAT3("POWI")) S DGELG3("POW")=""
K DGCDIS3 M DGCDIS3=OLDCDIS K DGCDIS3("EXT"),DGCDIS3("PROC"),DGCDIS3("COND"),DGCDIS3("DIAG")
;
;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
DGENUPL4 ;ALB/CJM,RTK,ISA/KWP,ISD/GSN,PHH,RGL,PJR,BRM,TDM,TMK,EG,BAJ - PROCESS INCOMING (Z11 EVENT TYPE) HL7 MESSAGES ; 01/05/07
+1 ;;5.3;PIMS;**1016**;JUN 30, 2012;Build 20
+2 ;
UOBJECTS(DFN,DGPAT,DGELG,DGCDIS,DGOEIF,MSGID,ERRCOUNT,MSGS,OLDPAT,OLDELG,OLDCDIS,OLDOEIF) ;
+1 ;Used to update PATIENT, ELIGIBILITY, CATASTROPHIC
+2 ;DISABILITY, and OEF/OIF CONFLICT objects 'in memory'.
+3 ;
+4 ;Input:
+5 ; DFN - ien of record in the PATIENT file
+6 ; DGPAT - PATIENT object array (pass by reference)
+7 ; DGELG - ELIGIBILITY object array (pass by ref)
+8 ; DGCDIS - CATASTROPHIC DISABILITY object array (pass by ref)
+9 ; DGOEIF - OEF/OIF conflict object array (pass by ref)
+10 ; MSGID - message control id of the HL7 message being processed
+11 ; ERRCOUNT - count of errors (pass by ref)
+12 ; MSGS - array of messages for the site (pass by ref)
+13 ;
+14 ;Output:
+15 ; Function Value: 1 if update was successful 'in memory',
+16 ; consistency checks pass and the objects can be stored in
+17 ; the local database, 0 otherwise.
+18 ; DGPAT - PATIENT object array (pass by reference)
+19 ; DGELG - ELIGIBILITY object array (pass by ref)
+20 ; DGCDIS - CATASTROPHIC DISABILITY object array (pass by ref)
+21 ; ERRCOUNT - count of errors (pass by ref)
+22 ; MSGS - array of messages for the site (pass by ref)
+23 ; OLDPAT - patient object array as it currently exists in database before the update (pass by ref)
+24 ; OLDELG - eligibility object array as it currently exists in database before the update (pass by ref)
+25 ; OLDCDIS - catastrophically disability object array as it currently exists in database before the update (pass by ref)
+26 ; OLDOEIF - OEF/OIF conflict data as it currently exists in database before the update (pass by ref)
+27 ;
+28 NEW DGPAT3,DGELG3,DGCDIS3,SUCCESS
+29 SET SUCCESS=1
+30 Begin DoDot:1
+31 ;first get local site's current data
+32 IF ('$$GET^DGENPTA(DFN,.OLDPAT))!('$$GET^DGENELA(DFN,.OLDELG))!('$$GET^DGENCDA(DFN,.OLDCDIS))!('$PIECE($$GET^DGENOEIF(DFN,.OLDOEIF,0),U,2))
Begin DoDot:2
+33 DO ADDERROR^DGENUPL(MSGID,DGPAT("SSN"),"UNABLE TO ACCESS PATIENT RECORD",.ERRCOUNT)
+34 SET SUCCESS=0
End DoDot:2
QUIT
+35 ;
+36 ;Phase II CD Consistency Checks (SRS 6.5.1.4) check VISTA against HEC
+37 SET SUCCESS=$$CDCHECK^DGENUPL9()
+38 IF 'SUCCESS
QUIT
+39 ;
+40 ;now merge with the update
+41 DO MERGE
+42 ;
+43 ;add the assumed values
+44 DO ADD
+45 ;
+46 ;now do the consistency checks
+47 SET SUCCESS=$$CHECK()
+48 IF 'SUCCESS
QUIT
+49 ;
+50 ;replace input arrays with fully updated versions
+51 KILL DGPAT
MERGE DGPAT=DGPAT3
+52 KILL DGELG
MERGE DGELG=DGELG3
+53 KILL DGCDIS
MERGE DGCDIS=DGCDIS3
End DoDot:1
+54 ;
+55 IF SUCCESS
Begin DoDot:1
+56 ;
+57 ;list of required notifications
+58 ;
+59 ;change in date of death
+60 IF DGPAT("DEATH")
IF $PIECE(OLDPAT("DEATH"),".")'=$PIECE(DGPAT("DEATH"),".")
Begin DoDot:2
+61 DO ADDMSG^DGENUPL3(.MSGS,"HEC SHOWS DATE OF DEATH = "_$$FMTE^XLFDT(DGPAT("DEATH"),"1"),1)
+62 DO ADDMSG^DGENUPL3(.MSGS,$SELECT('OLDPAT("DEATH"):"SITE DOES NOT HAVE DATE OF DEATH",1:"SITE HAS DATE OF DEATH = "_$$FMTE^XLFDT(OLDPAT("DEATH"),"1")),1)
End DoDot:2
+63 ;
+64 IF OLDPAT("DEATH")
IF 'DGPAT("DEATH")
Begin DoDot:2
+65 DO ADDMSG^DGENUPL3(.MSGS,"HEC SHOWS NO DATE OF DEATH",1)
+66 DO ADDMSG^DGENUPL3(.MSGS,"SITE HAS DATE OF DEATH = "_$$FMTE^XLFDT(OLDPAT("DEATH"),"1"),1)
End DoDot:2
+67 ;
+68 ;change in POW
+69 IF OLDELG("POW")="N"
IF DGELG("POW")="Y"
DO ADDMSG^DGENUPL3(.MSGS,"POW STATUS CHANGED TO YES")
+70 IF OLDELG("POW")="Y"
IF DGELG("POW")="N"
DO ADDMSG^DGENUPL3(.MSGS,"POW STATUS CHANGED TO NO")
+71 ;
+72 ;SC to NSC
+73 IF OLDELG("SC")="Y"
IF DGELG("SC")="N"
DO ADDMSG^DGENUPL3(.MSGS,"VETERAN CHANGED TO NON-SERVICE CONNECTED",1)
+74 ;
+75 ; Change from Eligible to Ineligible
+76 IF 'OLDPAT("INELDATE")
IF DGPAT("INELDATE")
DO ADDMSG^DGENUPL3(.MSGS,"VETERAN PREVIOUSLY ELIGIBLE FOR VA HEALTH CARE, NOW INELIGIBLE.",1)
+77 ;
+78 ; Check for erroneous CD deletion
+79 ;no notification is needed
IF OLDCDIS("VCD")=""
IF "@"[DGCDIS("VCD")
QUIT
+80 ;
+81 ; CD Determination Changed
+82 IF OLDCDIS("VCD")'=DGCDIS("VCD")
DO ADDMSG^DGENUPL3(.MSGS,"VETERANS CD EVALUATION HAS CHANGED.")
End DoDot:1
+83 DO EP^DGENUPLB
+84 QUIT SUCCESS
+85 ;
ADD ;
+1 ;Description: adds computed and assumed values to the updated objects
+2 ;
+3 ;Input: DGELG3(),DGPAT3() created in the UOBJECTS procedure.
+4 ;
+5 NEW SUB,TYPE,DATA
+6 SET DGELG3("ELIGENTBY")=.5
+7 SET SUB=0
FOR
SET SUB=$ORDER(DGELG3("RATEDIS",SUB))
IF 'SUB
QUIT
SET DGELG3("RATEDIS",SUB,"RDSC")=1
+8 ;
+9 ; Default Patient Types
+10 DO SCVET^DGENUPL3
+11 ;
+12 ; If Ineldate apply business rules
+13 IF DGPAT3("INELDATE")
IF DGELG3("SC")'="Y"
Begin DoDot:1
+14 SET DGPAT3("VETERAN")="N"
SET DGPAT3("PATYPE")=$ORDER(^DG(391,"B","NON-VETERAN (OTHER)",0))
+15 SET DGELG3("POS")=$ORDER(^DIC(21,"B","OTHER NON-VETERANS",0))
End DoDot:1
+16 ;
+17 ;update/set ELIGIBILITY VERIF. SOURCE field (Ineligible Project):
+18 SET DATA(.3613)=$SELECT(DGELG3("ELIGVERIF")["VBA":"H",DGELG3("ELIGVERIF")["CEV":"H",DGELG3("ELIGVERIF")["VIVA":"H",1:"V")
+19 ;
+20 ; File data fields modified by Ineligible Business Rules
+21 IF $$UPD^DGENDBS(2,DFN,.DATA,.ERROR)
+22 QUIT
+23 ;
MERGE ;
+1 ;Description: merges arrays with current patient data with the updates
+2 ; Merges DGPAT() + OLDPAT() -> DGPAT3()
+3 ; DGELG() + OLDELG() -> DGELG3()
+4 ; overlays catastrophic disability array with data from HEC
+5 ; DGCDIS() is info from HEC
+6 ;
+7 NEW SUB,SUB2,LOC,HEC,NATCODE
+8 MERGE DGPAT3=OLDPAT,DGELG3=OLDELG
+9 ;Replace POW in VistA with HEC data
+10 IF '$DATA(DGPAT3("POWI"))
SET DGELG3("POW")=""
+11 KILL DGCDIS3
MERGE DGCDIS3=OLDCDIS
KILL DGCDIS3("EXT"),DGCDIS3("PROC"),DGCDIS3("COND"),DGCDIS3("DIAG")
+12 ;
+13 ;discard MT status from local database - don't ever want to use it during upload
+14 SET DGELG3("MTSTA")=DGELG("MTSTA")
+15 ;
+16 ;patient array
+17 SET SUB=""
+18 FOR
SET SUB=$ORDER(DGPAT(SUB))
IF (SUB="")
QUIT
IF (DGPAT(SUB)'="")
SET DGPAT3(SUB)=$SELECT((DGPAT(SUB)="@"):"",1:DGPAT(SUB))
+19 ;
+20 ;Allow Ineligible info deletion (Ineligible Project):
+21 IF $DATA(DGPAT("INELDEC"))
IF DGPAT("INELDEC")=""
SET DGPAT("INELDEC")="@"
+22 IF $DATA(DGPAT("INELREA"))
IF DGPAT("INELREA")=""
SET DGPAT("INELREA")="@"
+23 IF $DATA(DGPAT("INELDATE"))
IF DGPAT("INELDATE")=""
SET DGPAT("INELDATE")="@"
+24 ;
+25 ;catastrophic disability array
+26 SET SUB=""
+27 FOR
SET SUB=$ORDER(DGCDIS(SUB))
IF (SUB="")
QUIT
Begin DoDot:1
+28 IF $DATA(DGCDIS(SUB))=1
IF ($GET(DGCDIS(SUB))'="")
SET DGCDIS3(SUB)=DGCDIS(SUB)
+29 IF $DATA(DGCDIS(SUB))=10
Begin DoDot:2
+30 SET SUB2=""
+31 FOR
SET SUB2=$ORDER(DGCDIS(SUB,SUB2))
IF SUB2=""
QUIT
Begin DoDot:3
+32 IF ($GET(DGCDIS(SUB,SUB2))'="")
SET DGCDIS3(SUB,SUB2)=DGCDIS(SUB,SUB2)
+33 IF SUB="PROC"
Begin DoDot:4
+34 NEW CDPROC,CDEXT,LIEN
+35 SET CDPROC=$GET(DGCDIS("PROC",SUB2))
+36 IF CDPROC=""
QUIT
+37 SET CDEXT=$GET(DGCDIS("EXT",SUB2,1))
+38 IF CDEXT=""
QUIT
+39 SET LIEN=$ORDER(^DGEN(27.17,CDPROC,1,"B",CDEXT,0))
+40 IF LIEN=""
QUIT
+41 SET DGCDIS3("EXT",SUB2,LIEN)=CDEXT
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+42 ;
+43 ;eligibility array
+44 FOR
SET SUB=$ORDER(DGELG(SUB))
IF (SUB="")
QUIT
IF ($GET(DGELG(SUB))'="")
SET DGELG3(SUB)=$SELECT((DGELG(SUB)="@"):"",1:DGELG(SUB))
+45 ;
+46 ;rated disabilities from HEC should replace local sites
+47 Begin DoDot:1
+48 KILL DGELG3("RATEDIS")
+49 MERGE DGELG3("RATEDIS")=DGELG("RATEDIS")
End DoDot:1
+50 ;
+51 ;primary eligibility
+52 IF (DGELG("ELIG","CODE")'="")
SET DGELG3("ELIG","CODE")=$SELECT((DGELG("ELIG","CODE")="@"):"",($$NATCODE^DGENELA(DGELG("ELIG","CODE"))=$$NATCODE^DGENELA(DGELG3("ELIG","CODE"))):DGELG3("ELIG","CODE"),1:DGELG("ELIG","CODE"))
+53 ;
+54 ;patient eligibilities multiple
+55 ;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
+56 ;first find all local codes already in the patient file and the ones sent from HEC, keep in arrays LOC and HEC
+57 SET NATCODE=$$NATCODE^DGENELA(DGELG("ELIG","CODE"))
IF NATCODE
SET HEC(NATCODE)=""
+58 SET SUB=0
FOR
SET SUB=$ORDER(DGELG("ELIG","CODE",SUB))
IF 'SUB
QUIT
SET NATCODE=$$NATCODE^DGENELA(SUB)
IF NATCODE
SET HEC(NATCODE)=""
+59 SET SUB=0
FOR
SET SUB=$ORDER(DGELG3("ELIG","CODE",SUB))
IF 'SUB
QUIT
SET NATCODE=$$NATCODE^DGENELA(SUB)
IF NATCODE
SET LOC(NATCODE)=""
+60 ;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:
+61 SET SUB=0
+62 FOR
SET SUB=$ORDER(DGELG3("ELIG","CODE",SUB))
IF 'SUB
QUIT
Begin DoDot:1
+63 IF $PIECE($GET(^DIC(8,SUB,0)),"^",5)="Y"!($PIECE($GET(^DIC(8,SUB,0)),"^")["HUMANITARIAN EMERGENCY")
IF '$DATA(HEC($$NATCODE^DGENELA(SUB)))
KILL DGELG3("ELIG","CODE",SUB)
End DoDot:1
+64 ;now add codes included in the update that the local database does not already contain
+65 SET SUB=0
+66 FOR
SET SUB=$ORDER(DGELG("ELIG","CODE",SUB))
IF 'SUB
QUIT
Begin DoDot:1
+67 IF '$DATA(LOC($$NATCODE^DGENELA(SUB)))
SET DGELG3("ELIG","CODE",SUB)=SUB
End DoDot:1
+68 ;Agent Orange Exp. Location, use local database when upload is NULL
+69 DO AO^DGENUPL9
+70 QUIT
+71 ;
CHECK() ;
+1 ;
+2 NEW SUCCESS,ALIVE,ERRMSG,DGENR
+3 SET SUCCESS=1
+4 SET ERRMSG=""
+5 ;
+6 ;if upload includes date of death, check for indications that patient is alive
+7 IF DGPAT3("DEATH")
IF 'OLDPAT("DEATH")
Begin DoDot:1
+8 ;
+9 ;determine if patient is at the moment being registered
+10 SET ALIVE=$$IFREG^DGREG(DFN)
+11 ;
+12 ;check if an inpatient
+13 IF 'ALIVE
IF $$INPAT^DGENPTA(DFN,DT,DT)
SET ALIVE=1
+14 ;
+15 ;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)
+16 NEW CURIEN,CURENR
+17 SET CURIEN=$$FINDCUR^DGENA(DFN)
+18 IF CURIEN
IF $$GET^DGENA(CURIEN,.CURENR)
IF CURENR("DATE")>DGPAT3("DEATH")
IF CURENR("STATUS")=1!(CURENR("STATUS")=14)
SET ALIVE=1
+19 ;there is an indication that he patient may not be dead
+20 IF ALIVE
DO ADDERROR^DGENUPL(MSGID,DGPAT("SSN"),"LOCAL SITE VERIFY PATIENT DEATH",.ERRCOUNT)
DO ADDMSG^DGENUPL3(.MSGS,"ELIBILITY UPLOAD CONTAINED DATE OF DEATH AND WAS REJECTED, PLEASE VERIFY PATIENT DEATH",1)
DO NOTIFY^DGENUPL3(.DGPAT,.MSGS)
End DoDot:1
IF ALIVE
SET SUCCESS=0
+21 ;
+22 ;only do consistency checks on this data if it is verified
+23 IF SUCCESS
IF (DGELG3("ELIGSTA")="V")
Begin DoDot:1
+24 IF $$CHECK^DGENPTA1(.DGPAT3,.ERRMSG)
IF $$CHECK^DGENELA1(.DGELG3,.DGPAT3,.DGCDIS3,.ERRMSG)
IF $$CHECK^DGENCDA1(.DGCDIS3,.ERRMSG)
+25 IF '$TEST
Begin DoDot:2
+26 SET SUCCESS=0
+27 DO ADDERROR^DGENUPL(MSGID,DGPAT("SSN"),ERRMSG,.ERRCOUNT)
End DoDot:2
End DoDot:1
+28 QUIT SUCCESS
