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

SDESAPPT.m

Go to the documentation of this file.
SDESAPPT ;ALB/BLB,KML,TAW,BWF,MGD,LAB,RRM- GET APPT REQUESTS ;July 5, 2022
 ;;5.3;Scheduling;**788,805,807,809,815,819,820,823,824**;Aug 13, 1993;Build 3
 ;;Per VHA Directive 6402, this routine should not be modified
 ;
 ; Reference to PATIENT in ICR #10035
 Q
 ;
APPGETJSON(SDECY,DFN,BDATE,EDATE,SDEAS) ; Return a list of appointments and associated data by PATIENT
 ;INPUT  - DFN (Date File Number) Pointer to PATIENT (#2) File.
 ;       - BDATE = start date for appointment search and gather (time included)
 ;       - EDATE = end date for the appointment search and gather (time included)
 ; SDEAS - [OPT] Enterprise Appointment Scheduling (EAS) Tracking Number associated to an appointment.
 ;RETURN PARMETERS:
 ;
 N IEN,NUM,ERR,IENS,SDAPPT,POP,APPTDATA
 S POP=0
 S DFN=$G(DFN)
 S ERR=0,IEN=0,NUM=0,BDATE=$G(BDATE),EDATE=$G(EDATE)
 S POP=$$VALIDATEDT(.BDATE,.EDATE)
 I DFN="" S POP=1 D ERRLOG^SDESJSON(.SDAPPT,1)
 I DFN'="",'$D(^DPT(DFN,0)) S POP=1 D ERRLOG^SDESJSON(.SDAPPT,2)
 S SDEAS=$$VALIDATEEAS(.SDAPPT,$G(SDEAS,""))
 I SDEAS=-1 S POP=1
 ;
 I 'POP D
 .F  S IEN=$O(^SDEC(409.84,"CPAT",DFN,IEN)) Q:'IEN  D
 ..I '$$APPTINDTRANGE(IEN,BDATE,EDATE) Q
 ..S NUM=NUM+1
 ..D SUMMARY^SDESAPPTDATA(.APPTDATA,IEN)
 ..S APPTDATA("AppointmentType")=$$GET1^DIQ(409.84,IEN_",",.06) ;vse-2263  SD*5.3*807  external representation of appointment type
 ..M SDAPPT("Appt",NUM)=APPTDATA
 .I '$D(SDAPPT("Appt")) S SDAPPT("Appt")=""
 D BUILDER
 Q
 ;
APPGETONEJSON(SDECY,IEN,SDEAS) ; Return a single appointment and associated data by IEN
 ;INPUT - IEN (Internal Entry Number) Pointer to SDEC APPOINTMENT (#409.84) File.
 ; SDEAS - [OPT] Enterprise Appointment Scheduling (EAS) Tracking Number associated to an appointment.
 ;RETURN PARMETERS: SDECY - array with JSON formatted data for the Appointment.
 ;
 N NUM,ERR,IENS,SDAPPT,POP,APPTDATA
 S ERR=0,NUM=0,POP=0,IEN=$G(IEN)
 I IEN="" S POP=1 D ERRLOG^SDESJSON(.SDAPPT,14)
 I IEN'="",'$D(^SDEC(409.84,IEN,0)) S POP=1 D ERRLOG^SDESJSON(.SDAPPT,15)
 S SDEAS=$$VALIDATEEAS(.SDAPPT,$G(SDEAS,""))
 I SDEAS=-1 S POP=1
 ;
 I 'POP D
 .S NUM=NUM+1
 .D SUMMARY^SDESAPPTDATA(.APPTDATA,IEN)
 .M SDAPPT("Appt",NUM)=APPTDATA
 .I '$D(SDAPPT("Appt")) S SDAPPT("Appt")=""
 D BUILDER
 Q
APPTBYRESOURCE(SDECY,SDRESIEN,SDBEG,SDEND,SDEAS) ;
 N POP,APPTIEN,APPTDT,SDAPPT,APPTDATA,COUNTER,JSONERR,DFN,PATIENT
 S (POP,APPTIEN,COUNTER,JSONERR)=""
 K SDECY
 ;Validate input parameters
 S SDBEG=$G(SDBEG)
 S SDEND=$G(SDEND)
 S POP=$$VALIDATEDT(.SDBEG,.SDEND)
 I $G(SDRESIEN)="" S POP=1 D ERRLOG^SDESJSON(.SDAPPT,18)
 I $G(SDRESIEN)'="",'$D(^SDEC(409.831,SDRESIEN,0)) S POP=1 D ERRLOG^SDESJSON(.SDAPPT,19)
 S SDEAS=$$VALIDATEEAS(.SDAPPT,$G(SDEAS,""))
 I SDEAS=-1 S POP=1
 ;
 I 'POP D
 .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
 ...D SUMMARY^SDESAPPTDATA(.APPTDATA,APPTIEN)
 ...S COUNTER=$G(COUNTER)+1
 ...M SDAPPT("Appt",COUNTER)=APPTDATA
 ...S DFN=$G(SDAPPT("Appt",COUNTER,"DFN"))
 ...S PATIENT=""
 ...D PATIENTIDADDDON^SDESPATIENTDATA(.PATIENT,DFN)
 ...S PATIENT("ICN")=$$GETPATICN^SDESINPUTVALUTL(DFN)
 ...M SDAPPT("Appt",COUNTER,"Patient")=PATIENT
 .I '$D(SDAPPT("Appt")) S SDAPPT("Appt")=""
 D BUILDER
 Q
APPTBYCLINICLIST(APPTLISTJSON,CLINICIENS) ;
 N APPTLIST,IENCOUNT,YESTERDAYEXTERNL,TODAYEXTERNAL,CLINICIEN
 S IENCOUNT=0
 I '$G(CLINICIENS(1)) D ERRLOG^SDESJSON(.APPTLIST,18)
 S YESTERDAYEXTERNL=$$FMADD^XLFDT(DT,"","","",-1)
 S YESTERDAYEXTERNL=$$FMTONET^SDECDATE(YESTERDAYEXTERNL)
 S TODAYEXTERNAL=$$FMADD^XLFDT(DT,"",23,59,59)
 S TODAYEXTERNAL=$$FMTONET^SDECDATE(TODAYEXTERNAL)
 F  S IENCOUNT=$O(CLINICIENS(IENCOUNT)) Q:'IENCOUNT  D
 .N TEMPLIST
 .D APPTBYCLINIC2(.TEMPLIST,CLINICIENS(IENCOUNT),YESTERDAYEXTERNL,TODAYEXTERNAL,"")
 .S CLINICIEN=CLINICIENS(IENCOUNT)
 .M APPTLIST("CLINIC IEN: "_CLINICIEN)=TEMPLIST
 D BUILDJSON(.APPTLISTJSON,.APPTLIST)
 Q
GETAPPTSBYCLINIC(APPTLISTJSON,SDCLINICIEN,SDBEG,SDEND,SDEAS) ;
 N APPTLIST
 D APPTBYCLINIC(.APPTLIST,SDCLINICIEN,SDBEG,SDEND,$G(SDEAS))
 D BUILDJSON(.APPTLISTJSON,.APPTLIST)
 Q
APPTBYCLINIC(SDAPPT,SDCLINICIEN,SDBEG,SDEND,SDEAS) ;
 N POP,APPTIEN,APPTDT,APPTDATA,COUNTER,JSONERR,DFN,PATIENT,RESTYPE,SDRESIEN
 S (POP,APPTIEN,COUNTER,JSONERR)=""
 K SDECY
 ;Validate input parameters
 S SDBEG=$G(SDBEG)
 S SDEND=$G(SDEND)
 S POP=$$VALIDATEDT(.SDBEG,.SDEND)
 I $G(SDCLINICIEN)="" S POP=1 D ERRLOG^SDESJSON(.SDAPPT,18)
 I $G(SDCLINICIEN)'="",'$D(^SC(SDCLINICIEN,0)) S POP=1 D ERRLOG^SDESJSON(.SDAPPT,19)
 S SDEAS=$$VALIDATEEAS(.SDAPPT,$G(SDEAS,""))
 I SDEAS=-1 S POP=1
 I POP S SDAPPT("Appt",1)=""
 ;
 I 'POP D
 .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
 ....D SUMMARY^SDESAPPTDATA(.APPTDATA,APPTIEN)
 ....S COUNTER=$G(COUNTER)+1
 ....M SDAPPT("Appt",COUNTER)=APPTDATA
 ....S DFN=$G(SDAPPT("Appt",COUNTER,"DFN"))
 ....S PATIENT=""
 ....D PATIENTIDADDDON^SDESPATIENTDATA(.PATIENT,DFN)
 ....M SDAPPT("Appt",COUNTER,"Patient")=PATIENT
 .I '$D(SDAPPT("Appt")) S SDAPPT("Appt")=""
 Q
APPTBYCLINIC2(SDAPPT,SDCLINICIEN,SDBEG,SDEND,SDEAS) ;
 N POP,APPTIEN,APPTDT,APPTDATA,COUNTER,JSONERR,DFN,PATIENT,RESTYPE,SDRESIEN
 S (POP,APPTIEN,COUNTER,JSONERR)=""
 K SDECY
 ;Validate input parameters
 S SDBEG=$G(SDBEG)
 S SDEND=$G(SDEND)
 S POP=$$VALIDATEDT(.SDBEG,.SDEND)
 I $G(SDCLINICIEN)="" S POP=1 D ERRLOG^SDESJSON(.SDAPPT,18)
 I $G(SDCLINICIEN)'="",'$D(^SC(SDCLINICIEN,0)) S POP=1 D ERRLOG^SDESJSON(.SDAPPT,19)
 S SDEAS=$$VALIDATEEAS(.SDAPPT,$G(SDEAS,""))
 I SDEAS=-1 S POP=1
 I POP S SDAPPT("Appt",1)=""
 ;
 I 'POP D
 .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
 ....D SUMMARY^SDESAPPTDATA(.APPTDATA,APPTIEN)
 ....S COUNTER=$G(COUNTER)+1
 ....M SDAPPT("Appt",COUNTER)=APPTDATA
 ....S DFN=$G(SDAPPT("Appt",COUNTER,"DFN"))
 ....S PATIENT=""
 ....D PATIENTIDADDDON^SDESPATIENTDATA2(.PATIENT,DFN)
 ....M SDAPPT("Appt",COUNTER,"Patient")=PATIENT
 .I '$D(SDAPPT("Appt")) S SDAPPT("Appt")=""
 Q
 ; Get appointment by request ien and appointment type
 ; REQIEN - Appointment request IEN from one of the following (#123, #403.5, or #409.85)
 ; REQTYPE - Appointment request type: C (CONSULT), R (RECALL), A (APPT)
APPTBYRIENAPTYP(SDECY,REQIEN,REQTYPE,SDEAS) ;
 N SDAPPT,SDERR,TRGTFILE,CHKTYPE,NOAPPTS
 S CHKTYPE=$E(REQTYPE)
 D VALAPPTTYPE(.SDERR,CHKTYPE)
 D VALREQIEN(.SDERR,REQIEN,CHKTYPE)
 S SDEAS=$$VALIDATEEAS(.SDERR,$G(SDEAS,""))
 I SDEAS=-1 S POP=1
 I $D(SDERR) S SDERR("Appointment",1)="" D BUILDJSON(.SDECY,.SDERR) Q
 D BLDAPTBYRIEN(.SDECY,REQIEN,CHKTYPE,SDEAS)
 I '$D(SDECY) D
 .S NOAPPTS("Appointment",1)="" D BUILDJSON(.SDECY,.NOAPPTS)
 Q
BLDAPTBYRIEN(SDECY,REQIEN,CHKTYPE,SDEAS) ;
 N TRGTFILE,FILEROOT,FULLREF,APPTIEN,APPTCNT,SDREQPATIEN
 S TRGTFILE=$S(CHKTYPE="C":123,CHKTYPE="A":409.85,1:"")
 I TRGTFILE=409.85 S SDREQPATIEN=$$GET1^DIQ(409.85,REQIEN,.01,"I")
 I TRGTFILE=123 S SDREQPATIEN=$$GET1^DIQ(123,REQIEN,.02,"I")
 S FILEROOT=$$ROOT^DILFD(TRGTFILE)
 S FULLREF=REQIEN_";"_$P(FILEROOT,U,2)
 S (APPTIEN,APPTCNT)=0 F  S APPTIEN=$O(^SDEC(409.84,"CPAT",SDREQPATIEN,APPTIEN)) Q:'APPTIEN  D
 .I $$GET1^DIQ(409.84,APPTIEN,.22,"I")'=FULLREF Q
 .D GETAPPTBYIEN^SDESGETAPPTWRAP2(.SDECY,APPTIEN,SDEAS)
 Q
VALREQIEN(ERRORS,IEN,TYPE) ; validate request IEN
 ; PLACE HOLDER
 N EFLAG
 I IEN="" S EFLAG=1 D ERRLOG^SDESJSON(.ERRORS,3)
 I IEN'="",TYPE="A",'$D(^SDEC(409.85,IEN)) S EFLAG=1 D ERRLOG^SDESJSON(.ERRORS,4)
 I IEN'="",TYPE="C",'$D(^GMR(123,IEN)) S EFLAG=1 D ERRLOG^SDESJSON(.ERRORS,4)
 Q $D(EFLAG)
 ;
VALAPPTTYPE(ERRORS,APTYPE) ; validate appointment type
 ; PLACE HOLDER
 N EFLAG
 I APTYPE="" S EFLAG=1 D ERRLOG^SDESJSON(.ERRORS,181)
 I APTYPE'="","CA"'[APTYPE S EFLAG=1 D ERRLOG^SDESJSON(.ERRORS,180)
 Q $D(EFLAG)
 ;
VALIDATEEAS(ERRORS,SDEAS) ;
 I $L(SDEAS) S SDEAS=$$EASVALIDATE^SDESUTIL($G(SDEAS))
 I $P($G(SDEAS),U)=-1 D ERRLOG^SDESJSON(.ERRORS,142) Q -1
 Q 0
 ;
BUILDER ;Convert data to JSON
 N JSONERR
 S JSONERR=""
 I POP S SDAPPT("Appt",1)=""
 D ENCODE^SDESJSON(.SDAPPT,.SDECY,.JSONERR)
 Q
 ;
BUILDJSON(APPTLISTJSON,APPTLISTARRAY) ;Convert data to JSON
 N JSONERR
 S JSONERR=""
 D ENCODE^SDESJSON(.APPTLISTARRAY,.APPTLISTJSON,.JSONERR)
 Q
VALIDATEDT(FROM,THRU) ;
 N POP
 S POP=0  ;Assume all is good
 I FROM="" S POP=1 D ERRLOG^SDESJSON(.SDAPPT,25)
 I THRU="" S POP=1 D ERRLOG^SDESJSON(.SDAPPT,26)
 I FROM'="" D
 .S FROM=$$NETTOFM^SDECDATE(FROM,"Y")
 .I FROM=-1 S POP=1 D ERRLOG^SDESJSON(.SDAPPT,27)
  I THRU'="" D
 .S THRU=$$NETTOFM^SDECDATE(THRU,"Y")
 .I THRU=-1 S POP=1 D ERRLOG^SDESJSON(.SDAPPT,28)
 I 'POP,THRU,FROM D
 .I FROM>THRU S POP=1 D ERRLOG^SDESJSON(.SDAPPT,29)
 Q POP
 ;
APPTINDTRANGE(IEN,BEG,END) ;
 ;Function to check if the Appt Sart Date / Time is within the desired date range
 ;
 ; Input
 ;   IEN - Internal # from Appointment File (409.84)
 ;   BEG - (Optional) Date in FM format
 ;   END - (Optional) Date in FM format
 ; Return
 ;   1 = Appointment Start Time is within BEG and END
 ;   0 = Not within the date range
 N INRANGE,APPTDT,FN,IENS,APPTARY,SDMSG,IENS
 S INRANGE=1  ;Assume success
 S FN=409.84,IENS=IEN_","
 D GETS^DIQ(FN,IEN,".01","I","APPTARY","SDMSG")
 S APPTDT=$G(APPTARY(FN,IENS,.01,"I"))
 I APPTDT=""!($G(SDMSG)) S INRANGE=0
 I $G(BEG),$G(APPTDT) S:APPTDT<BEG INRANGE=0
 I $G(END),$G(APPTDT) S:APPTDT>END INRANGE=0
 Q INRANGE