SDESCLINDAILYSCH ;ALB/BLB - SDES GET CLINIC DAILY SCHEDULE ;Jan 9, 2023@18:47
;;5.3;Scheduling;**836,860**;Aug 13, 1993;Build 12
;;Per VHA Directive 6402, this routine should not be modified
;
Q
;
GETSCHEDULE(JSONRETURN,CLINICIEN,DATE) ;
N ERRORS,RETURN,SCHEDULE,DOW,SUB
;
; validate
D VALIDATEDATE(.ERRORS,.DATE,$G(CLINICIEN))
D VALIDATECLINIC(.ERRORS,$G(CLINICIEN))
I $D(ERRORS) M RETURN=ERRORS D BUILDJSON(.JSONRETURN,.RETURN) Q
;
S DOW=$$UP^XLFSTR($$DOW^XLFDT(DATE))
S SUB=$$SUB(.SUB,DOW)
S DAYSCHEDULE=$$GETDAYSCHEDULE(CLINICIEN,SUB,DATE)
I $D(ERRORS) M RETURN=ERRORS D BUILDJSON(.JSONRETURN,.RETURN) Q
;
; build slots
D BUILD(.SCHEDULE,DAYSCHEDULE,CLINICIEN,SUB,DATE)
I '$D(SCHEDULE) S SCHEDULE("ClinicSlot",1)=""
M RETURN=SCHEDULE
D BUILDJSON(.JSONRETURN,.RETURN)
Q
;
BUILD(SCHEDULE,DAYSCHEDULE,CLINICIEN,SUB,DATE) ;
N SLOTIEN,CLINICSTART,APPTLENGTH,INCREMENT,SLOTS,STARTTIME,COUNT,NEWSLOTS,TIME,STRING
;
S STRING="123456789jklmnopqrstuvwxyz"
S CLINICSTART=$$GET1^DIQ(44,CLINICIEN,1914,"I")
S APPTLENGTH=$$GET1^DIQ(44,CLINICIEN,1912,"I")
S INCREMENT=$$GET1^DIQ(44,CLINICIEN,1917,"I")
;
I '$D(^SC(CLINICIEN,"ST",DATE,1)) D
.D ASSEMBLE(.ERRORS,CLINICIEN,DATE,INCREMENT,CLINICSTART)
;
D ARRAY^SDECUTL2(.SLOTS,DAYSCHEDULE,DATE,APPTLENGTH,CLINICSTART,INCREMENT)
D NEWSLOTS(.NEWSLOTS,DATE,.SLOTS)
;
S STARTTIME="",COUNT=0
F S STARTTIME=$O(NEWSLOTS(DATE,STARTTIME)) Q:STARTTIME="" D
.S COUNT=COUNT+1
.S TIME=STARTTIME
.;
.I $$GET1^DIQ(44,CLINICIEN,1912,"I")#60'=0 D
..I $L($G(TIME))=3 S TIME="0"_TIME
..I $L($G(TIME))=2 S TIME="00"_TIME
..I $L($G(TIME))=1 S TIME="000"_TIME
.;
.I $$GET1^DIQ(44,CLINICIEN,1912,"I")#60=0 D
..I $L(TIME)=1 D
...S TIME="0"_TIME_"00"
..;
..I $L(TIME)=2 D
...S TIME=TIME_"00"
.;
.S SCHEDULE("ClinicSlot",COUNT,"Date")=$$FMTISO^SDAMUTDT(DATE)
.S SCHEDULE("ClinicSlot",COUNT,"StartTime")=TIME
.I $G(NEWSLOTS(DATE,STARTTIME))'?.A,+$G(NEWSLOTS(DATE,STARTTIME))=0 S SCHEDULE("ClinicSlot",COUNT,"OpenSlots")=0 Q
.S SCHEDULE("ClinicSlot",COUNT,"OpenSlots")=$S($G(NEWSLOTS(DATE,STARTTIME))'?.N:$F(STRING,$G(NEWSLOTS(DATE,STARTTIME)))-1,1:+$G(NEWSLOTS(DATE,STARTTIME)))
Q
;
NEWSLOTS(NEWSLOT,CDATE,SLOTS) ;
N SLOT,VALUE,NEWTIMESLOT
S SLOT="" F S SLOT=$O(SLOTS(CDATE,SLOT)) Q:SLOT="" D
.S NEWTIMESLOT=+SLOT Q:SLOT=""
.S VALUE=$G(SLOTS(CDATE,SLOT))
.S NEWSLOT(CDATE,NEWTIMESLOT)=VALUE
Q
;
ASSEMBLE(ERRORS,CLINICIEN,DATE,INCREMENT,CLINSTART) ;
N DOW,MASTERPATTERN,MPATTERNSLOTS,X,Y,FILENOFDA,FDAIEN,FERR,FILENO
S X=DATE
D DOW^SDM0 S DOW=Y
S MASTERPATTERN=+$O(^SC(CLINICIEN,"T"_DOW,DATE))
S FILENO=$SELECT(DOW=0:44.06,DOW=1:44.07,DOW=2:44.08,DOW=3:44.09,DOW=4:44.008,DOW=5:44.009,DOW=6:44.0001,1:"")
S MPATTERNSLOTS=$$GET1^DIQ(FILENO,MASTERPATTERN_","_CLINICIEN_",",1)
S FDA(44.005,"+1,"_CLINICIEN_",",.01)=DATE
S FDA(44.005,"+1,"_CLINICIEN_",",1)=$P("SU^MO^TU^WE^TH^FR^SA",U,DOW+1)_" "_$E(DATE,6,7)_$J("",INCREMENT+INCREMENT-6)_MPATTERNSLOTS
S FDAIEN(1)=DATE
D UPDATE^DIE(,"FDA","FDAIEN","FERR") K FDA,FDAIEN
Q
;
GETDAYSCHEDULE(CLINICIEN,SUB,DATE) ;
S DAYSCHEDULE=$G(^SC(CLINICIEN,SUB,9999999,1))
I DAYSCHEDULE["CANCELLED" D ERRLOG^SDESJSON(.ERRORS,248) Q ""
;
I $D(^SC(CLINICIEN,"OST",DATE,1)) D
.S DAYSCHEDULE=$E($G(^SC(CLINICIEN,"OST",DATE,1)),8,$L($G(^SC(CLINICIEN,"OST",DATE,1))))
;
I DAYSCHEDULE'["[" D ERRLOG^SDESJSON(.ERRORS,249) Q "" ; doesnt meet today
Q DAYSCHEDULE
;
VALIDATEDATE(ERRORS,DATE,CLINICIEN) ;
I $G(DATE)="" D ERRLOG^SDESJSON(.ERRORS,45) Q
S DATE=$$ISOTFM^SDAMUTDT(DATE,CLINICIEN)
I $G(DATE)=-1 D ERRLOG^SDESJSON(.ERRORS,46) Q
I $G(DATE)&(DATE<DT) D ERRLOG^SDESJSON(.ERRORS,71)
Q DATE
;
VALIDATECLINIC(ERRORS,CLINICIEN) ;
I CLINICIEN="" D ERRLOG^SDESJSON(.ERRORS,18) Q
I CLINICIEN'="",'$D(^SC(CLINICIEN,0)) D ERRLOG^SDESJSON(.ERRORS,19)
Q
;
SUB(SUB,DOW) ;
S SUB="T"_$S(DOW="SUNDAY":0,DOW="MONDAY":1,DOW="TUESDAY":2,DOW="WEDNESDAY":3,DOW="THURSDAY":4,DOW="FRIDAY":5,DOW="SATURDAY":6,1:"")
Q SUB
;
BUILDJSON(JSONRETURN,RETURN) ;
N JSONERROR
D ENCODE^XLFJSON("RETURN","JSONRETURN","JSONERROR")
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDESCLINDAILYSCH 4157 printed Apr 09, 2024@21:58:24 Page 2
SDESCLINDAILYSCH ;ALB/BLB - SDES GET CLINIC DAILY SCHEDULE ;Jan 9, 2023@18:47
+1 ;;5.3;Scheduling;**836,860**;Aug 13, 1993;Build 12
+2 ;;Per VHA Directive 6402, this routine should not be modified
+3 ;
+4 QUIT
+5 ;
GETSCHEDULE(JSONRETURN,CLINICIEN,DATE) ;
+1 NEW ERRORS,RETURN,SCHEDULE,DOW,SUB
+2 ;
+3 ; validate
+4 DO VALIDATEDATE(.ERRORS,.DATE,$GET(CLINICIEN))
+5 DO VALIDATECLINIC(.ERRORS,$GET(CLINICIEN))
+6 IF $DATA(ERRORS)
MERGE RETURN=ERRORS
DO BUILDJSON(.JSONRETURN,.RETURN)
QUIT
+7 ;
+8 SET DOW=$$UP^XLFSTR($$DOW^XLFDT(DATE))
+9 SET SUB=$$SUB(.SUB,DOW)
+10 SET DAYSCHEDULE=$$GETDAYSCHEDULE(CLINICIEN,SUB,DATE)
+11 IF $DATA(ERRORS)
MERGE RETURN=ERRORS
DO BUILDJSON(.JSONRETURN,.RETURN)
QUIT
+12 ;
+13 ; build slots
+14 DO BUILD(.SCHEDULE,DAYSCHEDULE,CLINICIEN,SUB,DATE)
+15 IF '$DATA(SCHEDULE)
SET SCHEDULE("ClinicSlot",1)=""
+16 MERGE RETURN=SCHEDULE
+17 DO BUILDJSON(.JSONRETURN,.RETURN)
+18 QUIT
+19 ;
BUILD(SCHEDULE,DAYSCHEDULE,CLINICIEN,SUB,DATE) ;
+1 NEW SLOTIEN,CLINICSTART,APPTLENGTH,INCREMENT,SLOTS,STARTTIME,COUNT,NEWSLOTS,TIME,STRING
+2 ;
+3 SET STRING="123456789jklmnopqrstuvwxyz"
+4 SET CLINICSTART=$$GET1^DIQ(44,CLINICIEN,1914,"I")
+5 SET APPTLENGTH=$$GET1^DIQ(44,CLINICIEN,1912,"I")
+6 SET INCREMENT=$$GET1^DIQ(44,CLINICIEN,1917,"I")
+7 ;
+8 IF '$DATA(^SC(CLINICIEN,"ST",DATE,1))
Begin DoDot:1
+9 DO ASSEMBLE(.ERRORS,CLINICIEN,DATE,INCREMENT,CLINICSTART)
End DoDot:1
+10 ;
+11 DO ARRAY^SDECUTL2(.SLOTS,DAYSCHEDULE,DATE,APPTLENGTH,CLINICSTART,INCREMENT)
+12 DO NEWSLOTS(.NEWSLOTS,DATE,.SLOTS)
+13 ;
+14 SET STARTTIME=""
SET COUNT=0
+15 FOR
SET STARTTIME=$ORDER(NEWSLOTS(DATE,STARTTIME))
if STARTTIME=""
QUIT
Begin DoDot:1
+16 SET COUNT=COUNT+1
+17 SET TIME=STARTTIME
+18 ;
+19 IF $$GET1^DIQ(44,CLINICIEN,1912,"I")#60'=0
Begin DoDot:2
+20 IF $LENGTH($GET(TIME))=3
SET TIME="0"_TIME
+21 IF $LENGTH($GET(TIME))=2
SET TIME="00"_TIME
+22 IF $LENGTH($GET(TIME))=1
SET TIME="000"_TIME
End DoDot:2
+23 ;
+24 IF $$GET1^DIQ(44,CLINICIEN,1912,"I")#60=0
Begin DoDot:2
+25 IF $LENGTH(TIME)=1
Begin DoDot:3
+26 SET TIME="0"_TIME_"00"
End DoDot:3
+27 ;
+28 IF $LENGTH(TIME)=2
Begin DoDot:3
+29 SET TIME=TIME_"00"
End DoDot:3
End DoDot:2
+30 ;
+31 SET SCHEDULE("ClinicSlot",COUNT,"Date")=$$FMTISO^SDAMUTDT(DATE)
+32 SET SCHEDULE("ClinicSlot",COUNT,"StartTime")=TIME
+33 IF $GET(NEWSLOTS(DATE,STARTTIME))'?.A
IF +$GET(NEWSLOTS(DATE,STARTTIME))=0
SET SCHEDULE("ClinicSlot",COUNT,"OpenSlots")=0
QUIT
+34 SET SCHEDULE("ClinicSlot",COUNT,"OpenSlots")=$SELECT($GET(NEWSLOTS(DATE,STARTTIME))'?.N:$FIND(STRING,$GET(NEWSLOTS(DATE,STARTTIME)))-1,1:+$GET(NEWSLOTS(DATE,STARTTIME)))
End DoDot:1
+35 QUIT
+36 ;
NEWSLOTS(NEWSLOT,CDATE,SLOTS) ;
+1 NEW SLOT,VALUE,NEWTIMESLOT
+2 SET SLOT=""
FOR
SET SLOT=$ORDER(SLOTS(CDATE,SLOT))
if SLOT=""
QUIT
Begin DoDot:1
+3 SET NEWTIMESLOT=+SLOT
if SLOT=""
QUIT
+4 SET VALUE=$GET(SLOTS(CDATE,SLOT))
+5 SET NEWSLOT(CDATE,NEWTIMESLOT)=VALUE
End DoDot:1
+6 QUIT
+7 ;
ASSEMBLE(ERRORS,CLINICIEN,DATE,INCREMENT,CLINSTART) ;
+1 NEW DOW,MASTERPATTERN,MPATTERNSLOTS,X,Y,FILENOFDA,FDAIEN,FERR,FILENO
+2 SET X=DATE
+3 DO DOW^SDM0
SET DOW=Y
+4 SET MASTERPATTERN=+$ORDER(^SC(CLINICIEN,"T"_DOW,DATE))
+5 SET FILENO=$SELECT(DOW=0:44.06,DOW=1:44.07,DOW=2:44.08,DOW=3:44.09,DOW=4:44.008,DOW=5:44.009,DOW=6:44.0001,1:"")
+6 SET MPATTERNSLOTS=$$GET1^DIQ(FILENO,MASTERPATTERN_","_CLINICIEN_",",1)
+7 SET FDA(44.005,"+1,"_CLINICIEN_",",.01)=DATE
+8 SET FDA(44.005,"+1,"_CLINICIEN_",",1)=$PIECE("SU^MO^TU^WE^TH^FR^SA",U,DOW+1)_" "_$EXTRACT(DATE,6,7)_$JUSTIFY("",INCREMENT+INCREMENT-6)_MPATTERNSLOTS
+9 SET FDAIEN(1)=DATE
+10 DO UPDATE^DIE(,"FDA","FDAIEN","FERR")
KILL FDA,FDAIEN
+11 QUIT
+12 ;
GETDAYSCHEDULE(CLINICIEN,SUB,DATE) ;
+1 SET DAYSCHEDULE=$GET(^SC(CLINICIEN,SUB,9999999,1))
+2 IF DAYSCHEDULE["CANCELLED"
DO ERRLOG^SDESJSON(.ERRORS,248)
QUIT ""
+3 ;
+4 IF $DATA(^SC(CLINICIEN,"OST",DATE,1))
Begin DoDot:1
+5 SET DAYSCHEDULE=$EXTRACT($GET(^SC(CLINICIEN,"OST",DATE,1)),8,$LENGTH($GET(^SC(CLINICIEN,"OST",DATE,1))))
End DoDot:1
+6 ;
+7 ; doesnt meet today
IF DAYSCHEDULE'["["
DO ERRLOG^SDESJSON(.ERRORS,249)
QUIT ""
+8 QUIT DAYSCHEDULE
+9 ;
VALIDATEDATE(ERRORS,DATE,CLINICIEN) ;
+1 IF $GET(DATE)=""
DO ERRLOG^SDESJSON(.ERRORS,45)
QUIT
+2 SET DATE=$$ISOTFM^SDAMUTDT(DATE,CLINICIEN)
+3 IF $GET(DATE)=-1
DO ERRLOG^SDESJSON(.ERRORS,46)
QUIT
+4 IF $GET(DATE)&(DATE<DT)
DO ERRLOG^SDESJSON(.ERRORS,71)
+5 QUIT DATE
+6 ;
VALIDATECLINIC(ERRORS,CLINICIEN) ;
+1 IF CLINICIEN=""
DO ERRLOG^SDESJSON(.ERRORS,18)
QUIT
+2 IF CLINICIEN'=""
IF '$DATA(^SC(CLINICIEN,0))
DO ERRLOG^SDESJSON(.ERRORS,19)
+3 QUIT
+4 ;
SUB(SUB,DOW) ;
+1 SET SUB="T"_$SELECT(DOW="SUNDAY":0,DOW="MONDAY":1,DOW="TUESDAY":2,DOW="WEDNESDAY":3,DOW="THURSDAY":4,DOW="FRIDAY":5,DOW="SATURDAY":6,1:"")
+2 QUIT SUB
+3 ;
BUILDJSON(JSONRETURN,RETURN) ;
+1 NEW JSONERROR
+2 DO ENCODE^XLFJSON("RETURN","JSONRETURN","JSONERROR")
+3 QUIT
+4 ;
