Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SDESCHKAPPTOVP

SDESCHKAPPTOVP.m

Go to the documentation of this file.
  1. 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
  1. ;;Per VHA Directive 6402, this routine should not be modified
  1. ;
  1. ;External References
  1. ;-------------------
  1. ; Reference to $$GETS^DIQ,$$GETS1^DIQ in ICR #2056
  1. ;
  1. Q
  1. ;
  1. ;
  1. CHKOVERLAP(RETURNJSON,SDDFN,SDBEGDATE,SDDUR) ;
  1. ;
  1. ; Input:
  1. ; SDDFN [Required] = Patient's DFN from PATIENT File #2.
  1. ; SDBEGDATE [Required] = The beginning date/time in ISO8601 Time Format for the search.
  1. ; SDDUR [Required] = Duration of the appointment
  1. ;
  1. ; Output:
  1. ; RETURNJSON = Returns overlap flag (0-No, 1-Yes) in JSON format. JSON Errors will be returned for any invalid/missing parameters.
  1. ;
  1. N RETURN,HASFIELDS,ELGFIELDSARRAY,ELGRETURN
  1. N ISDFNVALID,ISBEGDTVALID,ISDURVALID
  1. S (RETURN,ELGFIELDSARRAY,HASFIELDS)=""
  1. S SDBEGDATE=$G(SDBEGDATE)
  1. ;
  1. S ISDFNVALID=$$VALIDATEPTDFN(.ERRORS,$G(SDDFN))
  1. S ISBEGDTVALID=$$VALIDATEBEGDATE(.ERRORS,.SDBEGDATE)
  1. S ISDURVALID=$$VALIDATEDUR(.ERRORS,$G(SDDUR))
  1. ;
  1. I $D(ERRORS) M RETURN=ERRORS
  1. I '$D(ERRORS) S HASFIELDS=$$CHKOVERL(.ELGFIELDSARRAY,SDDFN,SDBEGDATE,SDDUR)
  1. I HASFIELDS M RETURN=ELGFIELDSARRAY
  1. ;
  1. D BUILDJSON^SDESBUILDJSON(.RETURNJSON,.RETURN)
  1. D CLEANUP
  1. Q
  1. ;
  1. VALIDATEBEGDATE(ERRORS,SDBEGDATE) ;Validate Beginning Date
  1. N ERRORFLAG
  1. I $G(SDBEGDATE)="" D ERRLOG^SDESJSON(.ERRORS,25) S ERRORFLAG=1 Q $D(ERRORFLAG)
  1. S SDBEGDATE=$$ISOTFM^SDAMUTDT(SDBEGDATE)
  1. I $G(SDBEGDATE)=-1 S ERRORFLAG=1 D ERRLOG^SDESJSON(.ERRORS,27) Q $D(ERRORFLAG)
  1. I $P(SDBEGDATE,".",2)="" S ERRORFLAG=1 D ERRLOG^SDESJSON(.ERRORS,27) Q $D(ERRORFLAG)
  1. Q $D(ERRORFLAG)
  1. ;
  1. VALIDATEPTDFN(ERRORS,SDDFN) ; VALIDATE PATIENT DFN
  1. N ERRORFLAG
  1. I SDDFN="" S ERRORFLAG=1 D ERRLOG^SDESJSON(.ERRORS,1) Q $D(ERRORFLAG)
  1. I SDDFN'="",'$D(^DPT(SDDFN,0)) S ERRORFLAG=1 D ERRLOG^SDESJSON(.ERRORS,2) Q $D(ERRORFLAG)
  1. Q $D(ERRORFLAG)
  1. ;
  1. VALIDATEDUR(ERRORS,SDDUR) ; Validate Duration
  1. N ERRORFLAG
  1. I SDDUR="" S ERRORFLAG=1 D ERRLOG^SDESJSON(.ERRORS,115) Q $D(ERRORFLAG)
  1. I (+SDDUR<5)!(+SDDUR>240) S ERRORFLAG=1 D ERRLOG^SDESJSON(.ERRORS,116) Q $D(ERRORFLAG)
  1. Q $D(ERRORFLAG)
  1. ;
  1. CHKOVERL(ELGARRAY,SDDFN,SDBEGDATE,SDDUR) ; View Appointment using DFN of the patient
  1. N SDOVERLAP,SDENDDATE,SDAPPSDATE,SDAPPEDATE,IEN,SDNOD,HASDATA,SDAPPDUR,SDCANDATE
  1. S SDOVERLAP=0
  1. S SDENDDATE=$$FMADD^XLFDT(SDBEGDATE,0,0,+SDDUR,0)
  1. S SDAPPSDATE=$P(SDBEGDATE,".",1)_.0001
  1. F S SDAPPSDATE=$O(^SDEC(409.84,"APTDT",SDDFN,SDAPPSDATE)) Q:SDAPPSDATE="" Q:$P(SDAPPSDATE,".",1)>SDENDDATE D
  1. .S IEN=""
  1. .F S IEN=$O(^SDEC(409.84,"APTDT",SDDFN,SDAPPSDATE,IEN)) Q:IEN="" D
  1. ..S SDNOD=$G(^SDEC(409.84,IEN,0))
  1. ..Q:SDNOD="" ;appointment data missing
  1. ..S SDCANDATE=$$GET1^DIQ(409.84,IEN_",",.12,"I")
  1. ..Q:$G(SDCANDATE)'=""
  1. ..S SDAPPEDATE=$$GET1^DIQ(409.84,IEN_",",.02,"I")
  1. ..S SDAPPDUR=$$GET1^DIQ(409.84,IEN_",",.18,"I")
  1. ..I SDAPPEDATE="" S SDAPPEDATE=$$FMADD^XLFDT(SDBEGDATE,0,0,+SDAPPDUR,0)
  1. ..I SDBEGDATE>=SDAPPSDATE,SDBEGDATE<SDAPPEDATE S SDOVERLAP=1
  1. ..I SDENDDATE>SDAPPSDATE,SDENDDATE<=SDAPPEDATE S SDOVERLAP=1
  1. I SDOVERLAP S ELGARRAY("Overlap")="1"
  1. I 'SDOVERLAP S ELGARRAY("Overlap")="0"
  1. S HASDATA=($D(ELGARRAY)>1)
  1. Q HASDATA
  1. Q
  1. ;
  1. CLEANUP ;
  1. K RETURNERROR,SDALLAPPTARY,SDBEG,SDEND,ERRORFLAG,ERRORS,ISDFNVALID,ISBEGDTVALID,ISDURVALID
  1. K SDOVERLAP,SDENDDATE,SDAPPSDATE,SDAPPEDATE,IEN,SDNOD,HASDATA,SDAPPDUR,SDCANDATE
  1. Q
  1. ;