SDES2CRTCLNAVAIL ;ALB/BLB,BWF,JDJ,TJB - SDES2 SET CLINIC AVAILABILITY ;MAR 12, 2025
;;5.3;Scheduling;**890,897,899,903**;Aug 13, 1993;Build 3
;;Per VHA Directive 6402, this routine should not be modified
;
Q
;
CREATE(JSON,SDCONTEXT,AVAILABILITY) ;
N ERRORS,RETURNAVAIL,CLINICIEN,CLINICSTARTHOUR,NUMBEROFENTRIES,INPUTS,INDEFINITEUNTIL,SDDISPPERHR,SDCLINSTARTHR,SLOTSTOCANCEL,%,%DT
;
M INPUTS=AVAILABILITY
D VALIDATE(.ERRORS,.AVAILABILITY,.CLINICIEN,.CLINICSTARTHOUR,.NUMBEROFENTRIES,.INPUTS)
I $D(ERRORS) S ERRORS("ClinicAvailability")="" K COUNT,I D BUILDJSON^SDES2JSON(.JSON,.ERRORS) Q
;
D CREATEAVAIL(.AVAILABILITY,.SDCONTEXT,.SLOTSTOCANCEL,CLINICIEN,CLINICSTARTHOUR,$$GET1^DIQ(44,CLINICIEN,1917,"I"),$$GET1^DIQ(44,CLINICIEN,1914,"I"),NUMBEROFENTRIES,.INPUTS,.INDEFINITEUNTIL,.RETURNAVAIL,.ERRORS)
;
I $L($G(SLOTSTOCANCEL("CancelledSlots",1,"BeginTime"))) D
.D RECANCELSLOTS(.SLOTSTOCANCEL,CLINICIEN,.SDCONTEXT) K SLOTSTOCANCEL
;
D BUILDJSON^SDES2JSON(.JSON,.RETURNAVAIL)
K COUNT,I
Q
;
CREATEAVAIL(AVAILABILITY,SDCONTEXT,SLOTSTOCANCEL,CLINICIEN,CLINICSTARTHOUR,SDDISPPERHR,SDCLINSTARTHR,NUMBEROFENTRIES,INPUTS,INDEFINITEUNTIL,RETURNAVAIL,ERRORS) ;
N COUNT,ENDDATE,DATES,TIMES,SCHEDULEDDAYS,DATENEXTTIMESLOT,CANSLOTSENDDATE,DONE,SDRETURN,SDONE,J,SDSAV,SDST1,SM,SS,SEQ,%H,ENDATE,SB
;
S COUNT=0,DONE=0
F D Q:COUNT=NUMBEROFENTRIES!(DONE=1)
.S COUNT=COUNT+1
.I $G(SCHEDULEDDAYS)[$P($G(INPUTS("START DATE TIME",COUNT)),"T") Q
.;
.D CREATEDATESTIMES(.DATES,.TIMES,.INPUTS,$P($G(INPUTS("START DATE TIME",COUNT)),"T"),NUMBEROFENTRIES,.SLOTSTOCANCEL)
.I $D(SLOTSTOCANCEL("Error")) M RETURNAVAIL=SLOTSTOCANCEL S DONE=1 Q
.D CREATE^SDES2UTIL1(CLINICIEN,CLINICSTARTHOUR,$$GET1^DIQ(44,CLINICIEN,1912,"I"),$$DOW^XLFDT($P($G(AVAILABILITY("START DATE TIME",COUNT)),"."),1),.INDEFINITEUNTIL,.DATES,.TIMES,SDDISPPERHR,.SDRETURN,.ERRORS) K DATES,TIMES
.;
.S RETURNAVAIL("ClinicAvailability",COUNT,"Pattern")="Pattern Filed"
.I $G(INDEFINITEUNTIL) D
..S RETURNAVAIL("ClinicAvailability",COUNT,"DateIndefiniteScheduleEnds")=INDEFINITEUNTIL K INDEFINITEUNTIL
.S SCHEDULEDDAYS=$G(SCHEDULEDDAYS)_$P($G(INPUTS("START DATE TIME",COUNT)),"T")_U
.;
Q
;
CREATEDATESTIMES(DATES,TIMES,INPUTS,AVAILABILITYDATE,NUMBEROFENTRIES,SLOTSTOCANCEL) ;
N COUNT,SUBSCRIPT,STARTDATE,STARTTIME,ENDTIME,SLOTS,LASTTIMESLOTDATE,DONE,CANSLOTSENDDATE,DATENEXTTIMESLOT
;
S COUNT=0
F D Q:COUNT=NUMBEROFENTRIES
.S COUNT=COUNT+1
.I $P($G(INPUTS("START DATE TIME",COUNT)),"T")'=AVAILABILITYDATE Q
.;
.I $G(INPUTS("NUMBER OF SLOTS",COUNT))="@" D Q
..S DATES=$G(INPUTS("START DATE TIME",COUNT))="",DATES($$ISOTFM^SDAMUTDT(DATES))="",TIMES=""
.;
.S LASTTIMESLOTDATE=0,LASTTIMESLOTDATE=$O(DATES(LASTTIMESLOTDATE))
.I $G(LASTTIMESLOTDATE)=$$ISOTFM^SDAMUTDT($P($G(INPUTS("START DATE TIME",COUNT)),"T"))!('$G(LASTTIMESLOTDATE)) D
..S DATES=$$ISOTFM^SDAMUTDT($P($G(INPUTS("START DATE TIME",COUNT)),"T")),DATES(DATES)=""
..S TIMES=$G(TIMES)_$P($G(INPUTS("START DATE TIME",COUNT)),"T",2)_"-"_$P($G(INPUTS("END DATE TIME",COUNT)),"T",2)_";"
..S TIMES($P($G(INPUTS("START DATE TIME",COUNT)),"T",2))=$P($G(INPUTS("START DATE TIME",COUNT)),"T",2)_"-"_$P($G(INPUTS("END DATE TIME",COUNT)),"T",2)_U_$G(INPUTS("NUMBER OF SLOTS",COUNT))
.;
.I $G(INPUTS("INDEFINITE",COUNT)),'$D(DATES(9999999)) D
..S DATES=$G(DATES)_";9999999",DATES(9999999)=""
.;
.S DATENEXTTIMESLOT=$$ISOTFM^SDAMUTDT($P($G(INPUTS("START DATE TIME",COUNT)),"T"))
.S CANSLOTSENDDATE=$S($G(AVAILABILITY("INDEFINITE",COUNT)):$$FMTISO^SDAMUTDT($$GETLASTINDEFDATE(CLINICIEN,DATENEXTTIMESLOT,$$GET1^DIQ(44,CLINICIEN,2002))),1:DATENEXTTIMESLOT)
.I $G(INPUTS("INDEFINITE",COUNT)) D Q
..S DONE=0
..F D Q:DATENEXTTIMESLOT=$$ISOTFM^SDAMUTDT(CANSLOTSENDDATE)
...D GETCANSLOTS(CLINICIEN,.SLOTSTOCANCEL,$G(AVAILABILITY("INDEFINITE",COUNT)),CANSLOTSENDDATE,COUNT,$$FMTISO^SDAMUTDT(DATENEXTTIMESLOT),.INPUTS,.SDCONTEXT)
...S DATENEXTTIMESLOT=$$FMADD^XLFDT(DATENEXTTIMESLOT,7)
.;
.D GETCANSLOTS(CLINICIEN,.SLOTSTOCANCEL,$G(AVAILABILITY("INDEFINITE",COUNT)),CANSLOTSENDDATE,COUNT,$$FMTISO^SDAMUTDT(DATENEXTTIMESLOT),.INPUTS,.SDCONTEXT)
;
S TIMES=$E($G(TIMES),1,$L($G(TIMES))-1)
Q
;
GETLASTINDEFDATE(CLINICIEN,DATE,MAXBOOKINGDAYS) ;
N FOUND,OSTDATE
;
S OSTDATE=DATE,FOUND=0
F D Q:FOUND!(OSTDATE>$$FMADD^XLFDT(DT,MAXBOOKINGDAYS))
.S OSTDATE=$$FMADD^XLFDT(OSTDATE,7)
.I $D(^SC(CLINICIEN,"OST",OSTDATE)) S FOUND=1
Q $G(OSTDATE)
;
RECANCELSLOTS(SLOTSTOCANCEL,CLINICIEN,SDCONTEXT) ;
N COUNT,CANCEL,CANCELRETURN
;
S COUNT=0
F S COUNT=$O(SLOTSTOCANCEL("CancelledSlots",COUNT)) Q:'COUNT D
.S CANCEL("CLINIC IEN")=CLINICIEN
.S CANCEL("FULL PARTIAL FLAG")=$S($G(SLOTSTOCANCEL("CancelledSlots",COUNT,"BeginTime"))["T":"P",1:"F")
.S CANCEL("START DATE TIME")=$G(SLOTSTOCANCEL("CancelledSlots",COUNT,"BeginTime"))
.S CANCEL("END DATE TIME")=$G(SLOTSTOCANCEL("CancelledSlots",COUNT,"EndTime"))
.D CANCEL^SDES2CANCLNAVAIL(.CANCELRETURN,.SDCONTEXT,.CANCEL)
Q
;
GETCANSLOTS(CLINICIEN,SLOTSTOCANCEL,INDEFINITE,ENDDATE,COUNT,SCHEDULEDATE,INPUTS,SDCONTEXT) ;
N CANSLOTS,JSON,SLOTS,NUM,SLOTNUM
;
I $$GET1^DIQ(44.005,$$ISOTFM^SDAMUTDT(SCHEDULEDATE)_","_CLINICIEN_",",1,"I")["CANCELLED" D Q
.S SLOTSTOCANCEL("CancelledSlots",1,"BeginTime")=SCHEDULEDATE
.S SLOTSTOCANCEL("CancelledSlots",1,"EndTime")=SCHEDULEDATE
;
S CANSLOTS("CLINICIEN")=CLINICIEN
S CANSLOTS("SDESSTART")=SCHEDULEDATE_"T"_"0001"_$$GETTZOFFSET^SDESUTIL($$ISOTFM^SDAMUTDT(SCHEDULEDATE),CLINICIEN)
S CANSLOTS("SDESENDDATE")=SCHEDULEDATE_"T"_2359_$$GETTZOFFSET^SDESUTIL($$ISOTFM^SDAMUTDT(SCHEDULEDATE),CLINICIEN)
D GETCANCSLOTS^SDES2GETCANSLOTS(.JSON,.SDCONTEXT,.CANSLOTS) K CANSLOTS
D DECODE^XLFJSON("JSON","SLOTS")
;
I $D(SLOTSTOCANCEL("CancelledSlots",1,"BeginTime")),$L($G(SLOTS("CancelledSlots",1,"BeginTime"))) D Q
.S NUM="",NUM=$O(SLOTSTOCANCEL("CancelledSlots",NUM),-1)
.S SLOTNUM=0
.F S SLOTNUM=$O(SLOTS("CancelledSlots",SLOTNUM)) Q:'SLOTNUM D
..S NUM=NUM+1
..S SLOTSTOCANCEL("CancelledSlots",NUM,"BeginTime")=$G(SLOTS("CancelledSlots",SLOTNUM,"BeginTime"))
..S SLOTSTOCANCEL("CancelledSlots",NUM,"EndTime")=$G(SLOTS("CancelledSlots",SLOTNUM,"EndTime"))
;
I $D(SLOTS("CancelledSlots",1,"BeginTime")) D
.M SLOTSTOCANCEL=SLOTS
;
S SCHEDULEDATE=$$FMADD^XLFDT(SCHEDULEDATE,7) K SLOTS
Q
;
VALIDATE(ERRORS,AVAILABILITY,CLINICIEN,CLINICSTARTHOUR,NUMBEROFENTRIES,INPUTS) ;
N FDATA,VAL,COUNT
;
D VALCONTEXT^SDES2VALCONTEXT(.ERRORS,.SDCONTEXT)
D VALFILEIEN^SDES2VALUTIL(.VAL,.ERRORS,44,$G(AVAILABILITY("CLINIC IEN")),1,,18,19)
I $D(ERRORS) Q
;
S CLINICIEN=$G(AVAILABILITY("CLINIC IEN"))
S CLINICSTARTHOUR=$$GET1^DIQ(44,CLINICIEN,1914,"I")
;
S NUMBEROFENTRIES=$O(AVAILABILITY("NUMBER OF SLOTS",""),-1)
I $O(AVAILABILITY("START DATE TIME",""),-1)'=NUMBEROFENTRIES!($O(AVAILABILITY("END DATE TIME",""),-1)'=NUMBEROFENTRIES) D ERRLOG^SDES2JSON(.ERRORS,580)
; Fix INPUTS Date/Time to remove ":" in the time
F COUNT=1:1:NUMBEROFENTRIES D
. S:$G(INPUTS("START DATE TIME",COUNT)) INPUTS("START DATE TIME",COUNT)=$TR($G(INPUTS("START DATE TIME",COUNT)),":","")
. S:$G(INPUTS("END DATE TIME",COUNT)) INPUTS("END DATE TIME",COUNT)=$TR($G(INPUTS("END DATE TIME",COUNT)),":","")
;
D VALFILEIEN^SDES2VALUTIL(.VAL,.ERRORS,44,CLINICIEN,1,,18,19)
D VALAPPTLENGTH(.ERRORS,$$GET1^DIQ(44,CLINICIEN,1912,"I"),CLINICIEN) Q:$D(ERRORS)
D VALSTARTHOUR^SDES2VAL44(.ERRORS,.CLINICSTARTHOUR)
D VALIDATESLOTS(.ERRORS,.AVAILABILITY)
D VALIDATEDATETIME(.ERRORS,CLINICIEN,.AVAILABILITY,NUMBEROFENTRIES)
D VALIDATEINDEF(.ERRORS,.AVAILABILITY)
D VALPATTERNS(CLINICIEN,.AVAILABILITY,.INPUTS,CLINICSTARTHOUR,NUMBEROFENTRIES)
Q
;
VALIDATEINDEF(ERRORS,AVAILABILITY) ;
S COUNT=0
F S COUNT=$O(AVAILABILITY("INDEFINITE",COUNT)) Q:'COUNT!($D(ERRORS)) D
.I $G(AVAILABILITY("INDEFINITE",COUNT))="" D ERRLOG^SDES2JSON(.ERRORS,592) Q
.I $G(AVAILABILITY("INDEFINITE",COUNT))'=1,$G(AVAILABILITY("INDEFINITE",COUNT))'=0 D ERRLOG^SDES2JSON(.ERRORS,591) Q
Q
;
VALAPPTLENGTH(ERRORS,LENGTH,CLINICIEN) ;
I LENGTH="" D ERRLOG^SDES2JSON(.ERRORS,115) Q
I ((LENGTH<10)!(LENGTH>240)) D ERRLOG^SDES2JSON(.ERRORS,116) Q
I (LENGTH#10'=0),(LENGTH#15'=0) D ERRLOG^SDES2JSON(.ERRORS,116) Q
Q
;
VALIDATESLOTS(ERRORS,AVAILABILITY) ;
N COUNT
;
S COUNT=0
F S COUNT=$O(AVAILABILITY("NUMBER OF SLOTS",COUNT)) Q:'COUNT D
.I $G(AVAILABILITY("NUMBER OF SLOTS",COUNT))="@" Q
.I $G(AVAILABILITY("NUMBER OF SLOTS",COUNT))<1!($G(AVAILABILITY("NUMBER OF SLOTS",COUNT))>26) D ERRLOG^SDES2JSON(.ERRORS,125)
Q
;
VALIDATEDATETIME(ERRORS,CLINICIEN,AVAILABILITY,NUMBEROFENTRIES) ;
N COUNT,TIMEZONEOFFSET,TIME
;
F COUNT=1:1:NUMBEROFENTRIES D Q:$D(ERRORS)
.I $G(AVAILABILITY("NUMBER OF SLOTS",COUNT))="@" Q
.;
.I $L($P($P($G(AVAILABILITY("START DATE TIME",COUNT)),"T",2),"-",2))!($L($P($P($G(AVAILABILITY("END DATE TIME",COUNT)),"T",2),"-",2))) D ERRLOG^SDES2JSON(.ERRORS,590)
.S TIMEZONEOFFSET=$$GETTZOFFSET^SDESUTIL($$ISOTFM^SDAMUTDT($P($G(AVAILABILITY("START DATE TIME",COUNT)),"T")),CLINICIEN)
.S AVAILABILITY("START DATE TIME",COUNT)=$G(AVAILABILITY("START DATE TIME",COUNT))_TIMEZONEOFFSET
.S AVAILABILITY("END DATE TIME",COUNT)=$G(AVAILABILITY("END DATE TIME",COUNT))_TIMEZONEOFFSET
.;
.D VALISODATERANGE^SDES2VALISODTTM(.ERRORS,$G(AVAILABILITY("START DATE TIME",COUNT)),$G(AVAILABILITY("END DATE TIME",COUNT)),1,CLINICIEN)
.S AVAILABILITY("START DATE TIME",COUNT)=$$ISOTFM^SDAMUTDT($G(AVAILABILITY("START DATE TIME",COUNT)),CLINICIEN)
.S AVAILABILITY("END DATE TIME",COUNT)=$$ISOTFM^SDAMUTDT($G(AVAILABILITY("END DATE TIME",COUNT)),CLINICIEN)
.I $G(AVAILABILITY("START DATE TIME",COUNT))<DT D ERRLOG^SDES2JSON(.ERRORS,71)
.;
.I $$GET1^DIQ(44,CLINICIEN,1914,"I")*100>+$E($P($G(AVAILABILITY("START DATE TIME",COUNT)),".",2)_"0000",1,4) D ERRLOG^SDES2JSON(.ERRORS,581)
.I '$$CHECKDURATION^SDES2UTIL1($G(AVAILABILITY("START DATE TIME",COUNT)),$G(AVAILABILITY("END DATE TIME",COUNT)),$$GET1^DIQ(44,CLINICIEN,1912,"I")) D ERRLOG^SDES2JSON(.ERRORS,582)
.I $$INACTIVE^SDESUTIL(CLINICIEN,$P($G(AVAILABILITY("START DATE TIME",COUNT)),".")) D ERRLOG^SDES2JSON(.ERRORS,583)
.I $$GET1^DIQ(44,CLINICIEN,1918.5,"I")'="Y",$D(^HOLIDAY($P($G(AVAILABILITY("START DATE TIME",COUNT)),"."),0)) D ERRLOG^SDES2JSON(.ERRORS,465)
Q
VALPATTERNS(CLINIEN,AVAILABILITY,INPUTS,STARTDAY,NUMBEROFENTRIES) ;
N SLT,DOW,DISPINCPERHR,COUNT,DATES,TIMES,SLOTSTOCANCEL,DONE
S SLT=$$GET1^DIQ(44,CLINIEN,1912,"I")
S DISPINCPERHR=$$GET1^DIQ(44,CLINIEN,1917,"I")
S COUNT=0,DONE=0
F D Q:COUNT=NUMBEROFENTRIES!(DONE=1)
.S COUNT=COUNT+1
.;I $G(SCHEDULEDDAYS)[$P($G(AVAILABILITY("START DATE TIME",COUNT)),"T") Q
.S DOW=$$DOW^XLFDT($P($G(AVAILABILITY("START DATE TIME",COUNT)),"."),1)
.D CREATEDATESTIMES(.DATES,.TIMES,.INPUTS,$P($G(INPUTS("START DATE TIME",COUNT)),"T"),NUMBEROFENTRIES,.SLOTSTOCANCEL)
.D CHECKLEN(CLINIEN,STARTDAY,SLT,DOW,,.DATES,.TIMES,DISPINCPERHR,,.ERRORS)
Q
CHECKLEN(DA,STARTDAY,SLT,DOW,INDEFINITEUNTIL,DATES,TIMES,SDDISPPERHR,SDRETURN,ERRORS) ;
;DA = Clinic IEN (SDCLINIC)
;SLT - Appointment length
N D0,X,CNT,STARTTIME,T1,T2,NSL,CTR,DR,HY,MAX,SC,SD,SDREB,SDSTRTDT,SDZQ,ST,STR,Y1,INDEFINITELY,STIME,PATTERNS
N POP,LT,H1,H2,M1,M2,SDTOP,SDREACT,X,SI,ZDX,DH,DO,D,Y,SDEL,HSI,SDJJ,HHY,SDIN,SDRE,SDRE1,I,OK,X1,X2,A,SDA1,SDSOH,RETURN
S POP=0
S STARTTIME=STARTDAY*100
S (HSI,SI)=$G(SDDISPPERHR,4)
S:SI=1 SI=4,HSI=1
S:SI=2 SI=4,HSI=2
;
S D0=""
F S (SD,D0)=$O(DATES(D0)) Q:D0="" D Q:POP
.Q:D0?7"9"
.S (CNT,INDEFINITELY)=0
.I $O(DATES(D0))?7"9" S INDEFINITELY=1
.S STARTTIME=""
.F S STARTTIME=$O(TIMES(STARTTIME)) Q:STARTTIME="" D Q:POP
..S X=TIMES(STARTTIME)
..S T2=$P($P(X,"^",1),"-",2)
..S NSL=$P(X,"^",2)
..S T1=STARTTIME
..D G3 ;Set up time slots in the T node
.;
.D:'POP G5 ;Set up pattern for the date
K DATES,TIMES
Q
;
G3 ;
;
S SDTOP=1 ;????
S SDZQ=1
;
S LT=T2,H1=$E(T1,1,2),H2=$E(T2,1,2),M1=$E(T1,3,4),M2=$E(T2,3,4)
S M2=M2-SLT
G3A I M2<0 S M2=M2+60,H2=H2-1 G G3A
S:M2?1N M2="0"_M2 S:H2?1N H2="0"_H2
G4 S CNT=CNT+1,PATTERNS(DA,"T",D0,2,CNT,0)=H1_M1_"^"_NSL ;^SC(DA,"T",D0,2,CNT,0)=H1_M1_"^"_NSL
S M1=M1+SLT
G4A I M1>59 S M1=M1-60,H1=H1+1 G G4A
S:M1?1N M1="0"_M1 S:H1?1N H1="0"_H1
I (H1_M1)>(H2_M2) Q
G G4
Q
;
G5 ;
S SDEL=0
G:'CNT DEL1:'$D(SDREACT),DEL1:'$D(SDTOP)&$D(SDREACT)&'CNT,C^SDB
S DH=SLT*SI\60
F X=0:0 S X=$O(PATTERNS(DA,"T",D0,2,X)) Q:X="" D
.S Y=PATTERNS(DA,"T",D0,2,X,0)
.F D=1:1:DH S Y(Y#100*SI\60+(Y\100*SI)-(STARTDAY*SI)+D)=$S($P(Y,U,2):$E("123456789jklmnopqrstuvwxyz",$P(Y,U,2)),1:0)
S (DH,DO,X)=""
I $D(Y)=1 S SDEL=1 G D
I $D(HSI) I HSI=1!(HSI=2) D CKSI1
F Y=1:1 S DH=$D(Y(Y)),X=X_$S('DH&DO:"]",'DO&DH:"[",Y#SI=1:"|",1:" ")_$S(DH:Y(Y),1:" "),DO=DH I 'DH,$O(Y(Y))="" Q
;
K Y
; always kill off the T subscript that was created
K PATTERNS
I SI+SI+$L(X)>80 S CNT=0,LT=$G(STIME),SDEL=0 S POP=1 D ERRLOG^SDES2JSON(.ERRORS,52,"Pattern exceeds 80 characters for date: "_$$FMTISO^SDAMUTDT(D0,DA)) Q
G D
CKSI1 F SDJJ=$O(Y(-1)):$S(HSI=1:4,1:2) Q:SDJJ>41 S:$D(Y(SDJJ)) HY(SDJJ)="" I '$D(Y(SDJJ)) Q:$O(Y(SDJJ))="" S SDJJ=$O(Y(SDJJ-1))-$S(HSI=1:4,1:2)
F HHY=0:0 S HHY=$O(Y(HHY)) Q:HHY="" I '$D(HY(HHY)) K Y(HHY)
Q
;
DEL1 S (DH,DO,X)="",SDEL=1
D I $D(SDIN),SDIN>D0 S SDRE1=$S(SDRE:SDRE,1:9999999)
S DH=X,OK=0,CTR=0
S SDSOH=$S('$D(^SC(DA,"SL")):0,$P(^SC(DA,"SL"),"^",8)']"":0,1:1)
F X=D0:0 S X=+$O(^SC(DA,"T",X)) Q:X'>0 D DOW^SDM0 I Y=DOW S Y=X,DO=Y G R
I X'>0,$D(SDIN),SDIN>D0 D
.S SDRE1=$S(SDRE=0:9999999,1:SDRE)
.S X=SDIN
.F I=0:1:6 D DOW^SDM0 S:Y=DOW OK=1 Q:OK S X1=X,X2=1 D C^%DTC Q:X>SDRE1
I OK S Y=X,DO=D0 G R
S DO=9999999
R K OK
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDES2CRTCLNAVAIL 13725 printed Sep 23, 2025@20:30:07 Page 2
SDES2CRTCLNAVAIL ;ALB/BLB,BWF,JDJ,TJB - SDES2 SET CLINIC AVAILABILITY ;MAR 12, 2025
+1 ;;5.3;Scheduling;**890,897,899,903**;Aug 13, 1993;Build 3
+2 ;;Per VHA Directive 6402, this routine should not be modified
+3 ;
+4 QUIT
+5 ;
CREATE(JSON,SDCONTEXT,AVAILABILITY) ;
+1 NEW ERRORS,RETURNAVAIL,CLINICIEN,CLINICSTARTHOUR,NUMBEROFENTRIES,INPUTS,INDEFINITEUNTIL,SDDISPPERHR,SDCLINSTARTHR,SLOTSTOCANCEL,%,%DT
+2 ;
+3 MERGE INPUTS=AVAILABILITY
+4 DO VALIDATE(.ERRORS,.AVAILABILITY,.CLINICIEN,.CLINICSTARTHOUR,.NUMBEROFENTRIES,.INPUTS)
+5 IF $DATA(ERRORS)
SET ERRORS("ClinicAvailability")=""
KILL COUNT,I
DO BUILDJSON^SDES2JSON(.JSON,.ERRORS)
QUIT
+6 ;
+7 DO CREATEAVAIL(.AVAILABILITY,.SDCONTEXT,.SLOTSTOCANCEL,CLINICIEN,CLINICSTARTHOUR,$$GET1^DIQ(44,CLINICIEN,1917,"I"),$$GET1^DIQ(44,CLINICIEN,1914,"I"),NUMBEROFENTRIES,.INPUTS,.INDEFINITEUNTIL,.RETURNAVAIL,.ERRORS)
+8 ;
+9 IF $LENGTH($GET(SLOTSTOCANCEL("CancelledSlots",1,"BeginTime")))
Begin DoDot:1
+10 DO RECANCELSLOTS(.SLOTSTOCANCEL,CLINICIEN,.SDCONTEXT)
KILL SLOTSTOCANCEL
End DoDot:1
+11 ;
+12 DO BUILDJSON^SDES2JSON(.JSON,.RETURNAVAIL)
+13 KILL COUNT,I
+14 QUIT
+15 ;
CREATEAVAIL(AVAILABILITY,SDCONTEXT,SLOTSTOCANCEL,CLINICIEN,CLINICSTARTHOUR,SDDISPPERHR,SDCLINSTARTHR,NUMBEROFENTRIES,INPUTS,INDEFINITEUNTIL,RETURNAVAIL,ERRORS) ;
+1 NEW COUNT,ENDDATE,DATES,TIMES,SCHEDULEDDAYS,DATENEXTTIMESLOT,CANSLOTSENDDATE,DONE,SDRETURN,SDONE,J,SDSAV,SDST1,SM,SS,SEQ,%H,ENDATE,SB
+2 ;
+3 SET COUNT=0
SET DONE=0
+4 FOR
Begin DoDot:1
+5 SET COUNT=COUNT+1
+6 IF $GET(SCHEDULEDDAYS)[$PIECE($GET(INPUTS("START DATE TIME",COUNT)),"T")
QUIT
+7 ;
+8 DO CREATEDATESTIMES(.DATES,.TIMES,.INPUTS,$PIECE($GET(INPUTS("START DATE TIME",COUNT)),"T"),NUMBEROFENTRIES,.SLOTSTOCANCEL)
+9 IF $DATA(SLOTSTOCANCEL("Error"))
MERGE RETURNAVAIL=SLOTSTOCANCEL
SET DONE=1
QUIT
+10 DO CREATE^SDES2UTIL1(CLINICIEN,CLINICSTARTHOUR,$$GET1^DIQ(44,CLINICIEN,1912,"I"),$$DOW^XLFDT($PIECE($GET(AVAILABILITY("START DATE TIME",COUNT)),"."),1),.INDEFINITEUNTIL,.DATES,.TIMES,SDDISPPERHR,.SDRETURN,.ERRORS)
KILL DATES,TIMES
+11 ;
+12 SET RETURNAVAIL("ClinicAvailability",COUNT,"Pattern")="Pattern Filed"
+13 IF $GET(INDEFINITEUNTIL)
Begin DoDot:2
+14 SET RETURNAVAIL("ClinicAvailability",COUNT,"DateIndefiniteScheduleEnds")=INDEFINITEUNTIL
KILL INDEFINITEUNTIL
End DoDot:2
+15 SET SCHEDULEDDAYS=$GET(SCHEDULEDDAYS)_$PIECE($GET(INPUTS("START DATE TIME",COUNT)),"T")_U
+16 ;
End DoDot:1
if COUNT=NUMBEROFENTRIES!(DONE=1)
QUIT
+17 QUIT
+18 ;
CREATEDATESTIMES(DATES,TIMES,INPUTS,AVAILABILITYDATE,NUMBEROFENTRIES,SLOTSTOCANCEL) ;
+1 NEW COUNT,SUBSCRIPT,STARTDATE,STARTTIME,ENDTIME,SLOTS,LASTTIMESLOTDATE,DONE,CANSLOTSENDDATE,DATENEXTTIMESLOT
+2 ;
+3 SET COUNT=0
+4 FOR
Begin DoDot:1
+5 SET COUNT=COUNT+1
+6 IF $PIECE($GET(INPUTS("START DATE TIME",COUNT)),"T")'=AVAILABILITYDATE
QUIT
+7 ;
+8 IF $GET(INPUTS("NUMBER OF SLOTS",COUNT))="@"
Begin DoDot:2
+9 SET DATES=$GET(INPUTS("START DATE TIME",COUNT))=""
SET DATES($$ISOTFM^SDAMUTDT(DATES))=""
SET TIMES=""
End DoDot:2
QUIT
+10 ;
+11 SET LASTTIMESLOTDATE=0
SET LASTTIMESLOTDATE=$ORDER(DATES(LASTTIMESLOTDATE))
+12 IF $GET(LASTTIMESLOTDATE)=$$ISOTFM^SDAMUTDT($PIECE($GET(INPUTS("START DATE TIME",COUNT)),"T"))!('$GET(LASTTIMESLOTDATE))
Begin DoDot:2
+13 SET DATES=$$ISOTFM^SDAMUTDT($PIECE($GET(INPUTS("START DATE TIME",COUNT)),"T"))
SET DATES(DATES)=""
+14 SET TIMES=$GET(TIMES)_$PIECE($GET(INPUTS("START DATE TIME",COUNT)),"T",2)_"-"_$PIECE($GET(INPUTS("END DATE TIME",COUNT)),"T",2)_";"
+15 SET TIMES($PIECE($GET(INPUTS("START DATE TIME",COUNT)),"T",2))=$PIECE($GET(INPUTS("START DATE TIME",COUNT)),"T",2)_"-"_$PIECE($GET(INPUTS("END DATE TIME",COUNT)),"T",2)_U_$GET(INPUTS("NUMBER OF SLOTS",COUNT))
End DoDot:2
+16 ;
+17 IF $GET(INPUTS("INDEFINITE",COUNT))
IF '$DATA(DATES(9999999))
Begin DoDot:2
+18 SET DATES=$GET(DATES)_";9999999"
SET DATES(9999999)=""
End DoDot:2
+19 ;
+20 SET DATENEXTTIMESLOT=$$ISOTFM^SDAMUTDT($PIECE($GET(INPUTS("START DATE TIME",COUNT)),"T"))
+21 SET CANSLOTSENDDATE=$SELECT($GET(AVAILABILITY("INDEFINITE",COUNT)):$$FMTISO^SDAMUTDT($$GETLASTINDEFDATE(CLINICIEN,DATENEXTTIMESLOT,$$GET1^DIQ(44,CLINICIEN,2002))),1:DATENEXTTIMESLOT)
+22 IF $GET(INPUTS("INDEFINITE",COUNT))
Begin DoDot:2
+23 SET DONE=0
+24 FOR
Begin DoDot:3
+25 DO GETCANSLOTS(CLINICIEN,.SLOTSTOCANCEL,$GET(AVAILABILITY("INDEFINITE",COUNT)),CANSLOTSENDDATE,COUNT,$$FMTISO^SDAMUTDT(DATENEXTTIMESLOT),.INPUTS,.SDCONTEXT)
+26 SET DATENEXTTIMESLOT=$$FMADD^XLFDT(DATENEXTTIMESLOT,7)
End DoDot:3
if DATENEXTTIMESLOT=$$ISOTFM^SDAMUTDT(CANSLOTSENDDATE)
QUIT
End DoDot:2
QUIT
+27 ;
+28 DO GETCANSLOTS(CLINICIEN,.SLOTSTOCANCEL,$GET(AVAILABILITY("INDEFINITE",COUNT)),CANSLOTSENDDATE,COUNT,$$FMTISO^SDAMUTDT(DATENEXTTIMESLOT),.INPUTS,.SDCONTEXT)
End DoDot:1
if COUNT=NUMBEROFENTRIES
QUIT
+29 ;
+30 SET TIMES=$EXTRACT($GET(TIMES),1,$LENGTH($GET(TIMES))-1)
+31 QUIT
+32 ;
GETLASTINDEFDATE(CLINICIEN,DATE,MAXBOOKINGDAYS) ;
+1 NEW FOUND,OSTDATE
+2 ;
+3 SET OSTDATE=DATE
SET FOUND=0
+4 FOR
Begin DoDot:1
+5 SET OSTDATE=$$FMADD^XLFDT(OSTDATE,7)
+6 IF $DATA(^SC(CLINICIEN,"OST",OSTDATE))
SET FOUND=1
End DoDot:1
if FOUND!(OSTDATE>$$FMADD^XLFDT(DT,MAXBOOKINGDAYS))
QUIT
+7 QUIT $GET(OSTDATE)
+8 ;
RECANCELSLOTS(SLOTSTOCANCEL,CLINICIEN,SDCONTEXT) ;
+1 NEW COUNT,CANCEL,CANCELRETURN
+2 ;
+3 SET COUNT=0
+4 FOR
SET COUNT=$ORDER(SLOTSTOCANCEL("CancelledSlots",COUNT))
if 'COUNT
QUIT
Begin DoDot:1
+5 SET CANCEL("CLINIC IEN")=CLINICIEN
+6 SET CANCEL("FULL PARTIAL FLAG")=$SELECT($GET(SLOTSTOCANCEL("CancelledSlots",COUNT,"BeginTime"))["T":"P",1:"F")
+7 SET CANCEL("START DATE TIME")=$GET(SLOTSTOCANCEL("CancelledSlots",COUNT,"BeginTime"))
+8 SET CANCEL("END DATE TIME")=$GET(SLOTSTOCANCEL("CancelledSlots",COUNT,"EndTime"))
+9 DO CANCEL^SDES2CANCLNAVAIL(.CANCELRETURN,.SDCONTEXT,.CANCEL)
End DoDot:1
+10 QUIT
+11 ;
GETCANSLOTS(CLINICIEN,SLOTSTOCANCEL,INDEFINITE,ENDDATE,COUNT,SCHEDULEDATE,INPUTS,SDCONTEXT) ;
+1 NEW CANSLOTS,JSON,SLOTS,NUM,SLOTNUM
+2 ;
+3 IF $$GET1^DIQ(44.005,$$ISOTFM^SDAMUTDT(SCHEDULEDATE)_","_CLINICIEN_",",1,"I")["CANCELLED"
Begin DoDot:1
+4 SET SLOTSTOCANCEL("CancelledSlots",1,"BeginTime")=SCHEDULEDATE
+5 SET SLOTSTOCANCEL("CancelledSlots",1,"EndTime")=SCHEDULEDATE
End DoDot:1
QUIT
+6 ;
+7 SET CANSLOTS("CLINICIEN")=CLINICIEN
+8 SET CANSLOTS("SDESSTART")=SCHEDULEDATE_"T"_"0001"_$$GETTZOFFSET^SDESUTIL($$ISOTFM^SDAMUTDT(SCHEDULEDATE),CLINICIEN)
+9 SET CANSLOTS("SDESENDDATE")=SCHEDULEDATE_"T"_2359_$$GETTZOFFSET^SDESUTIL($$ISOTFM^SDAMUTDT(SCHEDULEDATE),CLINICIEN)
+10 DO GETCANCSLOTS^SDES2GETCANSLOTS(.JSON,.SDCONTEXT,.CANSLOTS)
KILL CANSLOTS
+11 DO DECODE^XLFJSON("JSON","SLOTS")
+12 ;
+13 IF $DATA(SLOTSTOCANCEL("CancelledSlots",1,"BeginTime"))
IF $LENGTH($GET(SLOTS("CancelledSlots",1,"BeginTime")))
Begin DoDot:1
+14 SET NUM=""
SET NUM=$ORDER(SLOTSTOCANCEL("CancelledSlots",NUM),-1)
+15 SET SLOTNUM=0
+16 FOR
SET SLOTNUM=$ORDER(SLOTS("CancelledSlots",SLOTNUM))
if 'SLOTNUM
QUIT
Begin DoDot:2
+17 SET NUM=NUM+1
+18 SET SLOTSTOCANCEL("CancelledSlots",NUM,"BeginTime")=$GET(SLOTS("CancelledSlots",SLOTNUM,"BeginTime"))
+19 SET SLOTSTOCANCEL("CancelledSlots",NUM,"EndTime")=$GET(SLOTS("CancelledSlots",SLOTNUM,"EndTime"))
End DoDot:2
End DoDot:1
QUIT
+20 ;
+21 IF $DATA(SLOTS("CancelledSlots",1,"BeginTime"))
Begin DoDot:1
+22 MERGE SLOTSTOCANCEL=SLOTS
End DoDot:1
+23 ;
+24 SET SCHEDULEDATE=$$FMADD^XLFDT(SCHEDULEDATE,7)
KILL SLOTS
+25 QUIT
+26 ;
VALIDATE(ERRORS,AVAILABILITY,CLINICIEN,CLINICSTARTHOUR,NUMBEROFENTRIES,INPUTS) ;
+1 NEW FDATA,VAL,COUNT
+2 ;
+3 DO VALCONTEXT^SDES2VALCONTEXT(.ERRORS,.SDCONTEXT)
+4 DO VALFILEIEN^SDES2VALUTIL(.VAL,.ERRORS,44,$GET(AVAILABILITY("CLINIC IEN")),1,,18,19)
+5 IF $DATA(ERRORS)
QUIT
+6 ;
+7 SET CLINICIEN=$GET(AVAILABILITY("CLINIC IEN"))
+8 SET CLINICSTARTHOUR=$$GET1^DIQ(44,CLINICIEN,1914,"I")
+9 ;
+10 SET NUMBEROFENTRIES=$ORDER(AVAILABILITY("NUMBER OF SLOTS",""),-1)
+11 IF $ORDER(AVAILABILITY("START DATE TIME",""),-1)'=NUMBEROFENTRIES!($ORDER(AVAILABILITY("END DATE TIME",""),-1)'=NUMBEROFENTRIES)
DO ERRLOG^SDES2JSON(.ERRORS,580)
+12 ; Fix INPUTS Date/Time to remove ":" in the time
+13 FOR COUNT=1:1:NUMBEROFENTRIES
Begin DoDot:1
+14 if $GET(INPUTS("START DATE TIME",COUNT))
SET INPUTS("START DATE TIME",COUNT)=$TRANSLATE($GET(INPUTS("START DATE TIME",COUNT)),":","")
+15 if $GET(INPUTS("END DATE TIME",COUNT))
SET INPUTS("END DATE TIME",COUNT)=$TRANSLATE($GET(INPUTS("END DATE TIME",COUNT)),":","")
End DoDot:1
+16 ;
+17 DO VALFILEIEN^SDES2VALUTIL(.VAL,.ERRORS,44,CLINICIEN,1,,18,19)
+18 DO VALAPPTLENGTH(.ERRORS,$$GET1^DIQ(44,CLINICIEN,1912,"I"),CLINICIEN)
if $DATA(ERRORS)
QUIT
+19 DO VALSTARTHOUR^SDES2VAL44(.ERRORS,.CLINICSTARTHOUR)
+20 DO VALIDATESLOTS(.ERRORS,.AVAILABILITY)
+21 DO VALIDATEDATETIME(.ERRORS,CLINICIEN,.AVAILABILITY,NUMBEROFENTRIES)
+22 DO VALIDATEINDEF(.ERRORS,.AVAILABILITY)
+23 DO VALPATTERNS(CLINICIEN,.AVAILABILITY,.INPUTS,CLINICSTARTHOUR,NUMBEROFENTRIES)
+24 QUIT
+25 ;
VALIDATEINDEF(ERRORS,AVAILABILITY) ;
+1 SET COUNT=0
+2 FOR
SET COUNT=$ORDER(AVAILABILITY("INDEFINITE",COUNT))
if 'COUNT!($DATA(ERRORS))
QUIT
Begin DoDot:1
+3 IF $GET(AVAILABILITY("INDEFINITE",COUNT))=""
DO ERRLOG^SDES2JSON(.ERRORS,592)
QUIT
+4 IF $GET(AVAILABILITY("INDEFINITE",COUNT))'=1
IF $GET(AVAILABILITY("INDEFINITE",COUNT))'=0
DO ERRLOG^SDES2JSON(.ERRORS,591)
QUIT
End DoDot:1
+5 QUIT
+6 ;
VALAPPTLENGTH(ERRORS,LENGTH,CLINICIEN) ;
+1 IF LENGTH=""
DO ERRLOG^SDES2JSON(.ERRORS,115)
QUIT
+2 IF ((LENGTH<10)!(LENGTH>240))
DO ERRLOG^SDES2JSON(.ERRORS,116)
QUIT
+3 IF (LENGTH#10'=0)
IF (LENGTH#15'=0)
DO ERRLOG^SDES2JSON(.ERRORS,116)
QUIT
+4 QUIT
+5 ;
VALIDATESLOTS(ERRORS,AVAILABILITY) ;
+1 NEW COUNT
+2 ;
+3 SET COUNT=0
+4 FOR
SET COUNT=$ORDER(AVAILABILITY("NUMBER OF SLOTS",COUNT))
if 'COUNT
QUIT
Begin DoDot:1
+5 IF $GET(AVAILABILITY("NUMBER OF SLOTS",COUNT))="@"
QUIT
+6 IF $GET(AVAILABILITY("NUMBER OF SLOTS",COUNT))<1!($GET(AVAILABILITY("NUMBER OF SLOTS",COUNT))>26)
DO ERRLOG^SDES2JSON(.ERRORS,125)
End DoDot:1
+7 QUIT
+8 ;
VALIDATEDATETIME(ERRORS,CLINICIEN,AVAILABILITY,NUMBEROFENTRIES) ;
+1 NEW COUNT,TIMEZONEOFFSET,TIME
+2 ;
+3 FOR COUNT=1:1:NUMBEROFENTRIES
Begin DoDot:1
+4 IF $GET(AVAILABILITY("NUMBER OF SLOTS",COUNT))="@"
QUIT
+5 ;
+6 IF $LENGTH($PIECE($PIECE($GET(AVAILABILITY("START DATE TIME",COUNT)),"T",2),"-",2))!($LENGTH($PIECE($PIECE($GET(AVAILABILITY("END DATE TIME",COUNT)),"T",2),"-",2)))
DO ERRLOG^SDES2JSON(.ERRORS,590)
+7 SET TIMEZONEOFFSET=$$GETTZOFFSET^SDESUTIL($$ISOTFM^SDAMUTDT($PIECE($GET(AVAILABILITY("START DATE TIME",COUNT)),"T")),CLINICIEN)
+8 SET AVAILABILITY("START DATE TIME",COUNT)=$GET(AVAILABILITY("START DATE TIME",COUNT))_TIMEZONEOFFSET
+9 SET AVAILABILITY("END DATE TIME",COUNT)=$GET(AVAILABILITY("END DATE TIME",COUNT))_TIMEZONEOFFSET
+10 ;
+11 DO VALISODATERANGE^SDES2VALISODTTM(.ERRORS,$GET(AVAILABILITY("START DATE TIME",COUNT)),$GET(AVAILABILITY("END DATE TIME",COUNT)),1,CLINICIEN)
+12 SET AVAILABILITY("START DATE TIME",COUNT)=$$ISOTFM^SDAMUTDT($GET(AVAILABILITY("START DATE TIME",COUNT)),CLINICIEN)
+13 SET AVAILABILITY("END DATE TIME",COUNT)=$$ISOTFM^SDAMUTDT($GET(AVAILABILITY("END DATE TIME",COUNT)),CLINICIEN)
+14 IF $GET(AVAILABILITY("START DATE TIME",COUNT))<DT
DO ERRLOG^SDES2JSON(.ERRORS,71)
+15 ;
+16 IF $$GET1^DIQ(44,CLINICIEN,1914,"I")*100>+$EXTRACT($PIECE($GET(AVAILABILITY("START DATE TIME",COUNT)),".",2)_"0000",1,4)
DO ERRLOG^SDES2JSON(.ERRORS,581)
+17 IF '$$CHECKDURATION^SDES2UTIL1($GET(AVAILABILITY("START DATE TIME",COUNT)),$GET(AVAILABILITY("END DATE TIME",COUNT)),$$GET1^DIQ(44,CLINICIEN,1912,"I"))
DO ERRLOG^SDES2JSON(.ERRORS,582)
+18 IF $$INACTIVE^SDESUTIL(CLINICIEN,$PIECE($GET(AVAILABILITY("START DATE TIME",COUNT)),"."))
DO ERRLOG^SDES2JSON(.ERRORS,583)
+19 IF $$GET1^DIQ(44,CLINICIEN,1918.5,"I")'="Y"
IF $DATA(^HOLIDAY($PIECE($GET(AVAILABILITY("START DATE TIME",COUNT)),"."),0))
DO ERRLOG^SDES2JSON(.ERRORS,465)
End DoDot:1
if $DATA(ERRORS)
QUIT
+20 QUIT
VALPATTERNS(CLINIEN,AVAILABILITY,INPUTS,STARTDAY,NUMBEROFENTRIES) ;
+1 NEW SLT,DOW,DISPINCPERHR,COUNT,DATES,TIMES,SLOTSTOCANCEL,DONE
+2 SET SLT=$$GET1^DIQ(44,CLINIEN,1912,"I")
+3 SET DISPINCPERHR=$$GET1^DIQ(44,CLINIEN,1917,"I")
+4 SET COUNT=0
SET DONE=0
+5 FOR
Begin DoDot:1
+6 SET COUNT=COUNT+1
+7 ;I $G(SCHEDULEDDAYS)[$P($G(AVAILABILITY("START DATE TIME",COUNT)),"T") Q
+8 SET DOW=$$DOW^XLFDT($PIECE($GET(AVAILABILITY("START DATE TIME",COUNT)),"."),1)
+9 DO CREATEDATESTIMES(.DATES,.TIMES,.INPUTS,$PIECE($GET(INPUTS("START DATE TIME",COUNT)),"T"),NUMBEROFENTRIES,.SLOTSTOCANCEL)
+10 DO CHECKLEN(CLINIEN,STARTDAY,SLT,DOW,,.DATES,.TIMES,DISPINCPERHR,,.ERRORS)
End DoDot:1
if COUNT=NUMBEROFENTRIES!(DONE=1)
QUIT
+11 QUIT
CHECKLEN(DA,STARTDAY,SLT,DOW,INDEFINITEUNTIL,DATES,TIMES,SDDISPPERHR,SDRETURN,ERRORS) ;
+1 ;DA = Clinic IEN (SDCLINIC)
+2 ;SLT - Appointment length
+3 NEW D0,X,CNT,STARTTIME,T1,T2,NSL,CTR,DR,HY,MAX,SC,SD,SDREB,SDSTRTDT,SDZQ,ST,STR,Y1,INDEFINITELY,STIME,PATTERNS
+4 NEW POP,LT,H1,H2,M1,M2,SDTOP,SDREACT,X,SI,ZDX,DH,DO,D,Y,SDEL,HSI,SDJJ,HHY,SDIN,SDRE,SDRE1,I,OK,X1,X2,A,SDA1,SDSOH,RETURN
+5 SET POP=0
+6 SET STARTTIME=STARTDAY*100
+7 SET (HSI,SI)=$GET(SDDISPPERHR,4)
+8 if SI=1
SET SI=4
SET HSI=1
+9 if SI=2
SET SI=4
SET HSI=2
+10 ;
+11 SET D0=""
+12 FOR
SET (SD,D0)=$ORDER(DATES(D0))
if D0=""
QUIT
Begin DoDot:1
+13 if D0?7"9"
QUIT
+14 SET (CNT,INDEFINITELY)=0
+15 IF $ORDER(DATES(D0))?7"9"
SET INDEFINITELY=1
+16 SET STARTTIME=""
+17 FOR
SET STARTTIME=$ORDER(TIMES(STARTTIME))
if STARTTIME=""
QUIT
Begin DoDot:2
+18 SET X=TIMES(STARTTIME)
+19 SET T2=$PIECE($PIECE(X,"^",1),"-",2)
+20 SET NSL=$PIECE(X,"^",2)
+21 SET T1=STARTTIME
+22 ;Set up time slots in the T node
DO G3
End DoDot:2
if POP
QUIT
+23 ;
+24 ;Set up pattern for the date
if 'POP
DO G5
End DoDot:1
if POP
QUIT
+25 KILL DATES,TIMES
+26 QUIT
+27 ;
G3 ;
+1 ;
+2 ;????
SET SDTOP=1
+3 SET SDZQ=1
+4 ;
+5 SET LT=T2
SET H1=$EXTRACT(T1,1,2)
SET H2=$EXTRACT(T2,1,2)
SET M1=$EXTRACT(T1,3,4)
SET M2=$EXTRACT(T2,3,4)
+6 SET M2=M2-SLT
G3A IF M2<0
SET M2=M2+60
SET H2=H2-1
GOTO G3A
+1 if M2?1N
SET M2="0"_M2
if H2?1N
SET H2="0"_H2
G4 ;^SC(DA,"T",D0,2,CNT,0)=H1_M1_"^"_NSL
SET CNT=CNT+1
SET PATTERNS(DA,"T",D0,2,CNT,0)=H1_M1_"^"_NSL
+1 SET M1=M1+SLT
G4A IF M1>59
SET M1=M1-60
SET H1=H1+1
GOTO G4A
+1 if M1?1N
SET M1="0"_M1
if H1?1N
SET H1="0"_H1
+2 IF (H1_M1)>(H2_M2)
QUIT
+3 GOTO G4
+4 QUIT
+5 ;
G5 ;
+1 SET SDEL=0
+2 if 'CNT
if '$DATA(SDREACT)
GOTO DEL1
if '$DATA(SDTOP)&$DATA(SDREACT)&'CNT
GOTO DEL1
GOTO C^SDB
+3 SET DH=SLT*SI\60
+4 FOR X=0:0
SET X=$ORDER(PATTERNS(DA,"T",D0,2,X))
if X=""
QUIT
Begin DoDot:1
+5 SET Y=PATTERNS(DA,"T",D0,2,X,0)
+6 FOR D=1:1:DH
SET Y(Y#100*SI\60+(Y\100*SI)-(STARTDAY*SI)+D)=$SELECT($PIECE(Y,U,2):$EXTRACT("123456789jklmnopqrstuvwxyz",$PIECE(Y,U,2)),1:0)
End DoDot:1
+7 SET (DH,DO,X)=""
+8 IF $DATA(Y)=1
SET SDEL=1
GOTO D
+9 IF $DATA(HSI)
IF HSI=1!(HSI=2)
DO CKSI1
+10 FOR Y=1:1
SET DH=$DATA(Y(Y))
SET X=X_$SELECT('DH&DO:"]",'DO&DH:"[",Y#SI=1:"|",1:" ")_$SELECT(DH:Y(Y),1:" ")
SET DO=DH
IF 'DH
IF $ORDER(Y(Y))=""
QUIT
+11 ;
+12 KILL Y
+13 ; always kill off the T subscript that was created
+14 KILL PATTERNS
+15 IF SI+SI+$LENGTH(X)>80
SET CNT=0
SET LT=$GET(STIME)
SET SDEL=0
SET POP=1
DO ERRLOG^SDES2JSON(.ERRORS,52,"Pattern exceeds 80 characters for date: "_$$FMTISO^SDAMUTDT(D0,DA))
QUIT
+16 GOTO D
CKSI1 FOR SDJJ=$ORDER(Y(-1)):$SELECT(HSI=1:4,1:2)
if SDJJ>41
QUIT
if $DATA(Y(SDJJ))
SET HY(SDJJ)=""
IF '$DATA(Y(SDJJ))
if $ORDER(Y(SDJJ))=""
QUIT
SET SDJJ=$ORDER(Y(SDJJ-1))-$SELECT(HSI=1:4,1:2)
+1 FOR HHY=0:0
SET HHY=$ORDER(Y(HHY))
if HHY=""
QUIT
IF '$DATA(HY(HHY))
KILL Y(HHY)
+2 QUIT
+3 ;
DEL1 SET (DH,DO,X)=""
SET SDEL=1
D IF $DATA(SDIN)
IF SDIN>D0
SET SDRE1=$SELECT(SDRE:SDRE,1:9999999)
+1 SET DH=X
SET OK=0
SET CTR=0
+2 SET SDSOH=$SELECT('$DATA(^SC(DA,"SL")):0,$PIECE(^SC(DA,"SL"),"^",8)']"":0,1:1)
+3 FOR X=D0:0
SET X=+$ORDER(^SC(DA,"T",X))
if X'>0
QUIT
DO DOW^SDM0
IF Y=DOW
SET Y=X
SET DO=Y
GOTO R
+4 IF X'>0
IF $DATA(SDIN)
IF SDIN>D0
Begin DoDot:1
+5 SET SDRE1=$SELECT(SDRE=0:9999999,1:SDRE)
+6 SET X=SDIN
+7 FOR I=0:1:6
DO DOW^SDM0
if Y=DOW
SET OK=1
if OK
QUIT
SET X1=X
SET X2=1
DO C^%DTC
if X>SDRE1
QUIT
End DoDot:1
+8 IF OK
SET Y=X
SET DO=D0
GOTO R
+9 SET DO=9999999
R KILL OK
