SDES2REMAP ;ALB/BWF/JAS - REMAP DIVISION/CLINIC ; MAY 21, 2025
;;5.3;Scheduling;**908**;Aug 13, 1993;Build 2
;;Per VHA Directive 6402, this routine should not be modified
;
Q
;
; SDCONTEXT - standard SDCONTEXT input array
;
; SDINPUT("DIVISION","ALL") - Only used to re-map all divisions
; This should only be passed if 'ALL' divisions are being re-mapped
;
; When re-mapping 'ALL' clinics, or a clinic list within
; a specific DIVISION, pass in the following:
; SDINPUT("DIVISION",DIVISION IEN,"CLINIC","ALL")="" - re-maps all clinics within the division
; SDINPUT("DIVISION",DIVISION IEN,"CLINIC",CLINICIEN)="" - list of clinics to remap
;
; When re-mapping a list of clinics that are not associated
; with a single division, send in a list of just the clinics
; being remapped:
; SDINPUT("CLINIC",CLINIC IEN)="" - required, if division is not passed
;
; SDINPUT("START DATE")=ISO START DATE (i.e. 2024-12-01) - required, re-map start date
; SDINPUT("END DATE")=ISO END DATE (i.e. 2024-12-30) - required, re-map end date
;
REMAP(RESULT,SDCONTEXT,SDINPUT) ;
N ERRORS,VALDATES,STARTDATE,ENDDATE,QUEUEREMAP,TASKRES,GBL,SDUSER
N %,D,D0,D1,D2,DG,DIC,DICR,DIW,SEQ,SEQ1,XMDUN,XMZ,Y
S QUEUEREMAP=0
D VALCONTEXT^SDES2VALCONTEXT(.ERRORS,.SDCONTEXT)
I $D(ERRORS) D Q
.S ERRORS("ClinicRemap",1)=""
.D BUILDJSON^SDES2JSON(.RESULT,.ERRORS)
;
; validate start/end date
S VALDATES=$$VALISODATERANGE^SDES2VALISODTTM(.ERRORS,$G(SDINPUT("START DATE")),$G(SDINPUT("END DATE")),1)
S STARTDATE=$P(VALDATES,U)
S ENDDATE=$P(VALDATES,U,2)
S SDUSER=$S($G(SDCONTEXT("USER DUZ")):SDCONTEXT("USER DUZ"),1:DUZ)
;
I $D(ERRORS) D Q
.S ERRORS("ClinicRemap",1)=""
.D BUILDJSON^SDES2JSON(.RESULT,.ERRORS)
;
D VALIDATE^SDES2REMAPUTIL(.ERRORS,.SDINPUT,.QUEUEREMAP)
I $D(ERRORS) D Q
.S ERRORS("ClinicRemap",1)=""
.D BUILDJSON^SDES2JSON(.RESULT,.ERRORS)
;
; queue remap in background if QUEUEREMAP=1
I QUEUEREMAP D Q
.D TASKREMAP^SDES2REMAPUTIL(.SDINPUT,STARTDATE,ENDDATE,.TASKRES,SDUSER)
.I '$D(TASKRES) S TASKRES("ClinicRemap",1)=""
.D BUILDJSON^SDES2JSON(.RESULT,.TASKRES)
;
S GBL=$NA(^TMP("SDES2REMAP",$J)) K @GBL
D REMAPFOREGROUND(.GBL,SDUSER)
M TASKRES("ClinicRemap","Status")=^TMP("SDES2REMAP",$J)
D BUILDJSON^SDES2JSON(.RESULT,.TASKRES)
Q
;
REMAPFOREGROUND(GBL,SDUSER) ;
N DIVISIONIEN,CLINICIEN,TMPCOUNT
S (DIVISIONIEN,TMPCOUNT)=0
; build report header
D HEADER^SDES2REMAPUTIL(.GBL,.TMPCOUNT)
I $D(SDINPUT("DIVISION")) D Q
.F S DIVISIONIEN=$O(SDINPUT("DIVISION",DIVISIONIEN)) Q:'DIVISIONIEN D
..; process all clinics
..I $D(SDINPUT("DIVISION",DIVISIONIEN,"CLINIC","ALL")) D Q
...S CLINICIEN=0
...F S CLINICIEN=$O(^SC(CLINICIEN)) Q:'CLINICIEN D
....Q:'$$CLINDIVCHECK^SDES2REMAPUTIL(DIVISIONIEN,CLINICIEN)
....D REMAPCLIN(.GBL,CLINICIEN,STARTDATE,ENDDATE,.TMPCOUNT)
...D MAIL^SDES2REMAPUTIL(GBL,SDUSER)
..; process clinics in the list
..S CLINICIEN=0
..F S CLINICIEN=$O(SDINPUT("DIVISION",DIVISIONIEN,"CLINIC",CLINICIEN)) Q:'CLINICIEN D
...Q:'$$CLINDIVCHECK^SDES2REMAPUTIL(DIVISIONIEN,CLINICIEN)
...D REMAPCLIN(.GBL,CLINICIEN,STARTDATE,ENDDATE,.TMPCOUNT)
..D MAIL^SDES2REMAPUTIL(GBL,SDUSER)
;
I $D(SDINPUT("CLINIC")) D Q
.S CLINIEN=0 F S CLINIEN=$O(SDINPUT("CLINIC",CLINIEN)) Q:'CLINIEN D
..Q:$$GET1^DIQ(44,CLINIEN,2,"I")'="C"
..Q:$$INACTIVE^SDES2UTIL(CLINIEN,DT)
..D REMAPCLIN(.GBL,CLINIEN,STARTDATE,ENDDATE,.TMPCOUNT)
.D MAIL^SDES2REMAPUTIL(GBL,SDUSER)
Q
;
REMAPCLIN(GBL,CLINICIEN,STARTDATE,ENDDATE,TMPCOUNT) ;
N CLINICNAME,SCHEDONHOLIDAY,STARTOFDAY,DISPINCPERHOUR,SDDAYOFWEEK,SDBEGO,SDX,REMAPDATE,DONE,ACTIVEAPPTS,X,AVAILABILITY,REMAPDAY,CLINTMPCNT
N CLINGBL,FIRSTAPPTDTTM,PATTERNFILE,REMAPDAYNAME,SPECPATTERN,STDEFINED,SAVECAN,MASTERPATTERN,NEWPATTERN,HOURBEFORESTART,CLINAPPTLENGTH,SDSI
N SDBEG,SDBEGZ,SDCNT,SDDAY,SDDOW,HSI,PATTERNDATE,DIVNAME
S CLINGBL=$NA(^TMP("SDES2REMAPCLINIC",$J)) K @CLINGBL
S CLINTMPCNT=0
S CLINAPPTLENGTH=$$GET1^DIQ(44,CLINICIEN,1912,"I") ; previously SL
S CLINICNAME=$$GET1^DIQ(44,CLINICIEN,.01,"E")
S SCHEDONHOLIDAY=$$GET1^DIQ(44,CLINICIEN,1918.5,"I")
S SCHEDONHOLIDAY=$S(SCHEDONHOLIDAY="Y":1,1:0)
S STARTOFDAY=$$GET1^DIQ(44,CLINICIEN,1914,"I")
S DIVNAME=$$GET1^DIQ(44,CLINICIEN,3.5,"E")
I $G(STARTOFDAY)="" S STARTOFDAY=8
S DISPINCPERHOUR=$$GET1^DIQ(44,CLINICIEN,1917,"I") ; formerly SI
S HSI=$S('DISPINCPERHOUR:4,DISPINCPERHOUR<3:8/DISPINCPERHOUR,1:2)
S SDSI=DISPINCPERHOUR
S DISPINCPERHOUR=$S(DISPINCPERHOUR:DISPINCPERHOUR,1:4) ; formerly SDSI
S DISPINCPERHOUR=$S(DISPINCPERHOUR=1:4,DISPINCPERHOUR=2:4,1:DISPINCPERHOUR)
; grab the hour before 'hour clinic display begins'
S HOURBEFORESTART=STARTOFDAY-1/100
;
;
; build clinic specific report header
D HEADER^SDES2REMAPUTIL(.CLINGBL,.CLINTMPCNT)
;
; code needed for SDDOW array
;Set beginning date to use for indefinite clinic availabilities
F SDDAYOFWEEK=0:1:6 S SDDOW(SDDAYOFWEEK,9999999)="" ;SD*5.3*674
S SDBEGO="" F SDDAY=0:1:6 S SDCNT=0 F S SDCNT=$O(^SC(CLINICIEN,"T"_SDDAY,SDCNT)) Q:'SDCNT S SDBEGO=SDBEGO_U_SDCNT
S SDX=0 F S SDX=$O(^SC(CLINICIEN,"T",SDX)) Q:'SDX!(SDX>ENDDATE) S SDBEGZ=$O(^SC(CLINICIEN,"T"_$$DOW^XLFDT(SDX,1),9999999),-1) D ;Add SDBEGZ to check for duplicate OST entry
.I '$D(^SC(CLINICIEN,"OST",SDX))!(SDBEGO[SDX)!(SDBEGZ=0)!($G(^SC(CLINICIEN,"T"_$$DOW^XLFDT(SDX,1),9999999))=""&(SDBEGZ>0)) S SDBEG=$G(^SC(CLINICIEN,"T",SDX,0),SDX) S SDDOW($$DOW^XLFDT(SDBEG,1),SDBEG)="" ;SD*5.3*674 and SD*5.3*726
S REMAPDATE=$$FMADD^XLFDT(STARTDATE,-1)
S DONE=0
F D Q:DONE
.S REMAPDATE=$$FMADD^XLFDT(REMAPDATE,1)
.I REMAPDATE>ENDDATE S DONE=1 Q
.S ACTIVEAPPTS=$$ACTIVEAPPTS^SDES2REMAPUTIL(CLINICIEN,REMAPDATE,.FIRSTAPPTDTTM)
.S AVAILABILITY=$$GET1^DIQ(44.005,REMAPDATE_","_CLINICIEN_",",1,"E")
.S REMAPDAY=$$DOW^XLFDT(REMAPDATE,1)
.S REMAPDAYNAME=$P("SUN^MON^TUES^WEDNES^THURS^FRI^SATUR",U,REMAPDAY+1)
.S STDEFINED=$D(^SC(CLINICIEN,"ST",REMAPDATE))
.; day doesn't match
.I $D(^SC(CLINICIEN,"ST",REMAPDATE,1)),AVAILABILITY'[$E(REMAPDAYNAME,1,2)&(AVAILABILITY["]") D Q
..D LOGDATA^SDES2REMAPUTIL(.GBL,.CLINGBL,.TMPCOUNT,.CLINTMPCNT,CLINICNAME,DIVNAME,REMAPDATE,SCHEDONHOLIDAY,ACTIVEAPPTS,REMAPDAYNAME,"Bogus clinic day"_$S(ACTIVEAPPTS:"- Appts!",1:""))
.; canceled this day
.I $D(^SC(CLINICIEN,"ST",REMAPDATE,1)),AVAILABILITY["CANCEL"!($E(AVAILABILITY,$F(AVAILABILITY,"["),999)?."X") D Q
..D LOGDATA^SDES2REMAPUTIL(.GBL,.CLINGBL,.TMPCOUNT,.CLINTMPCNT,CLINICNAME,DIVNAME,REMAPDATE,SCHEDONHOLIDAY,ACTIVEAPPTS,REMAPDAYNAME,"Cancelled")
.; update holiday schedule
.I $D(^HOLIDAY(REMAPDATE,0)),'SCHEDONHOLIDAY D Q
..I 'ACTIVEAPPTS D Q
...D NOSCHHOLIDAY(CLINICIEN,REMAPDATE,ACTIVEAPPTS,.GBL,.CLINGBL,CLINICNAME,DIVNAME,.TMPCOUNT,.CLINTMPCNT,SCHEDONHOLIDAY,REMAPDAYNAME)
..D LOGDATA^SDES2REMAPUTIL(.GBL,.CLINGBL,.TMPCOUNT,.CLINTMPCNT,CLINICNAME,DIVNAME,REMAPDATE,SCHEDONHOLIDAY,ACTIVEAPPTS,REMAPDAYNAME)
.S SAVECAN=$G(^SC(CLINICIEN,"ST",REMAPDATE,"CAN"))
.S FDA(44.005,REMAPDATE_","_CLINICIEN_",",.01)="@"
.D FILE^DIE(,"FDA") K FDA
.S PATTERNDATE=+$O(^SC(CLINICIEN,"T"_REMAPDAY,REMAPDATE))
.;
.; handle OST pattern
.;
.I $D(^SC(CLINICIEN,"OST",REMAPDATE,1)) D Q
..S (SPECPATTERN,NEWPATTERN)=$$GET1^DIQ(44.0002,REMAPDATE_","_CLINICIEN_",",1,"E")
..I SPECPATTERN="" Q
..S PATTERNDATE=0
..; rebuild pattern and file
..D REBUILDPATTERN(CLINICIEN,.NEWPATTERN,SPECPATTERN,REMAPDATE,REMAPDAY,DISPINCPERHOUR,FIRSTAPPTDTTM,CLINAPPTLENGTH,HSI,SDSI,HOURBEFORESTART)
..D FILEPATTERN(CLINICIEN,NEWPATTERN,REMAPDATE,.SDDOW,PATTERNDATE,SAVECAN)
..I ACTIVEAPPTS D LOGDATA^SDES2REMAPUTIL(.GBL,.CLINGBL,.TMPCOUNT,.CLINTMPCNT,CLINICNAME,DIVNAME,REMAPDATE,SCHEDONHOLIDAY,ACTIVEAPPTS,REMAPDAYNAME)
.S PATTERNFILE=$S(REMAPDAY=0:44.06,REMAPDAY=1:44.07,REMAPDAY=2:44.08,REMAPDAY=3:44.09,REMAPDAY=4:44.008,REMAPDAY=5:44.009,REMAPDAY=6:44.0001,1:"")
.I 'PATTERNFILE Q
.S MASTERPATTERN=$$GET1^DIQ(PATTERNFILE,PATTERNDATE_","_CLINICIEN_",",1,"E")
.I '$D(^SC(CLINICIEN,"T"_REMAPDAY,PATTERNDATE,1)) D Q
..I ACTIVEAPPTS D LOGDATA^SDES2REMAPUTIL(.GBL,.CLINGBL,.TMPCOUNT,.CLINTMPCNT,CLINICNAME,DIVNAME,REMAPDATE,SCHEDONHOLIDAY,ACTIVEAPPTS,REMAPDAYNAME)
.; no master pattern, and ST was originally defined, log and quit
.I MASTERPATTERN="",STDEFINED D Q
..D LOGDATA^SDES2REMAPUTIL(.GBL,.CLINGBL,.TMPCOUNT,.CLINTMPCNT,CLINICNAME,DIVNAME,REMAPDATE,SCHEDONHOLIDAY,ACTIVEAPPTS,REMAPDAYNAME,"no master pattern for this day")
.; no master pattern, no availability, no original ST defined, no active appts, and no cancelled times, so just quit
.I MASTERPATTERN="",AVAILABILITY="",'STDEFINED,'ACTIVEAPPTS,'$D(^SC(CLINICIEN,"S",REMAPDATE,"MES")) Q
.; fall through for all other scenarios
.S NEWPATTERN=$P("SU^MO^TU^WE^TH^FR^SA",U,REMAPDAY+1)_" "_$E(REMAPDATE,6,7)_$J("",DISPINCPERHOUR+DISPINCPERHOUR-6)_MASTERPATTERN_$J("",64-$L(MASTERPATTERN))
.; No active appointments, and no cancelled times.. Build the ST subscript and quit
.I 'ACTIVEAPPTS&('$D(^SC(CLINICIEN,"S",REMAPDATE,"MES"))) D Q
..D FILEPATTERN(CLINICIEN,NEWPATTERN,REMAPDATE,.SDDOW,PATTERNDATE,SAVECAN)
.D REBUILDPATTERN(CLINICIEN,.NEWPATTERN,MASTERPATTERN,REMAPDATE,REMAPDAY,DISPINCPERHOUR,FIRSTAPPTDTTM,CLINAPPTLENGTH,HSI,SDSI,HOURBEFORESTART)
.D FILEPATTERN(CLINICIEN,NEWPATTERN,REMAPDATE,.SDDOW,PATTERNDATE,SAVECAN)
.D LOGDATA^SDES2REMAPUTIL(.GBL,.CLINGBL,.TMPCOUNT,.CLINTMPCNT,CLINICNAME,DIVNAME,REMAPDATE,SCHEDONHOLIDAY,ACTIVEAPPTS,REMAPDAYNAME)
K @CLINGBL
Q
;
REBUILDPATTERN(CLINICIEN,NEWPATTERN,MASTERPATTERN,REMAPDATE,REMAPDAY,DISPINCPERHOUR,FIRSTAPPTDTTM,CLINAPPTLENGTH,HSI,SDSI,HOURBEFORESTART) ; Was 'I' in SDD0
N STARTLOC,SLOTPOSITION,PTRNAPPTANDPAST,PTRNBEFOREAPPT,APPTIEN,APPTIENS,LENGTHOFAPPT,SDSLOT,INCREMENT,STR,STDATA,APPTDTTM
S STR="{}&%?#@!$* XXWVUTSRQPONMLKJIHGFEDCBA0123456789jklmnopqrstuvwxyz"
S APPTDTTM=FIRSTAPPTDTTM-.01
F S APPTDTTM=$O(^SC(CLINICIEN,"S",APPTDTTM)) Q:'APPTDTTM!($P(APPTDTTM,".")>REMAPDATE) D
.S STARTLOC=APPTDTTM#1 ; get remainder (hour of the appointment)
.S STARTLOC=STARTLOC-HOURBEFORESTART*100 ; find the starting location (location of the first appointment)
.; Calculate the position
.S SLOTPOSITION=STARTLOC#1*DISPINCPERHOUR\.6+(STARTLOC\1*DISPINCPERHOUR)*2
.S PTRNAPPTANDPAST=$E(NEWPATTERN,SLOTPOSITION,999) ; FORMERLY SM
.S PTRNBEFOREAPPT=$E(NEWPATTERN,1,SLOTPOSITION-1) ; FORMERLY S
.;check for cancellations at this time
.I $D(^SC(CLINICIEN,"S",APPTDTTM,"MES")) D Q
..D CAN(CLINICIEN,APPTDTTM,.NEWPATTERN,PTRNBEFOREAPPT,PTRNAPPTANDPAST,STARTOFDAY,DISPINCPERHOUR)
.; process appointment adjustments
.S APPTIEN=0 F S APPTIEN=$O(^SC(CLINICIEN,"S",APPTDTTM,1,APPTIEN)) Q:'APPTIEN D
..S APPTIENS=APPTIEN_","_APPTDTTM_","_CLINICIEN
..Q:$$GET1^DIQ(44.003,APPTIENS,310,"I")="C" ; ignore cancelled appointments
..Q:$D(^SC(CLINICIEN,"S",APPTDTTM,"MES"))
..; might be able to move this into the appointment date/time loop
..Q:+$E($P(APPTDTTM,".",2)_"000",1,4)<$S(STARTOFDAY>0:STARTOFDAY_"00",1:800)
..; LENGTHOFAPPT = SDSL
..S LENGTHOFAPPT=$$GET1^DIQ(44.003,APPTIENS,1,"I")
..S SDSLOT=LENGTHOFAPPT/CLINAPPTLENGTH*(CLINAPPTLENGTH\(60/SDSI))*HSI-HSI
..F INCREMENT=0:HSI:SDSLOT D
...S STDATA=$E(PTRNAPPTANDPAST,INCREMENT+2)
...I STDATA="" S STDATA=" "
...S PTRNAPPTANDPAST=$E(PTRNAPPTANDPAST,1,INCREMENT+2-1)_$S("{}&%?#"[STDATA:STDATA,1:$E(STR,$F(STR,STDATA)-2))_$E(PTRNAPPTANDPAST,INCREMENT+3,999)
.S NEWPATTERN=PTRNBEFOREAPPT_PTRNAPPTANDPAST
Q
;
CAN(CLINICIEN,APPTDTTM,NEWPATTERN,PTRNBEFOREAPPT,PTRNAPPTANDPAST,STARTOFDAY,DISPINCPERHOUR) ;
N APPTTIME,CANCELSTRTLOC,CANCELENDLOC,CANCELENDTIME,TEMPPATTERN,CHAR,LOOP,S,P,SDIF
Q:'$D(^SC(CLINICIEN,"SDCAN",APPTDTTM,0))
S APPTTIME=$E($P(APPTDTTM,".",2)_"0000",1,4)
S TEMPPATTERN=PTRNBEFOREAPPT_PTRNAPPTANDPAST
S CANCELSTRTLOC=$$TIMELOCATION(APPTTIME,STARTOFDAY,DISPINCPERHOUR)
S CANCELENDTIME=$$GET1^DIQ(44.05,APPTDTTM_","_CLINICIEN_",",1)
S CANCELENDLOC=$$TIMELOCATION(CANCELENDTIME,STARTOFDAY,DISPINCPERHOUR)
S TEMPPATTERN=TEMPPATTERN_$J("",CANCELENDLOC-$L(TEMPPATTERN))
S CHAR=""
F LOOP=0:2:CANCELENDLOC D
.S S=$E(TEMPPATTERN,LOOP+DISPINCPERHOUR+DISPINCPERHOUR)
.S P=$S(LOOP<CANCELSTRTLOC:S_$E(TEMPPATTERN,LOOP+1+DISPINCPERHOUR+DISPINCPERHOUR),LOOP=CANCELENDLOC:$S(CHAR="[":CHAR,1:S)_$E(TEMPPATTERN,LOOP+1+DISPINCPERHOUR+DISPINCPERHOUR),1:$S(CHAR="["&(LOOP=CANCELSTRTLOC):"]",1:"X")_"X")
.S CHAR=$S(S="]":"",S="[":S,1:CHAR)
.S TEMPPATTERN=$E(TEMPPATTERN,1,LOOP-1+DISPINCPERHOUR+DISPINCPERHOUR)_P_$E(TEMPPATTERN,LOOP+2+DISPINCPERHOUR+DISPINCPERHOUR,999)
I '$F(TEMPPATTERN,"[") D
.S SDIF=$F(TEMPPATTERN,"X")
.S TEMPPATTERN=$E(TEMPPATTERN,1,(SDIF-2))_"["_$E(TEMPPATTERN,SDIF,999)
S NEWPATTERN=TEMPPATTERN
Q
TIMELOCATION(TIME,STARTOFDAY,DISPINCPERHOUR) ;
N MINUTES,INCREMENT
S MINUTES=$E(TIME,3,4)
S INCREMENT=TIME\100-STARTOFDAY*DISPINCPERHOUR+(MINUTES*DISPINCPERHOUR\60)*2
Q INCREMENT
;
NOSCHHOLIDAY(CLINIEN,REMAPDATE,ACTIVEAPPTS,GBL,CLINGBL,CLINICNAME,DIVNAME,TMPCOUNT,CLINTMPCNT,SCHEDONHOLIDAY,REMAPDAYNAME) ;
N HOLIDAYNAME,SCHEDIEN,FDA,FERR
S HOLIDAYNAME=$$GET1^DIQ(40.5,REMAPDATE,2,"E")
I 'ACTIVEAPPTS D Q
.I $D(^SC(CLINIEN,"ST",REMAPDATE)) D
..S FDA(44.005,REMAPDATE_","_CLINIEN_",",.01)=REMAPDATE
..S FDA(44.005,REMAPDATE_","_CLINIEN_",",1)=" "_$E(REMAPDATE,6,7)_" "_HOLIDAYNAME
..D FILE^DIE(,"FDA","FERR") K FDA
.I '$D(^SC(CLINIEN,"ST",REMAPDATE)) D
..S SCHEDIEN(1)=REMAPDATE
..S FDA(44.005,"+1,"_CLINIEN_",",.01)=REMAPDATE
..S FDA(44.005,"+1,"_CLINIEN_",",1)=" "_$E(REMAPDATE,6,7)_" "_HOLIDAYNAME
..D UPDATE^DIE(,"FDA","SCHEDIEN","FERR")
.I $D(FERR) D ERRLOG^SDES2JSON(.ERRORS,52,"Error filing holiday pattern. Clinic: "_CLINICNAME_" for remap date: "_$$FMTISO^SDAMUTDT(REMAPDATE)) Q
.D EN^SDTMPHLC(CLINIEN,REMAPDATE,,"C",HOLIDAYNAME)
.;D LOGDATA^SDES2REMAPUTIL(.GBL,.CLINGBL,.TMPCOUNT,.CLINTMPCNT,CLINICNAME,DIVNAME,REMAPDATE,SCHEDONHOLIDAY,ACTIVEAPPTS,REMAPDAYNAME,HOLIDAYNAME_"- Inserted")
D LOGDATA^SDES2REMAPUTIL(.GBL,.CLINGBL,.TMPCOUNT,.CLINTMPCNT,CLINICNAME,DIVNAME,REMAPDATE,SCHEDONHOLIDAY,ACTIVEAPPTS,REMAPDAYNAME,HOLIDAYNAME_"- Appts!")
Q
FILEPATTERN(CLINIEN,PATTERN,REMAPDATE,SDDOW,PATTERNDATE,SAVECAN) ; reset ST subscript for remapdate
N FDA,FDAIEN,FILERR
I $L(PATTERN)>PATTERN,(REMAPDATE>=$O(SDDOW($$DOW^XLFDT(REMAPDATE,1),(REMAPDATE+1)),-1)&($O(SDDOW($$DOW^XLFDT(REMAPDATE,1),(REMAPDATE+1)),-1)))!($D(^SC(CLINIEN,"OST",REMAPDATE))) D
.I $D(^SC(CLINIEN,"ST",REMAPDATE)) D Q
..S FDA(44.005,REMAPDATE_","_CLINIEN_",",.01)=REMAPDATE
..S FDA(44.005,REMAPDATE_","_CLINIEN_",",1)=PATTERN
..I PATTERNDATE'>0 S FDA(44.005,REMAPDATE_","_CLINIEN_",",3)=REMAPDATE
..D FILE^DIE(,"FDA") K FDA
..I $G(SAVECAN)]"" S ^SC(CLINIEN,"ST",REMAPDATE,"CAN")=SAVECAN
.I '$D(^SC(CLINIEN,"ST",REMAPDATE)) D
..S FDA(44.005,"+1,"_CLINIEN_",",.01)=REMAPDATE
..S FDA(44.005,"+1,"_CLINIEN_",",1)=PATTERN
..I PATTERNDATE'>0 S FDA(44.005,"+1,"_CLINIEN_",",3)=REMAPDATE
..S FDAIEN(1)=REMAPDATE
..D UPDATE^DIE(,"FDA","FDAIEN","FILERR")
..I $G(SAVECAN)]"" S ^SC(CLINIEN,"ST",REMAPDATE,"CAN")=SAVECAN
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDES2REMAP 15313 printed Aug 26, 2025@23:10:56 Page 2
SDES2REMAP ;ALB/BWF/JAS - REMAP DIVISION/CLINIC ; MAY 21, 2025
+1 ;;5.3;Scheduling;**908**;Aug 13, 1993;Build 2
+2 ;;Per VHA Directive 6402, this routine should not be modified
+3 ;
+4 QUIT
+5 ;
+6 ; SDCONTEXT - standard SDCONTEXT input array
+7 ;
+8 ; SDINPUT("DIVISION","ALL") - Only used to re-map all divisions
+9 ; This should only be passed if 'ALL' divisions are being re-mapped
+10 ;
+11 ; When re-mapping 'ALL' clinics, or a clinic list within
+12 ; a specific DIVISION, pass in the following:
+13 ; SDINPUT("DIVISION",DIVISION IEN,"CLINIC","ALL")="" - re-maps all clinics within the division
+14 ; SDINPUT("DIVISION",DIVISION IEN,"CLINIC",CLINICIEN)="" - list of clinics to remap
+15 ;
+16 ; When re-mapping a list of clinics that are not associated
+17 ; with a single division, send in a list of just the clinics
+18 ; being remapped:
+19 ; SDINPUT("CLINIC",CLINIC IEN)="" - required, if division is not passed
+20 ;
+21 ; SDINPUT("START DATE")=ISO START DATE (i.e. 2024-12-01) - required, re-map start date
+22 ; SDINPUT("END DATE")=ISO END DATE (i.e. 2024-12-30) - required, re-map end date
+23 ;
REMAP(RESULT,SDCONTEXT,SDINPUT) ;
+1 NEW ERRORS,VALDATES,STARTDATE,ENDDATE,QUEUEREMAP,TASKRES,GBL,SDUSER
+2 NEW %,D,D0,D1,D2,DG,DIC,DICR,DIW,SEQ,SEQ1,XMDUN,XMZ,Y
+3 SET QUEUEREMAP=0
+4 DO VALCONTEXT^SDES2VALCONTEXT(.ERRORS,.SDCONTEXT)
+5 IF $DATA(ERRORS)
Begin DoDot:1
+6 SET ERRORS("ClinicRemap",1)=""
+7 DO BUILDJSON^SDES2JSON(.RESULT,.ERRORS)
End DoDot:1
QUIT
+8 ;
+9 ; validate start/end date
+10 SET VALDATES=$$VALISODATERANGE^SDES2VALISODTTM(.ERRORS,$GET(SDINPUT("START DATE")),$GET(SDINPUT("END DATE")),1)
+11 SET STARTDATE=$PIECE(VALDATES,U)
+12 SET ENDDATE=$PIECE(VALDATES,U,2)
+13 SET SDUSER=$SELECT($GET(SDCONTEXT("USER DUZ")):SDCONTEXT("USER DUZ"),1:DUZ)
+14 ;
+15 IF $DATA(ERRORS)
Begin DoDot:1
+16 SET ERRORS("ClinicRemap",1)=""
+17 DO BUILDJSON^SDES2JSON(.RESULT,.ERRORS)
End DoDot:1
QUIT
+18 ;
+19 DO VALIDATE^SDES2REMAPUTIL(.ERRORS,.SDINPUT,.QUEUEREMAP)
+20 IF $DATA(ERRORS)
Begin DoDot:1
+21 SET ERRORS("ClinicRemap",1)=""
+22 DO BUILDJSON^SDES2JSON(.RESULT,.ERRORS)
End DoDot:1
QUIT
+23 ;
+24 ; queue remap in background if QUEUEREMAP=1
+25 IF QUEUEREMAP
Begin DoDot:1
+26 DO TASKREMAP^SDES2REMAPUTIL(.SDINPUT,STARTDATE,ENDDATE,.TASKRES,SDUSER)
+27 IF '$DATA(TASKRES)
SET TASKRES("ClinicRemap",1)=""
+28 DO BUILDJSON^SDES2JSON(.RESULT,.TASKRES)
End DoDot:1
QUIT
+29 ;
+30 SET GBL=$NAME(^TMP("SDES2REMAP",$JOB))
KILL @GBL
+31 DO REMAPFOREGROUND(.GBL,SDUSER)
+32 MERGE TASKRES("ClinicRemap","Status")=^TMP("SDES2REMAP",$JOB)
+33 DO BUILDJSON^SDES2JSON(.RESULT,.TASKRES)
+34 QUIT
+35 ;
REMAPFOREGROUND(GBL,SDUSER) ;
+1 NEW DIVISIONIEN,CLINICIEN,TMPCOUNT
+2 SET (DIVISIONIEN,TMPCOUNT)=0
+3 ; build report header
+4 DO HEADER^SDES2REMAPUTIL(.GBL,.TMPCOUNT)
+5 IF $DATA(SDINPUT("DIVISION"))
Begin DoDot:1
+6 FOR
SET DIVISIONIEN=$ORDER(SDINPUT("DIVISION",DIVISIONIEN))
if 'DIVISIONIEN
QUIT
Begin DoDot:2
+7 ; process all clinics
+8 IF $DATA(SDINPUT("DIVISION",DIVISIONIEN,"CLINIC","ALL"))
Begin DoDot:3
+9 SET CLINICIEN=0
+10 FOR
SET CLINICIEN=$ORDER(^SC(CLINICIEN))
if 'CLINICIEN
QUIT
Begin DoDot:4
+11 if '$$CLINDIVCHECK^SDES2REMAPUTIL(DIVISIONIEN,CLINICIEN)
QUIT
+12 DO REMAPCLIN(.GBL,CLINICIEN,STARTDATE,ENDDATE,.TMPCOUNT)
End DoDot:4
+13 DO MAIL^SDES2REMAPUTIL(GBL,SDUSER)
End DoDot:3
QUIT
+14 ; process clinics in the list
+15 SET CLINICIEN=0
+16 FOR
SET CLINICIEN=$ORDER(SDINPUT("DIVISION",DIVISIONIEN,"CLINIC",CLINICIEN))
if 'CLINICIEN
QUIT
Begin DoDot:3
+17 if '$$CLINDIVCHECK^SDES2REMAPUTIL(DIVISIONIEN,CLINICIEN)
QUIT
+18 DO REMAPCLIN(.GBL,CLINICIEN,STARTDATE,ENDDATE,.TMPCOUNT)
End DoDot:3
+19 DO MAIL^SDES2REMAPUTIL(GBL,SDUSER)
End DoDot:2
End DoDot:1
QUIT
+20 ;
+21 IF $DATA(SDINPUT("CLINIC"))
Begin DoDot:1
+22 SET CLINIEN=0
FOR
SET CLINIEN=$ORDER(SDINPUT("CLINIC",CLINIEN))
if 'CLINIEN
QUIT
Begin DoDot:2
+23 if $$GET1^DIQ(44,CLINIEN,2,"I")'="C"
QUIT
+24 if $$INACTIVE^SDES2UTIL(CLINIEN,DT)
QUIT
+25 DO REMAPCLIN(.GBL,CLINIEN,STARTDATE,ENDDATE,.TMPCOUNT)
End DoDot:2
+26 DO MAIL^SDES2REMAPUTIL(GBL,SDUSER)
End DoDot:1
QUIT
+27 QUIT
+28 ;
REMAPCLIN(GBL,CLINICIEN,STARTDATE,ENDDATE,TMPCOUNT) ;
+1 NEW CLINICNAME,SCHEDONHOLIDAY,STARTOFDAY,DISPINCPERHOUR,SDDAYOFWEEK,SDBEGO,SDX,REMAPDATE,DONE,ACTIVEAPPTS,X,AVAILABILITY,REMAPDAY,CLINTMPCNT
+2 NEW CLINGBL,FIRSTAPPTDTTM,PATTERNFILE,REMAPDAYNAME,SPECPATTERN,STDEFINED,SAVECAN,MASTERPATTERN,NEWPATTERN,HOURBEFORESTART,CLINAPPTLENGTH,SDSI
+3 NEW SDBEG,SDBEGZ,SDCNT,SDDAY,SDDOW,HSI,PATTERNDATE,DIVNAME
+4 SET CLINGBL=$NAME(^TMP("SDES2REMAPCLINIC",$JOB))
KILL @CLINGBL
+5 SET CLINTMPCNT=0
+6 ; previously SL
SET CLINAPPTLENGTH=$$GET1^DIQ(44,CLINICIEN,1912,"I")
+7 SET CLINICNAME=$$GET1^DIQ(44,CLINICIEN,.01,"E")
+8 SET SCHEDONHOLIDAY=$$GET1^DIQ(44,CLINICIEN,1918.5,"I")
+9 SET SCHEDONHOLIDAY=$SELECT(SCHEDONHOLIDAY="Y":1,1:0)
+10 SET STARTOFDAY=$$GET1^DIQ(44,CLINICIEN,1914,"I")
+11 SET DIVNAME=$$GET1^DIQ(44,CLINICIEN,3.5,"E")
+12 IF $GET(STARTOFDAY)=""
SET STARTOFDAY=8
+13 ; formerly SI
SET DISPINCPERHOUR=$$GET1^DIQ(44,CLINICIEN,1917,"I")
+14 SET HSI=$SELECT('DISPINCPERHOUR:4,DISPINCPERHOUR<3:8/DISPINCPERHOUR,1:2)
+15 SET SDSI=DISPINCPERHOUR
+16 ; formerly SDSI
SET DISPINCPERHOUR=$SELECT(DISPINCPERHOUR:DISPINCPERHOUR,1:4)
+17 SET DISPINCPERHOUR=$SELECT(DISPINCPERHOUR=1:4,DISPINCPERHOUR=2:4,1:DISPINCPERHOUR)
+18 ; grab the hour before 'hour clinic display begins'
+19 SET HOURBEFORESTART=STARTOFDAY-1/100
+20 ;
+21 ;
+22 ; build clinic specific report header
+23 DO HEADER^SDES2REMAPUTIL(.CLINGBL,.CLINTMPCNT)
+24 ;
+25 ; code needed for SDDOW array
+26 ;Set beginning date to use for indefinite clinic availabilities
+27 ;SD*5.3*674
FOR SDDAYOFWEEK=0:1:6
SET SDDOW(SDDAYOFWEEK,9999999)=""
+28 SET SDBEGO=""
FOR SDDAY=0:1:6
SET SDCNT=0
FOR
SET SDCNT=$ORDER(^SC(CLINICIEN,"T"_SDDAY,SDCNT))
if 'SDCNT
QUIT
SET SDBEGO=SDBEGO_U_SDCNT
+29 ;Add SDBEGZ to check for duplicate OST entry
SET SDX=0
FOR
SET SDX=$ORDER(^SC(CLINICIEN,"T",SDX))
if 'SDX!(SDX>ENDDATE)
QUIT
SET SDBEGZ=$ORDER(^SC(CLINICIEN,"T"_$$DOW^XLFDT(SDX,1),9999999),-1)
Begin DoDot:1
+30 ;SD*5.3*674 and SD*5.3*726
IF '$DATA(^SC(CLINICIEN,"OST",SDX))!(SDBEGO[SDX)!(SDBEGZ=0)!($GET(^SC(CLINICIEN,"T"_$$DOW^XLFDT(SDX,1),9999999))=""&(SDBEGZ>0))
SET SDBEG=$GET(^SC(CLINICIEN,"T",SDX,0),SDX)
SET SDDOW($$DOW^XLFDT(SDBEG,1),SDBEG)=""
End DoDot:1
+31 SET REMAPDATE=$$FMADD^XLFDT(STARTDATE,-1)
+32 SET DONE=0
+33 FOR
Begin DoDot:1
+34 SET REMAPDATE=$$FMADD^XLFDT(REMAPDATE,1)
+35 IF REMAPDATE>ENDDATE
SET DONE=1
QUIT
+36 SET ACTIVEAPPTS=$$ACTIVEAPPTS^SDES2REMAPUTIL(CLINICIEN,REMAPDATE,.FIRSTAPPTDTTM)
+37 SET AVAILABILITY=$$GET1^DIQ(44.005,REMAPDATE_","_CLINICIEN_",",1,"E")
+38 SET REMAPDAY=$$DOW^XLFDT(REMAPDATE,1)
+39 SET REMAPDAYNAME=$PIECE("SUN^MON^TUES^WEDNES^THURS^FRI^SATUR",U,REMAPDAY+1)
+40 SET STDEFINED=$DATA(^SC(CLINICIEN,"ST",REMAPDATE))
+41 ; day doesn't match
+42 IF $DATA(^SC(CLINICIEN,"ST",REMAPDATE,1))
IF AVAILABILITY'[$EXTRACT(REMAPDAYNAME,1,2)&(AVAILABILITY["]")
Begin DoDot:2
+43 DO LOGDATA^SDES2REMAPUTIL(.GBL,.CLINGBL,.TMPCOUNT,.CLINTMPCNT,CLINICNAME,DIVNAME,REMAPDATE,SCHEDONHOLIDAY,ACTIVEAPPTS,REMAPDAYNAME,"Bogus clinic day"_$SELECT(ACTIVEAPPTS:"- Appts!",1:""))
End DoDot:2
QUIT
+44 ; canceled this day
+45 IF $DATA(^SC(CLINICIEN,"ST",REMAPDATE,1))
IF AVAILABILITY["CANCEL"!($EXTRACT(AVAILABILITY,$FIND(AVAILABILITY,"["),999)?."X")
Begin DoDot:2
+46 DO LOGDATA^SDES2REMAPUTIL(.GBL,.CLINGBL,.TMPCOUNT,.CLINTMPCNT,CLINICNAME,DIVNAME,REMAPDATE,SCHEDONHOLIDAY,ACTIVEAPPTS,REMAPDAYNAME,"Cancelled")
End DoDot:2
QUIT
+47 ; update holiday schedule
+48 IF $DATA(^HOLIDAY(REMAPDATE,0))
IF 'SCHEDONHOLIDAY
Begin DoDot:2
+49 IF 'ACTIVEAPPTS
Begin DoDot:3
+50 DO NOSCHHOLIDAY(CLINICIEN,REMAPDATE,ACTIVEAPPTS,.GBL,.CLINGBL,CLINICNAME,DIVNAME,.TMPCOUNT,.CLINTMPCNT,SCHEDONHOLIDAY,REMAPDAYNAME)
End DoDot:3
QUIT
+51 DO LOGDATA^SDES2REMAPUTIL(.GBL,.CLINGBL,.TMPCOUNT,.CLINTMPCNT,CLINICNAME,DIVNAME,REMAPDATE,SCHEDONHOLIDAY,ACTIVEAPPTS,REMAPDAYNAME)
End DoDot:2
QUIT
+52 SET SAVECAN=$GET(^SC(CLINICIEN,"ST",REMAPDATE,"CAN"))
+53 SET FDA(44.005,REMAPDATE_","_CLINICIEN_",",.01)="@"
+54 DO FILE^DIE(,"FDA")
KILL FDA
+55 SET PATTERNDATE=+$ORDER(^SC(CLINICIEN,"T"_REMAPDAY,REMAPDATE))
+56 ;
+57 ; handle OST pattern
+58 ;
+59 IF $DATA(^SC(CLINICIEN,"OST",REMAPDATE,1))
Begin DoDot:2
+60 SET (SPECPATTERN,NEWPATTERN)=$$GET1^DIQ(44.0002,REMAPDATE_","_CLINICIEN_",",1,"E")
+61 IF SPECPATTERN=""
QUIT
+62 SET PATTERNDATE=0
+63 ; rebuild pattern and file
+64 DO REBUILDPATTERN(CLINICIEN,.NEWPATTERN,SPECPATTERN,REMAPDATE,REMAPDAY,DISPINCPERHOUR,FIRSTAPPTDTTM,CLINAPPTLENGTH,HSI,SDSI,HOURBEFORESTART)
+65 DO FILEPATTERN(CLINICIEN,NEWPATTERN,REMAPDATE,.SDDOW,PATTERNDATE,SAVECAN)
+66 IF ACTIVEAPPTS
DO LOGDATA^SDES2REMAPUTIL(.GBL,.CLINGBL,.TMPCOUNT,.CLINTMPCNT,CLINICNAME,DIVNAME,REMAPDATE,SCHEDONHOLIDAY,ACTIVEAPPTS,REMAPDAYNAME)
End DoDot:2
QUIT
+67 SET PATTERNFILE=$SELECT(REMAPDAY=0:44.06,REMAPDAY=1:44.07,REMAPDAY=2:44.08,REMAPDAY=3:44.09,REMAPDAY=4:44.008,REMAPDAY=5:44.009,REMAPDAY=6:44.0001,1:"")
+68 IF 'PATTERNFILE
QUIT
+69 SET MASTERPATTERN=$$GET1^DIQ(PATTERNFILE,PATTERNDATE_","_CLINICIEN_",",1,"E")
+70 IF '$DATA(^SC(CLINICIEN,"T"_REMAPDAY,PATTERNDATE,1))
Begin DoDot:2
+71 IF ACTIVEAPPTS
DO LOGDATA^SDES2REMAPUTIL(.GBL,.CLINGBL,.TMPCOUNT,.CLINTMPCNT,CLINICNAME,DIVNAME,REMAPDATE,SCHEDONHOLIDAY,ACTIVEAPPTS,REMAPDAYNAME)
End DoDot:2
QUIT
+72 ; no master pattern, and ST was originally defined, log and quit
+73 IF MASTERPATTERN=""
IF STDEFINED
Begin DoDot:2
+74 DO LOGDATA^SDES2REMAPUTIL(.GBL,.CLINGBL,.TMPCOUNT,.CLINTMPCNT,CLINICNAME,DIVNAME,REMAPDATE,SCHEDONHOLIDAY,ACTIVEAPPTS,REMAPDAYNAME,"no master pattern for this day")
End DoDot:2
QUIT
+75 ; no master pattern, no availability, no original ST defined, no active appts, and no cancelled times, so just quit
+76 IF MASTERPATTERN=""
IF AVAILABILITY=""
IF 'STDEFINED
IF 'ACTIVEAPPTS
IF '$DATA(^SC(CLINICIEN,"S",REMAPDATE,"MES"))
QUIT
+77 ; fall through for all other scenarios
+78 SET NEWPATTERN=$PIECE("SU^MO^TU^WE^TH^FR^SA",U,REMAPDAY+1)_" "_$EXTRACT(REMAPDATE,6,7)_$JUSTIFY("",DISPINCPERHOUR+DISPINCPERHOUR-6)_MASTERPATTERN_$JUSTIFY("",64-$LENGTH(MASTERPATTERN))
+79 ; No active appointments, and no cancelled times.. Build the ST subscript and quit
+80 IF 'ACTIVEAPPTS&('$DATA(^SC(CLINICIEN,"S",REMAPDATE,"MES")))
Begin DoDot:2
+81 DO FILEPATTERN(CLINICIEN,NEWPATTERN,REMAPDATE,.SDDOW,PATTERNDATE,SAVECAN)
End DoDot:2
QUIT
+82 DO REBUILDPATTERN(CLINICIEN,.NEWPATTERN,MASTERPATTERN,REMAPDATE,REMAPDAY,DISPINCPERHOUR,FIRSTAPPTDTTM,CLINAPPTLENGTH,HSI,SDSI,HOURBEFORESTART)
+83 DO FILEPATTERN(CLINICIEN,NEWPATTERN,REMAPDATE,.SDDOW,PATTERNDATE,SAVECAN)
+84 DO LOGDATA^SDES2REMAPUTIL(.GBL,.CLINGBL,.TMPCOUNT,.CLINTMPCNT,CLINICNAME,DIVNAME,REMAPDATE,SCHEDONHOLIDAY,ACTIVEAPPTS,REMAPDAYNAME)
End DoDot:1
if DONE
QUIT
+85 KILL @CLINGBL
+86 QUIT
+87 ;
REBUILDPATTERN(CLINICIEN,NEWPATTERN,MASTERPATTERN,REMAPDATE,REMAPDAY,DISPINCPERHOUR,FIRSTAPPTDTTM,CLINAPPTLENGTH,HSI,SDSI,HOURBEFORESTART) ; Was 'I' in SDD0
+1 NEW STARTLOC,SLOTPOSITION,PTRNAPPTANDPAST,PTRNBEFOREAPPT,APPTIEN,APPTIENS,LENGTHOFAPPT,SDSLOT,INCREMENT,STR,STDATA,APPTDTTM
+2 SET STR="{}&%?#@!$* XXWVUTSRQPONMLKJIHGFEDCBA0123456789jklmnopqrstuvwxyz"
+3 SET APPTDTTM=FIRSTAPPTDTTM-.01
+4 FOR
SET APPTDTTM=$ORDER(^SC(CLINICIEN,"S",APPTDTTM))
if 'APPTDTTM!($PIECE(APPTDTTM,".")>REMAPDATE)
QUIT
Begin DoDot:1
+5 ; get remainder (hour of the appointment)
SET STARTLOC=APPTDTTM#1
+6 ; find the starting location (location of the first appointment)
SET STARTLOC=STARTLOC-HOURBEFORESTART*100
+7 ; Calculate the position
+8 SET SLOTPOSITION=STARTLOC#1*DISPINCPERHOUR\.6+(STARTLOC\1*DISPINCPERHOUR)*2
+9 ; FORMERLY SM
SET PTRNAPPTANDPAST=$EXTRACT(NEWPATTERN,SLOTPOSITION,999)
+10 ; FORMERLY S
SET PTRNBEFOREAPPT=$EXTRACT(NEWPATTERN,1,SLOTPOSITION-1)
+11 ;check for cancellations at this time
+12 IF $DATA(^SC(CLINICIEN,"S",APPTDTTM,"MES"))
Begin DoDot:2
+13 DO CAN(CLINICIEN,APPTDTTM,.NEWPATTERN,PTRNBEFOREAPPT,PTRNAPPTANDPAST,STARTOFDAY,DISPINCPERHOUR)
End DoDot:2
QUIT
+14 ; process appointment adjustments
+15 SET APPTIEN=0
FOR
SET APPTIEN=$ORDER(^SC(CLINICIEN,"S",APPTDTTM,1,APPTIEN))
if 'APPTIEN
QUIT
Begin DoDot:2
+16 SET APPTIENS=APPTIEN_","_APPTDTTM_","_CLINICIEN
+17 ; ignore cancelled appointments
if $$GET1^DIQ(44.003,APPTIENS,310,"I")="C"
QUIT
+18 if $DATA(^SC(CLINICIEN,"S",APPTDTTM,"MES"))
QUIT
+19 ; might be able to move this into the appointment date/time loop
+20 if +$EXTRACT($PIECE(APPTDTTM,".",2)_"000",1,4)<$SELECT(STARTOFDAY>0
QUIT
+21 ; LENGTHOFAPPT = SDSL
+22 SET LENGTHOFAPPT=$$GET1^DIQ(44.003,APPTIENS,1,"I")
+23 SET SDSLOT=LENGTHOFAPPT/CLINAPPTLENGTH*(CLINAPPTLENGTH\(60/SDSI))*HSI-HSI
+24 FOR INCREMENT=0:HSI:SDSLOT
Begin DoDot:3
+25 SET STDATA=$EXTRACT(PTRNAPPTANDPAST,INCREMENT+2)
+26 IF STDATA=""
SET STDATA=" "
+27 SET PTRNAPPTANDPAST=$EXTRACT(PTRNAPPTANDPAST,1,INCREMENT+2-1)_$SELECT("{}&%?#"[STDATA:STDATA,1:$EXTRACT(STR,$FIND(STR,STDATA)-2))_$EXTRACT(PTRNAPPTANDPAST,INCREMENT+3,999)
End DoDot:3
End DoDot:2
+28 SET NEWPATTERN=PTRNBEFOREAPPT_PTRNAPPTANDPAST
End DoDot:1
+29 QUIT
+30 ;
CAN(CLINICIEN,APPTDTTM,NEWPATTERN,PTRNBEFOREAPPT,PTRNAPPTANDPAST,STARTOFDAY,DISPINCPERHOUR) ;
+1 NEW APPTTIME,CANCELSTRTLOC,CANCELENDLOC,CANCELENDTIME,TEMPPATTERN,CHAR,LOOP,S,P,SDIF
+2 if '$DATA(^SC(CLINICIEN,"SDCAN",APPTDTTM,0))
QUIT
+3 SET APPTTIME=$EXTRACT($PIECE(APPTDTTM,".",2)_"0000",1,4)
+4 SET TEMPPATTERN=PTRNBEFOREAPPT_PTRNAPPTANDPAST
+5 SET CANCELSTRTLOC=$$TIMELOCATION(APPTTIME,STARTOFDAY,DISPINCPERHOUR)
+6 SET CANCELENDTIME=$$GET1^DIQ(44.05,APPTDTTM_","_CLINICIEN_",",1)
+7 SET CANCELENDLOC=$$TIMELOCATION(CANCELENDTIME,STARTOFDAY,DISPINCPERHOUR)
+8 SET TEMPPATTERN=TEMPPATTERN_$JUSTIFY("",CANCELENDLOC-$LENGTH(TEMPPATTERN))
+9 SET CHAR=""
+10 FOR LOOP=0:2:CANCELENDLOC
Begin DoDot:1
+11 SET S=$EXTRACT(TEMPPATTERN,LOOP+DISPINCPERHOUR+DISPINCPERHOUR)
+12 SET P=$SELECT(LOOP<CANCELSTRTLOC:S_$EXTRACT(TEMPPATTERN,LOOP+1+DISPINCPERHOUR+DISPINCPERHOUR),LOOP=CANCELENDLOC:$SELECT(CHAR="[":CHAR,1:S)_$EXTRACT(TEMPPATTERN,LOOP+1+DISPINCPERHOUR+DISPINCPERHOUR),1:$SELECT(CHAR="["&(LOOP=CANCELSTRTLOC
):"]",1:"X")_"X")
+13 SET CHAR=$SELECT(S="]":"",S="[":S,1:CHAR)
+14 SET TEMPPATTERN=$EXTRACT(TEMPPATTERN,1,LOOP-1+DISPINCPERHOUR+DISPINCPERHOUR)_P_$EXTRACT(TEMPPATTERN,LOOP+2+DISPINCPERHOUR+DISPINCPERHOUR,999)
End DoDot:1
+15 IF '$FIND(TEMPPATTERN,"[")
Begin DoDot:1
+16 SET SDIF=$FIND(TEMPPATTERN,"X")
+17 SET TEMPPATTERN=$EXTRACT(TEMPPATTERN,1,(SDIF-2))_"["_$EXTRACT(TEMPPATTERN,SDIF,999)
End DoDot:1
+18 SET NEWPATTERN=TEMPPATTERN
+19 QUIT
TIMELOCATION(TIME,STARTOFDAY,DISPINCPERHOUR) ;
+1 NEW MINUTES,INCREMENT
+2 SET MINUTES=$EXTRACT(TIME,3,4)
+3 SET INCREMENT=TIME\100-STARTOFDAY*DISPINCPERHOUR+(MINUTES*DISPINCPERHOUR\60)*2
+4 QUIT INCREMENT
+5 ;
NOSCHHOLIDAY(CLINIEN,REMAPDATE,ACTIVEAPPTS,GBL,CLINGBL,CLINICNAME,DIVNAME,TMPCOUNT,CLINTMPCNT,SCHEDONHOLIDAY,REMAPDAYNAME) ;
+1 NEW HOLIDAYNAME,SCHEDIEN,FDA,FERR
+2 SET HOLIDAYNAME=$$GET1^DIQ(40.5,REMAPDATE,2,"E")
+3 IF 'ACTIVEAPPTS
Begin DoDot:1
+4 IF $DATA(^SC(CLINIEN,"ST",REMAPDATE))
Begin DoDot:2
+5 SET FDA(44.005,REMAPDATE_","_CLINIEN_",",.01)=REMAPDATE
+6 SET FDA(44.005,REMAPDATE_","_CLINIEN_",",1)=" "_$EXTRACT(REMAPDATE,6,7)_" "_HOLIDAYNAME
+7 DO FILE^DIE(,"FDA","FERR")
KILL FDA
End DoDot:2
+8 IF '$DATA(^SC(CLINIEN,"ST",REMAPDATE))
Begin DoDot:2
+9 SET SCHEDIEN(1)=REMAPDATE
+10 SET FDA(44.005,"+1,"_CLINIEN_",",.01)=REMAPDATE
+11 SET FDA(44.005,"+1,"_CLINIEN_",",1)=" "_$EXTRACT(REMAPDATE,6,7)_" "_HOLIDAYNAME
+12 DO UPDATE^DIE(,"FDA","SCHEDIEN","FERR")
End DoDot:2
+13 IF $DATA(FERR)
DO ERRLOG^SDES2JSON(.ERRORS,52,"Error filing holiday pattern. Clinic: "_CLINICNAME_" for remap date: "_$$FMTISO^SDAMUTDT(REMAPDATE))
QUIT
+14 DO EN^SDTMPHLC(CLINIEN,REMAPDATE,,"C",HOLIDAYNAME)
+15 ;D LOGDATA^SDES2REMAPUTIL(.GBL,.CLINGBL,.TMPCOUNT,.CLINTMPCNT,CLINICNAME,DIVNAME,REMAPDATE,SCHEDONHOLIDAY,ACTIVEAPPTS,REMAPDAYNAME,HOLIDAYNAME_"- Inserted")
End DoDot:1
QUIT
+16 DO LOGDATA^SDES2REMAPUTIL(.GBL,.CLINGBL,.TMPCOUNT,.CLINTMPCNT,CLINICNAME,DIVNAME,REMAPDATE,SCHEDONHOLIDAY,ACTIVEAPPTS,REMAPDAYNAME,HOLIDAYNAME_"- Appts!")
+17 QUIT
FILEPATTERN(CLINIEN,PATTERN,REMAPDATE,SDDOW,PATTERNDATE,SAVECAN) ; reset ST subscript for remapdate
+1 NEW FDA,FDAIEN,FILERR
+2 IF $LENGTH(PATTERN)>PATTERN
IF (REMAPDATE>=$ORDER(SDDOW($$DOW^XLFDT(REMAPDATE,1),(REMAPDATE+1)),-1)&($ORDER(SDDOW($$DOW^XLFDT(REMAPDATE,1),(REMAPDATE+1)),-1)))!($DATA(^SC(CLINIEN,"OST",REMAPDATE)))
Begin DoDot:1
+3 IF $DATA(^SC(CLINIEN,"ST",REMAPDATE))
Begin DoDot:2
+4 SET FDA(44.005,REMAPDATE_","_CLINIEN_",",.01)=REMAPDATE
+5 SET FDA(44.005,REMAPDATE_","_CLINIEN_",",1)=PATTERN
+6 IF PATTERNDATE'>0
SET FDA(44.005,REMAPDATE_","_CLINIEN_",",3)=REMAPDATE
+7 DO FILE^DIE(,"FDA")
KILL FDA
+8 IF $GET(SAVECAN)]""
SET ^SC(CLINIEN,"ST",REMAPDATE,"CAN")=SAVECAN
End DoDot:2
QUIT
+9 IF '$DATA(^SC(CLINIEN,"ST",REMAPDATE))
Begin DoDot:2
+10 SET FDA(44.005,"+1,"_CLINIEN_",",.01)=REMAPDATE
+11 SET FDA(44.005,"+1,"_CLINIEN_",",1)=PATTERN
+12 IF PATTERNDATE'>0
SET FDA(44.005,"+1,"_CLINIEN_",",3)=REMAPDATE
+13 SET FDAIEN(1)=REMAPDATE
+14 DO UPDATE^DIE(,"FDA","FDAIEN","FILERR")
+15 IF $GET(SAVECAN)]""
SET ^SC(CLINIEN,"ST",REMAPDATE,"CAN")=SAVECAN
End DoDot:2
End DoDot:1
+16 QUIT
