SDVSIT ;MJK/ALB - Visit Tracking Processing ; 12/19/12 10:13am
;;5.3;Scheduling;**27,44,75,96,132,161,219,630**;Aug 13, 1993;Build 2
;
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
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
F L +^SCE("ADFN",+$G(SDLOCK("DFN")),+$G(SDLOCK("EVENT DATE/TIME"))):$G(DILOCKTM,3) Q:$T ;LLS - 05-JAN-15 - SD*5.3*630 added timeout on lock
Q
;
UNLOCK(SDLOCK) ; -- unlock "ADFN" node
L -^SCE("ADFN",+$G(SDLOCK("DFN")),+$G(SDLOCK("EVENT DATE/TIME")))
Q
;
DIV(DIV) ; -- determine med div
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
N SDTR,SDI ;LLS 22-DEC-2014 - SD*5.3*630 - added
S SDTR=9999999-$P(SDT,".") ;LLS 22-DEC-2014 - SD*5.3*630 - added
I SDT["." S SDTR=SDTR_"."_$P(SDT,".",2) ;LLS 22-DEC-2014 - SD*5.3*630 - added
I '$D(SDVSIT("PAR")),$G(SDVIEN)="" D ;LLS 22-DEC-2014 - SD*5.3*630 - added the following section
. N SDVISARR,SDVIEN1
. S SDVIEN1="" F S SDVIEN1=$O(^AUPNVSIT("AA",DFN,SDTR,SDVIEN1)) Q:SDVIEN1="" D Q:$G(SDVIEN)]""
. . ; COMPARE VISIT: SERVICE CATEGORY, POINTER TO CLINIC STOP FILE, POINTER TO HOSPITAL LOCATION
. . ; FILE, & ENCOUNTER TYPE BEFORE SELECTING EXISTING VISIT INSTEAD OF CREATING A NEW ONE
. . D GETS^DIQ(9000010,SDVIEN1_",",".07;.08;.22;15003","I","SDVISARR")
. . Q:SDVISARR(9000010,SDVIEN1_",",.07,"I")'=$S($G(SDVSIT("SVC"))]"":SDVSIT("SVC"),$$INP^SDAM2(DFN,SDTR)="I":"I",1:"A")
. . Q:SDVISARR(9000010,SDVIEN1_",",.08,"I")'=$G(SDVSIT("CLN"))
. . Q:SDVISARR(9000010,SDVIEN1_",",.22,"I")'=$G(SDVSIT("LOC"))
. . Q:SDVISARR(9000010,SDVIEN1_",",15003,"I")'="P"
. . S SDVIEN=SDVIEN1
S SDVSIT("VST")=$G(SDVIEN)
IF 'SDVSIT("VST") D VISIT^SDVSIT0(SDT,.SDVSIT)
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)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDVSIT 8174 printed Oct 16, 2024@19:02:26 Page 2
SDVSIT ;MJK/ALB - Visit Tracking Processing ; 12/19/12 10:13am
+1 ;;5.3;Scheduling;**27,44,75,96,132,161,219,630**;Aug 13, 1993;Build 2
+2 ;
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 IF 'SDVSIT("CLN")!('SDVSIT("DIV"))
GOTO APPTQ
+24 ;
+25 ; -- set the rest
+26 SET SDVSIT("DFN")=DFN
SET SDVSIT("LOC")=SDCL
+27 if $PIECE(SDSC,U,10)
SET SDVSIT("ELG")=$PIECE(SDSC,U,10)
+28 if $PIECE(SDPT,U,16)
SET SDVSIT("TYP")=$PIECE(SDPT,U,16)
+29 ;
+30 ; -- call logic to add opt encounter(s)
+31 SET SDVSIT("ORG")=1
SET SDVSIT("REF")=SDDA
SET SDOE=$$SDOE(SDT,.SDVSIT,$GET(SDVIEN))
+32 IF SDOE
Begin DoDot:1
+33 NEW DA,DIE,DR
+34 SET DA=SDT
SET DA(1)=DFN
SET DR="21////"_SDOE
SET DIE="^DPT("_DFN_",""S"","
DO ^DIE
End DoDot:1
+35 ;
+36 ;Process credit stop if applicable
DO CSTOP(SDOE,SDCL0,.SDVSIT,SDT)
+37 ;
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 ;LLS - 05-JAN-15 - SD*5.3*630 added timeout on lock
FOR
LOCK +^SCE("ADFN",+$GET(SDLOCK("DFN")),+$GET(SDLOCK("EVENT DATE/TIME"))):$GET(DILOCKTM,3)
if $TEST
QUIT
+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 ; multi-div?
IF $PIECE($GET(^DG(43,1,"GL")),U,2)
IF $DATA(^DG(40.8,+DIV,0))
GOTO DIVQ
+2 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 ;LLS 22-DEC-2014 - SD*5.3*630 - added
NEW SDTR,SDI
+2 ;LLS 22-DEC-2014 - SD*5.3*630 - added
SET SDTR=9999999-$PIECE(SDT,".")
+3 ;LLS 22-DEC-2014 - SD*5.3*630 - added
IF SDT["."
SET SDTR=SDTR_"."_$PIECE(SDT,".",2)
+4 ;LLS 22-DEC-2014 - SD*5.3*630 - added the following section
IF '$DATA(SDVSIT("PAR"))
IF $GET(SDVIEN)=""
Begin DoDot:1
+5 NEW SDVISARR,SDVIEN1
+6 SET SDVIEN1=""
FOR
SET SDVIEN1=$ORDER(^AUPNVSIT("AA",DFN,SDTR,SDVIEN1))
if SDVIEN1=""
QUIT
Begin DoDot:2
+7 ; COMPARE VISIT: SERVICE CATEGORY, POINTER TO CLINIC STOP FILE, POINTER TO HOSPITAL LOCATION
+8 ; FILE, & ENCOUNTER TYPE BEFORE SELECTING EXISTING VISIT INSTEAD OF CREATING A NEW ONE
+9 DO GETS^DIQ(9000010,SDVIEN1_",",".07;.08;.22;15003","I","SDVISARR")
+10 if SDVISARR(9000010,SDVIEN1_",",.07,"I")'=$SELECT($GET(SDVSIT("SVC"))]""
QUIT
+11 if SDVISARR(9000010,SDVIEN1_",",.08,"I")'=$GET(SDVSIT("CLN"))
QUIT
+12 if SDVISARR(9000010,SDVIEN1_",",.22,"I")'=$GET(SDVSIT("LOC"))
QUIT
+13 if SDVISARR(9000010,SDVIEN1_",",15003,"I")'="P"
QUIT
+14 SET SDVIEN=SDVIEN1
End DoDot:2
if $GET(SDVIEN)]""
QUIT
End DoDot:1
+15 SET SDVSIT("VST")=$GET(SDVIEN)
+16 IF 'SDVSIT("VST")
DO VISIT^SDVSIT0(SDT,.SDVSIT)
+17 QUIT $$NEW^SDVSIT0(SDT,.SDVSIT)
+18 ;
+19 ;
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)
