SDESCHKAPPTOVP ;ALB/ANU,TJB - VISTA SCHEDULING RPCS - Routine to check for Appointment Overlaps ; June 17, 2024
;;5.3;Scheduling;**820,881**;Aug 13, 1993;Build 10
;;Per VHA Directive 6402, this routine should not be modified
;
;External References
;-------------------
; Reference to $$GETS^DIQ,$$GETS1^DIQ in ICR #2056
;
Q
;
;
CHKOVERLAP(RETURNJSON,SDDFN,SDBEGDATE,SDDUR) ;
;
; Input:
; SDDFN [Required] = Patient's DFN from PATIENT File #2.
; SDBEGDATE [Required] = The beginning date/time in ISO8601 Time Format for the search.
; SDDUR [Required] = Duration of the appointment
;
; Output:
; RETURNJSON = Returns overlap flag (0-No, 1-Yes) in JSON format. JSON Errors will be returned for any invalid/missing parameters.
;
N RETURN,HASFIELDS,ELGFIELDSARRAY,ELGRETURN
N ISDFNVALID,ISBEGDTVALID,ISDURVALID
S (RETURN,ELGFIELDSARRAY,HASFIELDS)=""
S SDBEGDATE=$G(SDBEGDATE)
;
S ISDFNVALID=$$VALIDATEPTDFN(.ERRORS,$G(SDDFN))
S ISBEGDTVALID=$$VALIDATEBEGDATE(.ERRORS,.SDBEGDATE)
S ISDURVALID=$$VALIDATEDUR(.ERRORS,$G(SDDUR))
;
I $D(ERRORS) M RETURN=ERRORS
I '$D(ERRORS) S HASFIELDS=$$CHKOVERL(.ELGFIELDSARRAY,SDDFN,SDBEGDATE,SDDUR)
I HASFIELDS M RETURN=ELGFIELDSARRAY
;
D BUILDJSON^SDESBUILDJSON(.RETURNJSON,.RETURN)
D CLEANUP
Q
;
VALIDATEBEGDATE(ERRORS,SDBEGDATE) ;Validate Beginning Date
N ERRORFLAG
I $G(SDBEGDATE)="" D ERRLOG^SDESJSON(.ERRORS,25) S ERRORFLAG=1 Q $D(ERRORFLAG)
S SDBEGDATE=$$ISOTFM^SDAMUTDT(SDBEGDATE)
I $G(SDBEGDATE)=-1 S ERRORFLAG=1 D ERRLOG^SDESJSON(.ERRORS,27) Q $D(ERRORFLAG)
I $P(SDBEGDATE,".",2)="" S ERRORFLAG=1 D ERRLOG^SDESJSON(.ERRORS,27) Q $D(ERRORFLAG)
Q $D(ERRORFLAG)
;
VALIDATEPTDFN(ERRORS,SDDFN) ; VALIDATE PATIENT DFN
N ERRORFLAG
I SDDFN="" S ERRORFLAG=1 D ERRLOG^SDESJSON(.ERRORS,1) Q $D(ERRORFLAG)
I SDDFN'="",'$D(^DPT(SDDFN,0)) S ERRORFLAG=1 D ERRLOG^SDESJSON(.ERRORS,2) Q $D(ERRORFLAG)
Q $D(ERRORFLAG)
;
VALIDATEDUR(ERRORS,SDDUR) ; Validate Duration
N ERRORFLAG
I SDDUR="" S ERRORFLAG=1 D ERRLOG^SDESJSON(.ERRORS,115) Q $D(ERRORFLAG)
I (+SDDUR<5)!(+SDDUR>240) S ERRORFLAG=1 D ERRLOG^SDESJSON(.ERRORS,116) Q $D(ERRORFLAG)
Q $D(ERRORFLAG)
;
CHKOVERL(ELGARRAY,SDDFN,SDBEGDATE,SDDUR) ; View Appointment using DFN of the patient
N SDOVERLAP,SDENDDATE,SDAPPSDATE,SDAPPEDATE,IEN,SDNOD,HASDATA,SDAPPDUR,SDCANDATE
S SDOVERLAP=0
S SDENDDATE=$$FMADD^XLFDT(SDBEGDATE,0,0,+SDDUR,0)
S SDAPPSDATE=$P(SDBEGDATE,".",1)_.0001
F S SDAPPSDATE=$O(^SDEC(409.84,"APTDT",SDDFN,SDAPPSDATE)) Q:SDAPPSDATE="" Q:$P(SDAPPSDATE,".",1)>SDENDDATE D
.S IEN=""
.F S IEN=$O(^SDEC(409.84,"APTDT",SDDFN,SDAPPSDATE,IEN)) Q:IEN="" D
..S SDNOD=$G(^SDEC(409.84,IEN,0))
..Q:SDNOD="" ;appointment data missing
..S SDCANDATE=$$GET1^DIQ(409.84,IEN_",",.12,"I")
..Q:$G(SDCANDATE)'=""
..S SDAPPEDATE=$$GET1^DIQ(409.84,IEN_",",.02,"I")
..S SDAPPDUR=$$GET1^DIQ(409.84,IEN_",",.18,"I")
..I SDAPPEDATE="" S SDAPPEDATE=$$FMADD^XLFDT(SDBEGDATE,0,0,+SDAPPDUR,0)
..I SDBEGDATE>=SDAPPSDATE,SDBEGDATE<SDAPPEDATE S SDOVERLAP=1
..I SDENDDATE>SDAPPSDATE,SDENDDATE<=SDAPPEDATE S SDOVERLAP=1
I SDOVERLAP S ELGARRAY("Overlap")="1"
I 'SDOVERLAP S ELGARRAY("Overlap")="0"
S HASDATA=($D(ELGARRAY)>1)
Q HASDATA
Q
;
CLEANUP ;
K RETURNERROR,SDALLAPPTARY,SDBEG,SDEND,ERRORFLAG,ERRORS,ISDFNVALID,ISBEGDTVALID,ISDURVALID
K SDOVERLAP,SDENDDATE,SDAPPSDATE,SDAPPEDATE,IEN,SDNOD,HASDATA,SDAPPDUR,SDCANDATE
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDESCHKAPPTOVP 3475 printed Nov 22, 2024@18:05:59 Page 2
SDESCHKAPPTOVP ;ALB/ANU,TJB - VISTA SCHEDULING RPCS - Routine to check for Appointment Overlaps ; June 17, 2024
+1 ;;5.3;Scheduling;**820,881**;Aug 13, 1993;Build 10
+2 ;;Per VHA Directive 6402, this routine should not be modified
+3 ;
+4 ;External References
+5 ;-------------------
+6 ; Reference to $$GETS^DIQ,$$GETS1^DIQ in ICR #2056
+7 ;
+8 QUIT
+9 ;
+10 ;
CHKOVERLAP(RETURNJSON,SDDFN,SDBEGDATE,SDDUR) ;
+1 ;
+2 ; Input:
+3 ; SDDFN [Required] = Patient's DFN from PATIENT File #2.
+4 ; SDBEGDATE [Required] = The beginning date/time in ISO8601 Time Format for the search.
+5 ; SDDUR [Required] = Duration of the appointment
+6 ;
+7 ; Output:
+8 ; RETURNJSON = Returns overlap flag (0-No, 1-Yes) in JSON format. JSON Errors will be returned for any invalid/missing parameters.
+9 ;
+10 NEW RETURN,HASFIELDS,ELGFIELDSARRAY,ELGRETURN
+11 NEW ISDFNVALID,ISBEGDTVALID,ISDURVALID
+12 SET (RETURN,ELGFIELDSARRAY,HASFIELDS)=""
+13 SET SDBEGDATE=$GET(SDBEGDATE)
+14 ;
+15 SET ISDFNVALID=$$VALIDATEPTDFN(.ERRORS,$GET(SDDFN))
+16 SET ISBEGDTVALID=$$VALIDATEBEGDATE(.ERRORS,.SDBEGDATE)
+17 SET ISDURVALID=$$VALIDATEDUR(.ERRORS,$GET(SDDUR))
+18 ;
+19 IF $DATA(ERRORS)
MERGE RETURN=ERRORS
+20 IF '$DATA(ERRORS)
SET HASFIELDS=$$CHKOVERL(.ELGFIELDSARRAY,SDDFN,SDBEGDATE,SDDUR)
+21 IF HASFIELDS
MERGE RETURN=ELGFIELDSARRAY
+22 ;
+23 DO BUILDJSON^SDESBUILDJSON(.RETURNJSON,.RETURN)
+24 DO CLEANUP
+25 QUIT
+26 ;
VALIDATEBEGDATE(ERRORS,SDBEGDATE) ;Validate Beginning Date
+1 NEW ERRORFLAG
+2 IF $GET(SDBEGDATE)=""
DO ERRLOG^SDESJSON(.ERRORS,25)
SET ERRORFLAG=1
QUIT $DATA(ERRORFLAG)
+3 SET SDBEGDATE=$$ISOTFM^SDAMUTDT(SDBEGDATE)
+4 IF $GET(SDBEGDATE)=-1
SET ERRORFLAG=1
DO ERRLOG^SDESJSON(.ERRORS,27)
QUIT $DATA(ERRORFLAG)
+5 IF $PIECE(SDBEGDATE,".",2)=""
SET ERRORFLAG=1
DO ERRLOG^SDESJSON(.ERRORS,27)
QUIT $DATA(ERRORFLAG)
+6 QUIT $DATA(ERRORFLAG)
+7 ;
VALIDATEPTDFN(ERRORS,SDDFN) ; VALIDATE PATIENT DFN
+1 NEW ERRORFLAG
+2 IF SDDFN=""
SET ERRORFLAG=1
DO ERRLOG^SDESJSON(.ERRORS,1)
QUIT $DATA(ERRORFLAG)
+3 IF SDDFN'=""
IF '$DATA(^DPT(SDDFN,0))
SET ERRORFLAG=1
DO ERRLOG^SDESJSON(.ERRORS,2)
QUIT $DATA(ERRORFLAG)
+4 QUIT $DATA(ERRORFLAG)
+5 ;
VALIDATEDUR(ERRORS,SDDUR) ; Validate Duration
+1 NEW ERRORFLAG
+2 IF SDDUR=""
SET ERRORFLAG=1
DO ERRLOG^SDESJSON(.ERRORS,115)
QUIT $DATA(ERRORFLAG)
+3 IF (+SDDUR<5)!(+SDDUR>240)
SET ERRORFLAG=1
DO ERRLOG^SDESJSON(.ERRORS,116)
QUIT $DATA(ERRORFLAG)
+4 QUIT $DATA(ERRORFLAG)
+5 ;
CHKOVERL(ELGARRAY,SDDFN,SDBEGDATE,SDDUR) ; View Appointment using DFN of the patient
+1 NEW SDOVERLAP,SDENDDATE,SDAPPSDATE,SDAPPEDATE,IEN,SDNOD,HASDATA,SDAPPDUR,SDCANDATE
+2 SET SDOVERLAP=0
+3 SET SDENDDATE=$$FMADD^XLFDT(SDBEGDATE,0,0,+SDDUR,0)
+4 SET SDAPPSDATE=$PIECE(SDBEGDATE,".",1)_.0001
+5 FOR
SET SDAPPSDATE=$ORDER(^SDEC(409.84,"APTDT",SDDFN,SDAPPSDATE))
if SDAPPSDATE=""
QUIT
if $PIECE(SDAPPSDATE,".",1)>SDENDDATE
QUIT
Begin DoDot:1
+6 SET IEN=""
+7 FOR
SET IEN=$ORDER(^SDEC(409.84,"APTDT",SDDFN,SDAPPSDATE,IEN))
if IEN=""
QUIT
Begin DoDot:2
+8 SET SDNOD=$GET(^SDEC(409.84,IEN,0))
+9 ;appointment data missing
if SDNOD=""
QUIT
+10 SET SDCANDATE=$$GET1^DIQ(409.84,IEN_",",.12,"I")
+11 if $GET(SDCANDATE)'=""
QUIT
+12 SET SDAPPEDATE=$$GET1^DIQ(409.84,IEN_",",.02,"I")
+13 SET SDAPPDUR=$$GET1^DIQ(409.84,IEN_",",.18,"I")
+14 IF SDAPPEDATE=""
SET SDAPPEDATE=$$FMADD^XLFDT(SDBEGDATE,0,0,+SDAPPDUR,0)
+15 IF SDBEGDATE>=SDAPPSDATE
IF SDBEGDATE<SDAPPEDATE
SET SDOVERLAP=1
+16 IF SDENDDATE>SDAPPSDATE
IF SDENDDATE<=SDAPPEDATE
SET SDOVERLAP=1
End DoDot:2
End DoDot:1
+17 IF SDOVERLAP
SET ELGARRAY("Overlap")="1"
+18 IF 'SDOVERLAP
SET ELGARRAY("Overlap")="0"
+19 SET HASDATA=($DATA(ELGARRAY)>1)
+20 QUIT HASDATA
+21 QUIT
+22 ;
CLEANUP ;
+1 KILL RETURNERROR,SDALLAPPTARY,SDBEG,SDEND,ERRORFLAG,ERRORS,ISDFNVALID,ISBEGDTVALID,ISDURVALID
+2 KILL SDOVERLAP,SDENDDATE,SDAPPSDATE,SDAPPEDATE,IEN,SDNOD,HASDATA,SDAPPDUR,SDCANDATE
+3 QUIT
+4 ;
