- 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 Jan 18, 2025@03:57:17 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 ;