SDESCLINICAVAIL ;ALB/RRM,KML,BWF,MGD,DJS,ANU,MGD - VISTA SCHEDULING RPCS GET CLINIC AVAILABILITY ; Oct 30, 2023@15:15
;;5.3;Scheduling;**800,805,809,816,820,823,826,827,828,831,864**;Aug 13, 1993;Build 15
;;Per VHA Directive 6402, this routine should not be modified
;
; External References
; -------------------
; Reference to ^%DT in ICR #10003
; Reference to $$FIND1^DIC in ICR #2051
; Reference to $$GET1^DIQ in ICR #2056
;
Q ;No Direct Call
;
GETCLAVAILABLTY(RETURN,CLINICIEN,SDESSTART,SDESENDDATE,SDEAS) ;Called from RPC: SDES GET CLINIC AVAILABILITY
; This RPC returns available appointment slots within a given timeframe for a given clinic in JSON format.
; Input:
; RETURN [required] - This is where the retrieve data is stored in JSON format
; CLINICIEN [required] - The Internal Entry Number (IEN) from the HOSPITAL LOCATION File #44
; SDESSTART [required] - The Start Date of search in ISO8601 format CCYY-MM-DDTHH:MM-OFFSET or external format CCYY-MM-DD
; SDESENDDATE [required] - The End Date of search in ISO8601 format CCYY-MM-DDTHH:MM-OFFSET or external format CCYY-MM-DD
; SDEAS [optional] - Enterprise Appointment Scheduling (EAS) Tracking Number associated to an appointment.
;
N SDGETCLAVL,SDCLNAME,ERROR,SDCLRESIEN,SDTMPARY,SDESSTARTDTTM,SDESENDDTTM
S ERROR=0
K RETURN,SDGETCLAVL ;always clear returned data array to ensure a new array of data are returned
D VALIDATEINPUT ;validate input parameters
I 'ERROR D
. K SDTMPARY
. S SDTMPARY=$NA(^TMP($J,"CLNCAVAIL"))
. K @SDTMPARY
. D GETSLOTS^SDEC57(SDTMPARY,SDCLRESIEN,SDESSTART,SDESENDDATE)
. D BUILDDATA(CLINICIEN)
. K @SDTMPARY
I ERROR!('$D(SDGETCLAVL("ClinAvail"))) S SDGETCLAVL("ClinAvail",1)=""
D BUILDJSON
K SDGETCLAVL
Q
;
VALIDATEINPUT ;validate input parameters
N SDERR,EFLAG,SFLAG
S (SFLAG,EFLAG)=0
;validate CLINIC IEN
S CLINICIEN=$G(CLINICIEN)
I CLINICIEN="" D ERRLOG^SDESJSON(.SDGETCLAVL,67) S ERROR=1 Q ;clinic cannot be blank
I +CLINICIEN,'$D(^SC(CLINICIEN)) D ERRLOG^SDESJSON(.SDGETCLAVL,19) S ERROR=1 Q ; clinic not found
I +CLINICIEN'>0 D ERRLOG^SDESJSON(.SDGETCLAVL,19) S ERROR=1 Q ; invalid clinic
I +CLINICIEN>0 D
. S SDCLNAME=$$GET1^DIQ(44,CLINICIEN_",",.01,"I") ;retrieve the clinic name
. I SDCLNAME="" D ERRLOG^SDESJSON(.SDGETCLAVL,80) S ERROR=1 Q ;clinic IEN not found
. S SDCLRESIEN=$$FIND1^DIC(409.831,"","MX",SDCLNAME,"","","SDERR") ;retrieve the resource IEN for the clinic
. I $D(SDERR) D ERRLOG^SDESJSON(.SDGETCLAVL,70) S ERROR=1 ;invalid clinic resource id
;validate start date
S SDESSTART=$G(SDESSTART)
I SDESSTART="" D ERRLOG^SDESJSON(.SDGETCLAVL,25) S ERROR=1 ;missing begin date/time
I SDESSTART'="",+$G(SDESSTART)'>0 D ERRLOG^SDESJSON(.SDGETCLAVL,27) S ERROR=1 ;invalid begin date
; If start date is external format, convert to ISO
I $E(SDESSTART,11)'="T" D
. S SDESSTART=$$ISOTFM^SDAMUTDT(SDESSTART,CLINICIEN)
. I SDESSTART'>0 D ERRLOG^SDESJSON(.SDGETCLAVL,27) S ERROR=1 Q
. S SDESSTART=SDESSTART_".000001"
. S SDESSTART=$$FMTISO^SDAMUTDT(SDESSTART,CLINICIEN)
. I SDESSTART'>0 D ERRLOG^SDESJSON(.SDGETCLAVL,27) S ERROR=1 Q
I +SDESSTART>0 D
. S SDESSTART=$$ISOTFM^SDAMUTDT(SDESSTART,CLINICIEN) ;convert ISO format to internal format
. S SDESSTARTDTTM=SDESSTART
. S SDESSTART=$P(SDESSTART,".")
. S SFLAG=1
. I +SDESSTART<1 D ERRLOG^SDESJSON(.SDGETCLAVL,27) S ERROR=1 Q ;invalid begin date/time
. I '$P(SDESSTARTDTTM,".",2) D ERRLOG^SDESJSON(.SDGETCLAVL,27) S ERROR=1 Q ; invalid begin date/time (missing time)
;validate end date
S SDESENDDATE=$G(SDESENDDATE)
I SDESENDDATE="" D ERRLOG^SDESJSON(.SDGETCLAVL,26) S ERROR=1 ;missing end date/time
I SDESENDDATE'="",+$G(SDESENDDATE)'>0 D ERRLOG^SDESJSON(.SDGETCLAVL,28) S ERROR=1 ;invalid end date
I $E(SDESENDDATE,11)'="T" D
. S SDESENDDATE=$$ISOTFM^SDAMUTDT(SDESENDDATE,CLINICIEN)
. I SDESENDDATE'>0 D ERRLOG^SDESJSON(.SDGETCLAVL,28) S ERROR=1 Q
. S SDESENDDATE=SDESENDDATE_".235959"
. S SDESENDDATE=$$FMTISO^SDAMUTDT(SDESENDDATE,CLINICIEN)
. I SDESENDDATE'>0 D ERRLOG^SDESJSON(.SDGETCLAVL,28) S ERROR=1 Q
I +SDESENDDATE>0 D
. S SDESENDDATE=$$ISOTFM^SDAMUTDT(SDESENDDATE,CLINICIEN) ;convert ISO format to internal format
. S SDESENDDTTM=SDESENDDATE
. S SDESENDDATE=$P(SDESENDDATE,".")
. S EFLAG=1
. I +SDESENDDATE<1 D ERRLOG^SDESJSON(.SDGETCLAVL,28) S ERROR=1 Q ;invalid end date/time
. I '$P(SDESENDDTTM,".",2) D ERRLOG^SDESJSON(.SDGETCLAVL,28) S ERROR=1 Q ; invalid end date/time (missing time)
. I $G(SDESENDDTTM)<$G(SDESSTARTDTTM) D ERRLOG^SDESJSON(.SDGETCLAVL,242) S ERROR=1 Q
; validate EAS
S SDEAS=$G(SDEAS,"")
I $L(SDEAS) S SDEAS=$$EASVALIDATE^SDESUTIL(SDEAS)
I SDEAS=-1 D ERRLOG^SDESJSON(.SDGETCLAVL,142) S ERROR=1
Q
;
BUILDDATA(CLINICIEN) ;retrieve clinic availability data
N SDP1,SDP2,SDP3,SDP4,SDSTRTDT,SDENDDT,SDSLOTS,SDSTOPTM,SDSTRTTM,SDTOTAL,II,SDDIV,SDINST
I $O(@SDTMPARY@(""))="" Q
S SDTOTAL=@SDTMPARY@("CNT")
F II=1:1:SDTOTAL D
. S SDP1=$P(@SDTMPARY@(II),U,2) ;start date
. S SDP2=$P(@SDTMPARY@(II),U,3) ;end date
. I (SDP1<SDESSTARTDTTM)!(SDP1>SDESENDDTTM) Q
. S SDP3=+$P(@SDTMPARY@(II),U,4) ;open slots available
. S SDP4=$P(@SDTMPARY@(II),U,5) ;access type (1=available, 2=not available, 3=cancelled)
. I $P(SDP1,".",2)=""!($P(SDP1,".",2)="00") S $P(SDP1,".",2)="0001"
. S SDSTRTTM=$$FMTISO^SDAMUTDT(SDP1,CLINICIEN)
. S SDSTOPTM=$$FMTISO^SDAMUTDT(SDP2,CLINICIEN)
. S SDSLOTS=$P(@SDTMPARY@(II),U,4)
. S SDSLOTS=$S(SDSLOTS=" ":"",1:SDSLOTS)
. S SDSLOTS=$S(SDP4=2:"",SDP4=3:"X",1:SDSLOTS)
. S SDGETCLAVL("ClinAvail",II,"BeginTime")=SDSTRTTM
. S SDGETCLAVL("ClinAvail",II,"EndTime")=SDSTOPTM
. S SDGETCLAVL("ClinAvail",II,"SlotsAvail")=SDSLOTS
; Changes for 831 start
I $G(CLINICIEN) D
.S SDDIV=$$GET1^DIQ(44,CLINICIEN_",",3.5,"I")
.S:SDDIV SDINST=$$GET1^DIQ(40.8,SDDIV_",",.07,"I")
.I $$GET1^DIQ(4,SDINST,800,"I")="" D
..S SDGETCLAVL("ClinAvail",0.1,"Error")="No Timezone set for Clinic."
..I $$GET1^DIQ(8989.3,1,217,"I")="" S SDGETCLAVL("ClinAvail",0.2,"Error")="No Timezone set for Institution in Kernel Parameters (#8989.3) file."
; Changes for 831 end
Q
;
BUILDJSON ;Convert data to JSON
N JSONERR
S JSONERR=""
D ENCODE^SDESJSON(.SDGETCLAVL,.RETURN,.JSONERR)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDESCLINICAVAIL 6323 printed Apr 09, 2024@21:56:39 Page 2
SDESCLINICAVAIL ;ALB/RRM,KML,BWF,MGD,DJS,ANU,MGD - VISTA SCHEDULING RPCS GET CLINIC AVAILABILITY ; Oct 30, 2023@15:15
+1 ;;5.3;Scheduling;**800,805,809,816,820,823,826,827,828,831,864**;Aug 13, 1993;Build 15
+2 ;;Per VHA Directive 6402, this routine should not be modified
+3 ;
+4 ; External References
+5 ; -------------------
+6 ; Reference to ^%DT in ICR #10003
+7 ; Reference to $$FIND1^DIC in ICR #2051
+8 ; Reference to $$GET1^DIQ in ICR #2056
+9 ;
+10 ;No Direct Call
QUIT
+11 ;
GETCLAVAILABLTY(RETURN,CLINICIEN,SDESSTART,SDESENDDATE,SDEAS) ;Called from RPC: SDES GET CLINIC AVAILABILITY
+1 ; This RPC returns available appointment slots within a given timeframe for a given clinic in JSON format.
+2 ; Input:
+3 ; RETURN [required] - This is where the retrieve data is stored in JSON format
+4 ; CLINICIEN [required] - The Internal Entry Number (IEN) from the HOSPITAL LOCATION File #44
+5 ; SDESSTART [required] - The Start Date of search in ISO8601 format CCYY-MM-DDTHH:MM-OFFSET or external format CCYY-MM-DD
+6 ; SDESENDDATE [required] - The End Date of search in ISO8601 format CCYY-MM-DDTHH:MM-OFFSET or external format CCYY-MM-DD
+7 ; SDEAS [optional] - Enterprise Appointment Scheduling (EAS) Tracking Number associated to an appointment.
+8 ;
+9 NEW SDGETCLAVL,SDCLNAME,ERROR,SDCLRESIEN,SDTMPARY,SDESSTARTDTTM,SDESENDDTTM
+10 SET ERROR=0
+11 ;always clear returned data array to ensure a new array of data are returned
KILL RETURN,SDGETCLAVL
+12 ;validate input parameters
DO VALIDATEINPUT
+13 IF 'ERROR
Begin DoDot:1
+14 KILL SDTMPARY
+15 SET SDTMPARY=$NAME(^TMP($JOB,"CLNCAVAIL"))
+16 KILL @SDTMPARY
+17 DO GETSLOTS^SDEC57(SDTMPARY,SDCLRESIEN,SDESSTART,SDESENDDATE)
+18 DO BUILDDATA(CLINICIEN)
+19 KILL @SDTMPARY
End DoDot:1
+20 IF ERROR!('$DATA(SDGETCLAVL("ClinAvail")))
SET SDGETCLAVL("ClinAvail",1)=""
+21 DO BUILDJSON
+22 KILL SDGETCLAVL
+23 QUIT
+24 ;
VALIDATEINPUT ;validate input parameters
+1 NEW SDERR,EFLAG,SFLAG
+2 SET (SFLAG,EFLAG)=0
+3 ;validate CLINIC IEN
+4 SET CLINICIEN=$GET(CLINICIEN)
+5 ;clinic cannot be blank
IF CLINICIEN=""
DO ERRLOG^SDESJSON(.SDGETCLAVL,67)
SET ERROR=1
QUIT
+6 ; clinic not found
IF +CLINICIEN
IF '$DATA(^SC(CLINICIEN))
DO ERRLOG^SDESJSON(.SDGETCLAVL,19)
SET ERROR=1
QUIT
+7 ; invalid clinic
IF +CLINICIEN'>0
DO ERRLOG^SDESJSON(.SDGETCLAVL,19)
SET ERROR=1
QUIT
+8 IF +CLINICIEN>0
Begin DoDot:1
+9 ;retrieve the clinic name
SET SDCLNAME=$$GET1^DIQ(44,CLINICIEN_",",.01,"I")
+10 ;clinic IEN not found
IF SDCLNAME=""
DO ERRLOG^SDESJSON(.SDGETCLAVL,80)
SET ERROR=1
QUIT
+11 ;retrieve the resource IEN for the clinic
SET SDCLRESIEN=$$FIND1^DIC(409.831,"","MX",SDCLNAME,"","","SDERR")
+12 ;invalid clinic resource id
IF $DATA(SDERR)
DO ERRLOG^SDESJSON(.SDGETCLAVL,70)
SET ERROR=1
End DoDot:1
+13 ;validate start date
+14 SET SDESSTART=$GET(SDESSTART)
+15 ;missing begin date/time
IF SDESSTART=""
DO ERRLOG^SDESJSON(.SDGETCLAVL,25)
SET ERROR=1
+16 ;invalid begin date
IF SDESSTART'=""
IF +$GET(SDESSTART)'>0
DO ERRLOG^SDESJSON(.SDGETCLAVL,27)
SET ERROR=1
+17 ; If start date is external format, convert to ISO
+18 IF $EXTRACT(SDESSTART,11)'="T"
Begin DoDot:1
+19 SET SDESSTART=$$ISOTFM^SDAMUTDT(SDESSTART,CLINICIEN)
+20 IF SDESSTART'>0
DO ERRLOG^SDESJSON(.SDGETCLAVL,27)
SET ERROR=1
QUIT
+21 SET SDESSTART=SDESSTART_".000001"
+22 SET SDESSTART=$$FMTISO^SDAMUTDT(SDESSTART,CLINICIEN)
+23 IF SDESSTART'>0
DO ERRLOG^SDESJSON(.SDGETCLAVL,27)
SET ERROR=1
QUIT
End DoDot:1
+24 IF +SDESSTART>0
Begin DoDot:1
+25 ;convert ISO format to internal format
SET SDESSTART=$$ISOTFM^SDAMUTDT(SDESSTART,CLINICIEN)
+26 SET SDESSTARTDTTM=SDESSTART
+27 SET SDESSTART=$PIECE(SDESSTART,".")
+28 SET SFLAG=1
+29 ;invalid begin date/time
IF +SDESSTART<1
DO ERRLOG^SDESJSON(.SDGETCLAVL,27)
SET ERROR=1
QUIT
+30 ; invalid begin date/time (missing time)
IF '$PIECE(SDESSTARTDTTM,".",2)
DO ERRLOG^SDESJSON(.SDGETCLAVL,27)
SET ERROR=1
QUIT
End DoDot:1
+31 ;validate end date
+32 SET SDESENDDATE=$GET(SDESENDDATE)
+33 ;missing end date/time
IF SDESENDDATE=""
DO ERRLOG^SDESJSON(.SDGETCLAVL,26)
SET ERROR=1
+34 ;invalid end date
IF SDESENDDATE'=""
IF +$GET(SDESENDDATE)'>0
DO ERRLOG^SDESJSON(.SDGETCLAVL,28)
SET ERROR=1
+35 IF $EXTRACT(SDESENDDATE,11)'="T"
Begin DoDot:1
+36 SET SDESENDDATE=$$ISOTFM^SDAMUTDT(SDESENDDATE,CLINICIEN)
+37 IF SDESENDDATE'>0
DO ERRLOG^SDESJSON(.SDGETCLAVL,28)
SET ERROR=1
QUIT
+38 SET SDESENDDATE=SDESENDDATE_".235959"
+39 SET SDESENDDATE=$$FMTISO^SDAMUTDT(SDESENDDATE,CLINICIEN)
+40 IF SDESENDDATE'>0
DO ERRLOG^SDESJSON(.SDGETCLAVL,28)
SET ERROR=1
QUIT
End DoDot:1
+41 IF +SDESENDDATE>0
Begin DoDot:1
+42 ;convert ISO format to internal format
SET SDESENDDATE=$$ISOTFM^SDAMUTDT(SDESENDDATE,CLINICIEN)
+43 SET SDESENDDTTM=SDESENDDATE
+44 SET SDESENDDATE=$PIECE(SDESENDDATE,".")
+45 SET EFLAG=1
+46 ;invalid end date/time
IF +SDESENDDATE<1
DO ERRLOG^SDESJSON(.SDGETCLAVL,28)
SET ERROR=1
QUIT
+47 ; invalid end date/time (missing time)
IF '$PIECE(SDESENDDTTM,".",2)
DO ERRLOG^SDESJSON(.SDGETCLAVL,28)
SET ERROR=1
QUIT
+48 IF $GET(SDESENDDTTM)<$GET(SDESSTARTDTTM)
DO ERRLOG^SDESJSON(.SDGETCLAVL,242)
SET ERROR=1
QUIT
End DoDot:1
+49 ; validate EAS
+50 SET SDEAS=$GET(SDEAS,"")
+51 IF $LENGTH(SDEAS)
SET SDEAS=$$EASVALIDATE^SDESUTIL(SDEAS)
+52 IF SDEAS=-1
DO ERRLOG^SDESJSON(.SDGETCLAVL,142)
SET ERROR=1
+53 QUIT
+54 ;
BUILDDATA(CLINICIEN) ;retrieve clinic availability data
+1 NEW SDP1,SDP2,SDP3,SDP4,SDSTRTDT,SDENDDT,SDSLOTS,SDSTOPTM,SDSTRTTM,SDTOTAL,II,SDDIV,SDINST
+2 IF $ORDER(@SDTMPARY@(""))=""
QUIT
+3 SET SDTOTAL=@SDTMPARY@("CNT")
+4 FOR II=1:1:SDTOTAL
Begin DoDot:1
+5 ;start date
SET SDP1=$PIECE(@SDTMPARY@(II),U,2)
+6 ;end date
SET SDP2=$PIECE(@SDTMPARY@(II),U,3)
+7 IF (SDP1<SDESSTARTDTTM)!(SDP1>SDESENDDTTM)
QUIT
+8 ;open slots available
SET SDP3=+$PIECE(@SDTMPARY@(II),U,4)
+9 ;access type (1=available, 2=not available, 3=cancelled)
SET SDP4=$PIECE(@SDTMPARY@(II),U,5)
+10 IF $PIECE(SDP1,".",2)=""!($PIECE(SDP1,".",2)="00")
SET $PIECE(SDP1,".",2)="0001"
+11 SET SDSTRTTM=$$FMTISO^SDAMUTDT(SDP1,CLINICIEN)
+12 SET SDSTOPTM=$$FMTISO^SDAMUTDT(SDP2,CLINICIEN)
+13 SET SDSLOTS=$PIECE(@SDTMPARY@(II),U,4)
+14 SET SDSLOTS=$SELECT(SDSLOTS=" ":"",1:SDSLOTS)
+15 SET SDSLOTS=$SELECT(SDP4=2:"",SDP4=3:"X",1:SDSLOTS)
+16 SET SDGETCLAVL("ClinAvail",II,"BeginTime")=SDSTRTTM
+17 SET SDGETCLAVL("ClinAvail",II,"EndTime")=SDSTOPTM
+18 SET SDGETCLAVL("ClinAvail",II,"SlotsAvail")=SDSLOTS
End DoDot:1
+19 ; Changes for 831 start
+20 IF $GET(CLINICIEN)
Begin DoDot:1
+21 SET SDDIV=$$GET1^DIQ(44,CLINICIEN_",",3.5,"I")
+22 if SDDIV
SET SDINST=$$GET1^DIQ(40.8,SDDIV_",",.07,"I")
+23 IF $$GET1^DIQ(4,SDINST,800,"I")=""
Begin DoDot:2
+24 SET SDGETCLAVL("ClinAvail",0.1,"Error")="No Timezone set for Clinic."
+25 IF $$GET1^DIQ(8989.3,1,217,"I")=""
SET SDGETCLAVL("ClinAvail",0.2,"Error")="No Timezone set for Institution in Kernel Parameters (#8989.3) file."
End DoDot:2
End DoDot:1
+26 ; Changes for 831 end
+27 QUIT
+28 ;
BUILDJSON ;Convert data to JSON
+1 NEW JSONERR
+2 SET JSONERR=""
+3 DO ENCODE^SDESJSON(.SDGETCLAVL,.RETURN,.JSONERR)
+4 QUIT
