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

SDES2APPTCLNLST.m

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