VistA-FOIAVistA/r/REGISTRATION-DGQE-DG-DPT-GR.../DGENPTA.m

298 lines
8.8 KiB
Mathematica
Raw Normal View History

DGENPTA ;ALB/CJM - Patient API - Retrieve Data; 13 JUN 1997
;;5.3;Registration;**121,122,147**;08/13/93
;
VET(DFN) ;returns 1 if the patient is an eligible veteran
;returns 0 if not a veteran or not eligible
;
N VET S VET=0
I $G(DFN),$D(^DPT(DFN,0)) D
.S VET=1
.I $P($G(^DPT(DFN,"VET")),"^")="N" S VET=0
.I $P($G(^DPT(DFN,.15)),"^",2) S VET=0
Q VET
;
VET1(DFN) ;returns 1 if the patient is a veteran
;returns 0 if not a veteran
;
N VET S VET=0
I $G(DFN),$D(^DPT(DFN,0)) D
.I $P($G(^DPT(DFN,"VET")),"^")="Y" S VET=1
Q VET
;
ACTIVE(DFN,DGDT) ;
;Description - Used to determine whether or not the patient has had a
; recent epiosode of inpatient or outpatient care.
;Input:
; DFN - ien of record in Patient file
; DGDT - date used to specify how far back to go looking for episode
; of care
;Output -
; returns 1 if recent episode of care, 0 otherwise
;
;!!!!!!! NOTE: This routine is not complete. !!!!!!!!!!!!!!!
; Still need to define how user wants to define an 'active' patient.
;!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
;
Q 1
;
PREF(DFN,FACNAME) ;
;Description: Used to determine the patient's preferred facility.
;Input:
; DFN - an ien of a record in the PATIENT file
;Output:
; Function Value - Returns a pointer to the INSTITUTION file entry that
; is the patient's preferred facility, NULL if the preferred facility
; can not be determined.
; FACNAME - optional parm, pass by reference - returns institution name
;
N FAC
S (FACNAME,FAC)=""
I $D(DFN),$D(^DPT(DFN,0)) S FAC=$P($G(^DPT(DFN,"ENR")),"^",2)
S:FAC FACNAME=$P($G(^DIC(4,FAC,0)),"^")
Q FAC
;
DEATH(DFN) ;
;Description: Used to determine whether or not the patient is alive.
;Input:
; DFN - an ien of a record in the PATIENT file
;Output:
; Function Value - Returns 0 if there is no record of the patient's
; death, otherwise returns the patients date of death
;
N DATE S DATE=0
I $D(DFN),$D(^DPT(DFN,0)) S DATE=$P($G(^DPT(DFN,.35)),"^")
I DATE S DATE=(DATE\1) ;get rid of the time portion
Q +DATE
;
GET(DFN,DGPAT) ;
;Description: Returns DGPAT() array with identifing infor for patient
; Input:
; DFN - ien, PATIENT file
; Output:
; Function Value - 1 on success, 0 on failure
; DGPAT() array (pass by reference)
; "DEATH" - date of death
; "DFN" - ien, PATIENT file
; "DOB" - date of birth
; "INELDATE" - INELIGIBLE DATE
; "INELREA" - INELIGIBLE REASON
; "INELDEC" - INELIGIBLE VARO DECISION
; "NAME" - patient name
; "PATYPE" - patient type
; "PID" - Primary Long ID
; "PREFAC" - prefered facility
; "SSN" - Social Security Number
; "SEX" - M=male, F=female
; "VETERAN" - VETERAN (Y/N)? - "Y"=YES,"N"=NO
;
N NODE
Q:'$G(DFN) 0
K DGPAT S DGPAT=""
S DGPAT("DFN")=DFN
S NODE=$G(^DPT(DFN,0))
Q:NODE="" 0
S DGPAT("NAME")=$P(NODE,"^")
S DGPAT("DOB")=$P(NODE,"^",3)
S DGPAT("SEX")=$P(NODE,"^",2)
S DGPAT("SSN")=$P(NODE,"^",9)
;
S DGPAT("DEATH")=$P($G(^DPT(DFN,.35)),"^")
S DGPAT("PATYPE")=$P($G(^DPT(DFN,"TYPE")),"^")
S DGPAT("VETERAN")=$P($G(^DPT(DFN,"VET")),"^")
S DGPAT("PREFAC")=$P($G(^DPT(DFN,"ENR")),"^",2)
S DGPAT("INELDATE")=$P($G(^DPT(DFN,.15)),"^",2)
S DGPAT("INELREA")=$P($G(^DPT(DFN,.3)),"^",7)
S DGPAT("INELDEC")=$P($G(^DPT(DFN,"INE")),"^",6)
S DGPAT("PID")=$P($G(^DPT(DFN,.36)),"^",3)
Q 1
;
SSN(DFN) ;
;Description: Function returns the patient's SSN, or "" on failure.
;
Q:'DFN ""
Q $P($G(^DPT(DFN,0)),"^",9)
;
NAME(DFN) ;
;Description: Function returns the patient's NAME, or "" on failure.
;
Q:'DFN ""
Q $P($G(^DPT(DFN,0)),"^")
;
EXT(SUB,VAL) ;
;Description: Given the subscript used in the PATIENT object array,
; DGPAT(), and a field value, returns the external representation of
; the value, as defined in the fields output transform of the PATIENT
; file.
;Input:
; SUB - array subscript
; VAL - field value
;Output:
; Function Value - returns the external value of the field
;
Q:(($G(SUB)="")!($G(VAL)="")) ""
;
N FLD
S FLD=$$FIELD^DGENPTA1(SUB)
Q:(FLD="") ""
Q $$EXTERNAL^DILFD(2,FLD,"F",VAL)
;
;
VALPAT(DFN) ; --
; Description: This function returns a 1 if the patient DFN is valid, 0 if the patient DFN is not valid.
;
; Input:
; DFN - as pointer to patient in Patient (#2) file
;
; Output:
; Function Value - Is patient (DFN) valid?
; Return 1 if successful, otherwise 0
;
; init variables
N DGVALID S DGVALID=0
;
; is patient (DFN) valid?
I $G(DFN),$D(^DPT(DFN,0)) S DGVALID=1
;
Q DGVALID
;
;
CURINPAT(DFN) ; --
; Description: This function will determine if the patient is a current inpatient.
;
; Input:
; DFN - IEN of record in Patient (#2) file
;
; Output:
; Function Value - Is patient a current inpatient?
; Return 1 if successful, otherwise 0
;
N DGCUR S DGCUR=0
;
; if valid patient, check if current inpatient
I $$VALPAT(DFN) D
.;
.; is patient a current inpatient?
.I $G(^DPT(DFN,.105)) S DGCUR=1
;
Q DGCUR
;
;
INPAT(DFN,DGBEG,DGEND) ; --
; Description: This function will determine if a patient was an inpatient between a specified date range.
;
; Input:
; DFN - IEN of record in Patient (#2) file
; DGBEG - as begin date/time for inpatient search
; DGEND - as end date/time for inpatient search
;
; Output:
; Function Value - Was patient an inpatient between date range?
; Return 1 if successful, otherwise 0
;
N DGINPAT,DGSDT,DGEDT,DGMOVE,DGTRANS
S DGINPAT=0
;
; if not valid patient (DFN) and not valid date range, exit
I '$$VALPAT(DFN),'($$RANGE(DGBEG,DGEND)) G INPATQ
;
; init date/time(s)
S DGSDT=DGBEG-.0001,DGEDT=DGEND+$S($P(DGEND,".",2)="":.2359,1:"")
;
; use "APRD" x-ref of Patient Movement (#405) file
F S DGSDT=$O(^DGPM("APRD",+DFN,DGSDT)) Q:'DGSDT!(DGSDT>DGEDT)!(DGINPAT) D
.S DGMOVE=0 F S DGMOVE=$O(^DGPM("APRD",+DFN,DGSDT,DGMOVE)) Q:'DGMOVE!(DGINPAT) D
..; - transaction type of movement
..S DGTRANS=$P($G(^DGPM(DGMOVE,0)),"^",2) ; movement transaction type
..; - if trans type not DISCHARGE, CHECK-IN LODGER, CHECK-OUT LODGER
..I DGTRANS'=3,(DGTRANS'=4),(DGTRANS'=5) S DGINPAT=1
;
INPATQ Q DGINPAT
;
;
OUTPAT(DFN,DGBEG,DGEND) ; --
; Description: This function will determine if a patient has an outpatient encounter between a specified date range that has successfully been checked out.
;
; Input:
; DFN - IEN of record in Patient (#2) file
; DGBEG - as begin date/time for outpatient search
; DGEND - as end date/time for outpatient search
;
; Output:
; Function Value - Does patient have outpatient encounter between date
; range that that has successfully been checked out?
; Return 1 if successful, otherwise 0
;
N DGOUT,DGSDT,DGEDT,DGOE
S DGOUT=0
;
; if not valid patient (DFN) and not valid date range, exit
I '$$VALPAT(DFN),'($$RANGE(DGBEG,DGEND)) G OUTPATQ
;
; init date/time(s)
S DGSDT=DGBEG-.0001,DGEDT=DGEND+$S($P(DGEND,".",2)="":.2359,1:"")
;
; use "ADFN" x-ref of Outpatient Encounter (#409.68) file
F S DGSDT=$O(^SCE("ADFN",+DFN,DGSDT)) Q:'DGSDT!(DGSDT>DGEDT)!(DGOUT) D
.;
.S DGOE=0 F S DGOE=$O(^SCE("ADFN",+DFN,DGSDT,DGOE)) Q:'DGOE!(DGOUT) D
..; - if encounter checked out, set flag
..I $P($G(^SCE(+DGOE,0)),"^",7) S DGOUT=1
;
OUTPATQ Q DGOUT
;
;
RANGE(DGBEG,DGEND) ; --
; Description: This function returns a 1 if two dates are a valid date range, 0 if they are not valid.
;
; Input:
; DGBEG - as begin date of date range
; DGEND - as end date of date range
;
; Output:
; Function Value - Is date range valid?
; Return 1 if successful, otherwise 0
;
N DGOK
;
S DGOK=0
;
; if input parameters not defined, exit
I '$D(DGBEG),('$D(DGEND)) G RANGEQ
;
; remove time from dates
S DGBEG=(DGBEG/1),DGEND=(DGEND/1)
;
; if begin date greater than end date, exit
I DGBEG>DGEND G RANGEQ
;
; if begin date and end date future dates, exit
I DGBEG>DT,(DGEND>DT) G RANGEQ
;
S DGOK=1
;
RANGEQ Q DGOK
;
LOOKUP(SSN,DOB,SEX,ERROR) ;
;Description: This function will do a search for the patient based on
;the identifying information provided. The function will be successful
;only if a single patient is found matching the identifiers provided.
;
;Inputs:
; SSN - patient Social Security Number
; DOB - patient date of birth (FM format)
; SEX - patient sex
;Outputs:
; Function Value - patient DFN if successful, 0 otherwise
; ERROR - if unsuccessful, an error message is returned (optional, pass by reference)
;
N DFN,NODE
;
S DFN=$O(^DPT("SSN",SSN,0))
I 'DFN S ERROR="SSN NOT FOUND" Q 0
I $O(^DPT("SSN",SSN,DFN)) S ERROR="MULTIPLE PATIENTS MATCHING SSN" Q 0
S NODE=$G(^DPT(DFN,0))
I $P(NODE,"^",2)'=SEX S ERROR="SEX DOES NOT MATCH" Q 0
I $E($P(NODE,"^",3),1,3)'=$E(DOB,1,3) S ERROR="DOB DOES NOT MATCH" Q 0
I $E($P(NODE,"^",3),4,5),$E($P(NODE,"^",3),4,5)'=$E(DOB,4,5) S ERROR="DOB DOES NOT MATCH" Q 0
Q DFN