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

DGENPTA.m

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