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