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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDESAPPT 10468 printed Dec 13, 2024@02:55:35 Page 2
SDESAPPT ;ALB/BLB,KML,TAW,BWF,MGD,LAB,RRM- GET APPT REQUESTS ;July 5, 2022
+1 ;;5.3;Scheduling;**788,805,807,809,815,819,820,823,824**;Aug 13, 1993;Build 3
+2 ;;Per VHA Directive 6402, this routine should not be modified
+3 ;
+4 ; Reference to PATIENT in ICR #10035
+5 QUIT
+6 ;
APPGETJSON(SDECY,DFN,BDATE,EDATE,SDEAS) ; Return a list of appointments and associated data by PATIENT
+1 ;INPUT - DFN (Date File Number) Pointer to PATIENT (#2) File.
+2 ; - BDATE = start date for appointment search and gather (time included)
+3 ; - EDATE = end date for the appointment search and gather (time included)
+4 ; SDEAS - [OPT] Enterprise Appointment Scheduling (EAS) Tracking Number associated to an appointment.
+5 ;RETURN PARMETERS:
+6 ;
+7 NEW IEN,NUM,ERR,IENS,SDAPPT,POP,APPTDATA
+8 SET POP=0
+9 SET DFN=$GET(DFN)
+10 SET ERR=0
SET IEN=0
SET NUM=0
SET BDATE=$GET(BDATE)
SET EDATE=$GET(EDATE)
+11 SET POP=$$VALIDATEDT(.BDATE,.EDATE)
+12 IF DFN=""
SET POP=1
DO ERRLOG^SDESJSON(.SDAPPT,1)
+13 IF DFN'=""
IF '$DATA(^DPT(DFN,0))
SET POP=1
DO ERRLOG^SDESJSON(.SDAPPT,2)
+14 SET SDEAS=$$VALIDATEEAS(.SDAPPT,$GET(SDEAS,""))
+15 IF SDEAS=-1
SET POP=1
+16 ;
+17 IF 'POP
Begin DoDot:1
+18 FOR
SET IEN=$ORDER(^SDEC(409.84,"CPAT",DFN,IEN))
if 'IEN
QUIT
Begin DoDot:2
+19 IF '$$APPTINDTRANGE(IEN,BDATE,EDATE)
QUIT
+20 SET NUM=NUM+1
+21 DO SUMMARY^SDESAPPTDATA(.APPTDATA,IEN)
+22 ;vse-2263 SD*5.3*807 external representation of appointment type
SET APPTDATA("AppointmentType")=$$GET1^DIQ(409.84,IEN_",",.06)
+23 MERGE SDAPPT("Appt",NUM)=APPTDATA
End DoDot:2
+24 IF '$DATA(SDAPPT("Appt"))
SET SDAPPT("Appt")=""
End DoDot:1
+25 DO BUILDER
+26 QUIT
+27 ;
APPGETONEJSON(SDECY,IEN,SDEAS) ; Return a single appointment and associated data by IEN
+1 ;INPUT - IEN (Internal Entry Number) Pointer to SDEC APPOINTMENT (#409.84) File.
+2 ; SDEAS - [OPT] Enterprise Appointment Scheduling (EAS) Tracking Number associated to an appointment.
+3 ;RETURN PARMETERS: SDECY - array with JSON formatted data for the Appointment.
+4 ;
+5 NEW NUM,ERR,IENS,SDAPPT,POP,APPTDATA
+6 SET ERR=0
SET NUM=0
SET POP=0
SET IEN=$GET(IEN)
+7 IF IEN=""
SET POP=1
DO ERRLOG^SDESJSON(.SDAPPT,14)
+8 IF IEN'=""
IF '$DATA(^SDEC(409.84,IEN,0))
SET POP=1
DO ERRLOG^SDESJSON(.SDAPPT,15)
+9 SET SDEAS=$$VALIDATEEAS(.SDAPPT,$GET(SDEAS,""))
+10 IF SDEAS=-1
SET POP=1
+11 ;
+12 IF 'POP
Begin DoDot:1
+13 SET NUM=NUM+1
+14 DO SUMMARY^SDESAPPTDATA(.APPTDATA,IEN)
+15 MERGE SDAPPT("Appt",NUM)=APPTDATA
+16 IF '$DATA(SDAPPT("Appt"))
SET SDAPPT("Appt")=""
End DoDot:1
+17 DO BUILDER
+18 QUIT
APPTBYRESOURCE(SDECY,SDRESIEN,SDBEG,SDEND,SDEAS) ;
+1 NEW POP,APPTIEN,APPTDT,SDAPPT,APPTDATA,COUNTER,JSONERR,DFN,PATIENT
+2 SET (POP,APPTIEN,COUNTER,JSONERR)=""
+3 KILL SDECY
+4 ;Validate input parameters
+5 SET SDBEG=$GET(SDBEG)
+6 SET SDEND=$GET(SDEND)
+7 SET POP=$$VALIDATEDT(.SDBEG,.SDEND)
+8 IF $GET(SDRESIEN)=""
SET POP=1
DO ERRLOG^SDESJSON(.SDAPPT,18)
+9 IF $GET(SDRESIEN)'=""
IF '$DATA(^SDEC(409.831,SDRESIEN,0))
SET POP=1
DO ERRLOG^SDESJSON(.SDAPPT,19)
+10 SET SDEAS=$$VALIDATEEAS(.SDAPPT,$GET(SDEAS,""))
+11 IF SDEAS=-1
SET POP=1
+12 ;
+13 IF 'POP
Begin DoDot:1
+14 SET APPTDT=SDBEG-.0001
+15 SET SDEND=SDEND+.0001
+16 FOR
SET APPTDT=$ORDER(^SDEC(409.84,"ARSRC",SDRESIEN,APPTDT))
if APPTDT=""
QUIT
Begin DoDot:2
+17 ;End loop since past the end date
IF SDEND
IF APPTDT>SDEND
SET POP=1
QUIT
+18 SET APPTIEN=""
+19 FOR
SET APPTIEN=$ORDER(^SDEC(409.84,"ARSRC",SDRESIEN,APPTDT,APPTIEN))
if APPTIEN=""
QUIT
Begin DoDot:3
+20 DO SUMMARY^SDESAPPTDATA(.APPTDATA,APPTIEN)
+21 SET COUNTER=$GET(COUNTER)+1
+22 MERGE SDAPPT("Appt",COUNTER)=APPTDATA
+23 SET DFN=$GET(SDAPPT("Appt",COUNTER,"DFN"))
+24 SET PATIENT=""
+25 DO PATIENTIDADDDON^SDESPATIENTDATA(.PATIENT,DFN)
+26 SET PATIENT("ICN")=$$GETPATICN^SDESINPUTVALUTL(DFN)
+27 MERGE SDAPPT("Appt",COUNTER,"Patient")=PATIENT
End DoDot:3
End DoDot:2
if POP
QUIT
+28 IF '$DATA(SDAPPT("Appt"))
SET SDAPPT("Appt")=""
End DoDot:1
+29 DO BUILDER
+30 QUIT
APPTBYCLINICLIST(APPTLISTJSON,CLINICIENS) ;
+1 NEW APPTLIST,IENCOUNT,YESTERDAYEXTERNL,TODAYEXTERNAL,CLINICIEN
+2 SET IENCOUNT=0
+3 IF '$GET(CLINICIENS(1))
DO ERRLOG^SDESJSON(.APPTLIST,18)
+4 SET YESTERDAYEXTERNL=$$FMADD^XLFDT(DT,"","","",-1)
+5 SET YESTERDAYEXTERNL=$$FMTONET^SDECDATE(YESTERDAYEXTERNL)
+6 SET TODAYEXTERNAL=$$FMADD^XLFDT(DT,"",23,59,59)
+7 SET TODAYEXTERNAL=$$FMTONET^SDECDATE(TODAYEXTERNAL)
+8 FOR
SET IENCOUNT=$ORDER(CLINICIENS(IENCOUNT))
if 'IENCOUNT
QUIT
Begin DoDot:1
+9 NEW TEMPLIST
+10 DO APPTBYCLINIC2(.TEMPLIST,CLINICIENS(IENCOUNT),YESTERDAYEXTERNL,TODAYEXTERNAL,"")
+11 SET CLINICIEN=CLINICIENS(IENCOUNT)
+12 MERGE APPTLIST("CLINIC IEN: "_CLINICIEN)=TEMPLIST
End DoDot:1
+13 DO BUILDJSON(.APPTLISTJSON,.APPTLIST)
+14 QUIT
GETAPPTSBYCLINIC(APPTLISTJSON,SDCLINICIEN,SDBEG,SDEND,SDEAS) ;
+1 NEW APPTLIST
+2 DO APPTBYCLINIC(.APPTLIST,SDCLINICIEN,SDBEG,SDEND,$GET(SDEAS))
+3 DO BUILDJSON(.APPTLISTJSON,.APPTLIST)
+4 QUIT
APPTBYCLINIC(SDAPPT,SDCLINICIEN,SDBEG,SDEND,SDEAS) ;
+1 NEW POP,APPTIEN,APPTDT,APPTDATA,COUNTER,JSONERR,DFN,PATIENT,RESTYPE,SDRESIEN
+2 SET (POP,APPTIEN,COUNTER,JSONERR)=""
+3 KILL SDECY
+4 ;Validate input parameters
+5 SET SDBEG=$GET(SDBEG)
+6 SET SDEND=$GET(SDEND)
+7 SET POP=$$VALIDATEDT(.SDBEG,.SDEND)
+8 IF $GET(SDCLINICIEN)=""
SET POP=1
DO ERRLOG^SDESJSON(.SDAPPT,18)
+9 IF $GET(SDCLINICIEN)'=""
IF '$DATA(^SC(SDCLINICIEN,0))
SET POP=1
DO ERRLOG^SDESJSON(.SDAPPT,19)
+10 SET SDEAS=$$VALIDATEEAS(.SDAPPT,$GET(SDEAS,""))
+11 IF SDEAS=-1
SET POP=1
+12 IF POP
SET SDAPPT("Appt",1)=""
+13 ;
+14 IF 'POP
Begin DoDot:1
+15 SET SDRESIEN=""
+16 FOR
SET SDRESIEN=$ORDER(^SDEC(409.831,"ALOC",SDCLINICIEN,SDRESIEN))
if SDRESIEN=""
QUIT
Begin DoDot:2
+17 SET RESTYPE=$PIECE($GET(^SDEC(409.831,SDRESIEN,0)),"^",11)
+18 ;Must be a Hospital Loc
IF $PIECE(RESTYPE,";",2)'="SC("
QUIT
+19 SET APPTDT=SDBEG-.0001
+20 SET SDEND=SDEND+.0001
+21 FOR
SET APPTDT=$ORDER(^SDEC(409.84,"ARSRC",SDRESIEN,APPTDT))
if APPTDT=""
QUIT
Begin DoDot:3
+22 ;End loop since past the end date
IF SDEND
IF APPTDT>SDEND
SET POP=1
QUIT
+23 SET APPTIEN=""
+24 FOR
SET APPTIEN=$ORDER(^SDEC(409.84,"ARSRC",SDRESIEN,APPTDT,APPTIEN))
if APPTIEN=""
QUIT
Begin DoDot:4
+25 DO SUMMARY^SDESAPPTDATA(.APPTDATA,APPTIEN)
+26 SET COUNTER=$GET(COUNTER)+1
+27 MERGE SDAPPT("Appt",COUNTER)=APPTDATA
+28 SET DFN=$GET(SDAPPT("Appt",COUNTER,"DFN"))
+29 SET PATIENT=""
+30 DO PATIENTIDADDDON^SDESPATIENTDATA(.PATIENT,DFN)
+31 MERGE SDAPPT("Appt",COUNTER,"Patient")=PATIENT
End DoDot:4
End DoDot:3
if POP
QUIT
End DoDot:2
+32 IF '$DATA(SDAPPT("Appt"))
SET SDAPPT("Appt")=""
End DoDot:1
+33 QUIT
APPTBYCLINIC2(SDAPPT,SDCLINICIEN,SDBEG,SDEND,SDEAS) ;
+1 NEW POP,APPTIEN,APPTDT,APPTDATA,COUNTER,JSONERR,DFN,PATIENT,RESTYPE,SDRESIEN
+2 SET (POP,APPTIEN,COUNTER,JSONERR)=""
+3 KILL SDECY
+4 ;Validate input parameters
+5 SET SDBEG=$GET(SDBEG)
+6 SET SDEND=$GET(SDEND)
+7 SET POP=$$VALIDATEDT(.SDBEG,.SDEND)
+8 IF $GET(SDCLINICIEN)=""
SET POP=1
DO ERRLOG^SDESJSON(.SDAPPT,18)
+9 IF $GET(SDCLINICIEN)'=""
IF '$DATA(^SC(SDCLINICIEN,0))
SET POP=1
DO ERRLOG^SDESJSON(.SDAPPT,19)
+10 SET SDEAS=$$VALIDATEEAS(.SDAPPT,$GET(SDEAS,""))
+11 IF SDEAS=-1
SET POP=1
+12 IF POP
SET SDAPPT("Appt",1)=""
+13 ;
+14 IF 'POP
Begin DoDot:1
+15 SET SDRESIEN=""
+16 FOR
SET SDRESIEN=$ORDER(^SDEC(409.831,"ALOC",SDCLINICIEN,SDRESIEN))
if SDRESIEN=""
QUIT
Begin DoDot:2
+17 SET RESTYPE=$PIECE($GET(^SDEC(409.831,SDRESIEN,0)),"^",11)
+18 ;Must be a Hospital Loc
IF $PIECE(RESTYPE,";",2)'="SC("
QUIT
+19 SET APPTDT=SDBEG-.0001
+20 SET SDEND=SDEND+.0001
+21 FOR
SET APPTDT=$ORDER(^SDEC(409.84,"ARSRC",SDRESIEN,APPTDT))
if APPTDT=""
QUIT
Begin DoDot:3
+22 ;End loop since past the end date
IF SDEND
IF APPTDT>SDEND
SET POP=1
QUIT
+23 SET APPTIEN=""
+24 FOR
SET APPTIEN=$ORDER(^SDEC(409.84,"ARSRC",SDRESIEN,APPTDT,APPTIEN))
if APPTIEN=""
QUIT
Begin DoDot:4
+25 DO SUMMARY^SDESAPPTDATA(.APPTDATA,APPTIEN)
+26 SET COUNTER=$GET(COUNTER)+1
+27 MERGE SDAPPT("Appt",COUNTER)=APPTDATA
+28 SET DFN=$GET(SDAPPT("Appt",COUNTER,"DFN"))
+29 SET PATIENT=""
+30 DO PATIENTIDADDDON^SDESPATIENTDATA2(.PATIENT,DFN)
+31 MERGE SDAPPT("Appt",COUNTER,"Patient")=PATIENT
End DoDot:4
End DoDot:3
if POP
QUIT
End DoDot:2
+32 IF '$DATA(SDAPPT("Appt"))
SET SDAPPT("Appt")=""
End DoDot:1
+33 QUIT
+34 ; Get appointment by request ien and appointment type
+35 ; REQIEN - Appointment request IEN from one of the following (#123, #403.5, or #409.85)
+36 ; REQTYPE - Appointment request type: C (CONSULT), R (RECALL), A (APPT)
APPTBYRIENAPTYP(SDECY,REQIEN,REQTYPE,SDEAS) ;
+1 NEW SDAPPT,SDERR,TRGTFILE,CHKTYPE,NOAPPTS
+2 SET CHKTYPE=$EXTRACT(REQTYPE)
+3 DO VALAPPTTYPE(.SDERR,CHKTYPE)
+4 DO VALREQIEN(.SDERR,REQIEN,CHKTYPE)
+5 SET SDEAS=$$VALIDATEEAS(.SDERR,$GET(SDEAS,""))
+6 IF SDEAS=-1
SET POP=1
+7 IF $DATA(SDERR)
SET SDERR("Appointment",1)=""
DO BUILDJSON(.SDECY,.SDERR)
QUIT
+8 DO BLDAPTBYRIEN(.SDECY,REQIEN,CHKTYPE,SDEAS)
+9 IF '$DATA(SDECY)
Begin DoDot:1
+10 SET NOAPPTS("Appointment",1)=""
DO BUILDJSON(.SDECY,.NOAPPTS)
End DoDot:1
+11 QUIT
BLDAPTBYRIEN(SDECY,REQIEN,CHKTYPE,SDEAS) ;
+1 NEW TRGTFILE,FILEROOT,FULLREF,APPTIEN,APPTCNT,SDREQPATIEN
+2 SET TRGTFILE=$SELECT(CHKTYPE="C":123,CHKTYPE="A":409.85,1:"")
+3 IF TRGTFILE=409.85
SET SDREQPATIEN=$$GET1^DIQ(409.85,REQIEN,.01,"I")
+4 IF TRGTFILE=123
SET SDREQPATIEN=$$GET1^DIQ(123,REQIEN,.02,"I")
+5 SET FILEROOT=$$ROOT^DILFD(TRGTFILE)
+6 SET FULLREF=REQIEN_";"_$PIECE(FILEROOT,U,2)
+7 SET (APPTIEN,APPTCNT)=0
FOR
SET APPTIEN=$ORDER(^SDEC(409.84,"CPAT",SDREQPATIEN,APPTIEN))
if 'APPTIEN
QUIT
Begin DoDot:1
+8 IF $$GET1^DIQ(409.84,APPTIEN,.22,"I")'=FULLREF
QUIT
+9 DO GETAPPTBYIEN^SDESGETAPPTWRAP2(.SDECY,APPTIEN,SDEAS)
End DoDot:1
+10 QUIT
VALREQIEN(ERRORS,IEN,TYPE) ; validate request IEN
+1 ; PLACE HOLDER
+2 NEW EFLAG
+3 IF IEN=""
SET EFLAG=1
DO ERRLOG^SDESJSON(.ERRORS,3)
+4 IF IEN'=""
IF TYPE="A"
IF '$DATA(^SDEC(409.85,IEN))
SET EFLAG=1
DO ERRLOG^SDESJSON(.ERRORS,4)
+5 IF IEN'=""
IF TYPE="C"
IF '$DATA(^GMR(123,IEN))
SET EFLAG=1
DO ERRLOG^SDESJSON(.ERRORS,4)
+6 QUIT $DATA(EFLAG)
+7 ;
VALAPPTTYPE(ERRORS,APTYPE) ; validate appointment type
+1 ; PLACE HOLDER
+2 NEW EFLAG
+3 IF APTYPE=""
SET EFLAG=1
DO ERRLOG^SDESJSON(.ERRORS,181)
+4 IF APTYPE'=""
IF "CA"'[APTYPE
SET EFLAG=1
DO ERRLOG^SDESJSON(.ERRORS,180)
+5 QUIT $DATA(EFLAG)
+6 ;
VALIDATEEAS(ERRORS,SDEAS) ;
+1 IF $LENGTH(SDEAS)
SET SDEAS=$$EASVALIDATE^SDESUTIL($GET(SDEAS))
+2 IF $PIECE($GET(SDEAS),U)=-1
DO ERRLOG^SDESJSON(.ERRORS,142)
QUIT -1
+3 QUIT 0
+4 ;
BUILDER ;Convert data to JSON
+1 NEW JSONERR
+2 SET JSONERR=""
+3 IF POP
SET SDAPPT("Appt",1)=""
+4 DO ENCODE^SDESJSON(.SDAPPT,.SDECY,.JSONERR)
+5 QUIT
+6 ;
BUILDJSON(APPTLISTJSON,APPTLISTARRAY) ;Convert data to JSON
+1 NEW JSONERR
+2 SET JSONERR=""
+3 DO ENCODE^SDESJSON(.APPTLISTARRAY,.APPTLISTJSON,.JSONERR)
+4 QUIT
VALIDATEDT(FROM,THRU) ;
+1 NEW POP
+2 ;Assume all is good
SET POP=0
+3 IF FROM=""
SET POP=1
DO ERRLOG^SDESJSON(.SDAPPT,25)
+4 IF THRU=""
SET POP=1
DO ERRLOG^SDESJSON(.SDAPPT,26)
+5 IF FROM'=""
Begin DoDot:1
+6 SET FROM=$$NETTOFM^SDECDATE(FROM,"Y")
+7 IF FROM=-1
SET POP=1
DO ERRLOG^SDESJSON(.SDAPPT,27)
End DoDot:1
+8 IF THRU'=""
Begin DoDot:1
+9 SET THRU=$$NETTOFM^SDECDATE(THRU,"Y")
+10 IF THRU=-1
SET POP=1
DO ERRLOG^SDESJSON(.SDAPPT,28)
End DoDot:1
+11 IF 'POP
IF THRU
IF FROM
Begin DoDot:1
+12 IF FROM>THRU
SET POP=1
DO ERRLOG^SDESJSON(.SDAPPT,29)
End DoDot:1
+13 QUIT POP
+14 ;
APPTINDTRANGE(IEN,BEG,END) ;
+1 ;Function to check if the Appt Sart Date / Time is within the desired date range
+2 ;
+3 ; Input
+4 ; IEN - Internal # from Appointment File (409.84)
+5 ; BEG - (Optional) Date in FM format
+6 ; END - (Optional) Date in FM format
+7 ; Return
+8 ; 1 = Appointment Start Time is within BEG and END
+9 ; 0 = Not within the date range
+10 NEW INRANGE,APPTDT,FN,IENS,APPTARY,SDMSG,IENS
+11 ;Assume success
SET INRANGE=1
+12 SET FN=409.84
SET IENS=IEN_","
+13 DO GETS^DIQ(FN,IEN,".01","I","APPTARY","SDMSG")
+14 SET APPTDT=$GET(APPTARY(FN,IENS,.01,"I"))
+15 IF APPTDT=""!($GET(SDMSG))
SET INRANGE=0
+16 IF $GET(BEG)
IF $GET(APPTDT)
if APPTDT<BEG
SET INRANGE=0
+17 IF $GET(END)
IF $GET(APPTDT)
if APPTDT>END
SET INRANGE=0
+18 QUIT INRANGE
