DGRODEBR ;DJH/AMA,TDM - ROM DATA ELEMENT BUSINESS RULES ; 10/20/10 9:59am
;;5.3;PIMS;**533,572,1015,1016**;JUN 30, 2012;Build 20
;
;BUSINESS RULES TO BE CHECKED JUST BEFORE FILING THE
;PATIENT DATA RETRIEVED FROM THE LAST SITE TREATED (LST)
;
;* DG*5.3*572 changed "I"nternal references to "E"xternal references
POW(DGDATA,DFN,LSTDFN) ;POW STATUS INDICATED?
; DGDATA - Data element array from LST, ^TMP("DGROFDA",$J)
; DFN - Pointer to the PATIENT (#2) file
; LSTDFN - Pointer to the patient data from the LST, in DGDATA
N RSPOW ;REQUESTING SITE POW STATUS INDICATED
N LSTPOW ;LAST SITE TREATED POW STATUS INDICATED
S RSPOW=$$GET1^DIQ(2,DFN,.525)
S LSTPOW=$G(@DGDATA@(2,LSTDFN_",",.525,"E"))
;If either of the POW STATUS INDICATED? flags
;are "N"o, don't file the POW data element(s)
I (RSPOW="NO")!(LSTPOW="NO") D
. N FIELD
. F FIELD=.525:.001:.528 K @DGDATA@(2,LSTDFN_",",FIELD)
Q
;
AO(DGDATA,DFN,LSTDFN) ;AGENT ORANGE EXPOSURE INDICATED?
; DGDATA - Data element array from LST, ^TMP("DGROFDA",$J)
; DFN - Pointer to the PATIENT (#2) file
; LSTDFN - Pointer to the patient data from the LST, in DGDATA
N RSAO ;R.S. AGENT ORANGE EXPOSURE INDICATED
N LSTAO ;LST AGENT ORANGE EXPOSURE INDICATED
S RSAO=$$GET1^DIQ(2,DFN,.32102)
S LSTAO=$G(@DGDATA@(2,LSTDFN_",",.32102,"E"))
;If either of the AGENT ORANGE EXPOSURE INDICATED?
;flags are "N"o, delete the AO data element(s)
I (RSAO="NO")!(LSTAO="NO") D
. N FIELD
. ;added AO LOCATION OF EXPOSURE (2/.3213) for DG*5.3*572 DJH
. F FIELD=.32102,.32107,.32108,.32109,.3211,.3213 K @DGDATA@(2,LSTDFN_",",FIELD)
Q
;
IR(DGDATA,DFN,LSTDFN) ;RADIATION EXPOSURE INDICATED?
; DGDATA - Data element array from LST, ^TMP("DGROFDA",$J)
; DFN - Pointer to the PATIENT (#2) file
; LSTDFN - Pointer to the patient data from the LST, in DGDATA
N RSIR ;R.S. RADIATION EXPOSURE INDICATED
N LSTIR ;LST RADIATION EXPOSURE INDICATED
S RSIR=$$GET1^DIQ(2,DFN,.32103)
S LSTIR=$G(@DGDATA@(2,LSTDFN_",",.32103,"E"))
;If either of the RADIATION EXPOSURE INDICATED
;flags are "N"o, delete the IR data elements
I (RSIR="NO")!(LSTIR="NO") D
. N FIELD
. F FIELD=.32103,.32111,.3212 K @DGDATA@(2,LSTDFN_",",FIELD)
Q
;
INC(DGDATA,DFN,LSTDFN) ;RATED INCOMPETENT (Y/N)
; DGDATA - Data element array from LST, ^TMP("DGROFDA",$J)
; DFN - Pointer to the PATIENT (#2) file
; LSTDFN - Pointer to the patient data from the LST, in DGDATA
N RSIN ;RATED INCOMPETENT (Y/N)
N LSTIN ;LST RATED INCOMPETENT (Y/N)
S RSIN=$$GET1^DIQ(2,DFN,.293)
S LSTIN=$G(@DGDATA@(2,LSTDFN_",",.293,"E"))
;If either of the RATED INCOMPETENT
;flags are "N"o, delete the IR data elements
I (RSIN="NO")!(LSTIN="NO") D
. N FIELD
. F FIELD=.292,.293 K @DGDATA@(2,LSTDFN_",",FIELD)
Q
;
INE(DGDATA,DFN,LSTDFN) ;INELIGIBLE DATA
; DGDATA - Data element array from LST, ^TMP("DGROFDA",$J)
; DFN - Pointer to the PATIENT (#2) file
; LSTDFN - Pointer to the patient data from the LST, in DGDATA
;
N LSTID ;INELIGIBLE DATE
S LSTID=$G(@DGDATA@(2,LSTDFN_",",.152,"E"))
;
;If no INELIGIBLE DATE from LST don't upload ineligible fields.
I LSTID="" D
. N FIELD
. F FIELD=.152,.307,.1651,.1653,.1654,.1656 K @DGDATA@(2,LSTDFN_",",FIELD)
Q
;
DOD(DGDATA,DFN,LSTDFN) ;DATE OF DEATH
;Retrieve all DATE OF DEATH data elements, but instead of being filed,
;they will be placed into a mail message to the appropriate group.
;
; DGDATA - Data element array from LST, ^TMP("DGROFDA",$J)
; DFN - Pointer to the PATIENT (#2) file
; LSTDFN - Pointer to the patient data from the LST, in DGDATA
;
N DGMSG,FLD
;Only send messages if actual DOD is defined (field # .351) ;DG*5.3*572
I $D(@DGDATA@(2,LSTDFN_",",.351)) D
. D DODMAIL^DGROMAIL(DGDATA,DFN,LSTDFN)
. S DGMSG(1)=" "
. S DGMSG(2)="Date of Death information has been retrieved from the LST."
. S DGMSG(3)="This information has NOT been filed into the patient's record."
. S DGMSG(4)="A mail message has been sent to the Register Once mail group."
. D EN^DDIOL(.DGMSG) R A:5
;Delete DoD fields from FDA array so they're not filed.
F FLD=.351:.001:.355 K @DGDATA@(2,LSTDFN_",",FLD) ;DG*5.3*572 - added .355
Q
;
TA(DGDATA,LSTDFN) ;TEMPORARY ADDRESS
; DGDATA - Data element array from LST, ^TMP("DGROFDA",$J)
; LSTDFN - Pointer to the patient data from the LST, in DGDATA
N LSTTAED ;LST TEMPORARY ADDRESS END DATE (EXTERNAL)
N LSTTAEDF ;LST TEMPORARY ADDRESS END DATE FILEMAN (DG*5.3*572)
S LSTTAED=$G(@DGDATA@(2,LSTDFN_",",.1218,"E"))
;*Convert External LST date to Fileman date (DG*5.3*572)
S X=LSTTAED
S %DT="RSN"
D ^%DT
S LSTTAEDF=Y
;If the TEMPORARY ADDRESS END DATE is less than the
;date of the query, delete the TA data elements
I (LSTTAEDF>0),(LSTTAEDF<DT) D
. N FIELD
. F FIELD=.12105,.12111,.12112,.1211:.0001:.1219 K @DGDATA@(2,LSTDFN_",",FIELD)
K X,%DT,Y
Q
;
SP(DGDATA,DFN,LSTDFN) ;SENSITIVE PATIENT
; DGDATA - Data element array from LST, ^TMP("DGROFDA",$J)
; DFN - Pointer to the PATIENT (#2) file
; LSTDFN - Pointer to the patient data from the LST, in DGDATA
;
N RSSP ;R.S. SENSITIVE PATIENT
N LSTSP ;LST SENSITIVE PATIENT
S RSSP=$$GET1^DIQ(38.1,DFN,2)
S LSTSP=$G(@DGDATA@(38.1,LSTDFN_",",2,"E"))
;
;* Remove code deleting Primary Eligibility Code (DG*5.3*572)
;* In all cases, delete Patient Type
K @DGDATA@(2,LSTDFN_",",391)
;
;If the SENSITIVE PATIENT flag is received from the HEC -- OR -- if the
;flag is NOT received from both the HEC and LST, retrieve and file all
;Sensitive data elements, but NOT the fields for the Security Log file.
I '((RSSP'="SENSITIVE")&(LSTSP="SENSITIVE")) D I 1
. K @DGDATA@(38.1)
E D
. ;Otherwise (flag not received from the HEC but is from the LST),
. ;send a mail message to the ISO and the "Register Once" mail
. ;group that this patient is listed as Sensitive
. D SPMAIL^DGROMAIL(DFN)
. N DGMSG
. S DGMSG(1)=" "
. S DGMSG(2)="Sensitive Patient information has been retrieved from the LST."
. S DGMSG(3)="This information has been filed into the patient's record."
. S DGMSG(4)="A mail message has been sent to the Register Once mail group"
. S DGMSG(5)="and the ISO explaining that this information has been received."
. D EN^DDIOL(.DGMSG) R A:5
Q
;
SWA(DGDATA,DFN,LSTDFN) ;SOUTHWEST ASIA CONDITIONS
; DGDATA - Data element array from LST, ^TMP("DGROFDA",$J)
; DFN - Pointer to the PATIENT (#2) file
; LSTDFN - Pointer to the patient data from the LST, in DGDATA
N RSSWA ;REQUESTING SITE SOUTHWEST ASIA CONDITIONS
N LSTSWA ;LAST SITE TREATED SOUTHWEST ASIA CONDITIONS
S RSSWA=$$GET1^DIQ(2,DFN,.322013)
S LSTSWA=$G(@DGDATA@(2,LSTDFN_",",.322013,"E"))
;If either of the SOUTHWEST ASIA CONDITIONS flags
;are "N"o, don't file the SOUTWEST ASIA CONDITION data element(s)
I (RSSWA="NO")!(LSTSWA="NO") D
. N FIELD
. F FIELD=.322013,322014,322015 K @DGDATA@(2,LSTDFN_",",FIELD)
Q
;
RE ;RACE AND ETHNICITY
;If the RACE AND ETHNICITY data not already
;populated, file it (already the basic rule)
Q
;
CA(DGDATA,LSTDFN) ;CONFIDENTIAL ADDRESS
; DGDATA - Data element array from LST, ^TMP("DGROFDA",$J)
; LSTDFN - Pointer to the patient data from the LST, in DGDATA
N LSTCAAF ;LST CONFIDENTIAL ADDRESS ACTIVE FLAG
N LSTCAED ;LST CONFIDENTIAL ADDRESS END DATE
N LSTCAEDF ;LST CONFIDENTIAL ADDRESS END DATE FILEMAN (DG*5.3*572)
S LSTCAAF=$G(@DGDATA@(2,LSTDFN_",",.14105,"E"))
S LSTCAED=$G(@DGDATA@(2,LSTDFN_",",.1418,"E"))
;*Convert LSTCAED to Fileman format date for compare (DG*5.3*572)
S X=LSTCAED
S %DT="SN"
D ^%DT
S LSTCAEDF=Y
;If the CONFIDENTIAL ADDRESS FLAG from the Last Site Treated is "N"o,
; OR if the C.A. END DATE from the LST is less than the Query date,
;delete the C.A. data elements
I (LSTCAAF'="YES")!((LSTCAEDF>0)&(LSTCAEDF<DT)) D
. N FIELD
. F FIELD=.1315,.14105,.14111:.00001:.14116,.1411:.0001:.1418 K @DGDATA@(2,LSTDFN_",",FIELD)
. K @DGDATA@(2.141)
;Else the Confidential Address information will be filed
;and a User Interface message will be displayed.
E D
. N DGMSG
. N DATEFM ;*DATE converted to Fileman format (DG*5.3*572)
. S DGMSG(1)=" "
. S DGMSG(2)="Confidential Address information has been retrieved from the LST."
. S DGMSG(3)="This information has been filed into the patient's record."
. S DATE=$G(@DGDATA@(2,LSTDFN_",",.1417,"E"))
. ;* Convert DATE to FM format (DG*5.3*572)
. K X,%DT,Y
. S X=DATE
. S %DT="SN"
. D ^%DT
. S DATEFM=Y
. I DATEFM>DT D
. . S DGMSG(4)=" NOTE: Confidential Address Start Date is in the future, "_DATE
. . S DGMSG(5)=" "
. D EN^DDIOL(.DGMSG) R A:5
K X,%DT,Y
Q
;
PA(DGDATA,LSTDFN) ;PERMANENT ADDRESS
; DGDATA - Data element array from LST, ^TMP("DGROFDA",$J)
; LSTDFN - Pointer to the patient data from the LST, in DGDATA
N LSTBAI ;LST BAD ADDRESS INDICATOR
S LSTBAI=$G(@DGDATA@(2,LSTDFN_",",.121,"E"))
;If the BAD ADDRESS INDICATOR from LST is NOT null,
;delete the PERMANENT ADDRESS data elements
I LSTBAI'="" D
. N FIELD
. F FIELD=.1112,.111:.001:.119,.12,.121 K @DGDATA@(2,LSTDFN_",",FIELD)
Q
;
RDOC(DGDATA,DFN,LSTDFN) ;RECENT DATE(S) OF CARE
; DGDATA - Data element array from LST, ^TMP("DGROFDA",$J)
; DFN - Pointer to the PATIENT (#2) file
; LSTDFN - Pointer to the patient data from the LST, in DGDATA
N LSTRCP ;LST RECEIVED VA CARE PREVIOUSLY?
N LSTLOC1 ;LST MOST RECENT LOCATION OF CARE
S LSTRCP=$G(@DGDATA@(2,LSTDFN_",",1010.15,"E"))
S LSTLOC1=$G(@DGDATA@(2,LSTDFN_",",1010.152,"E"))
;
;If the RECEIVED VA CARE PREVIOUSLY? from LST is not YES,
; OR the MOST RECENT LOCATION OF CARE from LST is NULL,
;delete all the RDOC fields.
I (LSTRCP'="YES")!(LSTLOC1="") D
. N FIELD
. F FIELD=1010.15,1010.151,1010.152,1010.153,1010.154 K @DGDATA@(2,LSTDFN_",",FIELD)
Q
;
MSE(DGDATA,LSTDFN) ;MILITARY SERVICE EPISODES
; DGDATA - Data element array from LST, ^TMP("DGROFDA",$J)
; LSTDFN - Pointer to the patient data from the LST, in DGDATA
;
;If new format MSE data exists from last site visited then do
;NOT load old format MSE data.
;
I $D(@DGDATA@(2.3216)) D
.N FIELD
.F FIELD=.324,.325,.326,.327,.328,.3285,.329,.3291,.32911,.32912,.32913,.3292,.3293,.3294,.32945,.3295,.3296,.3297,.3298,.3299 K @DGDATA@(2,LSTDFN_",",FIELD)
Q
DGRODEBR ;DJH/AMA,TDM - ROM DATA ELEMENT BUSINESS RULES ; 10/20/10 9:59am
+1 ;;5.3;PIMS;**533,572,1015,1016**;JUN 30, 2012;Build 20
+2 ;
+3 ;BUSINESS RULES TO BE CHECKED JUST BEFORE FILING THE
+4 ;PATIENT DATA RETRIEVED FROM THE LAST SITE TREATED (LST)
+5 ;
+6 ;* DG*5.3*572 changed "I"nternal references to "E"xternal references
POW(DGDATA,DFN,LSTDFN) ;POW STATUS INDICATED?
+1 ; DGDATA - Data element array from LST, ^TMP("DGROFDA",$J)
+2 ; DFN - Pointer to the PATIENT (#2) file
+3 ; LSTDFN - Pointer to the patient data from the LST, in DGDATA
+4 ;REQUESTING SITE POW STATUS INDICATED
NEW RSPOW
+5 ;LAST SITE TREATED POW STATUS INDICATED
NEW LSTPOW
+6 SET RSPOW=$$GET1^DIQ(2,DFN,.525)
+7 SET LSTPOW=$GET(@DGDATA@(2,LSTDFN_",",.525,"E"))
+8 ;If either of the POW STATUS INDICATED? flags
+9 ;are "N"o, don't file the POW data element(s)
+10 IF (RSPOW="NO")!(LSTPOW="NO")
Begin DoDot:1
+11 NEW FIELD
+12 FOR FIELD=.525:.001:.528
KILL @DGDATA@(2,LSTDFN_",",FIELD)
End DoDot:1
+13 QUIT
+14 ;
AO(DGDATA,DFN,LSTDFN) ;AGENT ORANGE EXPOSURE INDICATED?
+1 ; DGDATA - Data element array from LST, ^TMP("DGROFDA",$J)
+2 ; DFN - Pointer to the PATIENT (#2) file
+3 ; LSTDFN - Pointer to the patient data from the LST, in DGDATA
+4 ;R.S. AGENT ORANGE EXPOSURE INDICATED
NEW RSAO
+5 ;LST AGENT ORANGE EXPOSURE INDICATED
NEW LSTAO
+6 SET RSAO=$$GET1^DIQ(2,DFN,.32102)
+7 SET LSTAO=$GET(@DGDATA@(2,LSTDFN_",",.32102,"E"))
+8 ;If either of the AGENT ORANGE EXPOSURE INDICATED?
+9 ;flags are "N"o, delete the AO data element(s)
+10 IF (RSAO="NO")!(LSTAO="NO")
Begin DoDot:1
+11 NEW FIELD
+12 ;added AO LOCATION OF EXPOSURE (2/.3213) for DG*5.3*572 DJH
+13 FOR FIELD=.32102,.32107,.32108,.32109,.3211,.3213
KILL @DGDATA@(2,LSTDFN_",",FIELD)
End DoDot:1
+14 QUIT
+15 ;
IR(DGDATA,DFN,LSTDFN) ;RADIATION EXPOSURE INDICATED?
+1 ; DGDATA - Data element array from LST, ^TMP("DGROFDA",$J)
+2 ; DFN - Pointer to the PATIENT (#2) file
+3 ; LSTDFN - Pointer to the patient data from the LST, in DGDATA
+4 ;R.S. RADIATION EXPOSURE INDICATED
NEW RSIR
+5 ;LST RADIATION EXPOSURE INDICATED
NEW LSTIR
+6 SET RSIR=$$GET1^DIQ(2,DFN,.32103)
+7 SET LSTIR=$GET(@DGDATA@(2,LSTDFN_",",.32103,"E"))
+8 ;If either of the RADIATION EXPOSURE INDICATED
+9 ;flags are "N"o, delete the IR data elements
+10 IF (RSIR="NO")!(LSTIR="NO")
Begin DoDot:1
+11 NEW FIELD
+12 FOR FIELD=.32103,.32111,.3212
KILL @DGDATA@(2,LSTDFN_",",FIELD)
End DoDot:1
+13 QUIT
+14 ;
INC(DGDATA,DFN,LSTDFN) ;RATED INCOMPETENT (Y/N)
+1 ; DGDATA - Data element array from LST, ^TMP("DGROFDA",$J)
+2 ; DFN - Pointer to the PATIENT (#2) file
+3 ; LSTDFN - Pointer to the patient data from the LST, in DGDATA
+4 ;RATED INCOMPETENT (Y/N)
NEW RSIN
+5 ;LST RATED INCOMPETENT (Y/N)
NEW LSTIN
+6 SET RSIN=$$GET1^DIQ(2,DFN,.293)
+7 SET LSTIN=$GET(@DGDATA@(2,LSTDFN_",",.293,"E"))
+8 ;If either of the RATED INCOMPETENT
+9 ;flags are "N"o, delete the IR data elements
+10 IF (RSIN="NO")!(LSTIN="NO")
Begin DoDot:1
+11 NEW FIELD
+12 FOR FIELD=.292,.293
KILL @DGDATA@(2,LSTDFN_",",FIELD)
End DoDot:1
+13 QUIT
+14 ;
INE(DGDATA,DFN,LSTDFN) ;INELIGIBLE DATA
+1 ; DGDATA - Data element array from LST, ^TMP("DGROFDA",$J)
+2 ; DFN - Pointer to the PATIENT (#2) file
+3 ; LSTDFN - Pointer to the patient data from the LST, in DGDATA
+4 ;
+5 ;INELIGIBLE DATE
NEW LSTID
+6 SET LSTID=$GET(@DGDATA@(2,LSTDFN_",",.152,"E"))
+7 ;
+8 ;If no INELIGIBLE DATE from LST don't upload ineligible fields.
+9 IF LSTID=""
Begin DoDot:1
+10 NEW FIELD
+11 FOR FIELD=.152,.307,.1651,.1653,.1654,.1656
KILL @DGDATA@(2,LSTDFN_",",FIELD)
End DoDot:1
+12 QUIT
+13 ;
DOD(DGDATA,DFN,LSTDFN) ;DATE OF DEATH
+1 ;Retrieve all DATE OF DEATH data elements, but instead of being filed,
+2 ;they will be placed into a mail message to the appropriate group.
+3 ;
+4 ; DGDATA - Data element array from LST, ^TMP("DGROFDA",$J)
+5 ; DFN - Pointer to the PATIENT (#2) file
+6 ; LSTDFN - Pointer to the patient data from the LST, in DGDATA
+7 ;
+8 NEW DGMSG,FLD
+9 ;Only send messages if actual DOD is defined (field # .351) ;DG*5.3*572
+10 IF $DATA(@DGDATA@(2,LSTDFN_",",.351))
Begin DoDot:1
+11 DO DODMAIL^DGROMAIL(DGDATA,DFN,LSTDFN)
+12 SET DGMSG(1)=" "
+13 SET DGMSG(2)="Date of Death information has been retrieved from the LST."
+14 SET DGMSG(3)="This information has NOT been filed into the patient's record."
+15 SET DGMSG(4)="A mail message has been sent to the Register Once mail group."
+16 DO EN^DDIOL(.DGMSG)
READ A:5
End DoDot:1
+17 ;Delete DoD fields from FDA array so they're not filed.
+18 ;DG*5.3*572 - added .355
FOR FLD=.351:.001:.355
KILL @DGDATA@(2,LSTDFN_",",FLD)
+19 QUIT
+20 ;
TA(DGDATA,LSTDFN) ;TEMPORARY ADDRESS
+1 ; DGDATA - Data element array from LST, ^TMP("DGROFDA",$J)
+2 ; LSTDFN - Pointer to the patient data from the LST, in DGDATA
+3 ;LST TEMPORARY ADDRESS END DATE (EXTERNAL)
NEW LSTTAED
+4 ;LST TEMPORARY ADDRESS END DATE FILEMAN (DG*5.3*572)
NEW LSTTAEDF
+5 SET LSTTAED=$GET(@DGDATA@(2,LSTDFN_",",.1218,"E"))
+6 ;*Convert External LST date to Fileman date (DG*5.3*572)
+7 SET X=LSTTAED
+8 SET %DT="RSN"
+9 DO ^%DT
+10 SET LSTTAEDF=Y
+11 ;If the TEMPORARY ADDRESS END DATE is less than the
+12 ;date of the query, delete the TA data elements
+13 IF (LSTTAEDF>0)
IF (LSTTAEDF<DT)
Begin DoDot:1
+14 NEW FIELD
+15 FOR FIELD=.12105,.12111,.12112,.1211:.0001:.1219
KILL @DGDATA@(2,LSTDFN_",",FIELD)
End DoDot:1
+16 KILL X,%DT,Y
+17 QUIT
+18 ;
SP(DGDATA,DFN,LSTDFN) ;SENSITIVE PATIENT
+1 ; DGDATA - Data element array from LST, ^TMP("DGROFDA",$J)
+2 ; DFN - Pointer to the PATIENT (#2) file
+3 ; LSTDFN - Pointer to the patient data from the LST, in DGDATA
+4 ;
+5 ;R.S. SENSITIVE PATIENT
NEW RSSP
+6 ;LST SENSITIVE PATIENT
NEW LSTSP
+7 SET RSSP=$$GET1^DIQ(38.1,DFN,2)
+8 SET LSTSP=$GET(@DGDATA@(38.1,LSTDFN_",",2,"E"))
+9 ;
+10 ;* Remove code deleting Primary Eligibility Code (DG*5.3*572)
+11 ;* In all cases, delete Patient Type
+12 KILL @DGDATA@(2,LSTDFN_",",391)
+13 ;
+14 ;If the SENSITIVE PATIENT flag is received from the HEC -- OR -- if the
+15 ;flag is NOT received from both the HEC and LST, retrieve and file all
+16 ;Sensitive data elements, but NOT the fields for the Security Log file.
+17 IF '((RSSP'="SENSITIVE")&(LSTSP="SENSITIVE"))
Begin DoDot:1
+18 KILL @DGDATA@(38.1)
End DoDot:1
IF 1
+19 IF '$TEST
Begin DoDot:1
+20 ;Otherwise (flag not received from the HEC but is from the LST),
+21 ;send a mail message to the ISO and the "Register Once" mail
+22 ;group that this patient is listed as Sensitive
+23 DO SPMAIL^DGROMAIL(DFN)
+24 NEW DGMSG
+25 SET DGMSG(1)=" "
+26 SET DGMSG(2)="Sensitive Patient information has been retrieved from the LST."
+27 SET DGMSG(3)="This information has been filed into the patient's record."
+28 SET DGMSG(4)="A mail message has been sent to the Register Once mail group"
+29 SET DGMSG(5)="and the ISO explaining that this information has been received."
+30 DO EN^DDIOL(.DGMSG)
READ A:5
End DoDot:1
+31 QUIT
+32 ;
SWA(DGDATA,DFN,LSTDFN) ;SOUTHWEST ASIA CONDITIONS
+1 ; DGDATA - Data element array from LST, ^TMP("DGROFDA",$J)
+2 ; DFN - Pointer to the PATIENT (#2) file
+3 ; LSTDFN - Pointer to the patient data from the LST, in DGDATA
+4 ;REQUESTING SITE SOUTHWEST ASIA CONDITIONS
NEW RSSWA
+5 ;LAST SITE TREATED SOUTHWEST ASIA CONDITIONS
NEW LSTSWA
+6 SET RSSWA=$$GET1^DIQ(2,DFN,.322013)
+7 SET LSTSWA=$GET(@DGDATA@(2,LSTDFN_",",.322013,"E"))
+8 ;If either of the SOUTHWEST ASIA CONDITIONS flags
+9 ;are "N"o, don't file the SOUTWEST ASIA CONDITION data element(s)
+10 IF (RSSWA="NO")!(LSTSWA="NO")
Begin DoDot:1
+11 NEW FIELD
+12 FOR FIELD=.322013,322014,322015
KILL @DGDATA@(2,LSTDFN_",",FIELD)
End DoDot:1
+13 QUIT
+14 ;
RE ;RACE AND ETHNICITY
+1 ;If the RACE AND ETHNICITY data not already
+2 ;populated, file it (already the basic rule)
+3 QUIT
+4 ;
CA(DGDATA,LSTDFN) ;CONFIDENTIAL ADDRESS
+1 ; DGDATA - Data element array from LST, ^TMP("DGROFDA",$J)
+2 ; LSTDFN - Pointer to the patient data from the LST, in DGDATA
+3 ;LST CONFIDENTIAL ADDRESS ACTIVE FLAG
NEW LSTCAAF
+4 ;LST CONFIDENTIAL ADDRESS END DATE
NEW LSTCAED
+5 ;LST CONFIDENTIAL ADDRESS END DATE FILEMAN (DG*5.3*572)
NEW LSTCAEDF
+6 SET LSTCAAF=$GET(@DGDATA@(2,LSTDFN_",",.14105,"E"))
+7 SET LSTCAED=$GET(@DGDATA@(2,LSTDFN_",",.1418,"E"))
+8 ;*Convert LSTCAED to Fileman format date for compare (DG*5.3*572)
+9 SET X=LSTCAED
+10 SET %DT="SN"
+11 DO ^%DT
+12 SET LSTCAEDF=Y
+13 ;If the CONFIDENTIAL ADDRESS FLAG from the Last Site Treated is "N"o,
+14 ; OR if the C.A. END DATE from the LST is less than the Query date,
+15 ;delete the C.A. data elements
+16 IF (LSTCAAF'="YES")!((LSTCAEDF>0)&(LSTCAEDF<DT))
Begin DoDot:1
+17 NEW FIELD
+18 FOR FIELD=.1315,.14105,.14111:.00001:.14116,.1411:.0001:.1418
KILL @DGDATA@(2,LSTDFN_",",FIELD)
+19 KILL @DGDATA@(2.141)
End DoDot:1
+20 ;Else the Confidential Address information will be filed
+21 ;and a User Interface message will be displayed.
+22 IF '$TEST
Begin DoDot:1
+23 NEW DGMSG
+24 ;*DATE converted to Fileman format (DG*5.3*572)
NEW DATEFM
+25 SET DGMSG(1)=" "
+26 SET DGMSG(2)="Confidential Address information has been retrieved from the LST."
+27 SET DGMSG(3)="This information has been filed into the patient's record."
+28 SET DATE=$GET(@DGDATA@(2,LSTDFN_",",.1417,"E"))
+29 ;* Convert DATE to FM format (DG*5.3*572)
+30 KILL X,%DT,Y
+31 SET X=DATE
+32 SET %DT="SN"
+33 DO ^%DT
+34 SET DATEFM=Y
+35 IF DATEFM>DT
Begin DoDot:2
+36 SET DGMSG(4)=" NOTE: Confidential Address Start Date is in the future, "_DATE
+37 SET DGMSG(5)=" "
End DoDot:2
+38 DO EN^DDIOL(.DGMSG)
READ A:5
End DoDot:1
+39 KILL X,%DT,Y
+40 QUIT
+41 ;
PA(DGDATA,LSTDFN) ;PERMANENT ADDRESS
+1 ; DGDATA - Data element array from LST, ^TMP("DGROFDA",$J)
+2 ; LSTDFN - Pointer to the patient data from the LST, in DGDATA
+3 ;LST BAD ADDRESS INDICATOR
NEW LSTBAI
+4 SET LSTBAI=$GET(@DGDATA@(2,LSTDFN_",",.121,"E"))
+5 ;If the BAD ADDRESS INDICATOR from LST is NOT null,
+6 ;delete the PERMANENT ADDRESS data elements
+7 IF LSTBAI'=""
Begin DoDot:1
+8 NEW FIELD
+9 FOR FIELD=.1112,.111:.001:.119,.12,.121
KILL @DGDATA@(2,LSTDFN_",",FIELD)
End DoDot:1
+10 QUIT
+11 ;
RDOC(DGDATA,DFN,LSTDFN) ;RECENT DATE(S) OF CARE
+1 ; DGDATA - Data element array from LST, ^TMP("DGROFDA",$J)
+2 ; DFN - Pointer to the PATIENT (#2) file
+3 ; LSTDFN - Pointer to the patient data from the LST, in DGDATA
+4 ;LST RECEIVED VA CARE PREVIOUSLY?
NEW LSTRCP
+5 ;LST MOST RECENT LOCATION OF CARE
NEW LSTLOC1
+6 SET LSTRCP=$GET(@DGDATA@(2,LSTDFN_",",1010.15,"E"))
+7 SET LSTLOC1=$GET(@DGDATA@(2,LSTDFN_",",1010.152,"E"))
+8 ;
+9 ;If the RECEIVED VA CARE PREVIOUSLY? from LST is not YES,
+10 ; OR the MOST RECENT LOCATION OF CARE from LST is NULL,
+11 ;delete all the RDOC fields.
+12 IF (LSTRCP'="YES")!(LSTLOC1="")
Begin DoDot:1
+13 NEW FIELD
+14 FOR FIELD=1010.15,1010.151,1010.152,1010.153,1010.154
KILL @DGDATA@(2,LSTDFN_",",FIELD)
End DoDot:1
+15 QUIT
+16 ;
MSE(DGDATA,LSTDFN) ;MILITARY SERVICE EPISODES
+1 ; DGDATA - Data element array from LST, ^TMP("DGROFDA",$J)
+2 ; LSTDFN - Pointer to the patient data from the LST, in DGDATA
+3 ;
+4 ;If new format MSE data exists from last site visited then do
+5 ;NOT load old format MSE data.
+6 ;
+7 IF $DATA(@DGDATA@(2.3216))
Begin DoDot:1
+8 NEW FIELD
+9 FOR FIELD=.324,.325,.326,.327,.328,.3285,.329,.3291,.32911,.32912,.32913,.3292,.3293,.3294,.32945,.3295,.3296,.3297,.3298,.3299
KILL @DGDATA@(2,LSTDFN_",",FIELD)
End DoDot:1
+10 QUIT
