HMPSTMP.m

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 ---HMPSTMP   11457     printed  Apr 09, 2024@20:58:42                                                                                                                                                                                                    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       ;