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

SDES2CLINICLIST.m

Go to the documentation of this file. 
  1. SDES2CLINICLIST ;ALB/TJB - SDES2 GET APPTS BY CLIN LIST2 ;DEC 14,2023
  1.  ;;5.3;Scheduling;**869**;Aug 13, 1993;Build 13
  1.  ;;Per VHA Directive 6402, this routine should not be modified
  1.  ;
  1.  ; The SDCONTEXT array is controlled by the Acheron application and its fields are
  1.  ; needed for the storage of the required auditing information.
  1.  ;
  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. APPTBYCLINICLIST(RETNJSON,SDCONTEXT,SDPARAM) ;
  1.  N 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.  D BUILDCLINICS(.RETNJSON,.SDCONTEXT,.SDPARAM,.ERRORS)
  1.  Q
  1.  ;
  1. BUILDCLINICS(RETNJSON,SDCONTEXT,SDPARAM,ERRORS) ; 
  1.  N APPTLIST,IENCOUNT,YESTERDAYFM,TODAYFM,CLINICIEN,PRVUSERS,CLINTODAY,TODAY
  1.  S TODAY=$$FMTISO^SDAMUTDT($$NOW^XLFDT)
  1.  S IENCOUNT=0
  1.  F  S IENCOUNT=$O(SDPARAM("CLINIC IEN",IENCOUNT)) Q:'IENCOUNT  S CLINICIEN=SDPARAM("CLINIC IEN",IENCOUNT) D
  1.  . N TEMPLIST,DIVISION,INSTITUT,STATION
  1.  . S CLINTODAY=$P($$ISOTFM^SDAMUTDT(TODAY,CLINICIEN),".",1)
  1.  . S YESTERDAYFM=$$FMADD^XLFDT(CLINTODAY,"","","",-1)
  1.  . S TODAYFM=$$FMADD^XLFDT(CLINTODAY,"",23,59,59)
  1.  . D APPTBYCLINIC2(.TEMPLIST,CLINICIEN,YESTERDAYFM,TODAYFM,$G(SDCONTEXT("ACHERON AUDIT ID")),$G(SDCONTEXT("USER DUZ")))
  1.  . S DIVISION=$$GET1^DIQ(44,CLINICIEN,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")=CLINICIEN
  1.  . M APPTLIST("Clinics",IENCOUNT)=TEMPLIST
  1.  D BUILDJSON^SDES2JSON(.RETNJSON,.APPTLIST)
  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. APPTBYCLINIC2(SDAPPT,SDCLINICIEN,SDBEG,SDEND,SDEAS,SDDUZ) ;
  1.  N POP,APPTIEN,APPTDT,APPTDATA,COUNTER,JSONERR,DFN,PATIENT,RESTYPE,SDRESIEN
  1.  S (POP,APPTIEN,COUNTER,JSONERR)=""
  1.  K SDECY
  1.  ;Validate input parameters
  1.  S SDBEG=$G(SDBEG)
  1.  S SDEND=$G(SDEND)
  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
  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.  ... D SUMMARY(.APPTDATA,APPTIEN)
  1.  ... S COUNTER=$G(COUNTER)+1
  1.  ... M SDAPPT("Appt",COUNTER)=APPTDATA
  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.  ;
  1. SUMMARY(APPTDATA,IEN) ;
  1.  ;Returns a basic set of data for a specific appointment
  1.  ;
  1.  ; Input
  1.  ;  IEN - Specific appointment IEN
  1.  ; Return
  1.  ;  APPTDATA - Array of field names and the data for the field based on the IEN
  1.  ;
  1.  N APPTARY,FN,IENS,SDMSG,SDDFN,RESOURCEIEN,CLINICIEN,SIEN,OVERBOOK,STIME,ETIME,X
  1.  N DATETIME,NUM,STATPOINTER,CLINICARY,STAT,CLINICDATA,PROV,CLINICAPPT,CUSER
  1.  K APPTDATA
  1.  S FN=409.84,IENS=IEN_",",OVERBOOK=0
  1.  D GETS^DIQ(FN,IENS,".01;.02;.03;.04;.05;.06;.07;.12;.13;.121;.122;.14;.16;.17;.18;.22;1;3;4;100","IE","APPTARY","SDMSG") ;SD,814-Added 100 for the EAS Tracking Number
  1.  S RESOURCEIEN=$G(APPTARY(FN,IENS,.07,"I"))
  1.  S CLINICIEN=$$GET1^DIQ(409.831,RESOURCEIEN,.04,"I")
  1.  S APPTDATA("StartTime")=$G(APPTARY(FN,IENS,.01,"E"))
  1.  S APPTDATA("StartTimeFM")=$G(APPTARY(FN,IENS,.01,"I"))
  1.  S STIME=$G(APPTARY(FN,IENS,.01,"I"))
  1.  S APPTDATA("EndTime")=$G(APPTARY(FN,IENS,.02,"E"))
  1.  S ETIME=$G(APPTARY(FN,IENS,.02,"I"))
  1.  S APPTDATA("AppointmentTypeIEN")=$G(APPTARY(FN,IENS,.06,"I"))
  1.  S APPTDATA("LengthOfAppt")=$G(APPTARY(FN,IENS,.18,"E"))
  1.  S APPTDATA("RequestType")=$G(APPTARY(FN,IENS,.22,"E"))
  1.  S APPTDATA("RequestIEN")=$P($G(APPTARY(FN,IENS,.22,"I")),";")
  1.  K APPTARY(FN,IENS,1,"I"),APPTARY(FN,IENS,1,"E")
  1.  I $D(APPTARY(FN,IENS,1)) M APPTDATA("Note")=APPTARY(FN,IENS,1)
  1.  E  S APPTDATA("Note")=""
  1.  S APPTDATA("AppointmentIEN")=IEN
  1.  S DATETIME=$G(APPTARY(FN,IENS,.03,"I"))
  1.  S APPTDATA("CheckIn")=$$FMTE^XLFDT(DATETIME)
  1.  S DATETIME=$G(APPTARY(FN,IENS,.04,"I"))
  1.  S APPTDATA("CheckInEntered")=$$FMTE^XLFDT(DATETIME)
  1.  S DATETIME=$G(APPTARY(FN,IENS,.14,"I"))
  1.  S APPTDATA("CheckOut")=$$FMTE^XLFDT(DATETIME)
  1.  S APPTDATA("EASTrackingNumber")=$G(APPTARY(FN,IENS,100,"I")) ;SD,814-Retrieve EAS Tracking Number
  1.  S APPTDATA("CancelDateTime")=$$FMTE^XLFDT($G(APPTARY(FN,IENS,.12,"I")))
  1.  S APPTDATA("CancellationReason")=$G(APPTARY(FN,IENS,.122,"E"))
  1.  ;CancelledByUser Data Elements
  1.  S CUSER=$G(APPTARY(FN,IENS,.121,"I"))
  1.  I CUSER D
  1.  .S APPTDATA("CancelledByUser","ID")=CUSER
  1.  .S APPTDATA("CancelledByUser","Name")=$G(APPTARY(FN,IENS,.121,"E"))
  1.  .S APPTDATA("CancelledByUser","SecId")=$$GET1^DIQ(200,CUSER,205.1,"I")
  1.  I '$D(APPTDATA("CancelledByUser")) S APPTDATA("CancelledByUser",1)=""
  1.  ;
  1.  S APPTDATA("Walkin")=$G(APPTARY(FN,IENS,.13,"E"))
  1.  ;
  1.  ;Always send these Resource / Clinic data elements
  1.  S APPTDATA("Clinic","IsOverbook")=0
  1.  S APPTDATA("ResourceIEN")=RESOURCEIEN
  1.  S APPTDATA("Resource","Name")=$G(APPTARY(FN,IENS,.07,"E"))
  1.  S APPTDATA("Resource","ClinicIEN")=CLINICIEN
  1.  ;847
  1.  D SETSTATUS^SDESGETAPPTWRAP5(.APPTDATA,IEN,CLINICIEN)
  1.  S APPTDATA("CurrentStatus")=APPTDATA("Status")
  1.  ;
  1.  D APPTCLINIC^SDESCLINICDATA(.CLINICDATA,CLINICIEN)
  1.  M APPTDATA("Clinic")=CLINICDATA
  1.  S SDDFN=$G(APPTARY(FN,IENS,.05,"I"))
  1.  I CLINICIEN D
  1.  . S SIEN=0
  1.  . F  S SIEN=$O(^SC(CLINICIEN,"S",STIME,SIEN)) Q:'SIEN  D
  1.  .. S X=$O(^SC(CLINICIEN,"S",STIME,SIEN,""),-1)
  1.  .. Q:SDDFN'=$$GET1^DIQ(44.003,SIEN_","_STIME_","_CLINICIEN_",",.01,"I")
  1.  .. S:X OVERBOOK=$G(^SC(CLINICIEN,"S",STIME,SIEN,X,"OB"))
  1.  .. D GETS^DIQ(44.003,SIEN_","_STIME_","_CLINICIEN_",","10.5;30","IE","CLINICAPPT","SDMSG")
  1.  .. S APPTDATA("Clinic","CurrentEligibilityCode")=$G(CLINICAPPT(44.003,SIEN_","_STIME_","_CLINICIEN_",",10.5,"E"))
  1.  .. S APPTDATA("Clinic","EligibilityOfVisit")=$G(CLINICAPPT(44.003,SIEN_","_STIME_","_CLINICIEN_",",30,"E"))
  1.  S (SIEN,NUM)=0
  1.  F  S SIEN=$O(^SDEC(409.84,IEN,3,SIEN)) Q:'SIEN  D
  1.  . S NUM=NUM+1
  1.  . S STATPOINTER=$$GET1^DIQ(409.843,SIEN_","_IEN_",",.01,"I")
  1.  . S STAT=$$GET1^DIQ(409.842,STATPOINTER,.01,"E")
  1.  . S DATETIME=$$GET1^DIQ(409.843,SIEN_","_IEN_",",1,"E")
  1.  . S APPTDATA("CheckInSteps",NUM,"IEN")=SIEN
  1.  . S APPTDATA("CheckInSteps",NUM,"Status")=$G(STAT)
  1.  . S APPTDATA("CheckInSteps",NUM,"DateTime")=$$FMTE^XLFDT(DATETIME)
  1.  I '$D(APPTDATA("CheckInSteps")) S APPTDATA("CheckInSteps")=""
  1.  ;
  1.  ;Always send these Patient data elements
  1.  S APPTDATA("DFN")=SDDFN
  1.  S APPTDATA("Patient","EligibilityIEN")=$$GET1^DIQ(2,SDDFN_",",.361,"I")
  1.  S APPTDATA("Patient","Name")=$$GET1^DIQ(2,SDDFN_",",.01,"E")
  1.  ; 864
  1.  S APPTDATA("Patient","DateOfBirth")=$$FMTISO^SDAMUTDT($$GET1^DIQ(2,SDDFN_",",.03,"I"))
  1.  S APPTDATA("Patient","DateOfDeath")=$$FMTISO^SDAMUTDT($$GET1^DIQ(2,SDDFN_",",.351,"I"))
  1.  ;
  1.  ; patient comments
  1.  D GETPATCOMMENTS(.APPTDATA,IEN)
  1.  ; provider data elements
  1.  S PROV=$G(APPTARY(FN,IENS,.16,"I"))
  1.  S APPTDATA("Provider","ID")=PROV
  1.  S APPTDATA("Provider","Name")=$G(APPTARY(FN,IENS,.16,"E"))
  1.  S APPTDATA("Provider","SecId")=$$GET1^DIQ(200,PROV,205.1,"I")
  1.  Q
  1.  ;
  1. GETPATCOMMENTS(APPTDATA,IEN) ;
  1.  N SUBIEN,COUNT
  1.  S SUBIEN=0,COUNT=0
  1.  F  S SUBIEN=$O(^SDEC(409.84,IEN,6,SUBIEN)) Q:'SUBIEN  D
  1.  .S COUNT=COUNT+1
  1.  .S APPTDATA("PatientComments",COUNT)=$$GET1^DIQ(409.846,SUBIEN_","_IEN_",",.01,"E")
  1.  I '$D(APPTDATA("PatientComments")) S APPTDATA("PatientComments",1)=""
  1.  Q
  1.  ;