Routine: SDEC57A

SDEC57A ;ALB/SAT - VISTA SCHEDULING RPCS ;MAR 15, 2017

 ;;5.3;Scheduling;**627,643,642,651,658**;Aug 13, 1993;Build 23

 ;build access block array SDBLKS from pattern SDPAT

GETBLKS(SDBLKS,SDPAT,SDAY,SDCLS,SDLEN,SDSI,SDCL)  ;

 ;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

 ;  SDCL  - clinic IEN

 ;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 SDA,SDATAV,SDATCA,SDATUN,SDF,SDI,SDPATC,SDSE,SDSIM   ;alb/sat 651 add SDPATC

 S SDF=0

 ;get SDEC ACCESS TYPEs

 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 SDSIM=$S(SDSI="":4,SDSI<3:4,SDSI:SDSI,1:4)

 S SDA=$S(SDSI=3:6,SDSI=6:12,1:8)

 I SDPAT="" S SDPAT=$G(^SC(SDCL,"ST",SDAY,1)) S SDPAT=$E(SDPAT,SDA,$L(SDPAT))

 S SDPATC=$G(^SC(SDCL,"ST",SDAY,"CAN")) S:SDPATC'="" SDPATC=$E(SDPATC,SDA,$L(SDPATC))   ;alb/sat 651

 I ^SC(SDCL,"ST",SDAY,1)["CANCELLED" S SDF=1,SDPAT=$G(^SC(SDCL,"ST",SDAY,"CAN")) S SDPAT=$E(SDPAT,SDSIM+SDSIM,90)   ;get PATTERN from file 44

 D:SDPAT'="" ARRAY^SDECUTL2(.DTARRAY,SDPAT,SDAY,SDLEN,SDCLS,SDSI,+SDF) ;convert pattern to array

 S SDSE=$S(SDSI=2:30,SDSI=3:20,SDSI=4:15,SDSI=6:10,1:60)

 K SDBLKS

 ;1 2 3 4 OR 6

 ;D @SDSI  ;alb/sat 658

 D BUILD   ;alb/sat 658

BUILD  ;build  SDBLKS  ;alb/sat 658 BUILD replaced tags 1,2,3,4,and 6

 N BMIN,BSLOT,BSTART,BSTOP,BTIME,CLBEG,CNT1,DIFF,FX,HOUR,HR,NSTART,PSLOT,SDI,SDJ,SLOT,STA,STAR,VAL,XTIME

 S (PSLOT,XTIME)=""

 S SDI=0

 D A^SDECUT1A(.STA,SDCL,SDAY,SDSI,SDCLS)

 ;build array of start times

 ;STAR(O_BTIME)=SLOT^ETIME   PSLOT

 F CNT1=2:2 Q:CNT1>$L(SDPAT)  S SLOT=$S(SDF:"X",1:$E(SDPAT,CNT1)) D STAR

 I $E(SDPAT,(CNT1-2))="X" S SLOT="X" D STAR

 S CLBEG=$S($L(SDCLS)=1:"0"_SDCLS,1:SDCLS)_"00"   ;clinic begin time

 S SDJ=$O(STAR("")) I CLBEG'=$E(SDJ,2,5) S SDI=SDI+1 S SDBLKS(SDI)=CLBEG_U_$E(SDJ,2,5)_U_$S(+SDF:"X",1:0)_U_$S(+SDF:SDATCA,1:SDATUN)

 S (BSLOT,BSTART,BSTOP)=""

 S SDJ="" F  S SDJ=$O(STAR(SDJ)) Q:SDJ=""  D  Q:SLOT=""

 .S HOUR=$E(SDJ,2,3)

 .I '$D(STA(HOUR)) D STA

 .;S BSTART=SDAY_"."_HOUR_$S($E(SDJ,4,5)="00":"",$E(SDJ,4,5)=15:15,$E(SDJ,4,5)=30:3,$E(SDJ,4,5)=45:45,1:"")  ;alb/sat 651

 .S BSTART=SDAY_"."_HOUR_$S($E(SDJ,4,5)="00":"",$E(SDJ,4,5)=10:1,$E(SDJ,4,5)=20:2,$E(SDJ,4,5)=30:3,$E(SDJ,4,5)=40:4,$E(SDJ,4,5)=50:5,1:$E(SDJ,4,5))

 .I BSTOP'="",BSTOP<BSTART S SDI=SDI+1 S SDBLKS(SDI)=BSTOP_U_BSTART_U_$S(+SDF:"X",1:0)_U_$S(+SDF:SDATCA,1:SDATUN)

 .S SLOT=$P(STAR(SDJ),U,1)

 .S BSLOT=$S(SLOT="X":SLOT,$$VAL(SLOT):SLOT,1:" ")

 .I BSLOT=" ",SLOT="",$E($P(BSTART,".",2),1,2)<18 Q

 .;S BMIN=$S($E(SDJ,4,5)="00":"",$E(SDJ,4,5)=15:15,$E(SDJ,4,5)=30:3,$E(SDJ,4,5)=45:45,1:"")  ;alb/sat 651

 .S BMIN=$S($E(SDJ,4,5)="00":"",$E(SDJ,4,5)=10:1,$E(SDJ,4,5)=20:2,$E(SDJ,4,5)=30:3,$E(SDJ,4,5)=40:4,$E(SDJ,4,5)=50:5,1:$E(SDJ,4,5))

 .S BTIME=$S((BMIN="")&((HOUR#10)=0):$E(HOUR),1:$S($L(HOUR)=1:"0"_HOUR,1:HOUR))_$S(BMIN'="":BMIN,1:"")  ;BTIME is FM format

 .S BSTOP=$S($P(STAR(SDJ),U,2)'="":SDAY_"."_$P(STAR(SDJ),U,2),1:$$FMADD^XLFDT(SDAY_"."_BTIME,,,SDSE))

 .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_$S(+SDF:"X",1:BSLOT)_U_$S(+SDF:SDATCA,BSLOT="X":SDATCA,BSLOT=" ":SDATUN,1:SDATAV)

 S BTIME=$E($P(BSTOP,".",2),1,2) S:$L(BTIME)=1 BTIME=BTIME_0 I BTIME<18 S SDI=SDI+1 S SDBLKS(SDI)=BSTOP_U_SDAY_"."_18_U_$S(+SDF:"X",1:0)_U_$S(+SDF:SDATCA,1:SDATUN)

STAR ;

 N MOD   ;alb/sat 658

 S MOD=$S(SDSI=3:6,SDSI=6:12,1:8)  ;alb/sat 658

 S VAL=$$VAL(SLOT)

 S HOUR=(SDCLS+((CNT1-2)\MOD))  ;alb/sat 658 use MOD

 S HR=$S($L(HOUR)=1:"0"_HOUR,1:HOUR)

 I '$D(STA(HR)) D STA

 ;S BTIME=HR_$S((CNT1#8)=4:$P(STA(HR,4),U,1),(CNT1#8)=6:$P(STA(HR,6),U,1),(CNT1#8)=0:$P(STA(HR,0),U,1),1:$P(STA(HR,2),U,1))  ;alb/sat 658

 S BTIME=HR_$S((CNT1#MOD)=4:$P(STA(HR,4),U,1),(CNT1#MOD)=6:$P(STA(HR,6),U,1),(CNT1#MOD)=8:$P(STA(HR,8),U,1),(CNT1#MOD)=10:$P(STA(HR,10),U,1),(CNT1#MOD)=0:$P(STA(HR,0),U,1),1:$P(STA(HR,2),U,1))

 I 'VAL,PSLOT="X" S $P(STAR("O"_XTIME),U,2)=BTIME,(PSLOT,XTIME)=""

 Q:'VAL

 I SLOT="X" D

 .I PSLOT="X" S $P(STAR("O"_XTIME),U,2)=BTIME

 .I PSLOT'="X" S STAR("O"_BTIME)=SLOT,XTIME=BTIME

 .S PSLOT=SLOT

 I SLOT'="X" D

 .I PSLOT="X" S $P(STAR("O"_XTIME),U,2)=BTIME,XTIME="",PSLOT=""

 .S STAR("O"_BTIME)=SLOT

NSTAR(STAR,BSTART,BSTOP)  ;return 1 if BSTOP is after the cancelled time range; 0 if not after cancelled time range  ;alb/sat 651 - add $$NSTAR

 N SDAY,SDT,SDI,START,STOP

 S SDAY=$P(BSTART,".",1)

 S START=$P(BSTART,".",2),START=START_$S($L(START)=1:"000",$L(START)=2:"00",$L(START)=3:"0",1:"")

 S STOP=$P(BSTOP,".",2),STOP=STOP_$S($L(STOP)=1:"000",$L(STOP)=2:"00",$L(STOP)=3:"0",1:"")

 S SDI="O"_START F  S SDI=$O(STAR(SDI)) Q:SDI=""  Q:STAR(SDI)'="X"

 S:SDI="" SDI=STOP  ;alb/sat 651

 Q $$FMDIFF^XLFDT(BSTOP,SDAY_"."_$E(SDI,2,5),2)'>0

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)"

MAKE(SDBLKS,SDI,START,STOP,SLOT,SDF)  ;make block

 N SDATCA,SDATAV,SDATUN

 S SDF=$G(SDF)

 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))

 S SDI=SDI+1 S SDBLKS(SDI)=START_U_STOP_U_$S(+SDF:"X",1:SLOT)_U_$S(+SDF:SDATCA,$$VAL(SLOT):SDATAV,1:SDATUN)

 ;0-9,j-z for 0 to 26 available appts, A-W for overbooks 1-23,

 ;'*$!@#?' for overbook outside normal hours, X for cancelled

VAL(SLOT) ;Return 1 if valid available/overbook slots character

 I $L(SLOT)=0 Q 0

 Q "*$!@#0123456789jklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWX"[$E(SLOT,1)

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDEC57A   6218     printed  Mar 13, 2025@21:55:58                                                                                                                                                                                                     Page 2

SDEC57A   ;ALB/SAT - VISTA SCHEDULING RPCS ;MAR 15, 2017

 +1       ;;5.3;Scheduling;**627,643,642,651,658**;Aug 13, 1993;Build 23

 +2       ;

 +3        QUIT

 +4       ;

 +5       ;build access block array SDBLKS from pattern SDPAT

GETBLKS(SDBLKS,SDPAT,SDAY,SDCLS,SDLEN,SDSI,SDCL) ;

 +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       ;  SDCL  - clinic IEN

 +8       ;RETURN:

 +9       ; .SDBLKS - array of access block data to be stored in SDEC ACCESS BLOCK file

 +10      ;           SDBLKS(<count>)=<start time> ^ <end time> ^ <slots> ^ <access type>

 +11       NEW DTARRAY

 +12      ;alb/sat 651 add SDPATC

           NEW SDA,SDATAV,SDATCA,SDATUN,SDF,SDI,SDPATC,SDSE,SDSIM

 +13       SET SDF=0

 +14      ;get SDEC ACCESS TYPEs

 +15       SET SDATAV=$ORDER(^SDEC(409.823,"B","AVAILABLE",0))

 +16       SET SDATCA=$ORDER(^SDEC(409.823,"B","CANCELED",0))

 +17       SET SDATUN=$ORDER(^SDEC(409.823,"B","UNAVAILABLE",0))

 +18      ;SDSIM - calculated using DISPLAY INCREMENTS PER HOUR field from file 44

 +19       SET SDSIM=$SELECT(SDSI="":4,SDSI<3:4,SDSI:SDSI,1:4)

 +20       SET SDA=$SELECT(SDSI=3:6,SDSI=6:12,1:8)

 +21       IF SDPAT=""

               SET SDPAT=$GET(^SC(SDCL,"ST",SDAY,1))

               SET SDPAT=$EXTRACT(SDPAT,SDA,$LENGTH(SDPAT))

 +22      ;alb/sat 651

           SET SDPATC=$GET(^SC(SDCL,"ST",SDAY,"CAN"))

           if SDPATC'=""

               SET SDPATC=$EXTRACT(SDPATC,SDA,$LENGTH(SDPATC))

 +23      ;get PATTERN from file 44

           IF ^SC(SDCL,"ST",SDAY,1)["CANCELLED"

               SET SDF=1

               SET SDPAT=$GET(^SC(SDCL,"ST",SDAY,"CAN"))

               SET SDPAT=$EXTRACT(SDPAT,SDSIM+SDSIM,90)

 +24      ;convert pattern to array

           if SDPAT'=""

               DO ARRAY^SDECUTL2(.DTARRAY,SDPAT,SDAY,SDLEN,SDCLS,SDSI,+SDF)

 +25       SET SDSE=$SELECT(SDSI=2:30,SDSI=3:20,SDSI=4:15,SDSI=6:10,1:60)

 +26       KILL SDBLKS

 +27      ;1 2 3 4 OR 6

 +28      ;D @SDSI  ;alb/sat 658

 +29      ;alb/sat 658

           DO BUILD

 +30       QUIT

BUILD     ;build  SDBLKS  ;alb/sat 658 BUILD replaced tags 1,2,3,4,and 6

 +1        NEW BMIN,BSLOT,BSTART,BSTOP,BTIME,CLBEG,CNT1,DIFF,FX,HOUR,HR,NSTART,PSLOT,SDI,SDJ,SLOT,STA,STAR,VAL,XTIME

 +2        SET (PSLOT,XTIME)=""

 +3        SET SDI=0

 +4        DO A^SDECUT1A(.STA,SDCL,SDAY,SDSI,SDCLS)

 +5       ;build array of start times

 +6       ;STAR(O_BTIME)=SLOT^ETIME   PSLOT

 +7        FOR CNT1=2:2

               if CNT1>$LENGTH(SDPAT)

                   QUIT

               SET SLOT=$SELECT(SDF:"X",1:$EXTRACT(SDPAT,CNT1))

               DO STAR

 +8        IF $EXTRACT(SDPAT,(CNT1-2))="X"

               SET SLOT="X"

               DO STAR

 +9       ;clinic begin time

           SET CLBEG=$SELECT($LENGTH(SDCLS)=1:"0"_SDCLS,1:SDCLS)_"00"

 +10       SET SDJ=$ORDER(STAR(""))

           IF CLBEG'=$EXTRACT(SDJ,2,5)

               SET SDI=SDI+1

               SET SDBLKS(SDI)=CLBEG_U_$EXTRACT(SDJ,2,5)_U_$SELECT(+SDF:"X",1:0)_U_$SELECT(+SDF:SDATCA,1:SDATUN)

 +11       SET (BSLOT,BSTART,BSTOP)=""

 +12       SET SDJ=""

FOR

               SET SDJ=$ORDER(STAR(SDJ))

               if SDJ=""

                   QUIT

               Begin DoDot:1

 +13               SET HOUR=$EXTRACT(SDJ,2,3)

 +14               IF '$DATA(STA(HOUR))

                       DO STA

 +15      ;S BSTART=SDAY_"."_HOUR_$S($E(SDJ,4,5)="00":"",$E(SDJ,4,5)=15:15,$E(SDJ,4,5)=30:3,$E(SDJ,4,5)=45:45,1:"")  ;alb/sat 651

 +16               SET BSTART=SDAY_"."_HOUR_$SELECT($EXTRACT(SDJ,4,5)="00":"",$EXTRACT(SDJ,4,5)=10:1,$EXTRACT(SDJ,4,5)=20:2,$EXTRACT(SDJ,4,5)=30:3,$EXTRACT(SDJ,4,5)=40:4,$EXTRACT(SDJ,4,5)=50:5,1:$EXTRACT(SDJ,4,5))

 +17               IF BSTOP'=""

                       IF BSTOP<BSTART

                           SET SDI=SDI+1

                           SET SDBLKS(SDI)=BSTOP_U_BSTART_U_$SELECT(+SDF:"X",1:0)_U_$SELECT(+SDF:SDATCA,1:SDATUN)

 +18               SET SLOT=$PIECE(STAR(SDJ),U,1)

 +19               SET BSLOT=$SELECT(SLOT="X":SLOT,$$VAL(SLOT):SLOT,1:" ")

 +20               IF BSLOT=" "

                       IF SLOT=""

                           IF $EXTRACT($PIECE(BSTART,".",2),1,2)<18

                               QUIT

 +21      ;S BMIN=$S($E(SDJ,4,5)="00":"",$E(SDJ,4,5)=15:15,$E(SDJ,4,5)=30:3,$E(SDJ,4,5)=45:45,1:"")  ;alb/sat 651

 +22               SET BMIN=$SELECT($EXTRACT(SDJ,4,5)="00":"",$EXTRACT(SDJ,4,5)=10:1,$EXTRACT(SDJ,4,5)=20:2,$EXTRACT(SDJ,4,5)=30:3,$EXTRACT(SDJ,4,5)=40:4,$EXTRACT(SDJ,4,5)=50:5,1:$EXTRACT(SDJ,4,5))

 +23      ;BTIME is FM format

                   SET BTIME=$SELECT((BMIN="")&((HOUR#10)=0):$EXTRACT(HOUR),1:$SELECT($LENGTH(HOUR)=1:"0"_HOUR,1:HOUR))_$SELECT(BMIN'="":BMIN,1:"")

 +24               SET BSTOP=$SELECT($PIECE(STAR(SDJ),U,2)'="":SDAY_"."_$PIECE(STAR(SDJ),U,2),1:$$FMADD^XLFDT(SDAY_"."_BTIME,,,SDSE))

 +25               IF $EXTRACT($PIECE(BSTOP,".",2),1,2)>23

                       SET BSTOP=$PIECE(BSTOP,".",1)_".2359"

 +26               SET SDI=SDI+1

                   SET SDBLKS(SDI)=BSTART_U_BSTOP_U_$SELECT(+SDF:"X",1:BSLOT)_U_$SELECT(+SDF:SDATCA,BSLOT="X":SDATCA,BSLOT=" ":SDATUN,1:SDATAV)

               End DoDot:1

               if SLOT=""

                   QUIT

 +27       SET BTIME=$EXTRACT($PIECE(BSTOP,".",2),1,2)

           if $LENGTH(BTIME)=1

               SET BTIME=BTIME_0

           IF BTIME<18

               SET SDI=SDI+1

               SET SDBLKS(SDI)=BSTOP_U_SDAY_"."_18_U_$SELECT(+SDF:"X",1:0)_U_$SELECT(+SDF:SDATCA,1:SDATUN)

 +28       QUIT

 +29      ;

STAR      ;

 +1       ;alb/sat 658

           NEW MOD

 +2       ;alb/sat 658

           SET MOD=$SELECT(SDSI=3:6,SDSI=6:12,1:8)

 +3        SET VAL=$$VAL(SLOT)

 +4       ;alb/sat 658 use MOD

           SET HOUR=(SDCLS+((CNT1-2)\MOD))

 +5        SET HR=$SELECT($LENGTH(HOUR)=1:"0"_HOUR,1:HOUR)

 +6        IF '$DATA(STA(HR))

               DO STA

 +7       ;S BTIME=HR_$S((CNT1#8)=4:$P(STA(HR,4),U,1),(CNT1#8)=6:$P(STA(HR,6),U,1),(CNT1#8)=0:$P(STA(HR,0),U,1),1:$P(STA(HR,2),U,1))  ;alb/sat 658

 +8        SET BTIME=HR_$SELECT((CNT1#MOD)=4:$PIECE(STA(HR,4),U,1),(CNT1#MOD)=6:$PIECE(STA(HR,6),U,1),(CNT1#MOD)=8:$PIECE(STA(HR,8),U,1),(CNT1#MOD)=10:$PIECE(STA(HR,10),U,1),(CNT1#MOD)=0:$PIECE(STA(HR,0),U,1),1:$PIECE(STA(HR,2),U,1))

 +9        IF 'VAL

               IF PSLOT="X"

                   SET $PIECE(STAR("O"_XTIME),U,2)=BTIME

                   SET (PSLOT,XTIME)=""

 +10       if 'VAL

               QUIT

 +11       IF SLOT="X"

               Begin DoDot:1

 +12               IF PSLOT="X"

                       SET $PIECE(STAR("O"_XTIME),U,2)=BTIME

 +13               IF PSLOT'="X"

                       SET STAR("O"_BTIME)=SLOT

                       SET XTIME=BTIME

 +14               SET PSLOT=SLOT

               End DoDot:1

 +15       IF SLOT'="X"

               Begin DoDot:1

 +16               IF PSLOT="X"

                       SET $PIECE(STAR("O"_XTIME),U,2)=BTIME

                       SET XTIME=""

                       SET PSLOT=""

 +17               SET STAR("O"_BTIME)=SLOT

               End DoDot:1

 +18       QUIT

NSTAR(STAR,BSTART,BSTOP) ;return 1 if BSTOP is after the cancelled time range; 0 if not after cancelled time range  ;alb/sat 651 - add $$NSTAR

 +1        NEW SDAY,SDT,SDI,START,STOP

 +2        SET SDAY=$PIECE(BSTART,".",1)

 +3        SET START=$PIECE(BSTART,".",2)

           SET START=START_$SELECT($LENGTH(START)=1:"000",$LENGTH(START)=2:"00",$LENGTH(START)=3:"0",1:"")

 +4        SET STOP=$PIECE(BSTOP,".",2)

           SET STOP=STOP_$SELECT($LENGTH(STOP)=1:"000",$LENGTH(STOP)=2:"00",$LENGTH(STOP)=3:"0",1:"")

 +5        SET SDI="O"_START

FOR

               SET SDI=$ORDER(STAR(SDI))

               if SDI=""

                   QUIT

               if STAR(SDI)'="X"

                   QUIT

 +6       ;alb/sat 651

           if SDI=""

               SET SDI=STOP

 +7        QUIT $$FMDIFF^XLFDT(BSTOP,SDAY_"."_$EXTRACT(SDI,2,5),2)'>0

 +8       ;

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,SDF) ;make block

 +1        NEW SDATCA,SDATAV,SDATUN

 +2        SET SDF=$GET(SDF)

 +3        SET SDATAV=$ORDER(^SDEC(409.823,"B","AVAILABLE",0))

 +4        SET SDATCA=$ORDER(^SDEC(409.823,"B","CANCELED",0))

 +5        SET SDATUN=$ORDER(^SDEC(409.823,"B","UNAVAILABLE",0))

 +6        SET SDI=SDI+1

           SET SDBLKS(SDI)=START_U_STOP_U_$SELECT(+SDF:"X",1:SLOT)_U_$SELECT(+SDF:SDATCA,$$VAL(SLOT):SDATAV,1:SDATUN)

 +7        QUIT

 +8       ;0-9,j-z for 0 to 26 available appts, A-W for overbooks 1-23,

 +9       ;'*$!@#?' for overbook outside normal hours, X for cancelled

VAL(SLOT) ;Return 1 if valid available/overbook slots character

 +1        IF $LENGTH(SLOT)=0

               QUIT 0

 +2        QUIT "*$!@#0123456789jklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWX"[$EXTRACT(SLOT,1)

SDEC57A.m