- 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 Feb 19, 2025@00:08:58 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