HMPSTMP ;ASMR/JD,BL,ASF,CK,CPC - MetaStamp ;Aug 30, 2016 06:54:52
;;2.0;ENTERPRISE HEALTH MANAGEMENT PLATFORM;**1,2,3**;May 15, 2016;Build 15
;Per VA Directive 6402, this routine should not be modified.
;
; Returns the most recent date/time
; JD - 6/5/15 - Added code to the DOC section to consider the attachment date
; as one of the dates if it exists
; JD - 2/1/16 - Added code to the FINDNEW section to skip over the imprecise dates. DE3548
; JD - 2/7/16 - Modified FINDNEW section to default to NOW if no other dates exist. DE3728
Q
;
EN(A) ; extrinsic function, used to create "stampTime" or "lastUpdateTime" subscript in arrays
K B
N C
; A is either "now" or a domain name (per PTDOMS^HMPDJFSD)
; B is the return value (stampTime)
S C=$$UP^XLFSTR(A)
I C="NOW" G NOW
I C="ADM" G ADM
I C="ALLERGY" G ALL
I C="AUXILIARY" G AUX
I C="APPOINTMENT" G APP
I C="DIAGNOSIS" G DIA
I C="DOCUMENT" G DOC
I C="FACTOR" G FAC
I C="IMMUNIZATION" G IMM
I C="LAB" G LAB
I C="MED" G MED
I C="OBS" G OBS
I C="ORDER" G ORD
I C="PROBLEM" G PRO
I C="PROCEDURE" G PRC
I C="CONSULT" G CON
I C="IMAGE" G IMA
I C="SURGERY" G SUR
I C="TASK" G TAS
I C="VISIT" G VIS
I C="VITAL" G VIT
I C="PTF" G PTF
I C="EXAM" G EXA
I C="CPT" G CPT
I C="EDUCATION" G EDU
I C="POV" G POV
I C="SKIN" G SKI
I C="TREATMENT" G TRE
I C="MH" G MH
Q "" ; DE3504 changed B to "" to prevent error if code falls through
;
NOW ;
; Set stamp time in YYYYMMDDHHMMSS format
S B=$$FMTHL7($$NOW^XLFDT) ; DE5016
S B=$E(B_"000000",1,14) ; Need padding to force YYYYMMDDHHMMSS precision
Q B
;
ADM ; Admissions (these are visits whose ID starts with an "H"). JD - January 26, 2015
K DATA
S DATE(1)=$G(ADM("dateTime"))
S DATE(2)=$G(ADM("stay","dischargeDateTime"))
;DETERMINE WHICH ONE IS NEWER
Q $$FINDNEW(.DATE)
ALL ; Allergy ; rhl 20141231
K DATE
S DATE(1)=$G(REAC("entered"))
S DATE(2)=$G(REAC("verified"))
; dates in observations array
N I,J
S J="",J=$O(DATE(J),-1)
S I=0
F S I=$O(REAC("observations",I)) Q:I="" D
. I $G(REAC("observations",I,"date"))]"" S J=J+1,DATE(J)=REAC("observations",I,"date")
; dates in comment array
N I,J
S J="",J=$O(DATE(J),-1)
S I=0
F S I=$O(REAC("comments",I)) Q:I="" D
. I $G(REAC("comments",I,"entered"))]"" S J=J+1,DATE(J)=REAC("comments",I,"entered")
;DETERMINE WHICH ONE IS NEWER
Q $$FINDNEW(.DATE)
AUX ; Auxiliary
Q ""
K DATE
;S DATE(1)=$G(
;DETERMINE WHICH ONE IS NEWER
Q $$FINDNEW(.DATE)
APP ; Appointment
K DATE
S DATE(1)=$G(APPT("dateTime"))
S DATE(2)=$G(APPT("checkIn"))
S DATE(3)=$G(APPT("checkOut"))
;if freshness item get timestamp from stream get last update from freshness stream
I $G(FILTER("freshnessDateTime")) S DATE(4)=$$JSONDT^HMPUTILS(FILTER("freshnessDateTime")) ;DE4859
;DETERMINE WHICH ONE IS NEWER
Q $$FINDNEW(.DATE)
DIA ; Diagnosis
Q ""
K DATE
;S DATE(1)=$G(
;DETERMINE WHICH ONE IS NEWER
Q $$FINDNEW(.DATE)
DOC ; Document
N AUDDT
S AUDDT="" ; Audit trail date/time
K DATE
S DATE(1)=$G(DOC("referenceDateTime"))
S DATE(2)=$G(DOC("entered"))
;DE2818, ^TIU(8925.5) references - ICR 6279
; Find the most recent audit trail entry for the document
S:$G(DOC("localId")) AUDDT=$O(^TIU(8925.5,"B",DOC("localId"),""),-1)
; Get the audit trail date/time
S:AUDDT AUDDT=$P($G(^TIU(8925.5,AUDDT,3)),"^",2)
S:AUDDT DATE(3)=$$JSONDT^HMPUTILS(AUDDT)
;go through HMPDJ array
N I,II,J
S J=""
S J=$O(DATE(J),-1)
S I=0
F S I=$O(DOC("text",I)) Q:I="" D
. I $G(DOC("text",I,"dateTime"))]"" S J=J+1,DATE(J)=DOC("text",I,"dateTime")
. S II=0 F S II=$O(DOC("text",I,"clinicians",II)) Q:II="" D
. . I $G(DOC("text",I,"clinicians",II,"signedDateTime"))]"" S J=J+1,DATE(J)=DOC("text",I,"clinicians",II,"signedDateTime")
;DE4148 use freshness datetime if available
I $G(FILTER("freshnessDateTime")) S J=J+1,DATE(J)=$$JSONDT^HMPUTILS(FILTER("freshnessDateTime"))
;DETERMINE WHICH ONE IS NEWER
Q $$FINDNEW(.DATE)
FAC ; Factor
K DATE
S DATE(1)=$G(PCE("entered"))
;DETERMINE WHICH ONE IS NEWER
Q $$FINDNEW(.DATE)
IMM ; Immunization
K DATE
N T
S DATE(1)=$G(PCE("administeredDateTime"))
;DE4013 use freshness datetime if available
S T=$G(FILTER("freshnessDateTime"))
I T S DATE(2)=$$JSONDT^HMPUTILS(T)
;DETERMINE WHICH ONE IS NEWER
Q $$FINDNEW(.DATE)
LAB ; Lab
K DATE
S DATE(1)=$G(LAB("observed"))
S DATE(2)=$G(LAB("resulted"))
;DETERMINE WHICH ONE IS NEWER
Q $$FINDNEW(.DATE)
MED ; Med
K DATE
S DATE(1)=$G(MED("orders",1,"ordered"))
S DATE(2)=$G(MED("overallStart"))
S DATE(3)=$G(MED("overallStop"))
S DATE(4)=$G(MED("stopped"))
S DATE(5)=$G(MED("lastFilled"))
S DATE(6)=$G(MED("prescriptionFinished")) ; DE5723
;go through value array
N I,J
S J="",J=$O(DATE(J),-1)
S I=0
F S I=$O(MED("dosages",I)) Q:I="" D
. I $G(MED("dosages",I,"start"))]"" S J=J+1,DATE(J)=MED("dosages",I,"start")
. I $G(MED("dosages",I,"stop"))]"" S J=J+1,DATE(J)=MED("dosages",I,"stop")
S J="",J=$O(DATE(J),-1)
S I=0
F S I=$O(MED("fills",I)) Q:I="" D
. I $G(MED("fills",I,"dispenseDate"))]"" S J=J+1,DATE(J)=MED("fills",I,"dispenseDate")
. I $G(MED("fills",I,"releaseDate"))]"" S J=J+1,DATE(J)=MED("fills",I,"releaseDate")
;DETERMINE WHICH ONE IS NEWER
Q $$FINDNEW(.DATE)
OBS ; Obs ; rhl 20141231
K DATE
S DATE(1)=$G(CLIO("entered"))
S DATE(2)=$G(CLIO("observed"))
S DATE(3)=$G(CLIO("setStart"))
S DATE(4)=$G(CLIO("setStop"))
;DETERMINE WHICH ONE IS NEWER
Q $$FINDNEW(.DATE)
;
ORD ; Order ; RHL 20141231
N D,DATE,I,J,ND,XDT,SRVRNUM
S DATE(1)=$G(ORDER("entered")),SRVRNUM=$$SRVRNO^HMPOR(DFN) ; need server number for patient
; DE3504 - Jan 18, 2016, added the code below for US10045
; US10045 - PB check if patient and order in the HMP SUBSCRIPTION, if found get date/time stamps with seconds from there
I $D(^HMP(800000,SRVRNUM,1,DFN,1,ID,0)) D
. S ND=$G(^HMP(800000,SRVRNUM,1,DFN,1,ID,0))
. S XDT(2)=$P(ND,U,15),XDT(1)=$P(ND,U,2) ; FileMan format date/time
. S D=XDT(1) S:XDT(2)>D D=XDT(2) ; get later date in D
. S DATE(1)=$$JSONDT^HMPUTILS(D)
; these are signature /verification dates
;DE3337 Feb 3, 2016 ;US10045 - PB Oct 28, 2015 flag set in HMPDJ01 to indicate there is date in the array ORDER("clinicians",I,"signedDateTime") where I is the incremental variable
S J=1,I=0 ; evaluate this array every time DE3337
F S I=$O(ORDER("clinicians",I)) Q:'I D
. I $G(ORDER("clinicians",I,"signedDateTime"))]"" S J=J+1,DATE(J)=ORDER("clinicians",I,"signedDateTime")
;
I $G(ORDER("stop")) S J=J+1,DATE(J)=ORDER("stop")
Q $$FINDNEW(.DATE) ; determine newest date
;
PRO ; Problem
K DATE N I,J,T
S DATE(1)=$G(PROB("entered"))
S DATE(2)=$G(PROB("updated"))
S DATE(3)=$G(PROB("onset"))
S DATE(4)=$G(PROB("resolved"))
; there may be dates in comments
S I=0,J=4 ; J starts at 4 because of the logic above
F S I=$O(PROB("comments",I)) Q:I="" S T=$G(PROB("comments",I,"entered")) S:T J=J+1,DATE(J)=T
; ASF - DE3691, get lastUpdateTime, Feb 29, 2016
D
. ;if freshness item get timestamp from stream get last update from freshness stream
. S T=$G(FILTER("freshnessDateTime"))
. I T S J=J+1,DATE(J)=$$JSONDT^HMPUTILS(T) Q
. ;else get from audit file
. S T=$O(^GMPL(125.8,"AD",ID,0)) ; PROBLEM LIST AUDIT, ICR 2974, last changed date/time with seconds
. I T S J=J+1,DATE(J)=$$JSONDT^HMPUTILS(9999999-T) ; got an edited date/time (inverse order)
;
Q $$FINDNEW(.DATE) ; determine newest date
;
PRC ; Procedure
K DATE
S DATE(1)=$G(PROC("dateTime"))
S DATE(2)=$G(PROC("requested"))
;DETERMINE WHICH ONE IS NEWER
Q $$FINDNEW(.DATE)
CON ; Consult
K DATE
S DATE(1)=$G(CONS("dateTime"))
S DATE(2)=$G(CONS("earliestDate"))
S DATE(3)=$G(ACT("entered"))
S DATE(4)=$G(ACT("dateTime"))
;DETERMINE WHICH ONE IS NEWER
Q $$FINDNEW(.DATE)
IMA ; Image ; RHL 20150102
K DATE
S DATE(1)=$G(EXAM("dateTime"))
;DETERMINE WHICH ONE IS NEWER
Q $$FINDNEW(.DATE)
SUR ; Surgery ; RHL 20150102
K DATE
S DATE(1)=$G(SURG("dateTime"))
;DETERMINE WHICH ONE IS NEWER
Q $$FINDNEW(.DATE)
TAS ; Task
Q ""
K DATE
;S DATE(1)=$G(
;DETERMINE WHICH ONE IS NEWER
Q $$FINDNEW(.DATE)
VIS ; Visit
K DATE
S DATE(1)=$G(VST("dateTime"))
S DATE(2)=$G(VST("checkOut"))
;DE4049 use freshness datetime if available
I $G(FILTER("freshnessDateTime")) S DATE(3)=$$JSONDT^HMPUTILS(FILTER("freshnessDateTime"))
;DETERMINE WHICH ONE IS NEWER
Q $$FINDNEW(.DATE)
VIT ; Vital
K DATE
S DATE(1)=$G(VIT("observed"))
S DATE(2)=$G(VIT("resulted"))
S DATE(3)=$G(VIT("dateEnteredInError")) ; r1.3 - fix for including vital EIE date
;DETERMINE WHICH ONE IS NEWER
Q $$FINDNEW(.DATE)
PTF ; Ptf ; RHL 20150102
K DATE
S DATE(1)=$G(PTF("arrivalDateTime"))
S DATE(2)=$G(PTF("dischargeDateTime"))
;DETERMINE WHICH ONE IS NEWER
Q $$FINDNEW(.DATE)
EXA ; Exam
K DATE
S DATE(1)=$G(PCE("entered"))
;DETERMINE WHICH ONE IS NEWER
Q $$FINDNEW(.DATE)
CPT ; CPT
K DATE
S DATE(1)=$G(PCE("entered"))
;DETERMINE WHICH ONE IS NEWER
Q $$FINDNEW(.DATE)
EDU ; Education
K DATE
S DATE(1)=$G(PCE("entered"))
;DETERMINE WHICH ONE IS NEWER
Q $$FINDNEW(.DATE)
POV ; Pov
K DATE
S DATE(1)=$G(PCE("entered"))
;DETERMINE WHICH ONE IS NEWER
Q $$FINDNEW(.DATE)
SKI ; Skin
K DATE
S DATE(1)=$G(PCE("entered"))
S DATE(2)=$G(PCE("dateRead"))
;DETERMINE WHICH ONE IS NEWER
Q $$FINDNEW(.DATE)
TRE ; Treatment ; RHL 20150102
K DATE
S DATE(1)=$G(NTX("entered"))
S DATE(2)=$G(NTX("start"))
S DATE(3)=$G(NTX("stop"))
;these are dates in signature/verification dates; is this used for NTX orders
I $G(NTX("clinicians")) D
. N I,J
. S J="",J=$O(DATE(J),-1)
. S I=0
. F S I=$O(NTX("clinicians",I)) Q:I="" D
. . I $G(NTX("clinicians",I,"signedDateTime"))]"" S J=J+1,DATE(J)=NTX("clinicians",I,"signedDateTime")
;DETERMINE WHICH ONE IS NEWER
Q $$FINDNEW(.DATE)
MH ; Mh ; RHL 20150103
K DATE
S DATE(1)=$G(MH("administeredDateTime"))
;DETERMINE WHICH ONE IS NEWER
Q $$FINDNEW(.DATE)
;
FINDNEW(DATE) ; function, find the latest date from DATE array
;DATE array has following format DATE(1)=DATE DATE(2)=DATE
N ADATE,COMDATE,NDATE,X
; Jan 28, 2016, DE3519;bl set date for comparison, now plus 60 seconds padded with zeroes, no time zone offset
S NDATE=$E($$FMTHL7($$FMADD^XLFDT($$NOW^XLFDT,0,0,0,60))_"000000",1,14) ; DE5016
S X=0,COMDATE=0 ; initialize starting date to zero
F S X=$O(DATE(X)) Q:'X D:$E(DATE(X),7,8) ; evaluate only if precise date. DE3548
. S ADATE=$E(DATE(X)_"000000",1,14) ; Need padding down to the second (YYYYMMDDHHMM). JD-1/23/15
. I ADATE>NDATE Q ; DE3519;bl prevent future date/times in lastUpdateTime
. I ADATE>COMDATE S COMDATE=ADATE
;Defaut to NOW if there are no other dates. JD - 2/7/16. DE3728
I 'COMDATE S COMDATE=$E($$FMTHL7($$NOW^XLFDT)_"000000",1,14) ; DE5016
Q COMDATE
;
; DE5016 - May 26, 2016 - hrubovcak
FMTHL7(HMPFMDTM) ; function, return HL7 date/time from FileMan date/time, strip time zone offset
; DE6591 - 8/30/16 CK - translate plus or minus sign to '^', return 14 characters if time passed, return 8 otherwise
Q $E($P($TR($$FMTHL7^XLFDT(HMPFMDTM),"-+","^^"),"^")_$S($P(HMPFMDTM,".",2):"000000",1:""),1,14)
;note: code above should be invoked with one second after midnight if time is desired at the stroke of midnight
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHMPSTMP 11457 printed Nov 22, 2024@17:04:45 Page 2
HMPSTMP ;ASMR/JD,BL,ASF,CK,CPC - MetaStamp ;Aug 30, 2016 06:54:52
+1 ;;2.0;ENTERPRISE HEALTH MANAGEMENT PLATFORM;**1,2,3**;May 15, 2016;Build 15
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; Returns the most recent date/time
+5 ; JD - 6/5/15 - Added code to the DOC section to consider the attachment date
+6 ; as one of the dates if it exists
+7 ; JD - 2/1/16 - Added code to the FINDNEW section to skip over the imprecise dates. DE3548
+8 ; JD - 2/7/16 - Modified FINDNEW section to default to NOW if no other dates exist. DE3728
+9 QUIT
+10 ;
EN(A) ; extrinsic function, used to create "stampTime" or "lastUpdateTime" subscript in arrays
+1 KILL B
+2 NEW C
+3 ; A is either "now" or a domain name (per PTDOMS^HMPDJFSD)
+4 ; B is the return value (stampTime)
+5 SET C=$$UP^XLFSTR(A)
+6 IF C="NOW"
GOTO NOW
+7 IF C="ADM"
GOTO ADM
+8 IF C="ALLERGY"
GOTO ALL
+9 IF C="AUXILIARY"
GOTO AUX
+10 IF C="APPOINTMENT"
GOTO APP
+11 IF C="DIAGNOSIS"
GOTO DIA
+12 IF C="DOCUMENT"
GOTO DOC
+13 IF C="FACTOR"
GOTO FAC
+14 IF C="IMMUNIZATION"
GOTO IMM
+15 IF C="LAB"
GOTO LAB
+16 IF C="MED"
GOTO MED
+17 IF C="OBS"
GOTO OBS
+18 IF C="ORDER"
GOTO ORD
+19 IF C="PROBLEM"
GOTO PRO
+20 IF C="PROCEDURE"
GOTO PRC
+21 IF C="CONSULT"
GOTO CON
+22 IF C="IMAGE"
GOTO IMA
+23 IF C="SURGERY"
GOTO SUR
+24 IF C="TASK"
GOTO TAS
+25 IF C="VISIT"
GOTO VIS
+26 IF C="VITAL"
GOTO VIT
+27 IF C="PTF"
GOTO PTF
+28 IF C="EXAM"
GOTO EXA
+29 IF C="CPT"
GOTO CPT
+30 IF C="EDUCATION"
GOTO EDU
+31 IF C="POV"
GOTO POV
+32 IF C="SKIN"
GOTO SKI
+33 IF C="TREATMENT"
GOTO TRE
+34 IF C="MH"
GOTO MH
+35 ; DE3504 changed B to "" to prevent error if code falls through
QUIT ""
+36 ;
NOW ;
+1 ; Set stamp time in YYYYMMDDHHMMSS format
+2 ; DE5016
SET B=$$FMTHL7($$NOW^XLFDT)
+3 ; Need padding to force YYYYMMDDHHMMSS precision
SET B=$EXTRACT(B_"000000",1,14)
+4 QUIT B
+5 ;
ADM ; Admissions (these are visits whose ID starts with an "H"). JD - January 26, 2015
+1 KILL DATA
+2 SET DATE(1)=$GET(ADM("dateTime"))
+3 SET DATE(2)=$GET(ADM("stay","dischargeDateTime"))
+4 ;DETERMINE WHICH ONE IS NEWER
+5 QUIT $$FINDNEW(.DATE)
ALL ; Allergy ; rhl 20141231
+1 KILL DATE
+2 SET DATE(1)=$GET(REAC("entered"))
+3 SET DATE(2)=$GET(REAC("verified"))
+4 ; dates in observations array
+5 NEW I,J
+6 SET J=""
SET J=$ORDER(DATE(J),-1)
+7 SET I=0
+8 FOR
SET I=$ORDER(REAC("observations",I))
if I=""
QUIT
Begin DoDot:1
+9 IF $GET(REAC("observations",I,"date"))]""
SET J=J+1
SET DATE(J)=REAC("observations",I,"date")
End DoDot:1
+10 ; dates in comment array
+11 NEW I,J
+12 SET J=""
SET J=$ORDER(DATE(J),-1)
+13 SET I=0
+14 FOR
SET I=$ORDER(REAC("comments",I))
if I=""
QUIT
Begin DoDot:1
+15 IF $GET(REAC("comments",I,"entered"))]""
SET J=J+1
SET DATE(J)=REAC("comments",I,"entered")
End DoDot:1
+16 ;DETERMINE WHICH ONE IS NEWER
+17 QUIT $$FINDNEW(.DATE)
AUX ; Auxiliary
+1 QUIT ""
+2 KILL DATE
+3 ;S DATE(1)=$G(
+4 ;DETERMINE WHICH ONE IS NEWER
+5 QUIT $$FINDNEW(.DATE)
APP ; Appointment
+1 KILL DATE
+2 SET DATE(1)=$GET(APPT("dateTime"))
+3 SET DATE(2)=$GET(APPT("checkIn"))
+4 SET DATE(3)=$GET(APPT("checkOut"))
+5 ;if freshness item get timestamp from stream get last update from freshness stream
+6 ;DE4859
IF $GET(FILTER("freshnessDateTime"))
SET DATE(4)=$$JSONDT^HMPUTILS(FILTER("freshnessDateTime"))
+7 ;DETERMINE WHICH ONE IS NEWER
+8 QUIT $$FINDNEW(.DATE)
DIA ; Diagnosis
+1 QUIT ""
+2 KILL DATE
+3 ;S DATE(1)=$G(
+4 ;DETERMINE WHICH ONE IS NEWER
+5 QUIT $$FINDNEW(.DATE)
DOC ; Document
+1 NEW AUDDT
+2 ; Audit trail date/time
SET AUDDT=""
+3 KILL DATE
+4 SET DATE(1)=$GET(DOC("referenceDateTime"))
+5 SET DATE(2)=$GET(DOC("entered"))
+6 ;DE2818, ^TIU(8925.5) references - ICR 6279
+7 ; Find the most recent audit trail entry for the document
+8 if $GET(DOC("localId"))
SET AUDDT=$ORDER(^TIU(8925.5,"B",DOC("localId"),""),-1)
+9 ; Get the audit trail date/time
+10 if AUDDT
SET AUDDT=$PIECE($GET(^TIU(8925.5,AUDDT,3)),"^",2)
+11 if AUDDT
SET DATE(3)=$$JSONDT^HMPUTILS(AUDDT)
+12 ;go through HMPDJ array
+13 NEW I,II,J
+14 SET J=""
+15 SET J=$ORDER(DATE(J),-1)
+16 SET I=0
+17 FOR
SET I=$ORDER(DOC("text",I))
if I=""
QUIT
Begin DoDot:1
+18 IF $GET(DOC("text",I,"dateTime"))]""
SET J=J+1
SET DATE(J)=DOC("text",I,"dateTime")
+19 SET II=0
FOR
SET II=$ORDER(DOC("text",I,"clinicians",II))
if II=""
QUIT
Begin DoDot:2
+20 IF $GET(DOC("text",I,"clinicians",II,"signedDateTime"))]""
SET J=J+1
SET DATE(J)=DOC("text",I,"clinicians",II,"signedDateTime")
End DoDot:2
End DoDot:1
+21 ;DE4148 use freshness datetime if available
+22 IF $GET(FILTER("freshnessDateTime"))
SET J=J+1
SET DATE(J)=$$JSONDT^HMPUTILS(FILTER("freshnessDateTime"))
+23 ;DETERMINE WHICH ONE IS NEWER
+24 QUIT $$FINDNEW(.DATE)
FAC ; Factor
+1 KILL DATE
+2 SET DATE(1)=$GET(PCE("entered"))
+3 ;DETERMINE WHICH ONE IS NEWER
+4 QUIT $$FINDNEW(.DATE)
IMM ; Immunization
+1 KILL DATE
+2 NEW T
+3 SET DATE(1)=$GET(PCE("administeredDateTime"))
+4 ;DE4013 use freshness datetime if available
+5 SET T=$GET(FILTER("freshnessDateTime"))
+6 IF T
SET DATE(2)=$$JSONDT^HMPUTILS(T)
+7 ;DETERMINE WHICH ONE IS NEWER
+8 QUIT $$FINDNEW(.DATE)
LAB ; Lab
+1 KILL DATE
+2 SET DATE(1)=$GET(LAB("observed"))
+3 SET DATE(2)=$GET(LAB("resulted"))
+4 ;DETERMINE WHICH ONE IS NEWER
+5 QUIT $$FINDNEW(.DATE)
MED ; Med
+1 KILL DATE
+2 SET DATE(1)=$GET(MED("orders",1,"ordered"))
+3 SET DATE(2)=$GET(MED("overallStart"))
+4 SET DATE(3)=$GET(MED("overallStop"))
+5 SET DATE(4)=$GET(MED("stopped"))
+6 SET DATE(5)=$GET(MED("lastFilled"))
+7 ; DE5723
SET DATE(6)=$GET(MED("prescriptionFinished"))
+8 ;go through value array
+9 NEW I,J
+10 SET J=""
SET J=$ORDER(DATE(J),-1)
+11 SET I=0
+12 FOR
SET I=$ORDER(MED("dosages",I))
if I=""
QUIT
Begin DoDot:1
+13 IF $GET(MED("dosages",I,"start"))]""
SET J=J+1
SET DATE(J)=MED("dosages",I,"start")
+14 IF $GET(MED("dosages",I,"stop"))]""
SET J=J+1
SET DATE(J)=MED("dosages",I,"stop")
End DoDot:1
+15 SET J=""
SET J=$ORDER(DATE(J),-1)
+16 SET I=0
+17 FOR
SET I=$ORDER(MED("fills",I))
if I=""
QUIT
Begin DoDot:1
+18 IF $GET(MED("fills",I,"dispenseDate"))]""
SET J=J+1
SET DATE(J)=MED("fills",I,"dispenseDate")
+19 IF $GET(MED("fills",I,"releaseDate"))]""
SET J=J+1
SET DATE(J)=MED("fills",I,"releaseDate")
End DoDot:1
+20 ;DETERMINE WHICH ONE IS NEWER
+21 QUIT $$FINDNEW(.DATE)
OBS ; Obs ; rhl 20141231
+1 KILL DATE
+2 SET DATE(1)=$GET(CLIO("entered"))
+3 SET DATE(2)=$GET(CLIO("observed"))
+4 SET DATE(3)=$GET(CLIO("setStart"))
+5 SET DATE(4)=$GET(CLIO("setStop"))
+6 ;DETERMINE WHICH ONE IS NEWER
+7 QUIT $$FINDNEW(.DATE)
+8 ;
ORD ; Order ; RHL 20141231
+1 NEW D,DATE,I,J,ND,XDT,SRVRNUM
+2 ; need server number for patient
SET DATE(1)=$GET(ORDER("entered"))
SET SRVRNUM=$$SRVRNO^HMPOR(DFN)
+3 ; DE3504 - Jan 18, 2016, added the code below for US10045
+4 ; US10045 - PB check if patient and order in the HMP SUBSCRIPTION, if found get date/time stamps with seconds from there
+5 IF $DATA(^HMP(800000,SRVRNUM,1,DFN,1,ID,0))
Begin DoDot:1
+6 SET ND=$GET(^HMP(800000,SRVRNUM,1,DFN,1,ID,0))
+7 ; FileMan format date/time
SET XDT(2)=$PIECE(ND,U,15)
SET XDT(1)=$PIECE(ND,U,2)
+8 ; get later date in D
SET D=XDT(1)
if XDT(2)>D
SET D=XDT(2)
+9 SET DATE(1)=$$JSONDT^HMPUTILS(D)
End DoDot:1
+10 ; these are signature /verification dates
+11 ;DE3337 Feb 3, 2016 ;US10045 - PB Oct 28, 2015 flag set in HMPDJ01 to indicate there is date in the array ORDER("clinicians",I,"signedDateTime") where I is the incremental variable
+12 ; evaluate this array every time DE3337
SET J=1
SET I=0
+13 FOR
SET I=$ORDER(ORDER("clinicians",I))
if 'I
QUIT
Begin DoDot:1
+14 IF $GET(ORDER("clinicians",I,"signedDateTime"))]""
SET J=J+1
SET DATE(J)=ORDER("clinicians",I,"signedDateTime")
End DoDot:1
+15 ;
+16 IF $GET(ORDER("stop"))
SET J=J+1
SET DATE(J)=ORDER("stop")
+17 ; determine newest date
QUIT $$FINDNEW(.DATE)
+18 ;
PRO ; Problem
+1 KILL DATE
NEW I,J,T
+2 SET DATE(1)=$GET(PROB("entered"))
+3 SET DATE(2)=$GET(PROB("updated"))
+4 SET DATE(3)=$GET(PROB("onset"))
+5 SET DATE(4)=$GET(PROB("resolved"))
+6 ; there may be dates in comments
+7 ; J starts at 4 because of the logic above
SET I=0
SET J=4
+8 FOR
SET I=$ORDER(PROB("comments",I))
if I=""
QUIT
SET T=$GET(PROB("comments",I,"entered"))
if T
SET J=J+1
SET DATE(J)=T
+9 ; ASF - DE3691, get lastUpdateTime, Feb 29, 2016
+10 Begin DoDot:1
+11 ;if freshness item get timestamp from stream get last update from freshness stream
+12 SET T=$GET(FILTER("freshnessDateTime"))
+13 IF T
SET J=J+1
SET DATE(J)=$$JSONDT^HMPUTILS(T)
QUIT
+14 ;else get from audit file
+15 ; PROBLEM LIST AUDIT, ICR 2974, last changed date/time with seconds
SET T=$ORDER(^GMPL(125.8,"AD",ID,0))
+16 ; got an edited date/time (inverse order)
IF T
SET J=J+1
SET DATE(J)=$$JSONDT^HMPUTILS(9999999-T)
End DoDot:1
+17 ;
+18 ; determine newest date
QUIT $$FINDNEW(.DATE)
+19 ;
PRC ; Procedure
+1 KILL DATE
+2 SET DATE(1)=$GET(PROC("dateTime"))
+3 SET DATE(2)=$GET(PROC("requested"))
+4 ;DETERMINE WHICH ONE IS NEWER
+5 QUIT $$FINDNEW(.DATE)
CON ; Consult
+1 KILL DATE
+2 SET DATE(1)=$GET(CONS("dateTime"))
+3 SET DATE(2)=$GET(CONS("earliestDate"))
+4 SET DATE(3)=$GET(ACT("entered"))
+5 SET DATE(4)=$GET(ACT("dateTime"))
+6 ;DETERMINE WHICH ONE IS NEWER
+7 QUIT $$FINDNEW(.DATE)
IMA ; Image ; RHL 20150102
+1 KILL DATE
+2 SET DATE(1)=$GET(EXAM("dateTime"))
+3 ;DETERMINE WHICH ONE IS NEWER
+4 QUIT $$FINDNEW(.DATE)
SUR ; Surgery ; RHL 20150102
+1 KILL DATE
+2 SET DATE(1)=$GET(SURG("dateTime"))
+3 ;DETERMINE WHICH ONE IS NEWER
+4 QUIT $$FINDNEW(.DATE)
TAS ; Task
+1 QUIT ""
+2 KILL DATE
+3 ;S DATE(1)=$G(
+4 ;DETERMINE WHICH ONE IS NEWER
+5 QUIT $$FINDNEW(.DATE)
VIS ; Visit
+1 KILL DATE
+2 SET DATE(1)=$GET(VST("dateTime"))
+3 SET DATE(2)=$GET(VST("checkOut"))
+4 ;DE4049 use freshness datetime if available
+5 IF $GET(FILTER("freshnessDateTime"))
SET DATE(3)=$$JSONDT^HMPUTILS(FILTER("freshnessDateTime"))
+6 ;DETERMINE WHICH ONE IS NEWER
+7 QUIT $$FINDNEW(.DATE)
VIT ; Vital
+1 KILL DATE
+2 SET DATE(1)=$GET(VIT("observed"))
+3 SET DATE(2)=$GET(VIT("resulted"))
+4 ; r1.3 - fix for including vital EIE date
SET DATE(3)=$GET(VIT("dateEnteredInError"))
+5 ;DETERMINE WHICH ONE IS NEWER
+6 QUIT $$FINDNEW(.DATE)
PTF ; Ptf ; RHL 20150102
+1 KILL DATE
+2 SET DATE(1)=$GET(PTF("arrivalDateTime"))
+3 SET DATE(2)=$GET(PTF("dischargeDateTime"))
+4 ;DETERMINE WHICH ONE IS NEWER
+5 QUIT $$FINDNEW(.DATE)
EXA ; Exam
+1 KILL DATE
+2 SET DATE(1)=$GET(PCE("entered"))
+3 ;DETERMINE WHICH ONE IS NEWER
+4 QUIT $$FINDNEW(.DATE)
CPT ; CPT
+1 KILL DATE
+2 SET DATE(1)=$GET(PCE("entered"))
+3 ;DETERMINE WHICH ONE IS NEWER
+4 QUIT $$FINDNEW(.DATE)
EDU ; Education
+1 KILL DATE
+2 SET DATE(1)=$GET(PCE("entered"))
+3 ;DETERMINE WHICH ONE IS NEWER
+4 QUIT $$FINDNEW(.DATE)
POV ; Pov
+1 KILL DATE
+2 SET DATE(1)=$GET(PCE("entered"))
+3 ;DETERMINE WHICH ONE IS NEWER
+4 QUIT $$FINDNEW(.DATE)
SKI ; Skin
+1 KILL DATE
+2 SET DATE(1)=$GET(PCE("entered"))
+3 SET DATE(2)=$GET(PCE("dateRead"))
+4 ;DETERMINE WHICH ONE IS NEWER
+5 QUIT $$FINDNEW(.DATE)
TRE ; Treatment ; RHL 20150102
+1 KILL DATE
+2 SET DATE(1)=$GET(NTX("entered"))
+3 SET DATE(2)=$GET(NTX("start"))
+4 SET DATE(3)=$GET(NTX("stop"))
+5 ;these are dates in signature/verification dates; is this used for NTX orders
+6 IF $GET(NTX("clinicians"))
Begin DoDot:1
+7 NEW I,J
+8 SET J=""
SET J=$ORDER(DATE(J),-1)
+9 SET I=0
+10 FOR
SET I=$ORDER(NTX("clinicians",I))
if I=""
QUIT
Begin DoDot:2
+11 IF $GET(NTX("clinicians",I,"signedDateTime"))]""
SET J=J+1
SET DATE(J)=NTX("clinicians",I,"signedDateTime")
End DoDot:2
End DoDot:1
+12 ;DETERMINE WHICH ONE IS NEWER
+13 QUIT $$FINDNEW(.DATE)
MH ; Mh ; RHL 20150103
+1 KILL DATE
+2 SET DATE(1)=$GET(MH("administeredDateTime"))
+3 ;DETERMINE WHICH ONE IS NEWER
+4 QUIT $$FINDNEW(.DATE)
+5 ;
FINDNEW(DATE) ; function, find the latest date from DATE array
+1 ;DATE array has following format DATE(1)=DATE DATE(2)=DATE
+2 NEW ADATE,COMDATE,NDATE,X
+3 ; Jan 28, 2016, DE3519;bl set date for comparison, now plus 60 seconds padded with zeroes, no time zone offset
+4 ; DE5016
SET NDATE=$EXTRACT($$FMTHL7($$FMADD^XLFDT($$NOW^XLFDT,0,0,0,60))_"000000",1,14)
+5 ; initialize starting date to zero
SET X=0
SET COMDATE=0
+6 ; evaluate only if precise date. DE3548
FOR
SET X=$ORDER(DATE(X))
if 'X
QUIT
if $EXTRACT(DATE(X),7,8)
Begin DoDot:1
+7 ; Need padding down to the second (YYYYMMDDHHMM). JD-1/23/15
SET ADATE=$EXTRACT(DATE(X)_"000000",1,14)
+8 ; DE3519;bl prevent future date/times in lastUpdateTime
IF ADATE>NDATE
QUIT
+9 IF ADATE>COMDATE
SET COMDATE=ADATE
End DoDot:1
+10 ;Defaut to NOW if there are no other dates. JD - 2/7/16. DE3728
+11 ; DE5016
IF 'COMDATE
SET COMDATE=$EXTRACT($$FMTHL7($$NOW^XLFDT)_"000000",1,14)
+12 QUIT COMDATE
+13 ;
+14 ; DE5016 - May 26, 2016 - hrubovcak
FMTHL7(HMPFMDTM) ; function, return HL7 date/time from FileMan date/time, strip time zone offset
+1 ; DE6591 - 8/30/16 CK - translate plus or minus sign to '^', return 14 characters if time passed, return 8 otherwise
+2 QUIT $EXTRACT($PIECE($TRANSLATE($$FMTHL7^XLFDT(HMPFMDTM),"-+","^^"),"^")_$SELECT($PIECE(HMPFMDTM,".",2):"000000",1:""),1,14)
+3 ;note: code above should be invoked with one second after midnight if time is desired at the stroke of midnight
+4 ;