SDVSIT ;MJK/ALB - Visit Tracking Processing ; 3/28/01 2:12pm
;;5.3;Scheduling;**27,44,75,96,132,161,219,1001,1003,1015**;Aug 13, 1993;Build 21
;IHS/ANMC/LJF 7/23/2001 bypass VA Vist Tracking
; 9/21/2001 used IHS code to determine division
;IHS/ITSC/LJF 5/04/2005 PATCH 1003 stuff visit IEN if not correct
;
;
AEUPD(SDVIEN,SDATYPE,SDOEP) ; -- update one entry in multiple
; input: SDVIEN := Visit file pointer
; SDATYPE := Appointment Type [optional]
; SDOEP := ien of ^SCE that is the parent encounter [optional]
;
N SDOE,DA,DR,DE,DQ,DIE,SD0,SDVSIT,SDT,SDLOCK,SDCL0
;
G AEUPDQ:'$G(^AUPNVSIT(+$G(SDVIEN),0)) S SD0=^(0)
S SDT=+SD0
S SDVSIT("DFN")=$P(SD0,U,5)
I ('SDVSIT("DFN")) G AEUPDQ
;
; -- set lock data and lock
S SDLOCK("DFN")=$P(SD0,U,5)
S SDLOCK("EVENT DATE/TIME")=SDT
D LOCK(.SDLOCK)
;
; -- quit if encounter does exist for visit
IF $O(^SCE("AVSIT",SDVIEN,0)) G AEUPDQ
;
S SDVSIT("DIV")=+$P($G(^SC(+$P(SD0,U,22),0)),U,15)
S SDVSIT("DIV")=$$DIV(SDVSIT("DIV"))
I ('SDVSIT("DIV")) G AEUPDQ
;
S SDVSIT("CLN")=+$P(SD0,U,8)
; -- this may not be needed any longer but doesn't hurt (mjk)
I $P($G(^DIC(40.7,+$P(SD0,U,8),0)),U,2)=900 S SDVSIT("CLN")=+$P($G(^SC(+$P(SD0,U,22),0)),U,7)
I 'SDVSIT("CLN") G AEUPDQ
;
S:$P(SD0,U,22) SDVSIT("LOC")=$P(SD0,U,22)
S:$P(SD0,U,21) SDVSIT("ELG")=$P(SD0,U,21)
S SDVSIT("TYP")=$G(SDATYPE)
S SDVSIT("PAR")=$G(SDOEP)
S SDVSIT("ORG")=2
S SDVSIT("REF")=""
S SDOE=$$SDOE(SDT,.SDVSIT,SDVIEN,$G(SDOEP))
S SDCL0=$G(^SC(+SDVSIT("LOC"),0))
D CSTOP(SDOE,SDCL0,.SDVSIT,SDT) ;Process credit stop if applicable
AEUPDQ D UNLOCK(.SDLOCK)
Q
;
APPT(DFN,SDT,SDCL,SDVIEN) ; -- process appt
; input DFN = ien of patient file entry
; SDT = visit date internal format
; SDCL = ien of hospital location file entry
; SDVIEN = Visit file pointer [optional]
;
N SDVSIT,SDOE,DA,DIE,DR,SDPT,SDSC,SDCL0,SDDA,SDLOCK
;
; -- set lock data and lock
S SDLOCK("DFN")=DFN
S SDLOCK("EVENT DATE/TIME")=SDT
D LOCK(.SDLOCK)
;
; -- set node vars
S SDPT=$G(^DPT(DFN,"S",SDT,0))
S SDCL0=$G(^SC(SDCL,0)),SDDA=+$$FIND^SDAM2(DFN,SDT,SDCL)
S SDSC=$G(^SC(SDCL,"S",SDT,1,SDDA,0))
S SDVSIT("CLN")=$P(SDCL0,U,7),SDVSIT("DIV")=$$DIV($P(SDCL0,U,15))
;
; -- do checks
I 'SDPT!('SDSC)!($P(SDCL0,U,3)'="C") G APPTQ
I SDCL,+SDPT'=SDCL G APPTQ
I $P(SDPT,U,20) G APPTQ
;
;ihs/cmi/maw 02/23/2012 1015 going to leave this commented out to see if it fixes our EHR problem
;IHS/ITSC/LJF 5/04/2005 PATCH 1003 if OE entry already exists, update visit
;I $P(SDPT,U,20) G APPTQ
;I $P(SDPT,U,20) D G APPTQ
;. Q:'$G(SDVIEN) ;no visit ien, then just quit
;. NEW DIE,DA,DR
;. S DA=$P(SDPT,U,20) I $P(^SCE(DA,0),U,5)=SDVIEN Q ;correct visit
;. S DIE="^SCE(",DR=".05////"_SDVIEN D ^DIE ;stuff correct visit
;end of PATCH 1003 mods
;
I 'SDVSIT("CLN")!('SDVSIT("DIV")) G APPTQ
;
; -- set the rest
S SDVSIT("DFN")=DFN,SDVSIT("LOC")=SDCL
S:$P(SDSC,U,10) SDVSIT("ELG")=$P(SDSC,U,10)
S:$P(SDPT,U,16) SDVSIT("TYP")=$P(SDPT,U,16)
;
; -- call logic to add opt encounter(s)
S SDVSIT("ORG")=1,SDVSIT("REF")=SDDA,SDOE=$$SDOE(SDT,.SDVSIT,$G(SDVIEN))
I SDOE D
.N DA,DIE,DR
.S DA=SDT,DA(1)=DFN,DR="21////"_SDOE,DIE="^DPT("_DFN_",""S""," D ^DIE
;
D CSTOP(SDOE,SDCL0,.SDVSIT,SDT) ;Process credit stop if applicable
;
APPTQ D UNLOCK(.SDLOCK)
Q
;
CSTOP(SDOE,SDCL0,SDVSIT,SDT) ;Process credit stop
;Input: SDOE=encounter ien
;Input: SDCL0=zeroeth node of HOSPITAL LOCATION file record
;Input: SDVSIT=visit data array (pass by reference)
;Input: SDT=encounter date/time
; -- does clinic have a credit stop code?
; -- process only if non non-count and not equal to credit
;
I SDOE,$P(SDCL0,U,18),($P(SDCL0,U,18)'=SDVSIT("CLN")),($P(SDCL0,U,17)'="Y") D
. N X,SDVIENSV,SDVIENOR
. S X=$G(^DIC(40.7,$P(SDCL0,U,18),0))
.; -- is stop code active?
. I $S('$P(X,U,3):1,1:SDT<$P(X,U,3)) D
. . S SDVSIT("CLN")=$P(SDCL0,U,18)
. . S SDVIENOR=$G(SDVSIT("ORG"))
. . S SDVSIT("ORG")=4
. . S SDVSIT("PAR")=SDOE
. . S SDVIENSV=$G(SDVSIT("VST"))
. . K SDVSIT("VST")
. . S X=$$SDOE(SDT,.SDVSIT)
. . IF X D LOGDATA^SDAPIAP(X)
. .;
. .; -- restore SDVSIT
. . S SDVSIT("CLN")=$P(SDCL0,U,7)
. . S SDVSIT("ORG")=SDVIENOR
. . S SDVSIT("VST")=SDVIENSV
. . K SDVSIT("PAR")
. . Q
. Q
Q
;
DISP(DFN,SDT,SDVIEN) ; -- process disposition
; input DFN = ien of patient file entry
; SDT = visit date internal format
; SDIV = ien of med ctr file entry
; SDVIEN = Visit file pointer [optional]
;
N SDVSIT,SDOE,DA,DIE,DR,SDIS,SDDA,SDLOCK
;
; -- set lock data and lock
S SDLOCK("DFN")=DFN
S SDLOCK("EVENT DATE/TIME")=SDT
D LOCK(.SDLOCK)
;
; -- set up array and other vars
D ARRAY(.DFN,.SDT,.SDDA,.SDIS,.SDVSIT)
;
; -- do checks
I $P(SDIS,U,2)=2!($P(SDIS,U,2)="")!($P(SDIS,U,18)) G DISPQ
I 'SDVSIT("CLN")!('SDVSIT("DIV")) G DISPQ
;
; -- call logic to add opt encounter/visit
S SDOE=$$SDOE(SDT,.SDVSIT,$G(SDVIEN))
I SDOE S DA=SDDA,DA(1)=DFN,DR="18////"_SDOE,DIE="^DPT("_DFN_",""DIS""," D ^DIE
DISPQ D UNLOCK(.SDLOCK)
Q
;
ARRAY(DFN,SDT,SDDA,SDIS,SDVSIT) ; -- setup sdvsit for disposition
S SDDA=9999999-SDT
S SDIS=$G(^DPT(DFN,"DIS",SDDA,0))
S SDVSIT("CLN")=$O(^DIC(40.7,"C",102,0))
S SDVSIT("DIV")=$$DIV(+$P(SDIS,U,4))
S:$P(SDIS,U,13) SDVSIT("ELG")=$P(SDIS,U,13)
S SDVSIT("DFN")=DFN
S SDVSIT("ORG")=3
S SDVSIT("REF")=SDDA
S SDVSIT("VST")=""
S SDVSIT("TYP")=9
Q
;
LOCK(SDLOCK) ; -- lock "ADFN" node
L +^SCE("ADFN",+$G(SDLOCK("DFN")),+$G(SDLOCK("EVENT DATE/TIME")))
Q
;
UNLOCK(SDLOCK) ; -- unlock "ADFN" node
L -^SCE("ADFN",+$G(SDLOCK("DFN")),+$G(SDLOCK("EVENT DATE/TIME")))
Q
;
DIV(DIV) ; -- determine med div
Q $S(+DIV:DIV,1:$$DIV^BSDU) ;IHS/ANMC/LJF 9/21/2001
;
I $P($G(^DG(43,1,"GL")),U,2),$D(^DG(40.8,+DIV,0)) G DIVQ ; multi-div?
S DIV=+$O(^DG(40.8,0))
DIVQ Q DIV
;
; -- see bottom of SDVSIT0 for additional doc
;
SDOE(SDT,SDVSIT,SDVIEN,SDOEP) ; -- get visit & encounter
S SDVSIT("VST")=$G(SDVIEN)
;IF 'SDVSIT("VST") D VISIT^SDVSIT0(SDT,.SDVSIT) ;IHS/ITSC/LJF 5/20/2004 PATCH #1001
Q $$NEW^SDVSIT0(SDT,.SDVSIT)
;
;
DATECHCK(DATETIME) ;Validate FileMan date/time
;Input : DATETIME - Date and optional time in FileMan format
;Output : DATETIME - Valid date/time in FileMan format
;Notes : If time was not included on input, time will not be included
; on output
; : If time rolls past midnight, 235959 (one second before
; midnight) will be used
; : Current date/time will be returned on NULL input
; : Current date will be used if input date is not valid
;
;Check input
Q:($G(DATETIME)="") $$NOW^XLFDT()
;Declare variables
N DATE,TIME,HR,MIN,SEC,X,Y,%DT
;Break out date & time
S DATE=$P(DATETIME,".",1)
S TIME=$P(DATETIME,".",2)_"000000"
;Validate date
S X=DATE
S %DT="X"
D ^%DT
;Date not valid - use current date
S:(Y<0) DATE=$$DT^XLFDT()
;No time - return date
Q:('TIME) DATE
;Break out hours, minutes, and seconds
S HR=$E(TIME,1,2)
S MIN=$E(TIME,3,4)
S SEC=$E(TIME,5,6)
;Validate seconds - increment minutes if needed
S:(SEC>59) MIN=MIN+1,SEC=SEC-60
;Validate minutes - increment hours if needed
S:(MIN>59) HR=HR+1,MIN=MIN-60
;Validate hours - revert to one second before midnight
S:(HR>23) HR=23,MIN=59,SEC=59
;Append leading zeros to hours, minutes, and seconds
S HR="00"_HR
S HR=$E(HR,($L(HR)-1),$L(HR))
S MIN="00"_MIN
S MIN=$E(MIN,($L(MIN)-1),$L(MIN))
S SEC="00"_SEC
S SEC=$E(SEC,($L(SEC)-1),$L(SEC))
;Rebuild time
S TIME=HR_MIN_SEC
;Done - return date and time (trailing zeros removed)
Q +(DATE_"."_TIME)
SDVSIT ;MJK/ALB - Visit Tracking Processing ; 3/28/01 2:12pm
+1 ;;5.3;Scheduling;**27,44,75,96,132,161,219,1001,1003,1015**;Aug 13, 1993;Build 21
+2 ;IHS/ANMC/LJF 7/23/2001 bypass VA Vist Tracking
+3 ; 9/21/2001 used IHS code to determine division
+4 ;IHS/ITSC/LJF 5/04/2005 PATCH 1003 stuff visit IEN if not correct
+5 ;
+6 ;
AEUPD(SDVIEN,SDATYPE,SDOEP) ; -- update one entry in multiple
+1 ; input: SDVIEN := Visit file pointer
+2 ; SDATYPE := Appointment Type [optional]
+3 ; SDOEP := ien of ^SCE that is the parent encounter [optional]
+4 ;
+5 NEW SDOE,DA,DR,DE,DQ,DIE,SD0,SDVSIT,SDT,SDLOCK,SDCL0
+6 ;
+7 IF '$GET(^AUPNVSIT(+$GET(SDVIEN),0))
GOTO AEUPDQ
SET SD0=^(0)
+8 SET SDT=+SD0
+9 SET SDVSIT("DFN")=$PIECE(SD0,U,5)
+10 IF ('SDVSIT("DFN"))
GOTO AEUPDQ
+11 ;
+12 ; -- set lock data and lock
+13 SET SDLOCK("DFN")=$PIECE(SD0,U,5)
+14 SET SDLOCK("EVENT DATE/TIME")=SDT
+15 DO LOCK(.SDLOCK)
+16 ;
+17 ; -- quit if encounter does exist for visit
+18 IF $ORDER(^SCE("AVSIT",SDVIEN,0))
GOTO AEUPDQ
+19 ;
+20 SET SDVSIT("DIV")=+$PIECE($GET(^SC(+$PIECE(SD0,U,22),0)),U,15)
+21 SET SDVSIT("DIV")=$$DIV(SDVSIT("DIV"))
+22 IF ('SDVSIT("DIV"))
GOTO AEUPDQ
+23 ;
+24 SET SDVSIT("CLN")=+$PIECE(SD0,U,8)
+25 ; -- this may not be needed any longer but doesn't hurt (mjk)
+26 IF $PIECE($GET(^DIC(40.7,+$PIECE(SD0,U,8),0)),U,2)=900
SET SDVSIT("CLN")=+$PIECE($GET(^SC(+$PIECE(SD0,U,22),0)),U,7)
+27 IF 'SDVSIT("CLN")
GOTO AEUPDQ
+28 ;
+29 IF $PIECE(SD0,U,22)
SET SDVSIT("LOC")=$PIECE(SD0,U,22)
+30 IF $PIECE(SD0,U,21)
SET SDVSIT("ELG")=$PIECE(SD0,U,21)
+31 SET SDVSIT("TYP")=$GET(SDATYPE)
+32 SET SDVSIT("PAR")=$GET(SDOEP)
+33 SET SDVSIT("ORG")=2
+34 SET SDVSIT("REF")=""
+35 SET SDOE=$$SDOE(SDT,.SDVSIT,SDVIEN,$GET(SDOEP))
+36 SET SDCL0=$GET(^SC(+SDVSIT("LOC"),0))
+37 ;Process credit stop if applicable
DO CSTOP(SDOE,SDCL0,.SDVSIT,SDT)
AEUPDQ DO UNLOCK(.SDLOCK)
+1 QUIT
+2 ;
APPT(DFN,SDT,SDCL,SDVIEN) ; -- process appt
+1 ; input DFN = ien of patient file entry
+2 ; SDT = visit date internal format
+3 ; SDCL = ien of hospital location file entry
+4 ; SDVIEN = Visit file pointer [optional]
+5 ;
+6 NEW SDVSIT,SDOE,DA,DIE,DR,SDPT,SDSC,SDCL0,SDDA,SDLOCK
+7 ;
+8 ; -- set lock data and lock
+9 SET SDLOCK("DFN")=DFN
+10 SET SDLOCK("EVENT DATE/TIME")=SDT
+11 DO LOCK(.SDLOCK)
+12 ;
+13 ; -- set node vars
+14 SET SDPT=$GET(^DPT(DFN,"S",SDT,0))
+15 SET SDCL0=$GET(^SC(SDCL,0))
SET SDDA=+$$FIND^SDAM2(DFN,SDT,SDCL)
+16 SET SDSC=$GET(^SC(SDCL,"S",SDT,1,SDDA,0))
+17 SET SDVSIT("CLN")=$PIECE(SDCL0,U,7)
SET SDVSIT("DIV")=$$DIV($PIECE(SDCL0,U,15))
+18 ;
+19 ; -- do checks
+20 IF 'SDPT!('SDSC)!($PIECE(SDCL0,U,3)'="C")
GOTO APPTQ
+21 IF SDCL
IF +SDPT'=SDCL
GOTO APPTQ
+22 IF $PIECE(SDPT,U,20)
GOTO APPTQ
+23 ;
+24 ;ihs/cmi/maw 02/23/2012 1015 going to leave this commented out to see if it fixes our EHR problem
+25 ;IHS/ITSC/LJF 5/04/2005 PATCH 1003 if OE entry already exists, update visit
+26 ;I $P(SDPT,U,20) G APPTQ
+27 ;I $P(SDPT,U,20) D G APPTQ
+28 ;. Q:'$G(SDVIEN) ;no visit ien, then just quit
+29 ;. NEW DIE,DA,DR
+30 ;. S DA=$P(SDPT,U,20) I $P(^SCE(DA,0),U,5)=SDVIEN Q ;correct visit
+31 ;. S DIE="^SCE(",DR=".05////"_SDVIEN D ^DIE ;stuff correct visit
+32 ;end of PATCH 1003 mods
+33 ;
+34 IF 'SDVSIT("CLN")!('SDVSIT("DIV"))
GOTO APPTQ
+35 ;
+36 ; -- set the rest
+37 SET SDVSIT("DFN")=DFN
SET SDVSIT("LOC")=SDCL
+38 IF $PIECE(SDSC,U,10)
SET SDVSIT("ELG")=$PIECE(SDSC,U,10)
+39 IF $PIECE(SDPT,U,16)
SET SDVSIT("TYP")=$PIECE(SDPT,U,16)
+40 ;
+41 ; -- call logic to add opt encounter(s)
+42 SET SDVSIT("ORG")=1
SET SDVSIT("REF")=SDDA
SET SDOE=$$SDOE(SDT,.SDVSIT,$GET(SDVIEN))
+43 IF SDOE
Begin DoDot:1
+44 NEW DA,DIE,DR
+45 SET DA=SDT
SET DA(1)=DFN
SET DR="21////"_SDOE
SET DIE="^DPT("_DFN_",""S"","
DO ^DIE
End DoDot:1
+46 ;
+47 ;Process credit stop if applicable
DO CSTOP(SDOE,SDCL0,.SDVSIT,SDT)
+48 ;
APPTQ DO UNLOCK(.SDLOCK)
+1 QUIT
+2 ;
CSTOP(SDOE,SDCL0,SDVSIT,SDT) ;Process credit stop
+1 ;Input: SDOE=encounter ien
+2 ;Input: SDCL0=zeroeth node of HOSPITAL LOCATION file record
+3 ;Input: SDVSIT=visit data array (pass by reference)
+4 ;Input: SDT=encounter date/time
+5 ; -- does clinic have a credit stop code?
+6 ; -- process only if non non-count and not equal to credit
+7 ;
+8 IF SDOE
IF $PIECE(SDCL0,U,18)
IF ($PIECE(SDCL0,U,18)'=SDVSIT("CLN"))
IF ($PIECE(SDCL0,U,17)'="Y")
Begin DoDot:1
+9 NEW X,SDVIENSV,SDVIENOR
+10 SET X=$GET(^DIC(40.7,$PIECE(SDCL0,U,18),0))
+11 ; -- is stop code active?
+12 IF $SELECT('$PIECE(X,U,3):1,1:SDT<$PIECE(X,U,3))
Begin DoDot:2
+13 SET SDVSIT("CLN")=$PIECE(SDCL0,U,18)
+14 SET SDVIENOR=$GET(SDVSIT("ORG"))
+15 SET SDVSIT("ORG")=4
+16 SET SDVSIT("PAR")=SDOE
+17 SET SDVIENSV=$GET(SDVSIT("VST"))
+18 KILL SDVSIT("VST")
+19 SET X=$$SDOE(SDT,.SDVSIT)
+20 IF X
DO LOGDATA^SDAPIAP(X)
+21 ;
+22 ; -- restore SDVSIT
+23 SET SDVSIT("CLN")=$PIECE(SDCL0,U,7)
+24 SET SDVSIT("ORG")=SDVIENOR
+25 SET SDVSIT("VST")=SDVIENSV
+26 KILL SDVSIT("PAR")
+27 QUIT
End DoDot:2
+28 QUIT
End DoDot:1
+29 QUIT
+30 ;
DISP(DFN,SDT,SDVIEN) ; -- process disposition
+1 ; input DFN = ien of patient file entry
+2 ; SDT = visit date internal format
+3 ; SDIV = ien of med ctr file entry
+4 ; SDVIEN = Visit file pointer [optional]
+5 ;
+6 NEW SDVSIT,SDOE,DA,DIE,DR,SDIS,SDDA,SDLOCK
+7 ;
+8 ; -- set lock data and lock
+9 SET SDLOCK("DFN")=DFN
+10 SET SDLOCK("EVENT DATE/TIME")=SDT
+11 DO LOCK(.SDLOCK)
+12 ;
+13 ; -- set up array and other vars
+14 DO ARRAY(.DFN,.SDT,.SDDA,.SDIS,.SDVSIT)
+15 ;
+16 ; -- do checks
+17 IF $PIECE(SDIS,U,2)=2!($PIECE(SDIS,U,2)="")!($PIECE(SDIS,U,18))
GOTO DISPQ
+18 IF 'SDVSIT("CLN")!('SDVSIT("DIV"))
GOTO DISPQ
+19 ;
+20 ; -- call logic to add opt encounter/visit
+21 SET SDOE=$$SDOE(SDT,.SDVSIT,$GET(SDVIEN))
+22 IF SDOE
SET DA=SDDA
SET DA(1)=DFN
SET DR="18////"_SDOE
SET DIE="^DPT("_DFN_",""DIS"","
DO ^DIE
DISPQ DO UNLOCK(.SDLOCK)
+1 QUIT
+2 ;
ARRAY(DFN,SDT,SDDA,SDIS,SDVSIT) ; -- setup sdvsit for disposition
+1 SET SDDA=9999999-SDT
+2 SET SDIS=$GET(^DPT(DFN,"DIS",SDDA,0))
+3 SET SDVSIT("CLN")=$ORDER(^DIC(40.7,"C",102,0))
+4 SET SDVSIT("DIV")=$$DIV(+$PIECE(SDIS,U,4))
+5 IF $PIECE(SDIS,U,13)
SET SDVSIT("ELG")=$PIECE(SDIS,U,13)
+6 SET SDVSIT("DFN")=DFN
+7 SET SDVSIT("ORG")=3
+8 SET SDVSIT("REF")=SDDA
+9 SET SDVSIT("VST")=""
+10 SET SDVSIT("TYP")=9
+11 QUIT
+12 ;
LOCK(SDLOCK) ; -- lock "ADFN" node
+1 LOCK +^SCE("ADFN",+$GET(SDLOCK("DFN")),+$GET(SDLOCK("EVENT DATE/TIME")))
+2 QUIT
+3 ;
UNLOCK(SDLOCK) ; -- unlock "ADFN" node
+1 LOCK -^SCE("ADFN",+$GET(SDLOCK("DFN")),+$GET(SDLOCK("EVENT DATE/TIME")))
+2 QUIT
+3 ;
DIV(DIV) ; -- determine med div
+1 ;IHS/ANMC/LJF 9/21/2001
QUIT $SELECT(+DIV:DIV,1:$$DIV^BSDU)
+2 ;
+3 ; multi-div?
IF $PIECE($GET(^DG(43,1,"GL")),U,2)
IF $DATA(^DG(40.8,+DIV,0))
GOTO DIVQ
+4 SET DIV=+$ORDER(^DG(40.8,0))
DIVQ QUIT DIV
+1 ;
+2 ; -- see bottom of SDVSIT0 for additional doc
+3 ;
SDOE(SDT,SDVSIT,SDVIEN,SDOEP) ; -- get visit & encounter
+1 SET SDVSIT("VST")=$GET(SDVIEN)
+2 ;IF 'SDVSIT("VST") D VISIT^SDVSIT0(SDT,.SDVSIT) ;IHS/ITSC/LJF 5/20/2004 PATCH #1001
+3 QUIT $$NEW^SDVSIT0(SDT,.SDVSIT)
+4 ;
+5 ;
DATECHCK(DATETIME) ;Validate FileMan date/time
+1 ;Input : DATETIME - Date and optional time in FileMan format
+2 ;Output : DATETIME - Valid date/time in FileMan format
+3 ;Notes : If time was not included on input, time will not be included
+4 ; on output
+5 ; : If time rolls past midnight, 235959 (one second before
+6 ; midnight) will be used
+7 ; : Current date/time will be returned on NULL input
+8 ; : Current date will be used if input date is not valid
+9 ;
+10 ;Check input
+11 IF ($GET(DATETIME)="")
QUIT $$NOW^XLFDT()
+12 ;Declare variables
+13 NEW DATE,TIME,HR,MIN,SEC,X,Y,%DT
+14 ;Break out date & time
+15 SET DATE=$PIECE(DATETIME,".",1)
+16 SET TIME=$PIECE(DATETIME,".",2)_"000000"
+17 ;Validate date
+18 SET X=DATE
+19 SET %DT="X"
+20 DO ^%DT
+21 ;Date not valid - use current date
+22 IF (Y<0)
SET DATE=$$DT^XLFDT()
+23 ;No time - return date
+24 IF ('TIME)
QUIT DATE
+25 ;Break out hours, minutes, and seconds
+26 SET HR=$EXTRACT(TIME,1,2)
+27 SET MIN=$EXTRACT(TIME,3,4)
+28 SET SEC=$EXTRACT(TIME,5,6)
+29 ;Validate seconds - increment minutes if needed
+30 IF (SEC>59)
SET MIN=MIN+1
SET SEC=SEC-60
+31 ;Validate minutes - increment hours if needed
+32 IF (MIN>59)
SET HR=HR+1
SET MIN=MIN-60
+33 ;Validate hours - revert to one second before midnight
+34 IF (HR>23)
SET HR=23
SET MIN=59
SET SEC=59
+35 ;Append leading zeros to hours, minutes, and seconds
+36 SET HR="00"_HR
+37 SET HR=$EXTRACT(HR,($LENGTH(HR)-1),$LENGTH(HR))
+38 SET MIN="00"_MIN
+39 SET MIN=$EXTRACT(MIN,($LENGTH(MIN)-1),$LENGTH(MIN))
+40 SET SEC="00"_SEC
+41 SET SEC=$EXTRACT(SEC,($LENGTH(SEC)-1),$LENGTH(SEC))
+42 ;Rebuild time
+43 SET TIME=HR_MIN_SEC
+44 ;Done - return date and time (trailing zeros removed)
+45 QUIT +(DATE_"."_TIME)
