Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DGENPTA1

DGENPTA1.m

Go to the documentation of this file.
  1. 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
  1. ;Per VHA Directive 2004-038, this routine should not be modified.
  1. ;
  1. LOCK(DFN) ;
  1. ;Description: Given an internal entry number of a PATIENT record, this
  1. ; function will lock the record. It should be used when updating the
  1. ; record.
  1. ;Input:
  1. ; DFN - Patient IEN
  1. ;Output:
  1. ; Function Value - Returns 1 if the lock was successful, 0 otherwise
  1. ;
  1. I $G(DFN) L +^DPT(DFN):2
  1. Q $T
  1. UNLOCK(DFN) ;
  1. ;Description: Given an internal entry number of a record in the PATIENT
  1. ; file, this function will unlock the record that was previously
  1. ; locked by LOCK PATIENT RECORD.
  1. ;Input:
  1. ; DFN - Patient IEN
  1. ;Output: None
  1. ;
  1. I $G(DFN) L -^DPT(DFN)
  1. Q
  1. ;
  1. STOREPRE(DFN,DGPREFAC) ;
  1. ;Description: Used to store the patient's preferred facility in the
  1. ; patient record.
  1. ;Input:
  1. ; DFN - Patient IEN
  1. ; DGPREFAC - pointer to the record in the INSTITUTION file.
  1. ;Output:
  1. ; Function Value - Returns 1 on success, 0 on failure.
  1. ;
  1. N SUCCESS,DATA
  1. S SUCCESS=1
  1. D ;drops out if invalid condition found
  1. . I $G(DFN),$D(^DPT(DFN,0))
  1. . E S SUCCESS=0 Q
  1. . I ($G(DGPREFAC)'=""),'$G(DGPREFAC) S SUCCESS=0 Q
  1. . I $G(DGPREFAC),'$D(^DIC(4,DGPREFAC,0)) S SUCCESS=0 Q
  1. . S DATA(27.02)=DGPREFAC
  1. . S DATA(27.03)="V" ; DG*5.3*838
  1. . S SUCCESS=$$UPD^DGENDBS(2,DFN,.DATA)
  1. Q SUCCESS
  1. ;
  1. CHECK(DGPAT,ERROR) ;
  1. ;Description: Does validation checks on the patient contained in the
  1. ;DGPAT array.
  1. ;
  1. ;Input:
  1. ; DGPAT - this local array contains patient data
  1. ;Output:
  1. ; Function Value - returns 1 if all validation checks passed, 0 otherwise
  1. ; ERROR - if validation checks fail, an error message is returned (pass by reference)
  1. ;
  1. ;
  1. N SUCCESS,FIELD
  1. S SUCCESS=1
  1. S ERROR=""
  1. ;
  1. ;check field values
  1. ;
  1. ;some of the field's input transforms require DA or DUZ to be defined, so do not do this
  1. ;F S SUB=$O(DGPAT(SUB)) Q:SUB="" D:(DGPAT(SUB)'="") Q:'SUCCESS
  1. ;.S FIELD=$$FIELD(SUB)
  1. ;.I '$$TESTVAL^DGENDBS(2,FIELD,DGPAT(SUB)) D
  1. ;..S SUCCESS=0
  1. ;..S ERROR="BAD FIELD VALUE, PATIENT FILE FIELD = "_$$GET1^DID(2,FIELD,,"LABEL")
  1. ;
  1. ;instead, check field values without referencing DD
  1. 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
  1. ;
  1. I DGPAT("INELREA")'="",($L(DGPAT("INELREA"))>40) S SUCCESS=0,ERROR="BAD FIELD VALUE, PATIENT FIELD FIELD = INELIGIBLE REASON" G QCHECK
  1. ;
  1. I DGPAT("VETERAN")="" S SUCCESS=0,ERROR="BAD FIELD VALUE, PATIENT FIELD = VETERAN (Y/N)?" G QCHECK
  1. ;
  1. I DGPAT("DEATH"),(DGPAT("DEATH")>$$NOW^XLFDT) S SUCCESS=0,ERROR="DATE OF DEATH CAN NOT BE A FUTURE DATE" G QCHECK
  1. ;
  1. I DGPAT("INELDATE"),(DGPAT("INELREA")="") S SUCCESS=0,ERROR="INELIGIBLE REASON UNSPECIFIED FOR INELIGIBLE PATIENT" G QCHECK
  1. ;
  1. QCHECK ;
  1. Q SUCCESS
  1. ;
  1. STORE(DGPAT,ERROR,NOCHECK) ;
  1. ;Description: Files data in the patient record. It requires a lock
  1. ;on the Patient record, adn releases the lock when done.
  1. ;
  1. ;Input:
  1. ; DGPAT- the patient array, passed by reference
  1. ; NOCHECK - a flag, if set to 1 it means consistency checks were done aready, so skip
  1. ;
  1. ;Output:
  1. ; Function Value - returns 1 if successful, otherwise 0
  1. ; ERROR - on failure, an error message is returned (optional, pass by reference)
  1. ;
  1. S ERROR=""
  1. I '$D(DGPAT) S ERROR="PATIENT NOT FOUND" Q 0
  1. I '$$LOCK(DGPAT("DFN")) S ERROR="UNABLE TO LOCK THE PATIENT RECORD" Q 0
  1. I $G(NOCHECK)'=1 Q:'$$CHECK(.DGPAT,.ERROR) 0
  1. ;
  1. N DATA,SUB,FIELD,SUCCESS,DGINDID,DGINDAD,DGINDSD,DGINDED,DGINDARR
  1. S SUB=""
  1. ;
  1. ; DG*5.3*1064
  1. ; Check value in Patient file is changed, then only update
  1. D GETS^DIQ(2,DFN,".571:.574","I","DGINDARR")
  1. S DGINDID=$G(DGINDARR(2,DFN_",",.571,"I"))
  1. S DGINDAD=$G(DGINDARR(2,DFN_",",.573,"I"))
  1. S DGINDSD=$G(DGINDARR(2,DFN_",",.572,"I"))
  1. S DGINDED=$G(DGINDARR(2,DFN_",",.574,"I"))
  1. ; DG*5.3*1093 - Add $G for IND fields to cover null values being sent in ZPD
  1. I DGINDID=$G(DGPAT("INDID")) K DGPAT("INDID")
  1. I DGINDAD=$G(DGPAT("INDADT")) K DGPAT("INDADT")
  1. I DGINDSD=$G(DGPAT("INDSDT")) K DGPAT("INDSDT")
  1. ; If Indian End Date is blank or double quotes, delete the field in Patient file
  1. I DGINDED'=$G(DGPAT("INDEDT")),$G(DGPAT("INDEDT"))="" S DGPAT("INDEDT")="@"
  1. I DGINDED=$G(DGPAT("INDEDT")) K DGPAT("INDEDT")
  1. ;DG*5.3*1121 - Delete Persian Gulf indicator and Persian Gulf Change date if they are blank
  1. I $G(DGPAT("PGULFTS"))="" S DGPAT("PGULFTS")="@"
  1. I $G(DGPAT("PGULF"))="" S DGPAT("PGULF")="@"
  1. ;
  1. 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))
  1. S SUCCESS=$$UPD^DGENDBS(2,DGPAT("DFN"),.DATA)
  1. I 'SUCCESS S ERROR="FILEMAN UNABLE TO UPDATE PATIENT RECORD"
  1. ; 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
  1. ; these are timestamps that may have been triggered by VistA filing the other 1010.* fields above.
  1. ; So we set those values from the HL7 into the database now - after those others have been filed
  1. I SUCCESS,$D(DGPAT("APPREQTS")) D
  1. . N DATA,DGENDA
  1. . S DGENDA=DGPAT("DFN")
  1. . S DATA(1010.1515)=DGPAT("APPREQTS")
  1. . S SUCCESS=$$UPD^DGENDBS(2,.DGENDA,.DATA)
  1. . K DATA,DGENDA
  1. I SUCCESS,$D(DGPAT("ORIGAPPREQTS")) D
  1. . N DATA,DGENDA
  1. . S DGENDA=DGPAT("DFN")
  1. . S DATA(1010.1514)=DGPAT("ORIGAPPREQTS")
  1. . S SUCCESS=$$UPD^DGENDBS(2,.DGENDA,.DATA)
  1. . K DATA,DGENDA
  1. ;
  1. ; Call Purple Heart API to file PH data in file 2
  1. I SUCCESS,$D(DGPAT("PHI")) D EDITPH^DGRPLE($G(DGPAT("PHI")),$G(DGPAT("PHST")),$G(DGPAT("PHRR")),DGPAT("DFN"))
  1. ; Call POW API to file POW data in file 2 - DG*5.3*653
  1. ;I SUCCESS,$D(DGPAT("POWI")) D EDITPOW^DGRPLE($G(DGPAT("POWI")),$G(DGPAT("POWLOC")),$G(DGPAT("POWFDT")),$G(DGPAT("POWTDT")),DGPAT("DFN"))
  1. I SUCCESS D
  1. . I '$D(DGPAT("POWI")) D Q
  1. . . N DATA,ERROR,DGENDA
  1. . . S DGENDA=DGPAT("DFN")
  1. . . S (DATA(.525),DATA(.526),DATA(.527),DATA(.528),DATA(.529))="@"
  1. . . I '$$UPD^DGENDBS(2,.DGENDA,.DATA,.ERROR) D
  1. . . . D ADDMSG^DGENUPL3(.MSGS,"Unable to update POW Data.",1)
  1. . . K DATA,ERROR,DGENDA
  1. . D EDITPOW^DGRPLE($G(DGPAT("POWI")),$G(DGPAT("POWLOC")),$G(DGPAT("POWFDT")),$G(DGPAT("POWTDT")),DGPAT("DFN"))
  1. D UNLOCK(DGPAT("DFN"))
  1. Q SUCCESS
  1. ;
  1. FIELD(SUB) ;
  1. ;Description: Returns the field number of a subscript for the PATIENT object.
  1. ;
  1. N FNUM
  1. 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:"")
  1. S:'FNUM FNUM=$S(SUB="INELDATE":.152,SUB="INELREA":.307,SUB="INELDEC":.1656,SUB="PID":.363,SUB="EMGRES":.181,1:"")
  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:"")
  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
  1. I FNUM="" S FNUM=$S(SUB="ORIGAPPREQ":1010.1512,SUB="ORIGAPPREQDT":1010.1513,1:"")
  1. I FNUM="" S FNUM=$S(SUB="MOH":.541,SUB="DENTC2IN":.3858,SUB="DENTC2DT":.3859,1:"")
  1. I FNUM="" S FNUM=$S(SUB="PENAEFDT":.3851,SUB="PENAREAS":.3852,SUB="PENTRMDT":.3853,1:"")
  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:"")
  1. ; DG*5.3*1064
  1. I FNUM="" S FNUM=$S(SUB="INDID":.571,SUB="INDADT":.573,SUB="INDSDT":.572,SUB="INDEDT":.574,1:"")
  1. ; DG*5.3*1103 - Update Toxic Exposure Risk Activity (TERA) indicator that is received from ZEL segment sequence #48
  1. I FNUM="" S FNUM=$S(SUB="TERA":.32116,1:"")
  1. ;DG*5.3*1121 - Update Persian Gulf indicator and last change date that are received from ZEL segment sequence numbers #49 and #50
  1. I FNUM="" S FNUM=$S(SUB="PGULF":.32117,SUB="PGULFTS":.32118,1:"")
  1. Q FNUM