SDES2APPTCLNLST ;ALB/TJB - SDES2 GET APPTS CLINIEN LIST ;DEC 1,2023
;;5.3;Scheduling;**867**;Aug 13, 1993;Build 8
;;Per VHA Directive 6402, this routine should not be modified
;
; Reference to PATIENT in ICR #10035
; COPY OF SDESAPPT4
Q
;
;INPUT -
; SDCONTEXT("ACHERON AUDIT ID") = Up to 40 Character unique ID number. Ex: 11d9dcc6-c6a2-4785-8031-8261576fca37
; SDCONTEXT("PATIENT DFN") = The DFN/IEN of the target patient from the calling application.
; SDCONTEXT("PATIENT ICN") = The ICN of the target patient from the calling application.
; SDCONTEXT("USER DUZ") = The DUZ of the user taking action in the calling application.
; SDCONTEXT("USER SECID") = The SECID of the user taking action in the calling application.
;
; Note one SDPARAM("CLINIC IEN",1) is required additional clinics can be specified but are optional
; SDPARAM("CLINIC IEN",1)=IEN1 The clinic IEN from HOSPITAL LOCATION (#44) to list appointments (required)
; SDPARAM("CLINIC IEN",2)=IEN2 (optional)
; SDPARAM("CLINIC IEN",3)=IEN3 (optional)
; Additional clinics can be specified
; Any specified "CLINIC IEN" must be valid to proceed
;
APPTBYCLNLIST(RETNJSON,SDCONTEXT,SDPARAM) ;
N APPTLIST,IENCOUNT,YESTERDAYEXTERNL,TODAYEXTERNAL,ERRORS
D VALCONTEXT^SDES2VALCONTEXT(.ERRORS,.SDCONTEXT)
D VALPARAM(.ERRORS,.SDPARAM)
I $D(ERRORS) S ERRORS("Clinics")="" D BUILDJSON^SDES2JSON(.RETNJSON,.ERRORS) Q
;
D BUILDCLINAPPT(.RETNJSON,.SDCONTEXT,.SDPARAM,.ERRORS)
Q
;
VALPARAM(ERRORS,SDPARAM) ; Validate the clinics in the INPUTARRAY
N INDEX,CLNIEN S INDEX=""
I $D(SDPARAM("CLINIC IEN"))'>1 D ERRLOG^SDES2JSON(.ERRORS,18) Q ; no clinic array to build
; Check the clinic IEN to make sure they are valid
F S INDEX=$O(SDPARAM("CLINIC IEN",INDEX)) Q:INDEX="" S CLNIEN=SDPARAM("CLINIC IEN",INDEX) D VALCLINIEN^SDES2VAL44(.ERRORS,CLNIEN,1,0)
Q
;
BUILDCLINAPPT(RETNJSON,SDCONTEXT,SDPARAM,ERRORS) ; Build the list of appointments for clinics specified
N APPTLIST,IENCOUNT,YESTERDAYFM,TODAYFM,CLINTODAY,TODAYISO,TODAYEOD,SDCLINIC,INDEX
S TODAYFM=$$NOW^XLFDT
S TODAYISO=$$FMTISO^SDAMUTDT($$NOW^XLFDT)
;
S INDEX="",IENCOUNT=0
F S INDEX=$O(SDPARAM("CLINIC IEN",INDEX)) Q:INDEX="" S IENCOUNT=IENCOUNT+1,SDCLINIC=SDPARAM("CLINIC IEN",INDEX) D
. N TEMPLIST,VALDT
. ; The date conversions need to be done on a per clinic basis because of timezones
. S CLINTODAY=$P($$ISOTFM^SDAMUTDT(TODAYISO,SDCLINIC),".",1)
. S YESTERDAYFM=$$FMADD^XLFDT(CLINTODAY,"","","",-1)
. S TODAYEOD=$$FMADD^XLFDT(CLINTODAY,"",23,59,59)
. D APPTBYCLINIC2EXT(.TEMPLIST,SDCLINIC,YESTERDAYFM,TODAYEOD,$G(SDCONTEXT("USER DUZ")),"")
. N DIVISION,INSTITUT,STATION
. S DIVISION=$$GET1^DIQ(44,SDCLINIC,3.5,"I")
. S INSTITUT=$$GET1^DIQ(40.8,DIVISION,.07,"I")
. S STATION=$$GET1^DIQ(4,INSTITUT,99,"I")
. S APPTLIST("Clinics",IENCOUNT,"Station")=STATION
. S APPTLIST("Clinics",IENCOUNT,"IEN")=SDCLINIC
. M APPTLIST("Clinics",IENCOUNT)=TEMPLIST
D BUILDJSON^SDES2JSON(.RETNJSON,.APPTLIST)
Q
;
APPTBYCLINIC2EXT(SDAPPT,SDCLINICIEN,SDBEG,SDEND,SDDUZ,SDEAS) ;
N POP,APPTIEN,APPTDT,APPTDATA,COUNTER,JSONERR,DFN,PATIENT,RESTYPE,SDRESIEN
N SDBEGDATE,SDENDDATE,SDVIEWAPPTBY,SDAPPTIEN,SDALLAPPTARY
S (POP,APPTIEN,COUNTER,JSONERR)=""
K SDECY
;Validate input parameters
S SDBEG=$G(SDBEG)
S SDEND=$G(SDEND)
;
S SDRESIEN=""
F S SDRESIEN=$O(^SDEC(409.831,"ALOC",SDCLINICIEN,SDRESIEN)) Q:SDRESIEN="" D
. S RESTYPE=$P($G(^SDEC(409.831,SDRESIEN,0)),"^",11)
. I $P(RESTYPE,";",2)'="SC(" Q ;Must be a Hospital Loc
. S APPTDT=SDBEG-.0001
. S SDEND=SDEND+.0001
. F S APPTDT=$O(^SDEC(409.84,"ARSRC",SDRESIEN,APPTDT)) Q:APPTDT="" D Q:POP
.. I SDEND,APPTDT>SDEND S POP=1 Q ;End loop since past the end date
.. S APPTIEN=""
.. F S APPTIEN=$O(^SDEC(409.84,"ARSRC",SDRESIEN,APPTDT,APPTIEN)) Q:APPTIEN="" D
... S SDVIEWAPPTBY=2 ;view appointment using APPOINTMENT IEN from SDEC APPOINTMENT File #409.84
... S SDAPPTIEN=APPTIEN
... S DFN=$$GET1^DIQ(409.84,SDAPPTIEN,.05,"I")
... S SDBEGDATE=$$GET1^DIQ(409.84,SDAPPTIEN,.01,"I")
... S SDENDDATE=$$GET1^DIQ(409.84,SDAPPTIEN,.02,"I")
... D GETAPPOINTMENTS^SDESGETAPPTWRAP4(.SDALLAPPTARY,DFN,SDBEGDATE,SDENDDATE,SDVIEWAPPTBY,SDAPPTIEN)
... S COUNTER=$G(COUNTER)+1
... M SDAPPT("Appt",COUNTER)=SDALLAPPTARY("Appointment",1)
... ;
... ;S DFN=$G(SDAPPT("Appt",COUNTER,"DFN"))
... S PATIENT=""
... D PATIENTADDON^SDES2PATDATA(.PATIENT,DFN,$S($G(SDDUZ)'="":SDDUZ,1:DUZ))
... M SDAPPT("Appt",COUNTER,"Patient")=PATIENT
I '$D(SDAPPT("Appt")) S SDAPPT("Appt")=""
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDES2APPTCLNLST 4595 printed Apr 09, 2024@21:56:06 Page 2
SDES2APPTCLNLST ;ALB/TJB - SDES2 GET APPTS CLINIEN LIST ;DEC 1,2023
+1 ;;5.3;Scheduling;**867**;Aug 13, 1993;Build 8
+2 ;;Per VHA Directive 6402, this routine should not be modified
+3 ;
+4 ; Reference to PATIENT in ICR #10035
+5 ; COPY OF SDESAPPT4
+6 QUIT
+7 ;
+8 ;INPUT -
+9 ; SDCONTEXT("ACHERON AUDIT ID") = Up to 40 Character unique ID number. Ex: 11d9dcc6-c6a2-4785-8031-8261576fca37
+10 ; SDCONTEXT("PATIENT DFN") = The DFN/IEN of the target patient from the calling application.
+11 ; SDCONTEXT("PATIENT ICN") = The ICN of the target patient from the calling application.
+12 ; SDCONTEXT("USER DUZ") = The DUZ of the user taking action in the calling application.
+13 ; SDCONTEXT("USER SECID") = The SECID of the user taking action in the calling application.
+14 ;
+15 ; Note one SDPARAM("CLINIC IEN",1) is required additional clinics can be specified but are optional
+16 ; SDPARAM("CLINIC IEN",1)=IEN1 The clinic IEN from HOSPITAL LOCATION (#44) to list appointments (required)
+17 ; SDPARAM("CLINIC IEN",2)=IEN2 (optional)
+18 ; SDPARAM("CLINIC IEN",3)=IEN3 (optional)
+19 ; Additional clinics can be specified
+20 ; Any specified "CLINIC IEN" must be valid to proceed
+21 ;
APPTBYCLNLIST(RETNJSON,SDCONTEXT,SDPARAM) ;
+1 NEW APPTLIST,IENCOUNT,YESTERDAYEXTERNL,TODAYEXTERNAL,ERRORS
+2 DO VALCONTEXT^SDES2VALCONTEXT(.ERRORS,.SDCONTEXT)
+3 DO VALPARAM(.ERRORS,.SDPARAM)
+4 IF $DATA(ERRORS)
SET ERRORS("Clinics")=""
DO BUILDJSON^SDES2JSON(.RETNJSON,.ERRORS)
QUIT
+5 ;
+6 DO BUILDCLINAPPT(.RETNJSON,.SDCONTEXT,.SDPARAM,.ERRORS)
+7 QUIT
+8 ;
VALPARAM(ERRORS,SDPARAM) ; Validate the clinics in the INPUTARRAY
+1 NEW INDEX,CLNIEN
SET INDEX=""
+2 ; no clinic array to build
IF $DATA(SDPARAM("CLINIC IEN"))'>1
DO ERRLOG^SDES2JSON(.ERRORS,18)
QUIT
+3 ; Check the clinic IEN to make sure they are valid
+4 FOR
SET INDEX=$ORDER(SDPARAM("CLINIC IEN",INDEX))
if INDEX=""
QUIT
SET CLNIEN=SDPARAM("CLINIC IEN",INDEX)
DO VALCLINIEN^SDES2VAL44(.ERRORS,CLNIEN,1,0)
+5 QUIT
+6 ;
BUILDCLINAPPT(RETNJSON,SDCONTEXT,SDPARAM,ERRORS) ; Build the list of appointments for clinics specified
+1 NEW APPTLIST,IENCOUNT,YESTERDAYFM,TODAYFM,CLINTODAY,TODAYISO,TODAYEOD,SDCLINIC,INDEX
+2 SET TODAYFM=$$NOW^XLFDT
+3 SET TODAYISO=$$FMTISO^SDAMUTDT($$NOW^XLFDT)
+4 ;
+5 SET INDEX=""
SET IENCOUNT=0
+6 FOR
SET INDEX=$ORDER(SDPARAM("CLINIC IEN",INDEX))
if INDEX=""
QUIT
SET IENCOUNT=IENCOUNT+1
SET SDCLINIC=SDPARAM("CLINIC IEN",INDEX)
Begin DoDot:1
+7 NEW TEMPLIST,VALDT
+8 ; The date conversions need to be done on a per clinic basis because of timezones
+9 SET CLINTODAY=$PIECE($$ISOTFM^SDAMUTDT(TODAYISO,SDCLINIC),".",1)
+10 SET YESTERDAYFM=$$FMADD^XLFDT(CLINTODAY,"","","",-1)
+11 SET TODAYEOD=$$FMADD^XLFDT(CLINTODAY,"",23,59,59)
+12 DO APPTBYCLINIC2EXT(.TEMPLIST,SDCLINIC,YESTERDAYFM,TODAYEOD,$GET(SDCONTEXT("USER DUZ")),"")
+13 NEW DIVISION,INSTITUT,STATION
+14 SET DIVISION=$$GET1^DIQ(44,SDCLINIC,3.5,"I")
+15 SET INSTITUT=$$GET1^DIQ(40.8,DIVISION,.07,"I")
+16 SET STATION=$$GET1^DIQ(4,INSTITUT,99,"I")
+17 SET APPTLIST("Clinics",IENCOUNT,"Station")=STATION
+18 SET APPTLIST("Clinics",IENCOUNT,"IEN")=SDCLINIC
+19 MERGE APPTLIST("Clinics",IENCOUNT)=TEMPLIST
End DoDot:1
+20 DO BUILDJSON^SDES2JSON(.RETNJSON,.APPTLIST)
+21 QUIT
+22 ;
APPTBYCLINIC2EXT(SDAPPT,SDCLINICIEN,SDBEG,SDEND,SDDUZ,SDEAS) ;
+1 NEW POP,APPTIEN,APPTDT,APPTDATA,COUNTER,JSONERR,DFN,PATIENT,RESTYPE,SDRESIEN
+2 NEW SDBEGDATE,SDENDDATE,SDVIEWAPPTBY,SDAPPTIEN,SDALLAPPTARY
+3 SET (POP,APPTIEN,COUNTER,JSONERR)=""
+4 KILL SDECY
+5 ;Validate input parameters
+6 SET SDBEG=$GET(SDBEG)
+7 SET SDEND=$GET(SDEND)
+8 ;
+9 SET SDRESIEN=""
+10 FOR
SET SDRESIEN=$ORDER(^SDEC(409.831,"ALOC",SDCLINICIEN,SDRESIEN))
if SDRESIEN=""
QUIT
Begin DoDot:1
+11 SET RESTYPE=$PIECE($GET(^SDEC(409.831,SDRESIEN,0)),"^",11)
+12 ;Must be a Hospital Loc
IF $PIECE(RESTYPE,";",2)'="SC("
QUIT
+13 SET APPTDT=SDBEG-.0001
+14 SET SDEND=SDEND+.0001
+15 FOR
SET APPTDT=$ORDER(^SDEC(409.84,"ARSRC",SDRESIEN,APPTDT))
if APPTDT=""
QUIT
Begin DoDot:2
+16 ;End loop since past the end date
IF SDEND
IF APPTDT>SDEND
SET POP=1
QUIT
+17 SET APPTIEN=""
+18 FOR
SET APPTIEN=$ORDER(^SDEC(409.84,"ARSRC",SDRESIEN,APPTDT,APPTIEN))
if APPTIEN=""
QUIT
Begin DoDot:3
+19 ;view appointment using APPOINTMENT IEN from SDEC APPOINTMENT File #409.84
SET SDVIEWAPPTBY=2
+20 SET SDAPPTIEN=APPTIEN
+21 SET DFN=$$GET1^DIQ(409.84,SDAPPTIEN,.05,"I")
+22 SET SDBEGDATE=$$GET1^DIQ(409.84,SDAPPTIEN,.01,"I")
+23 SET SDENDDATE=$$GET1^DIQ(409.84,SDAPPTIEN,.02,"I")
+24 DO GETAPPOINTMENTS^SDESGETAPPTWRAP4(.SDALLAPPTARY,DFN,SDBEGDATE,SDENDDATE,SDVIEWAPPTBY,SDAPPTIEN)
+25 SET COUNTER=$GET(COUNTER)+1
+26 MERGE SDAPPT("Appt",COUNTER)=SDALLAPPTARY("Appointment",1)
+27 ;
+28 ;S DFN=$G(SDAPPT("Appt",COUNTER,"DFN"))
+29 SET PATIENT=""
+30 DO PATIENTADDON^SDES2PATDATA(.PATIENT,DFN,$SELECT($GET(SDDUZ)'="":SDDUZ,1:DUZ))
+31 MERGE SDAPPT("Appt",COUNTER,"Patient")=PATIENT
End DoDot:3
End DoDot:2
if POP
QUIT
End DoDot:1
+32 IF '$DATA(SDAPPT("Appt"))
SET SDAPPT("Appt")=""
+33 QUIT
+34 ;
