- 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 Jan 18, 2025@04:03:13 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)