DGENPTA1 ;ALB/CJM,EG,CKN,ERC,TDM,PWC,JAM,KUM - Patient API - File Data ;7/24/24 4:54PM
;;5.3;Registration;**121,147,314,677,659,653,688,810,754,838,841,842,978,1036,1064,1093,1103,1121**;Aug 13,1993;Build 14
;Per VHA Directive 2004-038, this routine should not be modified.
;
LOCK(DFN) ;
;Description: Given an internal entry number of a PATIENT record, this
; function will lock the record. It should be used when updating the
; record.
;Input:
; DFN - Patient IEN
;Output:
; Function Value - Returns 1 if the lock was successful, 0 otherwise
;
I $G(DFN) L +^DPT(DFN):2
Q $T
UNLOCK(DFN) ;
;Description: Given an internal entry number of a record in the PATIENT
; file, this function will unlock the record that was previously
; locked by LOCK PATIENT RECORD.
;Input:
; DFN - Patient IEN
;Output: None
;
I $G(DFN) L -^DPT(DFN)
Q
;
STOREPRE(DFN,DGPREFAC) ;
;Description: Used to store the patient's preferred facility in the
; patient record.
;Input:
; DFN - Patient IEN
; DGPREFAC - pointer to the record in the INSTITUTION file.
;Output:
; Function Value - Returns 1 on success, 0 on failure.
;
N SUCCESS,DATA
S SUCCESS=1
D ;drops out if invalid condition found
. I $G(DFN),$D(^DPT(DFN,0))
. E S SUCCESS=0 Q
. I ($G(DGPREFAC)'=""),'$G(DGPREFAC) S SUCCESS=0 Q
. I $G(DGPREFAC),'$D(^DIC(4,DGPREFAC,0)) S SUCCESS=0 Q
. S DATA(27.02)=DGPREFAC
. S DATA(27.03)="V" ; DG*5.3*838
. S SUCCESS=$$UPD^DGENDBS(2,DFN,.DATA)
Q SUCCESS
;
CHECK(DGPAT,ERROR) ;
;Description: Does validation checks on the patient contained in the
;DGPAT array.
;
;Input:
; DGPAT - this local array contains patient data
;Output:
; Function Value - returns 1 if all validation checks passed, 0 otherwise
; ERROR - if validation checks fail, an error message is returned (pass by reference)
;
;
N SUCCESS,FIELD
S SUCCESS=1
S ERROR=""
;
;check field values
;
;some of the field's input transforms require DA or DUZ to be defined, so do not do this
;F S SUB=$O(DGPAT(SUB)) Q:SUB="" D:(DGPAT(SUB)'="") Q:'SUCCESS
;.S FIELD=$$FIELD(SUB)
;.I '$$TESTVAL^DGENDBS(2,FIELD,DGPAT(SUB)) D
;..S SUCCESS=0
;..S ERROR="BAD FIELD VALUE, PATIENT FILE FIELD = "_$$GET1^DID(2,FIELD,,"LABEL")
;
;instead, check field values without referencing DD
I DGPAT("INELDEC")'="",($L(DGPAT("INELDEC"))>75)!($L(DGPAT("INELDEC"))<3) S SUCCESS=0,ERROR="BAD FIELD VALUE, PATIENT FIELD FIELD = INELIGIBLE VARO DECISION" G QCHECK
;
I DGPAT("INELREA")'="",($L(DGPAT("INELREA"))>40) S SUCCESS=0,ERROR="BAD FIELD VALUE, PATIENT FIELD FIELD = INELIGIBLE REASON" G QCHECK
;
I DGPAT("VETERAN")="" S SUCCESS=0,ERROR="BAD FIELD VALUE, PATIENT FIELD = VETERAN (Y/N)?" G QCHECK
;
I DGPAT("DEATH"),(DGPAT("DEATH")>$$NOW^XLFDT) S SUCCESS=0,ERROR="DATE OF DEATH CAN NOT BE A FUTURE DATE" G QCHECK
;
I DGPAT("INELDATE"),(DGPAT("INELREA")="") S SUCCESS=0,ERROR="INELIGIBLE REASON UNSPECIFIED FOR INELIGIBLE PATIENT" G QCHECK
;
QCHECK ;
Q SUCCESS
;
STORE(DGPAT,ERROR,NOCHECK) ;
;Description: Files data in the patient record. It requires a lock
;on the Patient record, adn releases the lock when done.
;
;Input:
; DGPAT- the patient array, passed by reference
; NOCHECK - a flag, if set to 1 it means consistency checks were done aready, so skip
;
;Output:
; Function Value - returns 1 if successful, otherwise 0
; ERROR - on failure, an error message is returned (optional, pass by reference)
;
S ERROR=""
I '$D(DGPAT) S ERROR="PATIENT NOT FOUND" Q 0
I '$$LOCK(DGPAT("DFN")) S ERROR="UNABLE TO LOCK THE PATIENT RECORD" Q 0
I $G(NOCHECK)'=1 Q:'$$CHECK(.DGPAT,.ERROR) 0
;
N DATA,SUB,FIELD,SUCCESS,DGINDID,DGINDAD,DGINDSD,DGINDED,DGINDARR
S SUB=""
;
; DG*5.3*1064
; Check value in Patient file is changed, then only update
D GETS^DIQ(2,DFN,".571:.574","I","DGINDARR")
S DGINDID=$G(DGINDARR(2,DFN_",",.571,"I"))
S DGINDAD=$G(DGINDARR(2,DFN_",",.573,"I"))
S DGINDSD=$G(DGINDARR(2,DFN_",",.572,"I"))
S DGINDED=$G(DGINDARR(2,DFN_",",.574,"I"))
; DG*5.3*1093 - Add $G for IND fields to cover null values being sent in ZPD
I DGINDID=$G(DGPAT("INDID")) K DGPAT("INDID")
I DGINDAD=$G(DGPAT("INDADT")) K DGPAT("INDADT")
I DGINDSD=$G(DGPAT("INDSDT")) K DGPAT("INDSDT")
; If Indian End Date is blank or double quotes, delete the field in Patient file
I DGINDED'=$G(DGPAT("INDEDT")),$G(DGPAT("INDEDT"))="" S DGPAT("INDEDT")="@"
I DGINDED=$G(DGPAT("INDEDT")) K DGPAT("INDEDT")
;DG*5.3*1121 - Delete Persian Gulf indicator and Persian Gulf Change date if they are blank
I $G(DGPAT("PGULFTS"))="" S DGPAT("PGULFTS")="@"
I $G(DGPAT("PGULF"))="" S DGPAT("PGULF")="@"
;
F S SUB=$O(DGPAT(SUB)) Q:(SUB="") I (SUB'="DEATH")&(SUB'="SSN") S FIELD=$$FIELD(SUB) I FIELD S DATA(FIELD)=$G(DGPAT(SUB))
S SUCCESS=$$UPD^DGENDBS(2,DGPAT("DFN"),.DATA)
I 'SUCCESS S ERROR="FILEMAN UNABLE TO UPDATE PATIENT RECORD"
; jam; dg*5.3*978 - 1010.1514 and 1010.1515 fields added to the ZIO segment (seq 7 and 10) - ORIG APPT REQUEST CHG DT/TM and APPT REQUEST ON 1010EZ CHG DT/TM
; these are timestamps that may have been triggered by VistA filing the other 1010.* fields above.
; So we set those values from the HL7 into the database now - after those others have been filed
I SUCCESS,$D(DGPAT("APPREQTS")) D
. N DATA,DGENDA
. S DGENDA=DGPAT("DFN")
. S DATA(1010.1515)=DGPAT("APPREQTS")
. S SUCCESS=$$UPD^DGENDBS(2,.DGENDA,.DATA)
. K DATA,DGENDA
I SUCCESS,$D(DGPAT("ORIGAPPREQTS")) D
. N DATA,DGENDA
. S DGENDA=DGPAT("DFN")
. S DATA(1010.1514)=DGPAT("ORIGAPPREQTS")
. S SUCCESS=$$UPD^DGENDBS(2,.DGENDA,.DATA)
. K DATA,DGENDA
;
; Call Purple Heart API to file PH data in file 2
I SUCCESS,$D(DGPAT("PHI")) D EDITPH^DGRPLE($G(DGPAT("PHI")),$G(DGPAT("PHST")),$G(DGPAT("PHRR")),DGPAT("DFN"))
; Call POW API to file POW data in file 2 - DG*5.3*653
;I SUCCESS,$D(DGPAT("POWI")) D EDITPOW^DGRPLE($G(DGPAT("POWI")),$G(DGPAT("POWLOC")),$G(DGPAT("POWFDT")),$G(DGPAT("POWTDT")),DGPAT("DFN"))
I SUCCESS D
. I '$D(DGPAT("POWI")) D Q
. . N DATA,ERROR,DGENDA
. . S DGENDA=DGPAT("DFN")
. . S (DATA(.525),DATA(.526),DATA(.527),DATA(.528),DATA(.529))="@"
. . I '$$UPD^DGENDBS(2,.DGENDA,.DATA,.ERROR) D
. . . D ADDMSG^DGENUPL3(.MSGS,"Unable to update POW Data.",1)
. . K DATA,ERROR,DGENDA
. D EDITPOW^DGRPLE($G(DGPAT("POWI")),$G(DGPAT("POWLOC")),$G(DGPAT("POWFDT")),$G(DGPAT("POWTDT")),DGPAT("DFN"))
D UNLOCK(DGPAT("DFN"))
Q SUCCESS
;
FIELD(SUB) ;
;Description: Returns the field number of a subscript for the PATIENT object.
;
N FNUM
S FNUM=$S(SUB="DEATH":.351,SUB="PATYPE":391,SUB="VETERAN":1901,SUB="NAME":.01,SUB="DOB":.03,SUB="SEX":.02,SUB="SSN":.09,SUB="PREFAC":27.02,SUB="AG/ALLY":.309,1:"")
S:'FNUM FNUM=$S(SUB="INELDATE":.152,SUB="INELREA":.307,SUB="INELDEC":.1656,SUB="PID":.363,SUB="EMGRES":.181,1:"")
I FNUM="" S FNUM=$S(SUB="IR":.32103,SUB="RADEXPM":.3212,SUB="APPREQ":1010.159,SUB="APPREQDT":1010.1511,SUB="SPININJ":57.4,SUB="PFSRC":27.03,1:"")
; jam; DG*5.3*978 - these fields added to the ZIO segment (seq 8 and 9) - ORIGINAL APPOINTMENT REQUEST and ORIG APPT REQUEST DATE
I FNUM="" S FNUM=$S(SUB="ORIGAPPREQ":1010.1512,SUB="ORIGAPPREQDT":1010.1513,1:"")
I FNUM="" S FNUM=$S(SUB="MOH":.541,SUB="DENTC2IN":.3858,SUB="DENTC2DT":.3859,1:"")
I FNUM="" S FNUM=$S(SUB="PENAEFDT":.3851,SUB="PENAREAS":.3852,SUB="PENTRMDT":.3853,1:"")
I FNUM="" S FNUM=$S(SUB="PENTRMR1":.3854,SUB="PENTRMR2":.3855,SUB="PENTRMR3":.3856,SUB="PENTRMR4":.3857,SUB="PILOCK":.386,SUB="PALOCK":.3861,1:"")
; DG*5.3*1064
I FNUM="" S FNUM=$S(SUB="INDID":.571,SUB="INDADT":.573,SUB="INDSDT":.572,SUB="INDEDT":.574,1:"")
; DG*5.3*1103 - Update Toxic Exposure Risk Activity (TERA) indicator that is received from ZEL segment sequence #48
I FNUM="" S FNUM=$S(SUB="TERA":.32116,1:"")
;DG*5.3*1121 - Update Persian Gulf indicator and last change date that are received from ZEL segment sequence numbers #49 and #50
I FNUM="" S FNUM=$S(SUB="PGULF":.32117,SUB="PGULFTS":.32118,1:"")
Q FNUM
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGENPTA1 8106 printed Dec 13, 2024@02:42:55 Page 2
DGENPTA1 ;ALB/CJM,EG,CKN,ERC,TDM,PWC,JAM,KUM - Patient API - File Data ;7/24/24 4:54PM
+1 ;;5.3;Registration;**121,147,314,677,659,653,688,810,754,838,841,842,978,1036,1064,1093,1103,1121**;Aug 13,1993;Build 14
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
LOCK(DFN) ;
+1 ;Description: Given an internal entry number of a PATIENT record, this
+2 ; function will lock the record. It should be used when updating the
+3 ; record.
+4 ;Input:
+5 ; DFN - Patient IEN
+6 ;Output:
+7 ; Function Value - Returns 1 if the lock was successful, 0 otherwise
+8 ;
+9 IF $GET(DFN)
LOCK +^DPT(DFN):2
+10 QUIT $TEST
UNLOCK(DFN) ;
+1 ;Description: Given an internal entry number of a record in the PATIENT
+2 ; file, this function will unlock the record that was previously
+3 ; locked by LOCK PATIENT RECORD.
+4 ;Input:
+5 ; DFN - Patient IEN
+6 ;Output: None
+7 ;
+8 IF $GET(DFN)
LOCK -^DPT(DFN)
+9 QUIT
+10 ;
STOREPRE(DFN,DGPREFAC) ;
+1 ;Description: Used to store the patient's preferred facility in the
+2 ; patient record.
+3 ;Input:
+4 ; DFN - Patient IEN
+5 ; DGPREFAC - pointer to the record in the INSTITUTION file.
+6 ;Output:
+7 ; Function Value - Returns 1 on success, 0 on failure.
+8 ;
+9 NEW SUCCESS,DATA
+10 SET SUCCESS=1
+11 ;drops out if invalid condition found
Begin DoDot:1
+12 IF $GET(DFN)
IF $DATA(^DPT(DFN,0))
+13 IF '$TEST
SET SUCCESS=0
QUIT
+14 IF ($GET(DGPREFAC)'="")
IF '$GET(DGPREFAC)
SET SUCCESS=0
QUIT
+15 IF $GET(DGPREFAC)
IF '$DATA(^DIC(4,DGPREFAC,0))
SET SUCCESS=0
QUIT
+16 SET DATA(27.02)=DGPREFAC
+17 ; DG*5.3*838
SET DATA(27.03)="V"
+18 SET SUCCESS=$$UPD^DGENDBS(2,DFN,.DATA)
End DoDot:1
+19 QUIT SUCCESS
+20 ;
CHECK(DGPAT,ERROR) ;
+1 ;Description: Does validation checks on the patient contained in the
+2 ;DGPAT array.
+3 ;
+4 ;Input:
+5 ; DGPAT - this local array contains patient data
+6 ;Output:
+7 ; Function Value - returns 1 if all validation checks passed, 0 otherwise
+8 ; ERROR - if validation checks fail, an error message is returned (pass by reference)
+9 ;
+10 ;
+11 NEW SUCCESS,FIELD
+12 SET SUCCESS=1
+13 SET ERROR=""
+14 ;
+15 ;check field values
+16 ;
+17 ;some of the field's input transforms require DA or DUZ to be defined, so do not do this
+18 ;F S SUB=$O(DGPAT(SUB)) Q:SUB="" D:(DGPAT(SUB)'="") Q:'SUCCESS
+19 ;.S FIELD=$$FIELD(SUB)
+20 ;.I '$$TESTVAL^DGENDBS(2,FIELD,DGPAT(SUB)) D
+21 ;..S SUCCESS=0
+22 ;..S ERROR="BAD FIELD VALUE, PATIENT FILE FIELD = "_$$GET1^DID(2,FIELD,,"LABEL")
+23 ;
+24 ;instead, check field values without referencing DD
+25 IF DGPAT("INELDEC")'=""
IF ($LENGTH(DGPAT("INELDEC"))>75)!($LENGTH(DGPAT("INELDEC"))<3)
SET SUCCESS=0
SET ERROR="BAD FIELD VALUE, PATIENT FIELD FIELD = INELIGIBLE VARO DECISION"
GOTO QCHECK
+26 ;
+27 IF DGPAT("INELREA")'=""
IF ($LENGTH(DGPAT("INELREA"))>40)
SET SUCCESS=0
SET ERROR="BAD FIELD VALUE, PATIENT FIELD FIELD = INELIGIBLE REASON"
GOTO QCHECK
+28 ;
+29 IF DGPAT("VETERAN")=""
SET SUCCESS=0
SET ERROR="BAD FIELD VALUE, PATIENT FIELD = VETERAN (Y/N)?"
GOTO QCHECK
+30 ;
+31 IF DGPAT("DEATH")
IF (DGPAT("DEATH")>$$NOW^XLFDT)
SET SUCCESS=0
SET ERROR="DATE OF DEATH CAN NOT BE A FUTURE DATE"
GOTO QCHECK
+32 ;
+33 IF DGPAT("INELDATE")
IF (DGPAT("INELREA")="")
SET SUCCESS=0
SET ERROR="INELIGIBLE REASON UNSPECIFIED FOR INELIGIBLE PATIENT"
GOTO QCHECK
+34 ;
QCHECK ;
+1 QUIT SUCCESS
+2 ;
STORE(DGPAT,ERROR,NOCHECK) ;
+1 ;Description: Files data in the patient record. It requires a lock
+2 ;on the Patient record, adn releases the lock when done.
+3 ;
+4 ;Input:
+5 ; DGPAT- the patient array, passed by reference
+6 ; NOCHECK - a flag, if set to 1 it means consistency checks were done aready, so skip
+7 ;
+8 ;Output:
+9 ; Function Value - returns 1 if successful, otherwise 0
+10 ; ERROR - on failure, an error message is returned (optional, pass by reference)
+11 ;
+12 SET ERROR=""
+13 IF '$DATA(DGPAT)
SET ERROR="PATIENT NOT FOUND"
QUIT 0
+14 IF '$$LOCK(DGPAT("DFN"))
SET ERROR="UNABLE TO LOCK THE PATIENT RECORD"
QUIT 0
+15 IF $GET(NOCHECK)'=1
if '$$CHECK(.DGPAT,.ERROR)
QUIT 0
+16 ;
+17 NEW DATA,SUB,FIELD,SUCCESS,DGINDID,DGINDAD,DGINDSD,DGINDED,DGINDARR
+18 SET SUB=""
+19 ;
+20 ; DG*5.3*1064
+21 ; Check value in Patient file is changed, then only update
+22 DO GETS^DIQ(2,DFN,".571:.574","I","DGINDARR")
+23 SET DGINDID=$GET(DGINDARR(2,DFN_",",.571,"I"))
+24 SET DGINDAD=$GET(DGINDARR(2,DFN_",",.573,"I"))
+25 SET DGINDSD=$GET(DGINDARR(2,DFN_",",.572,"I"))
+26 SET DGINDED=$GET(DGINDARR(2,DFN_",",.574,"I"))
+27 ; DG*5.3*1093 - Add $G for IND fields to cover null values being sent in ZPD
+28 IF DGINDID=$GET(DGPAT("INDID"))
KILL DGPAT("INDID")
+29 IF DGINDAD=$GET(DGPAT("INDADT"))
KILL DGPAT("INDADT")
+30 IF DGINDSD=$GET(DGPAT("INDSDT"))
KILL DGPAT("INDSDT")
+31 ; If Indian End Date is blank or double quotes, delete the field in Patient file
+32 IF DGINDED'=$GET(DGPAT("INDEDT"))
IF $GET(DGPAT("INDEDT"))=""
SET DGPAT("INDEDT")="@"
+33 IF DGINDED=$GET(DGPAT("INDEDT"))
KILL DGPAT("INDEDT")
+34 ;DG*5.3*1121 - Delete Persian Gulf indicator and Persian Gulf Change date if they are blank
+35 IF $GET(DGPAT("PGULFTS"))=""
SET DGPAT("PGULFTS")="@"
+36 IF $GET(DGPAT("PGULF"))=""
SET DGPAT("PGULF")="@"
+37 ;
+38 FOR
SET SUB=$ORDER(DGPAT(SUB))
if (SUB="")
QUIT
IF (SUB'="DEATH")&(SUB'="SSN")
SET FIELD=$$FIELD(SUB)
IF FIELD
SET DATA(FIELD)=$GET(DGPAT(SUB))
+39 SET SUCCESS=$$UPD^DGENDBS(2,DGPAT("DFN"),.DATA)
+40 IF 'SUCCESS
SET ERROR="FILEMAN UNABLE TO UPDATE PATIENT RECORD"
+41 ; jam; dg*5.3*978 - 1010.1514 and 1010.1515 fields added to the ZIO segment (seq 7 and 10) - ORIG APPT REQUEST CHG DT/TM and APPT REQUEST ON 1010EZ CHG DT/TM
+42 ; these are timestamps that may have been triggered by VistA filing the other 1010.* fields above.
+43 ; So we set those values from the HL7 into the database now - after those others have been filed
+44 IF SUCCESS
IF $DATA(DGPAT("APPREQTS"))
Begin DoDot:1
+45 NEW DATA,DGENDA
+46 SET DGENDA=DGPAT("DFN")
+47 SET DATA(1010.1515)=DGPAT("APPREQTS")
+48 SET SUCCESS=$$UPD^DGENDBS(2,.DGENDA,.DATA)
+49 KILL DATA,DGENDA
End DoDot:1
+50 IF SUCCESS
IF $DATA(DGPAT("ORIGAPPREQTS"))
Begin DoDot:1
+51 NEW DATA,DGENDA
+52 SET DGENDA=DGPAT("DFN")
+53 SET DATA(1010.1514)=DGPAT("ORIGAPPREQTS")
+54 SET SUCCESS=$$UPD^DGENDBS(2,.DGENDA,.DATA)
+55 KILL DATA,DGENDA
End DoDot:1
+56 ;
+57 ; Call Purple Heart API to file PH data in file 2
+58 IF SUCCESS
IF $DATA(DGPAT("PHI"))
DO EDITPH^DGRPLE($GET(DGPAT("PHI")),$GET(DGPAT("PHST")),$GET(DGPAT("PHRR")),DGPAT("DFN"))
+59 ; Call POW API to file POW data in file 2 - DG*5.3*653
+60 ;I SUCCESS,$D(DGPAT("POWI")) D EDITPOW^DGRPLE($G(DGPAT("POWI")),$G(DGPAT("POWLOC")),$G(DGPAT("POWFDT")),$G(DGPAT("POWTDT")),DGPAT("DFN"))
+61 IF SUCCESS
Begin DoDot:1
+62 IF '$DATA(DGPAT("POWI"))
Begin DoDot:2
+63 NEW DATA,ERROR,DGENDA
+64 SET DGENDA=DGPAT("DFN")
+65 SET (DATA(.525),DATA(.526),DATA(.527),DATA(.528),DATA(.529))="@"
+66 IF '$$UPD^DGENDBS(2,.DGENDA,.DATA,.ERROR)
Begin DoDot:3
+67 DO ADDMSG^DGENUPL3(.MSGS,"Unable to update POW Data.",1)
End DoDot:3
+68 KILL DATA,ERROR,DGENDA
End DoDot:2
QUIT
+69 DO EDITPOW^DGRPLE($GET(DGPAT("POWI")),$GET(DGPAT("POWLOC")),$GET(DGPAT("POWFDT")),$GET(DGPAT("POWTDT")),DGPAT("DFN"))
End DoDot:1
+70 DO UNLOCK(DGPAT("DFN"))
+71 QUIT SUCCESS
+72 ;
FIELD(SUB) ;
+1 ;Description: Returns the field number of a subscript for the PATIENT object.
+2 ;
+3 NEW FNUM
+4 SET FNUM=$SELECT(SUB="DEATH":.351,SUB="PATYPE":391,SUB="VETERAN":1901,SUB="NAME":.01,SUB="DOB":.03,SUB="SEX":.02,SUB="SSN":.09,SUB="PREFAC":27.02,SUB="AG/ALLY":.309,1:"")
+5 if 'FNUM
SET FNUM=$SELECT(SUB="INELDATE":.152,SUB="INELREA":.307,SUB="INELDEC":.1656,SUB="PID":.363,SUB="EMGRES":.181,1:"")
+6 IF FNUM=""
SET FNUM=$SELECT(SUB="IR":.32103,SUB="RADEXPM":.3212,SUB="APPREQ":1010.159,SUB="APPREQDT":1010.1511,SUB="SPININJ":57.4,SUB="PFSRC":27.03,1:"")
+7 ; jam; DG*5.3*978 - these fields added to the ZIO segment (seq 8 and 9) - ORIGINAL APPOINTMENT REQUEST and ORIG APPT REQUEST DATE
+8 IF FNUM=""
SET FNUM=$SELECT(SUB="ORIGAPPREQ":1010.1512,SUB="ORIGAPPREQDT":1010.1513,1:"")
+9 IF FNUM=""
SET FNUM=$SELECT(SUB="MOH":.541,SUB="DENTC2IN":.3858,SUB="DENTC2DT":.3859,1:"")
+10 IF FNUM=""
SET FNUM=$SELECT(SUB="PENAEFDT":.3851,SUB="PENAREAS":.3852,SUB="PENTRMDT":.3853,1:"")
+11 IF FNUM=""
SET FNUM=$SELECT(SUB="PENTRMR1":.3854,SUB="PENTRMR2":.3855,SUB="PENTRMR3":.3856,SUB="PENTRMR4":.3857,SUB="PILOCK":.386,SUB="PALOCK":.3861,1:"")
+12 ; DG*5.3*1064
+13 IF FNUM=""
SET FNUM=$SELECT(SUB="INDID":.571,SUB="INDADT":.573,SUB="INDSDT":.572,SUB="INDEDT":.574,1:"")
+14 ; DG*5.3*1103 - Update Toxic Exposure Risk Activity (TERA) indicator that is received from ZEL segment sequence #48
+15 IF FNUM=""
SET FNUM=$SELECT(SUB="TERA":.32116,1:"")
+16 ;DG*5.3*1121 - Update Persian Gulf indicator and last change date that are received from ZEL segment sequence numbers #49 and #50
+17 IF FNUM=""
SET FNUM=$SELECT(SUB="PGULF":.32117,SUB="PGULFTS":.32118,1:"")
+18 QUIT FNUM
