SDECUTL1 ;ALB/SAT - VISTA SCHEDULING RPCS ;MAR 15, 2017
;;5.3;Scheduling;**627,642,658**;Aug 13, 1993;Build 23
;
Q
;
GETBLKS(SDBLKS,SDPAT,SDAY,SDCLS,SDLEN,SDSI,SDCL) ;build access block array SDBLKS from pattern SDPAT
;INPUT:
; SDPAT - Pattern from CURRENT AVAILABILITY field of PATTERN multiple in file 44
; SDAY - date (no time) in FM format
; SDCLS - hour clinic display begins from field 1914 in file 44
; SDLEN - length of app't from field 1912 in file 44
; SDSI - display increments per hour
;RETURN:
; .SDBLKS - array of access block data to be stored in SDEC ACCESS BLOCK file
; SDBLKS(<count>)=<start time> ^ <end time> ^ <slots> ^ <access type>
N DTARRAY
N SDATAV,SDATCA,SDATUN,SDF,SDI,SDSIM,SDSTPAT
S SDF=0
S SDATAV=$O(^SDEC(409.823,"B","AVAILABLE",0))
S SDATCA=$O(^SDEC(409.823,"B","CANCELED",0))
S SDATUN=$O(^SDEC(409.823,"B","UNAVAILABLE",0))
;SDSIM - calculated using DISPLAY INCREMENTS PER HOUR field from file 44
; $S(X="":4,X<3:4,X:X,1:4)
S SDSIM=$S(SDSI="":4,SDSI<3:4,SDSI:SDSI,1:4)
;S SDPAT=$E(SDPAT,SDSIM+SDSIM,90)
S SDSTPAT=$G(^SC(SDCL,"ST",SDAY,1)) I SDSTPAT["CANCELLED" S SDF=1,SDSTPAT=$G(^SC(SDCL,"ST",SDAY,"CAN")) ;get PATTERN from file 44
D:SDSTPAT'="" ARRAY^SDECUTL2(.DTARRAY,SDSTPAT,SDAY,SDLEN,SDCLS,SDSI,+SDF) ;convert pattern to array
K SDBLKS
;1 2 3 4 OR 6
D @SDSI
Q
1 ;1 increments per hour (60 min)
N AU,BCNT,BMIN,BSLOT,BSTART,BTIME,BSTOP,CNT,CNT1,HOUR,HR,HRP,P1,P2,SDCAN,SDTAR,SDI,SLOT,STA
D A^SDECUT1A(.STA,SDCL,SDAY,SDSI,SDCLS)
S SDI=0
F CNT1=2:2 Q:+$E(SDPAT,CNT1) Q:CNT1>$L(SDPAT) ;find 1st slot ;might not be on the hour
I CNT1>6 D
.S BSTART=SDAY_"."_$S($L(SDCLS)=1:"0"_SDCLS,1:SDCLS)
.S BTIME=SDCLS+(CNT1\8)
.S HR=$S($L(BTIME)=1:"0"_BTIME,1:BTIME)
.I '$D(STA(HR)) D STA
.S BTIME=$S($L(BTIME)=1:"0"_BTIME,1:BTIME)_$S((CNT1#8)=4:$P(STA(HR,4),U,2),(CNT1#8)=6:$P(STA(HR,6),U,2),(CNT1#8)=0:$P(STA(HR,0),U,2),1:$P(STA(HR,2),U,2))
.S BSTOP=SDAY_"."_BTIME
.S SDI=SDI+1 S SDBLKS(SDI)=BSTART_U_BSTOP_U_0_U_SDATUN
S (BSLOT,BSTART)=""
S HOUR=(SDCLS+(CNT1\8))-1
F CNT=CNT1:8 D Q:SLOT=""
.S HOUR=HOUR+1 ;I (CNT#8)=2 S HOUR=HOUR+1
.S HR=$S($L(HOUR)=1:"0"_HOUR,1:HOUR)
.I '$D(STA(HR)) D STA
.S:BSTART="" BSTART=SDAY_"."_HR_$S((CNT#8)=4:$P(STA(HR,4),U,2),(CNT#8)=6:$P(STA(HR,6),U,2),(CNT#8)=0:$P(STA(HR,0),U,2),1:$P(STA(HR,2),U,2))
.S SDCAN=$G(DTARRAY(SDAY,HR))="X"
.S SLOT=$S(SDCAN:"X",1:$E(SDPAT,CNT)) S SLOT=$S(SDCAN:"X",SLOT="":SLOT,+SLOT:SLOT,1:" ")
.S:BSLOT="" BSLOT=$S(SLOT="X":SLOT,+SLOT:SLOT,1:" ")
.I SLOT'=BSLOT D
..I BSLOT=" ",SLOT="",$E($P(BSTART,".",2),1,2)<18 Q
..S BMIN=$S((CNT#8)=4:$P(STA(HR,4),U,2),(CNT#8)=6:$P(STA(HR,6),U,2),(CNT#8)=0:$P(STA(HR,0),U,2),1:$P(STA(HR,2),U,2))
..S BTIME=$S((BMIN="")&((HOUR#10)=0):$E(HOUR),1:$S($L(HOUR)=1:"0"_HOUR,1:HOUR))_$S(BMIN'="":BMIN,1:"")
..S BSTOP=SDAY_"."_BTIME
..I $E($P(BSTOP,".",2),1,2)>23 S BSTOP=$P(BSTOP,".",1)_".2359"
..S SDI=SDI+1 S SDBLKS(SDI)=BSTART_U_BSTOP_U_BSLOT_U_$S(BSLOT="X":SDATCA,BSLOT=" ":SDATUN,1:SDATAV)
..S BSLOT=$S(SLOT="X":"X",+SLOT:SLOT,1:" ")
..S BSTART=BSTOP ;SDAY_"."_$S($L(HOUR)=1:"0"_HOUR,1:HOUR) ;_$S((CNT#8)=4:15,(CNT#8)=6:3,(CNT#8)=0:45,1:"")
.S BCNT=CNT
I $E($P(BSTART,".",2),1,2)<18 S SDI=SDI+1 S SDBLKS(SDI)=BSTART_U_SDAY_"."_18_U_0_U_SDATUN
Q
2 ;2 increments per hour (30 min)
N AU,BCNT,BSLOT,BSTART,BSTOP,BTIME,CNT,CNT1,HOUR,HR,HRP,P1,P2,SDCAN,SDI,SDTAR,SLOT,STA
S (BSLOT,BSTART,STA)=""
S SDI=0
S HOUR=SDCLS-1
F CNT1=2:2 S:(CNT1#8)=2 HOUR=HOUR+1 Q:+$E(SDPAT,CNT1) Q:CNT1>$L(SDPAT) ;find 1st slot ;might not be on the hour
Q:CNT1>$L(SDPAT)
D A^SDECUT1A(.STA,SDCL,SDAY,SDSI,SDCLS)
I CNT1>2 D
.S BSTART=SDAY_"."_$S($L(SDCLS)=1:"0"_SDCLS,1:SDCLS)
.S HR=$S($L(HOUR)=1:"0"_HOUR,1:HOUR)
.I '$D(STA(HR)) D STA
.S BSTOP=SDAY_"."_HR_$S((CNT1#8)=4:$P(STA(HR,4),U,2),(CNT1#8)=6:$P(STA(HR,6),U,2),(CNT1#8)=0:$P(STA(HR,0),U,2),1:$P(STA(HR,2),U,2))
.D MAKE(.SDBLKS,.SDI,BSTART,BSTOP,0)
S BSTART=""
I ((CNT1#8)=2)!((CNT1#8)=4) S HOUR=HOUR-1
F CNT=CNT1:4 D Q:SLOT=""
.I ((CNT#8)=2)!((CNT#8)=4) S HOUR=HOUR+1
.S HR=$S($L(HOUR)=1:"0"_HOUR,1:HOUR)
.I '$D(STA(HR)) D STA
.S:BSTART="" BSTART=SDAY_"."_HR_$S((CNT#8)=4:$P(STA(HR,4),U,2),(CNT#8)=6:$P(STA(HR,6),U,2),(CNT#8)=0:$P(STA(HR,0),U,2),1:$P(STA(HR,2),U,2))
.S SDCAN=$G(DTARRAY(SDAY,HR_$S((CNT#8)=4:$P(STA(HR,4),U,1),(CNT#8)=6:$P(STA(HR,6),U,1),(CNT#8)=0:$P(STA(HR,0),U,1),1:$P(STA(HR,2),U,1))))="X"
.S SLOT=$S(SDCAN:"X",1:$E(SDPAT,CNT)) S SLOT=$S(SDCAN:"X",SLOT="":SLOT,+SLOT:SLOT,1:" ")
.S:BSLOT="" BSLOT=$S(SLOT="X":SLOT,+SLOT:SLOT,1:" ")
.I SLOT'=BSLOT D
..I BSLOT=" ",SLOT="",$E($P(BSTART,".",2),1,2)<18 Q
..S BTIME=$S(((CNT#8)=2)&((HOUR#10)=0):$E(HOUR),1:$S($L(HOUR)=1:"0"_HOUR,1:HOUR)_$S((CNT#8)=4:$P(STA(HR,4),U,2),(CNT#8)=6:$P(STA(HR,6),U,2),(CNT#8)=0:$P(STA(HR,0),U,2),1:$P(STA(HR,2),U,2)))
..S BSTOP=SDAY_"."_BTIME
..I $E($P(BSTOP,".",2),1,2)>23 S BSTOP=$P(BSTOP,".",1)_".2359"
..S SDI=SDI+1 S SDBLKS(SDI)=BSTART_U_BSTOP_U_BSLOT_U_$S(BSLOT="X":SDATCA,BSLOT=" ":SDATUN,1:SDATAV)
..S BSLOT=$S(SLOT="X":"X",+SLOT:SLOT,1:" ")
..S BSTART=BSTOP ;SDAY_"."_$S($L(HOUR)=1:"0"_HOUR,1:HOUR)_$S((CNT#8)=6:3,1:"")
.S BCNT=CNT
I $E($P(BSTART,".",2),1,2)<18 S SDI=SDI+1 S SDBLKS(SDI)=BSTART_U_SDAY_"."_18_U_U_SDATUN
Q
3 ;3 increments per hour (20 min)
N AU,BCNT,BSLOT,BSTART,BSTOP,BTIME,CNT,CNT1,HOUR,HR,HRP,P1,P2,SDCAN,SDI,SDTAR,SLOT,STA
S (BSLOT,BSTART)=""
S SDI=0
S HOUR=SDCLS-1
F CNT1=2:2 S:(CNT1#6)=2 HOUR=HOUR+1 Q:+$E(SDPAT,CNT1) Q:CNT1>$L(SDPAT) ;find 1st slot ;might not be on the hour
Q:CNT1>$L(SDPAT)
D A^SDECUT1A(.STA,SDCL,SDAY,SDSI,SDCLS)
I CNT1>2 D
.S BSTART=SDAY_"."_$S($L(SDCLS)=1:"0"_SDCLS,1:SDCLS)
.S HR=$S($L(HOUR)=1:"0"_HOUR,1:HOUR)
.I '$D(STA(HR)) D STA
.S BSTOP=SDAY_"."_HR_$S((CNT1#6)=4:$P(STA(HR,4),U,2),(CNT1#6)=0:$P(STA(HR,0),U,2),1:$P(STA(HR,2),U,2))
.D MAKE(.SDBLKS,.SDI,BSTART,BSTOP,0)
S BSTART=""
I ((CNT1#6)=2) S HOUR=HOUR-1
F CNT=CNT1:2 D Q:SLOT=""
.I (CNT#6)=2 S HOUR=HOUR+1
.S HR=$S($L(HOUR)=1:"0"_HOUR,1:HOUR)
.I '$D(STA(HR)) D STA
.S:BSTART="" BSTART=SDAY_"."_HR_$S((CNT#6)=4:$P(STA(HR,4),U,2),(CNT#6)=0:$P(STA(HR,0),U,2),1:$P(STA(HR,2),U,2))
.S SDCAN=$G(DTARRAY(SDAY,HR_$S((CNT#6)=4:$P(STA(HR,4),U,1),(CNT#6)=0:$P(STA(HR,0),U,1),1:$P(STA(HR,2),U,1))))="X"
.S SLOT=$S(SDCAN:"X",1:$E(SDPAT,CNT)) S SLOT=$S(SDCAN:"X",SLOT="":SLOT,+SLOT:SLOT,1:" ")
.S:BSLOT="" BSLOT=$S(SLOT="X":SLOT,+SLOT:SLOT,1:" ")
.I SLOT'=BSLOT D
..I BSLOT=" ",SLOT="",$E($P(BSTART,".",2),1,2)<18 Q
..;S HR=$S($L(HOUR)=1:"0"_HOUR,1:HOUR)
..S BTIME=$S(((CNT#6)=2)&((HOUR#10)=0):$E(HOUR),1:$S($L(HOUR)=1:"0"_HOUR,1:HOUR)_$S((CNT#6)=4:$P(STA(HR,4),U,2),(CNT#6)=0:$P(STA(HR,0),U,2),1:$P(STA(HR,2),U,2)))
..S BSTOP=SDAY_"."_BTIME
..I $E($P(BSTOP,".",2),1,2)>23 S BSTOP=$P(BSTOP,".",1)_".2359"
..S SDI=SDI+1 S SDBLKS(SDI)=BSTART_U_BSTOP_U_BSLOT_U_$S(BSLOT="X":SDATCA,BSLOT=" ":SDATUN,1:SDATAV)
..S BSLOT=$S(SLOT="X":"X",+SLOT:SLOT,1:" ")
..S BSTART=BSTOP ;SDAY_"."_$S($L(HOUR)=1:"0"_HOUR,1:HOUR)_$S((CNT#6)=4:2,(CNT#6)=0:4,1:"")
.S BCNT=CNT
I $E($P(BSTART,".",2),1,2)<18 S SDI=SDI+1 S SDBLKS(SDI)=BSTART_U_SDAY_"."_18_U_U_SDATUN
Q
4 ;4 increments per hour (15 min)
N AU,BCNT,BSLOT,BSTART,BSTOP,BTIME,CNT,CNT1,HOUR,HR,HRP,P1,P2,SDCAN,SDI,SDTAR,SLOT,STA
S (BSLOT,BSTART,STA)=""
S SDI=0
D A^SDECUT1A(.STA,SDCL,SDAY,SDSI,SDCLS)
S HOUR=SDCLS-1
F CNT=2:2 D Q:SLOT=""
.I (CNT#8)=2 S HOUR=HOUR+1
.S HR=$S($L(HOUR)=1:"0"_HOUR,1:HOUR)
.I '$D(STA(HR)) D STA
.S:BSTART="" BSTART=SDAY_"."_HR_$S((CNT#8)=4:$P(STA(HR,4),U,2),(CNT#8)=6:$P(STA(HR,6),U,2),(CNT#8)=0:$P(STA(HR,0),U,2),1:$P(STA(HR,2),U,2))
.S SDCAN=$G(DTARRAY(SDAY,HR_$S((CNT#8)=4:$P(STA(HR,4),U,1),(CNT#8)=6:$P(STA(HR,6),U,1),(CNT#8)=0:$P(STA(HR,0),U,1),1:$P(STA(HR,2),U,1))))="X"
.S SLOT=$S(SDCAN:"X",1:$E(SDPAT,CNT)) S SLOT=$S(SDCAN:"X",SLOT="":SLOT,+SLOT:SLOT,1:" ")
.S:BSLOT="" BSLOT=$S(SLOT="X":SLOT,+SLOT:SLOT,1:" ")
.I SLOT'=BSLOT D
..I BSLOT=" ",SLOT="",$E($P(BSTART,".",2),1,2)<18 Q
..S BTIME=$S(((CNT#8)=2)&((HOUR#10)=0):$E(HOUR),1:$S($L(HOUR)=1:"0"_HOUR,1:HOUR)_$S((CNT#8)=4:$P(STA(HR,4),U,2),(CNT#8)=6:$P(STA(HR,6),U,2),(CNT#8)=0:$P(STA(HR,0),U,2),1:$P(STA(HR,2),U,2)))
..S BSTOP=SDAY_"."_BTIME
..I $E($P(BSTOP,".",2),1,2)>23 S BSTOP=$P(BSTOP,".",1)_".2359"
..S SDI=SDI+1 S SDBLKS(SDI)=BSTART_U_BSTOP_U_BSLOT_U_$S(BSLOT="X":SDATCA,BSLOT=" ":SDATUN,1:SDATAV)
..S BSLOT=$S(SLOT="X":"X",+SLOT:SLOT,1:" ")
..S BSTART=BSTOP ;SDAY_"."_$S($L(HOUR)=1:"0"_HOUR,1:HOUR)_$S((CNT#8)=4:15,(CNT#8)=6:3,(CNT#8)=0:45,1:"")
.S BCNT=CNT
I $E($P(BSTART,".",2),1,2)<18 S SDI=SDI+1 S SDBLKS(SDI)=BSTART_U_SDAY_"."_18_U_U_SDATUN
Q
6 ;6 increments per hour (10 min)
N AU,BCNT,BSLOT,BSTART,BSTOP,BTIME,CNT,CNT1,HOUR,HR,HRP,P1,P2,SDCAN,SDI,SDTAR,SLOT,STA
S (BSLOT,BSTART)=""
S SDI=0
D A^SDECUT1A(.STA,SDCL,SDAY,SDSI,SDCLS)
S HOUR=SDCLS-1
F CNT=2:2 D Q:SLOT=""
.I (CNT#12)=2 S HOUR=HOUR+1
.S HR=$S($L(HOUR)=1:"0"_HOUR,1:HOUR)
.I '$D(STA(HR)) D STA
.S:BSTART="" BSTART=SDAY_"."_HR_$S((CNT#12)=4:$P(STA(HR,4),U,2),(CNT#12)=6:$P(STA(HR,6),U,2),(CNT#12)=8:$P(STA(HR,8),U,2),(CNT#12)=10:$P(STA(HR,10),U,2),(CNT#12)=0:$P(STA(HR,0),U,2),1:$P(STA(HR,2),U,2))
.S SDCAN=$G(DTARRAY(SDAY,$S($L(HOUR)=1:"0"_HOUR,1:HOUR)_$S((CNT#12)=4:$P(STA(HR,4),U,1),(CNT#12)=6:$P(STA(HR,6),U,1),(CNT#12)=8:$P(STA(HR,8),U,1),(CNT#12)=10:$P(STA(HR,10),U,1),(CNT#12)=0:$P(STA(HR,0),U,1),1:$P(STA(HR,2),U,1))))="X"
.S SLOT=$S(SDCAN:"X",1:$E(SDPAT,CNT)) S SLOT=$S(SDCAN:"X",SLOT="":SLOT,+SLOT:SLOT,1:" ")
.S:BSLOT="" BSLOT=$S(SLOT="X":SLOT,+SLOT:SLOT,1:" ")
.I SLOT'=BSLOT D
..I BSLOT=" ",SLOT="",$E($P(BSTART,".",2),1,2)<18 Q
..S HR=$S($L(HOUR)=1:"0"_HOUR,1:HOUR)
..S BTIME=HR_$S((CNT#12)=4:$P(STA(HR,4),U,2),(CNT#12)=6:$P(STA(HR,6),U,2),(CNT#12)=8:$P(STA(HR,8),U,2),(CNT#12)=10:$P(STA(HR,10),U,2),(CNT#12)=0:$P(STA(HR,0),U,2),1:$P(STA(HR,2),U,2))
..S BSTOP=SDAY_"."_BTIME
..I $E($P(BSTOP,".",2),1,2)>23 S BSTOP=$P(BSTOP,".",1)_".2359"
..S SDI=SDI+1 S SDBLKS(SDI)=BSTART_U_BSTOP_U_BSLOT_U_$S(BSLOT="X":SDATCA,BSLOT=" ":SDATUN,1:SDATAV)
..S BSLOT=$S(SLOT="X":"X",+SLOT:SLOT,1:" ")
..S BSTART=BSTOP ;SDAY_"."_$S($L(HOUR)=1:"0"_HOUR,1:HOUR)_$S((CNT#12)=4:1,(CNT#12)=6:2,(CNT#12)=8:3,(CNT#12)=10:4,(CNT#12)=0:5,1:"")
.S BCNT=CNT
I $E($P(BSTART,".",2),1,2)<18 S SDI=SDI+1 S SDBLKS(SDI)=BSTART_U_SDAY_"."_18_U_U_SDATUN
Q
STA ;
N HRP
S HRP=HR-1 S HRP=$S($L(HRP)=1:"0"_HRP,1:HRP)
I $D(STA(HRP)) D
.S STA(HR,4)=STA(HRP,4)
.S:SDSI'=3 STA(HR,6)=STA(HRP,6)
.S:SDSI=6 STA(HR,8)=STA(HRP,8)
.S:SDSI=6 STA(HR,10)=STA(HRP,10)
.S STA(HR,0)=STA(HRP,0)
.S STA(HR,2)=STA(HRP,2)
E X "D B"_SDSI_"^SDECUT1A(.STA,"""_HR_""",0)"
Q
;
MAKE(SDBLKS,SDI,START,STOP,SLOT) ;make block
N SDATAV,SDATUN
S SDATAV=$O(^SDEC(409.823,"B","AVAILABLE",0))
S SDATUN=$O(^SDEC(409.823,"B","UNAVAILABLE",0))
S SDI=SDI+1 S SDBLKS(SDI)=START_U_STOP_U_SLOT_U_$S(+SLOT:SDATAV,1:SDATUN)
Q
;
RESNB(SDAB,SDBLKS,SDCL,SDAY,SDRES) ;create/update access blocks for 1 day
N SDI,SDJ,SDNOD,SDRESP
Q:'$D(SDBLKS)
Q:$G(SDAY)'?7N
S SDRESP=$G(SDRES)
;delete all related access blocks
;build new access blocks with calls to RESNB1
S SDI="" F S SDI=$O(SDBLKS(SDI)) Q:SDI="" D
.S SDNOD=SDBLKS(SDI)
.Q:$P($P(SDNOD,U,1),".",1)'=SDAY
.D RESNB1(SDAB,SDCL,$P(SDNOD,U,1),$P(SDNOD,U,2),$P(SDNOD,U,3),$P(SDNOD,U,4),,$P(SDNOD,U,5)) ;alb/sat 658 add 8 param OBM
Q
;
RESNBD(SDCL,SDAY,SDRESP) ;delete access blocks for the day
Q
;
RESNB1(SDAB,SDCL,SDSTART,SDSTOP,SDSLOTS,SDAT,SDRES,OBM) ;create/update 1 access block ;alb/sat 658 add OBM
;INPUT:
; SDAB - global name for access blocks - "^TMP("_$J_",""SDEC"",""BLKS"")"
; SDCL - clinic ID pointer to HOSPITAL LOCATION file
; not used if SDRES is passed in
; SDSTART - start time in FM format
; SDSTOP - stop time in FM format
; SDSLOTS - number of slots
; SDAT - access type ID pointer to SDEC ACCESS TYPE file
; SDRES - resource ID pointer to SDEC RESOURCE file
; only update this resource if passed in
; calling routine needs to make sure SDRES belongs to the proper HOSPITAL LOCATION (sdcl)
S SDRES=$G(SDRES)
D RESNBR
Q
;only update passed in resource
I SDRES'="" I $D(^SDEC(409.831,"ALOC",SDCL,SDRES)) D RESNBR Q
;update all resources if no resource passed in
I SDRES="" S SDRES=0 F S SDRES=$O(^SDEC(409.831,"ALOC",SDCL,SDRES)) Q:SDRES'>0 D RESNBR
Q
RESNBR ;create access block for 1 resource
N SDCNT,SDFDA,SDIEN,SDIENS,SDMSG
S (SDCNT,@SDAB@("CNT"))=$G(@SDAB@("CNT"))+1
S @SDAB@(SDCNT)=SDRES_U_SDSTART_U_SDSTOP_U_SDSLOTS_U_SDAT_U_$G(OBM) ;alb/sat 658 add OBM
Q
;
DAY ;;^SUN^MON^TUES^WEDNES^THURS^FRI^SATUR
;
GETDAY(DATE) ;return day of the week
N DOW,RET
S RET=""
S DATE=$P($G(DATE),".",1)
Q:DATE'?7N RET
S DOW="S %=$E(DATE,1,3),I=$E(DATE,4,5),I=I>2&'(%#4)+$E(""144025036146"",I) X ""F %=%:-1:281 S I=%#4=1+1+I"" S RET=$P(""SUN^MON^TUES^WEDNES^THURS^FRI^SATUR"",U,$E(DATE,6,7)+I#7+1)_""DAY"""
X DOW
Q RET
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDECUTL1 13055 printed Dec 13, 2024@02:52:53 Page 2
SDECUTL1 ;ALB/SAT - VISTA SCHEDULING RPCS ;MAR 15, 2017
+1 ;;5.3;Scheduling;**627,642,658**;Aug 13, 1993;Build 23
+2 ;
+3 QUIT
+4 ;
GETBLKS(SDBLKS,SDPAT,SDAY,SDCLS,SDLEN,SDSI,SDCL) ;build access block array SDBLKS from pattern SDPAT
+1 ;INPUT:
+2 ; SDPAT - Pattern from CURRENT AVAILABILITY field of PATTERN multiple in file 44
+3 ; SDAY - date (no time) in FM format
+4 ; SDCLS - hour clinic display begins from field 1914 in file 44
+5 ; SDLEN - length of app't from field 1912 in file 44
+6 ; SDSI - display increments per hour
+7 ;RETURN:
+8 ; .SDBLKS - array of access block data to be stored in SDEC ACCESS BLOCK file
+9 ; SDBLKS(<count>)=<start time> ^ <end time> ^ <slots> ^ <access type>
+10 NEW DTARRAY
+11 NEW SDATAV,SDATCA,SDATUN,SDF,SDI,SDSIM,SDSTPAT
+12 SET SDF=0
+13 SET SDATAV=$ORDER(^SDEC(409.823,"B","AVAILABLE",0))
+14 SET SDATCA=$ORDER(^SDEC(409.823,"B","CANCELED",0))
+15 SET SDATUN=$ORDER(^SDEC(409.823,"B","UNAVAILABLE",0))
+16 ;SDSIM - calculated using DISPLAY INCREMENTS PER HOUR field from file 44
+17 ; $S(X="":4,X<3:4,X:X,1:4)
+18 SET SDSIM=$SELECT(SDSI="":4,SDSI<3:4,SDSI:SDSI,1:4)
+19 ;S SDPAT=$E(SDPAT,SDSIM+SDSIM,90)
+20 ;get PATTERN from file 44
SET SDSTPAT=$GET(^SC(SDCL,"ST",SDAY,1))
IF SDSTPAT["CANCELLED"
SET SDF=1
SET SDSTPAT=$GET(^SC(SDCL,"ST",SDAY,"CAN"))
+21 ;convert pattern to array
if SDSTPAT'=""
DO ARRAY^SDECUTL2(.DTARRAY,SDSTPAT,SDAY,SDLEN,SDCLS,SDSI,+SDF)
+22 KILL SDBLKS
+23 ;1 2 3 4 OR 6
+24 DO @SDSI
+25 QUIT
1 ;1 increments per hour (60 min)
+1 NEW AU,BCNT,BMIN,BSLOT,BSTART,BTIME,BSTOP,CNT,CNT1,HOUR,HR,HRP,P1,P2,SDCAN,SDTAR,SDI,SLOT,STA
+2 DO A^SDECUT1A(.STA,SDCL,SDAY,SDSI,SDCLS)
+3 SET SDI=0
+4 ;find 1st slot ;might not be on the hour
FOR CNT1=2:2
if +$EXTRACT(SDPAT,CNT1)
QUIT
if CNT1>$LENGTH(SDPAT)
QUIT
+5 IF CNT1>6
Begin DoDot:1
+6 SET BSTART=SDAY_"."_$SELECT($LENGTH(SDCLS)=1:"0"_SDCLS,1:SDCLS)
+7 SET BTIME=SDCLS+(CNT1\8)
+8 SET HR=$SELECT($LENGTH(BTIME)=1:"0"_BTIME,1:BTIME)
+9 IF '$DATA(STA(HR))
DO STA
+10 SET BTIME=$SELECT($LENGTH(BTIME)=1:"0"_BTIME,1:BTIME)_$SELECT((CNT1#8)=4:$PIECE(STA(HR,4),U,2),(CNT1#8)=6:$PIECE(STA(HR,6),U,2),(CNT1#8)=0:$PIECE(STA(HR,0),U,2),1:$PIECE(STA(HR,2),U,2))
+11 SET BSTOP=SDAY_"."_BTIME
+12 SET SDI=SDI+1
SET SDBLKS(SDI)=BSTART_U_BSTOP_U_0_U_SDATUN
End DoDot:1
+13 SET (BSLOT,BSTART)=""
+14 SET HOUR=(SDCLS+(CNT1\8))-1
+15 FOR CNT=CNT1:8
Begin DoDot:1
+16 ;I (CNT#8)=2 S HOUR=HOUR+1
SET HOUR=HOUR+1
+17 SET HR=$SELECT($LENGTH(HOUR)=1:"0"_HOUR,1:HOUR)
+18 IF '$DATA(STA(HR))
DO STA
+19 if BSTART=""
SET BSTART=SDAY_"."_HR_$SELECT((CNT#8)=4:$PIECE(STA(HR,4),U,2),(CNT#8)=6:$PIECE(STA(HR,6),U,2),(CNT#8)=0:$PIECE(STA(HR,0),U,2),1:$PIECE(STA(HR,2),U,2))
+20 SET SDCAN=$GET(DTARRAY(SDAY,HR))="X"
+21 SET SLOT=$SELECT(SDCAN:"X",1:$EXTRACT(SDPAT,CNT))
SET SLOT=$SELECT(SDCAN:"X",SLOT="":SLOT,+SLOT:SLOT,1:" ")
+22 if BSLOT=""
SET BSLOT=$SELECT(SLOT="X":SLOT,+SLOT:SLOT,1:" ")
+23 IF SLOT'=BSLOT
Begin DoDot:2
+24 IF BSLOT=" "
IF SLOT=""
IF $EXTRACT($PIECE(BSTART,".",2),1,2)<18
QUIT
+25 SET BMIN=$SELECT((CNT#8)=4:$PIECE(STA(HR,4),U,2),(CNT#8)=6:$PIECE(STA(HR,6),U,2),(CNT#8)=0:$PIECE(STA(HR,0),U,2),1:$PIECE(STA(HR,2),U,2))
+26 SET BTIME=$SELECT((BMIN="")&((HOUR#10)=0):$EXTRACT(HOUR),1:$SELECT($LENGTH(HOUR)=1:"0"_HOUR,1:HOUR))_$SELECT(BMIN'="":BMIN,1:"")
+27 SET BSTOP=SDAY_"."_BTIME
+28 IF $EXTRACT($PIECE(BSTOP,".",2),1,2)>23
SET BSTOP=$PIECE(BSTOP,".",1)_".2359"
+29 SET SDI=SDI+1
SET SDBLKS(SDI)=BSTART_U_BSTOP_U_BSLOT_U_$SELECT(BSLOT="X":SDATCA,BSLOT=" ":SDATUN,1:SDATAV)
+30 SET BSLOT=$SELECT(SLOT="X":"X",+SLOT:SLOT,1:" ")
+31 ;SDAY_"."_$S($L(HOUR)=1:"0"_HOUR,1:HOUR) ;_$S((CNT#8)=4:15,(CNT#8)=6:3,(CNT#8)=0:45,1:"")
SET BSTART=BSTOP
End DoDot:2
+32 SET BCNT=CNT
End DoDot:1
if SLOT=""
QUIT
+33 IF $EXTRACT($PIECE(BSTART,".",2),1,2)<18
SET SDI=SDI+1
SET SDBLKS(SDI)=BSTART_U_SDAY_"."_18_U_0_U_SDATUN
+34 QUIT
2 ;2 increments per hour (30 min)
+1 NEW AU,BCNT,BSLOT,BSTART,BSTOP,BTIME,CNT,CNT1,HOUR,HR,HRP,P1,P2,SDCAN,SDI,SDTAR,SLOT,STA
+2 SET (BSLOT,BSTART,STA)=""
+3 SET SDI=0
+4 SET HOUR=SDCLS-1
+5 ;find 1st slot ;might not be on the hour
FOR CNT1=2:2
if (CNT1#8)=2
SET HOUR=HOUR+1
if +$EXTRACT(SDPAT,CNT1)
QUIT
if CNT1>$LENGTH(SDPAT)
QUIT
+6 if CNT1>$LENGTH(SDPAT)
QUIT
+7 DO A^SDECUT1A(.STA,SDCL,SDAY,SDSI,SDCLS)
+8 IF CNT1>2
Begin DoDot:1
+9 SET BSTART=SDAY_"."_$SELECT($LENGTH(SDCLS)=1:"0"_SDCLS,1:SDCLS)
+10 SET HR=$SELECT($LENGTH(HOUR)=1:"0"_HOUR,1:HOUR)
+11 IF '$DATA(STA(HR))
DO STA
+12 SET BSTOP=SDAY_"."_HR_$SELECT((CNT1#8)=4:$PIECE(STA(HR,4),U,2),(CNT1#8)=6:$PIECE(STA(HR,6),U,2),(CNT1#8)=0:$PIECE(STA(HR,0),U,2),1:$PIECE(STA(HR,2),U,2))
+13 DO MAKE(.SDBLKS,.SDI,BSTART,BSTOP,0)
End DoDot:1
+14 SET BSTART=""
+15 IF ((CNT1#8)=2)!((CNT1#8)=4)
SET HOUR=HOUR-1
+16 FOR CNT=CNT1:4
Begin DoDot:1
+17 IF ((CNT#8)=2)!((CNT#8)=4)
SET HOUR=HOUR+1
+18 SET HR=$SELECT($LENGTH(HOUR)=1:"0"_HOUR,1:HOUR)
+19 IF '$DATA(STA(HR))
DO STA
+20 if BSTART=""
SET BSTART=SDAY_"."_HR_$SELECT((CNT#8)=4:$PIECE(STA(HR,4),U,2),(CNT#8)=6:$PIECE(STA(HR,6),U,2),(CNT#8)=0:$PIECE(STA(HR,0),U,2),1:$PIECE(STA(HR,2),U,2))
+21 SET SDCAN=$GET(DTARRAY(SDAY,HR_$SELECT((CNT#8)=4:$PIECE(STA(HR,4),U,1),(CNT#8)=6:$PIECE(STA(HR,6),U,1),(CNT#8)=0:$PIECE(STA(HR,0),U,1),1:$PIECE(STA(HR,2),U,1))))="X"
+22 SET SLOT=$SELECT(SDCAN:"X",1:$EXTRACT(SDPAT,CNT))
SET SLOT=$SELECT(SDCAN:"X",SLOT="":SLOT,+SLOT:SLOT,1:" ")
+23 if BSLOT=""
SET BSLOT=$SELECT(SLOT="X":SLOT,+SLOT:SLOT,1:" ")
+24 IF SLOT'=BSLOT
Begin DoDot:2
+25 IF BSLOT=" "
IF SLOT=""
IF $EXTRACT($PIECE(BSTART,".",2),1,2)<18
QUIT
+26 SET BTIME=$SELECT(((CNT#8)=2)&((HOUR#10)=0):$EXTRACT(HOUR),1:$SELECT($LENGTH(HOUR)=1:"0"_HOUR,1:HOUR)_$SELECT((CNT#8)=4:$PIECE(STA(HR,4),U,2),(CNT#8)=6:$PIECE(STA(HR,6),U,2),(CNT#8)=0:$PIECE(STA(HR,0),U,2),1:$PIECE(STA(HR,2),U,2
)))
+27 SET BSTOP=SDAY_"."_BTIME
+28 IF $EXTRACT($PIECE(BSTOP,".",2),1,2)>23
SET BSTOP=$PIECE(BSTOP,".",1)_".2359"
+29 SET SDI=SDI+1
SET SDBLKS(SDI)=BSTART_U_BSTOP_U_BSLOT_U_$SELECT(BSLOT="X":SDATCA,BSLOT=" ":SDATUN,1:SDATAV)
+30 SET BSLOT=$SELECT(SLOT="X":"X",+SLOT:SLOT,1:" ")
+31 ;SDAY_"."_$S($L(HOUR)=1:"0"_HOUR,1:HOUR)_$S((CNT#8)=6:3,1:"")
SET BSTART=BSTOP
End DoDot:2
+32 SET BCNT=CNT
End DoDot:1
if SLOT=""
QUIT
+33 IF $EXTRACT($PIECE(BSTART,".",2),1,2)<18
SET SDI=SDI+1
SET SDBLKS(SDI)=BSTART_U_SDAY_"."_18_U_U_SDATUN
+34 QUIT
3 ;3 increments per hour (20 min)
+1 NEW AU,BCNT,BSLOT,BSTART,BSTOP,BTIME,CNT,CNT1,HOUR,HR,HRP,P1,P2,SDCAN,SDI,SDTAR,SLOT,STA
+2 SET (BSLOT,BSTART)=""
+3 SET SDI=0
+4 SET HOUR=SDCLS-1
+5 ;find 1st slot ;might not be on the hour
FOR CNT1=2:2
if (CNT1#6)=2
SET HOUR=HOUR+1
if +$EXTRACT(SDPAT,CNT1)
QUIT
if CNT1>$LENGTH(SDPAT)
QUIT
+6 if CNT1>$LENGTH(SDPAT)
QUIT
+7 DO A^SDECUT1A(.STA,SDCL,SDAY,SDSI,SDCLS)
+8 IF CNT1>2
Begin DoDot:1
+9 SET BSTART=SDAY_"."_$SELECT($LENGTH(SDCLS)=1:"0"_SDCLS,1:SDCLS)
+10 SET HR=$SELECT($LENGTH(HOUR)=1:"0"_HOUR,1:HOUR)
+11 IF '$DATA(STA(HR))
DO STA
+12 SET BSTOP=SDAY_"."_HR_$SELECT((CNT1#6)=4:$PIECE(STA(HR,4),U,2),(CNT1#6)=0:$PIECE(STA(HR,0),U,2),1:$PIECE(STA(HR,2),U,2))
+13 DO MAKE(.SDBLKS,.SDI,BSTART,BSTOP,0)
End DoDot:1
+14 SET BSTART=""
+15 IF ((CNT1#6)=2)
SET HOUR=HOUR-1
+16 FOR CNT=CNT1:2
Begin DoDot:1
+17 IF (CNT#6)=2
SET HOUR=HOUR+1
+18 SET HR=$SELECT($LENGTH(HOUR)=1:"0"_HOUR,1:HOUR)
+19 IF '$DATA(STA(HR))
DO STA
+20 if BSTART=""
SET BSTART=SDAY_"."_HR_$SELECT((CNT#6)=4:$PIECE(STA(HR,4),U,2),(CNT#6)=0:$PIECE(STA(HR,0),U,2),1:$PIECE(STA(HR,2),U,2))
+21 SET SDCAN=$GET(DTARRAY(SDAY,HR_$SELECT((CNT#6)=4:$PIECE(STA(HR,4),U,1),(CNT#6)=0:$PIECE(STA(HR,0),U,1),1:$PIECE(STA(HR,2),U,1))))="X"
+22 SET SLOT=$SELECT(SDCAN:"X",1:$EXTRACT(SDPAT,CNT))
SET SLOT=$SELECT(SDCAN:"X",SLOT="":SLOT,+SLOT:SLOT,1:" ")
+23 if BSLOT=""
SET BSLOT=$SELECT(SLOT="X":SLOT,+SLOT:SLOT,1:" ")
+24 IF SLOT'=BSLOT
Begin DoDot:2
+25 IF BSLOT=" "
IF SLOT=""
IF $EXTRACT($PIECE(BSTART,".",2),1,2)<18
QUIT
+26 ;S HR=$S($L(HOUR)=1:"0"_HOUR,1:HOUR)
+27 SET BTIME=$SELECT(((CNT#6)=2)&((HOUR#10)=0):$EXTRACT(HOUR),1:$SELECT($LENGTH(HOUR)=1:"0"_HOUR,1:HOUR)_$SELECT((CNT#6)=4:$PIECE(STA(HR,4),U,2),(CNT#6)=0:$PIECE(STA(HR,0),U,2),1:$PIECE(STA(HR,2),U,2)))
+28 SET BSTOP=SDAY_"."_BTIME
+29 IF $EXTRACT($PIECE(BSTOP,".",2),1,2)>23
SET BSTOP=$PIECE(BSTOP,".",1)_".2359"
+30 SET SDI=SDI+1
SET SDBLKS(SDI)=BSTART_U_BSTOP_U_BSLOT_U_$SELECT(BSLOT="X":SDATCA,BSLOT=" ":SDATUN,1:SDATAV)
+31 SET BSLOT=$SELECT(SLOT="X":"X",+SLOT:SLOT,1:" ")
+32 ;SDAY_"."_$S($L(HOUR)=1:"0"_HOUR,1:HOUR)_$S((CNT#6)=4:2,(CNT#6)=0:4,1:"")
SET BSTART=BSTOP
End DoDot:2
+33 SET BCNT=CNT
End DoDot:1
if SLOT=""
QUIT
+34 IF $EXTRACT($PIECE(BSTART,".",2),1,2)<18
SET SDI=SDI+1
SET SDBLKS(SDI)=BSTART_U_SDAY_"."_18_U_U_SDATUN
+35 QUIT
4 ;4 increments per hour (15 min)
+1 NEW AU,BCNT,BSLOT,BSTART,BSTOP,BTIME,CNT,CNT1,HOUR,HR,HRP,P1,P2,SDCAN,SDI,SDTAR,SLOT,STA
+2 SET (BSLOT,BSTART,STA)=""
+3 SET SDI=0
+4 DO A^SDECUT1A(.STA,SDCL,SDAY,SDSI,SDCLS)
+5 SET HOUR=SDCLS-1
+6 FOR CNT=2:2
Begin DoDot:1
+7 IF (CNT#8)=2
SET HOUR=HOUR+1
+8 SET HR=$SELECT($LENGTH(HOUR)=1:"0"_HOUR,1:HOUR)
+9 IF '$DATA(STA(HR))
DO STA
+10 if BSTART=""
SET BSTART=SDAY_"."_HR_$SELECT((CNT#8)=4:$PIECE(STA(HR,4),U,2),(CNT#8)=6:$PIECE(STA(HR,6),U,2),(CNT#8)=0:$PIECE(STA(HR,0),U,2),1:$PIECE(STA(HR,2),U,2))
+11 SET SDCAN=$GET(DTARRAY(SDAY,HR_$SELECT((CNT#8)=4:$PIECE(STA(HR,4),U,1),(CNT#8)=6:$PIECE(STA(HR,6),U,1),(CNT#8)=0:$PIECE(STA(HR,0),U,1),1:$PIECE(STA(HR,2),U,1))))="X"
+12 SET SLOT=$SELECT(SDCAN:"X",1:$EXTRACT(SDPAT,CNT))
SET SLOT=$SELECT(SDCAN:"X",SLOT="":SLOT,+SLOT:SLOT,1:" ")
+13 if BSLOT=""
SET BSLOT=$SELECT(SLOT="X":SLOT,+SLOT:SLOT,1:" ")
+14 IF SLOT'=BSLOT
Begin DoDot:2
+15 IF BSLOT=" "
IF SLOT=""
IF $EXTRACT($PIECE(BSTART,".",2),1,2)<18
QUIT
+16 SET BTIME=$SELECT(((CNT#8)=2)&((HOUR#10)=0):$EXTRACT(HOUR),1:$SELECT($LENGTH(HOUR)=1:"0"_HOUR,1:HOUR)_$SELECT((CNT#8)=4:$PIECE(STA(HR,4),U,2),(CNT#8)=6:$PIECE(STA(HR,6),U,2),(CNT#8)=0:$PIECE(STA(HR,0),U,2),1:$PIECE(STA(HR,2),U,2
)))
+17 SET BSTOP=SDAY_"."_BTIME
+18 IF $EXTRACT($PIECE(BSTOP,".",2),1,2)>23
SET BSTOP=$PIECE(BSTOP,".",1)_".2359"
+19 SET SDI=SDI+1
SET SDBLKS(SDI)=BSTART_U_BSTOP_U_BSLOT_U_$SELECT(BSLOT="X":SDATCA,BSLOT=" ":SDATUN,1:SDATAV)
+20 SET BSLOT=$SELECT(SLOT="X":"X",+SLOT:SLOT,1:" ")
+21 ;SDAY_"."_$S($L(HOUR)=1:"0"_HOUR,1:HOUR)_$S((CNT#8)=4:15,(CNT#8)=6:3,(CNT#8)=0:45,1:"")
SET BSTART=BSTOP
End DoDot:2
+22 SET BCNT=CNT
End DoDot:1
if SLOT=""
QUIT
+23 IF $EXTRACT($PIECE(BSTART,".",2),1,2)<18
SET SDI=SDI+1
SET SDBLKS(SDI)=BSTART_U_SDAY_"."_18_U_U_SDATUN
+24 QUIT
6 ;6 increments per hour (10 min)
+1 NEW AU,BCNT,BSLOT,BSTART,BSTOP,BTIME,CNT,CNT1,HOUR,HR,HRP,P1,P2,SDCAN,SDI,SDTAR,SLOT,STA
+2 SET (BSLOT,BSTART)=""
+3 SET SDI=0
+4 DO A^SDECUT1A(.STA,SDCL,SDAY,SDSI,SDCLS)
+5 SET HOUR=SDCLS-1
+6 FOR CNT=2:2
Begin DoDot:1
+7 IF (CNT#12)=2
SET HOUR=HOUR+1
+8 SET HR=$SELECT($LENGTH(HOUR)=1:"0"_HOUR,1:HOUR)
+9 IF '$DATA(STA(HR))
DO STA
+10 if BSTART=""
SET BSTART=SDAY_"."_HR_$SELECT((CNT#12)=4:$PIECE(STA(HR,4),U,2),(CNT#12)=6:$PIECE(STA(HR,6),U,2),(CNT#12)=8:$PIECE(STA(HR,8),U,2),(CNT#12)=10:$PIECE(STA(HR,10),U,2),(CNT#12)=0:$PIECE(STA(HR,0),U,2),1:$PIECE(STA(HR,2),U,2))
+11 SET SDCAN=$GET(DTARRAY(SDAY,$SELECT($LENGTH(HOUR)=1:"0"_HOUR,1:HOUR)_$SELECT((CNT#12)=4:...
... $PIECE(STA(HR,4),U,1),(CNT#12)=6:$PIECE(STA(HR,6),U,1),(CNT#12)=8:$PIECE(STA(HR,8),U,1),(CNT#12)=10:$PIECE(STA(HR,10),U,1),(CNT#12)=0:$PIECE(STA(HR,0),U,1),1:$PIECE(STA(HR,2),U,1))))="X"
+12 SET SLOT=$SELECT(SDCAN:"X",1:$EXTRACT(SDPAT,CNT))
SET SLOT=$SELECT(SDCAN:"X",SLOT="":SLOT,+SLOT:SLOT,1:" ")
+13 if BSLOT=""
SET BSLOT=$SELECT(SLOT="X":SLOT,+SLOT:SLOT,1:" ")
+14 IF SLOT'=BSLOT
Begin DoDot:2
+15 IF BSLOT=" "
IF SLOT=""
IF $EXTRACT($PIECE(BSTART,".",2),1,2)<18
QUIT
+16 SET HR=$SELECT($LENGTH(HOUR)=1:"0"_HOUR,1:HOUR)
+17 SET BTIME=HR_$SELECT((CNT#12)=4:$PIECE(STA(HR,4),U,2),(CNT#12)=6:$PIECE(STA(HR,6),U,2),(CNT#12)=8:$PIECE(STA(HR,8),U,2),(CNT#12)=10:$PIECE(STA(HR,10),U,2),(CNT#12)=0:$PIECE(STA(HR,0),U,2),1:$PIECE(STA(HR,2),U,2))
+18 SET BSTOP=SDAY_"."_BTIME
+19 IF $EXTRACT($PIECE(BSTOP,".",2),1,2)>23
SET BSTOP=$PIECE(BSTOP,".",1)_".2359"
+20 SET SDI=SDI+1
SET SDBLKS(SDI)=BSTART_U_BSTOP_U_BSLOT_U_$SELECT(BSLOT="X":SDATCA,BSLOT=" ":SDATUN,1:SDATAV)
+21 SET BSLOT=$SELECT(SLOT="X":"X",+SLOT:SLOT,1:" ")
+22 ;SDAY_"."_$S($L(HOUR)=1:"0"_HOUR,1:HOUR)_$S((CNT#12)=4:1,(CNT#12)=6:2,(CNT#12)=8:3,(CNT#12)=10:4,(CNT#12)=0:5,1:"")
SET BSTART=BSTOP
End DoDot:2
+23 SET BCNT=CNT
End DoDot:1
if SLOT=""
QUIT
+24 IF $EXTRACT($PIECE(BSTART,".",2),1,2)<18
SET SDI=SDI+1
SET SDBLKS(SDI)=BSTART_U_SDAY_"."_18_U_U_SDATUN
+25 QUIT
STA ;
+1 NEW HRP
+2 SET HRP=HR-1
SET HRP=$SELECT($LENGTH(HRP)=1:"0"_HRP,1:HRP)
+3 IF $DATA(STA(HRP))
Begin DoDot:1
+4 SET STA(HR,4)=STA(HRP,4)
+5 if SDSI'=3
SET STA(HR,6)=STA(HRP,6)
+6 if SDSI=6
SET STA(HR,8)=STA(HRP,8)
+7 if SDSI=6
SET STA(HR,10)=STA(HRP,10)
+8 SET STA(HR,0)=STA(HRP,0)
+9 SET STA(HR,2)=STA(HRP,2)
End DoDot:1
+10 IF '$TEST
XECUTE "D B"_SDSI_"^SDECUT1A(.STA,"""_HR_""",0)"
+11 QUIT
+12 ;
MAKE(SDBLKS,SDI,START,STOP,SLOT) ;make block
+1 NEW SDATAV,SDATUN
+2 SET SDATAV=$ORDER(^SDEC(409.823,"B","AVAILABLE",0))
+3 SET SDATUN=$ORDER(^SDEC(409.823,"B","UNAVAILABLE",0))
+4 SET SDI=SDI+1
SET SDBLKS(SDI)=START_U_STOP_U_SLOT_U_$SELECT(+SLOT:SDATAV,1:SDATUN)
+5 QUIT
+6 ;
RESNB(SDAB,SDBLKS,SDCL,SDAY,SDRES) ;create/update access blocks for 1 day
+1 NEW SDI,SDJ,SDNOD,SDRESP
+2 if '$DATA(SDBLKS)
QUIT
+3 if $GET(SDAY)'?7N
QUIT
+4 SET SDRESP=$GET(SDRES)
+5 ;delete all related access blocks
+6 ;build new access blocks with calls to RESNB1
+7 SET SDI=""
FOR
SET SDI=$ORDER(SDBLKS(SDI))
if SDI=""
QUIT
Begin DoDot:1
+8 SET SDNOD=SDBLKS(SDI)
+9 if $PIECE($PIECE(SDNOD,U,1),".",1)'=SDAY
QUIT
+10 ;alb/sat 658 add 8 param OBM
DO RESNB1(SDAB,SDCL,$PIECE(SDNOD,U,1),$PIECE(SDNOD,U,2),$PIECE(SDNOD,U,3),$PIECE(SDNOD,U,4),,$PIECE(SDNOD,U,5))
End DoDot:1
+11 QUIT
+12 ;
RESNBD(SDCL,SDAY,SDRESP) ;delete access blocks for the day
+1 QUIT
+2 ;
RESNB1(SDAB,SDCL,SDSTART,SDSTOP,SDSLOTS,SDAT,SDRES,OBM) ;create/update 1 access block ;alb/sat 658 add OBM
+1 ;INPUT:
+2 ; SDAB - global name for access blocks - "^TMP("_$J_",""SDEC"",""BLKS"")"
+3 ; SDCL - clinic ID pointer to HOSPITAL LOCATION file
+4 ; not used if SDRES is passed in
+5 ; SDSTART - start time in FM format
+6 ; SDSTOP - stop time in FM format
+7 ; SDSLOTS - number of slots
+8 ; SDAT - access type ID pointer to SDEC ACCESS TYPE file
+9 ; SDRES - resource ID pointer to SDEC RESOURCE file
+10 ; only update this resource if passed in
+11 ; calling routine needs to make sure SDRES belongs to the proper HOSPITAL LOCATION (sdcl)
+12 SET SDRES=$GET(SDRES)
+13 DO RESNBR
+14 QUIT
+15 ;only update passed in resource
+16 IF SDRES'=""
IF $DATA(^SDEC(409.831,"ALOC",SDCL,SDRES))
DO RESNBR
QUIT
+17 ;update all resources if no resource passed in
+18 IF SDRES=""
SET SDRES=0
FOR
SET SDRES=$ORDER(^SDEC(409.831,"ALOC",SDCL,SDRES))
if SDRES'>0
QUIT
DO RESNBR
+19 QUIT
RESNBR ;create access block for 1 resource
+1 NEW SDCNT,SDFDA,SDIEN,SDIENS,SDMSG
+2 SET (SDCNT,@SDAB@("CNT"))=$GET(@SDAB@("CNT"))+1
+3 ;alb/sat 658 add OBM
SET @SDAB@(SDCNT)=SDRES_U_SDSTART_U_SDSTOP_U_SDSLOTS_U_SDAT_U_$GET(OBM)
+4 QUIT
+5 ;
DAY ;;^SUN^MON^TUES^WEDNES^THURS^FRI^SATUR
+1 ;
GETDAY(DATE) ;return day of the week
+1 NEW DOW,RET
+2 SET RET=""
+3 SET DATE=$PIECE($GET(DATE),".",1)
+4 if DATE'?7N
QUIT RET
+5 SET DOW="S %=$E(DATE,1,3),I=$E(DATE,4,5),I=I>2&'(%#4)+$E(""144025036146"",I) X ""F %=%:-1:281 S I=%#4=1+1+I"" S RET=$P(""SUN^MON^TUES^WEDNES^THURS^FRI^SATUR"",U,$E(DATE,6,7)+I#7+1)_""DAY"""
+6 XECUTE DOW
+7 QUIT RET
