- 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 Jan 18, 2025@03:43:35 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