SRSBDEL.m

SRSBDEL ;B'HAM ISC/MAM - DELETE SERVICE BLOCKOUT ; [ 01/08/98   9:54 AM ]

 ;;3.0; Surgery ;**26,77,104**;24 Jun 93

SER ; service abbreviation

 S SRSOUT=0

 R !!,"Select service you wish to delete. (3-4 characters)  ",SRSSER:DTIME I '$T!("^"[SRSSER) S SRSOUT=1 G END

 I SRSSER["?"!(SRSSER["=") D QUES G SER

 F SRMM=1:1:$L(SRSSER) I $E(SRSSER,SRMM)?1U S SRSSER=$E(SRSSER,0,SRMM-1)_$C($A(SRSSER,SRMM)+32)_$E(SRSSER,SRMM+1,999)

 I '$D(^SRS("SER",SRSSER)) W !!!,SRSSER_" does not exist.",! G SER

 S (OR,CNT)=0 F I=0:0 S OR=$O(^SRS("SER",SRSSER,OR)) Q:OR=""  D

 .I $D(SRSITE("DIV")) Q:'($$ORDIV^SROUTL0(OR,SRSITE("DIV"))) 

 .S SRSOR=$P(^SC($P(^SRS(OR,0),"^"),0),"^") S DAY=0 F I=0:0 S DAY=$O(^SRS("SER",SRSSER,OR,DAY)) Q:DAY=""  D TIME

 W !!!,"The service '"_SRSSER_"' has the following time(s) scheduled: " F I=1:1:CNT W !,?2,$P(SRSOR(I),"^")

NUM R !!!,"Which number would you like to delete ?  ",NUM:DTIME I '$T!("^"[NUM) S SRSOUT=1 G END

 I NUM<1!(NUM>CNT)!(NUM'?.N) W !!,"Enter a number from 1 to "_CNT_", or '^' to leave this option.",! G NUM

STDATE S SRSOR=$P(SRSOR(NUM),"^",2),DAY=$P(SRSOR(NUM),"^",3),SRSST=$P(SRSOR(NUM),"^",4),SRSET=$P(SRSOR(NUM),"^",5)

DATE W ! S %DT("A")="Delete the Blockout starting with which date ?  ",%DT="AEFX" D ^%DT W:Y<1 !!,"No action taken.",! G:Y<1 END S (X,SRSDATE)=Y D DW^%DTC S DAYOFW=X

 I SRSDATE<DT W !!,"Past dates cannot be entered.",! G DATE

 I $E(DAYOFW,1,2)'=DAY W !!,"The date you entered is not a " D DAY W DAY2_".",!! G STDATE

 D DAYCHK^SRSBD1 I SRCHK=1 W !!,"The service '"_SRSSER_"' is not scheduled for this date at the time period you",!,"have entered.  The option 'Display Availability' may be used to determine",!,"the proper date." H 4 G END

 S SRSNUM=$P(^SRS("SER",SRSSER,SRSOR,DAY,SRSST),"^",4)

ASK W !!,"Do you want to delete the blockout for this service on this",!,"date only ?  NO// " R Z:DTIME I '$T!(Z="^") G END

 S:Z="" Z="N" S Z=$E(Z)

 I "NnYy"'[Z W !!,"If you only want to delete the blockout for this date, enter 'YES'.  Enter",!,"RETURN to delete the blockout from this date on." G ASK

 W !!,"Updating Schedules...",!! S SRSALL=$S("Nn"[Z:1,1:0) I SRSALL=1 G MULD

DEL S SRS1=11+($P(SRSST,".")*5)+(SRSST-$P(SRSST,".")*100\15),SRS2=11+($P(SRSET,".")*5)+(SRSET-$P(SRSET,".")*100\15),S="" F I=SRS1:1:SRS2-1 S S=S_$S('(I#5):"|",1:"_")

 S X0=^SRS(SRSOR,"SS",SRSDATE,1),(X0,^(1))=$E(X0,1,SRS1)_S_$E(X0,SRS2+1,200)

 S X1=^SRS(SRSOR,"S",SRSDATE,1)

 F I=SRS1:1:SRS2+1 I $E(X1,I)'="X" S X1=$E(X1,1,I-1)_$E(X0,I)_$E(X1,I+1,200)

 S ^SRS(SRSOR,"S",SRSDATE,1)=X1

 G:'SRSALL END Q

DAY S DAY2=$S(DAY="MO":"Monday",DAY="TU":"Tuesday",DAY="WE":"Wednesday",DAY="TH":"Thursday",DAY="FR":"Friday",DAY="SA":"Saturday",1:"Sunday")

 Q

CK1 I SRSNUM=0 S X=7 D UPDATE G:X CK1

CK2 I SRSNUM>7 S X=14 D UPDATE G:X CK2

CK0 I SRSNUM>0,(SRSNUM<5) S X5=$E(SRSDATE,4,5),X1=SRSDATE,X2=7 D C^%DTC S SRSDATE=X G:$E(X,4,5)=X5 CK0

CK3 I SRSNUM>0,(SRSNUM<5) S X=SRSNUM-1*7 D UPDATE G:X CK0

CK5 I SRSNUM=5 S X1=SRSDATE,X2=21 D C^%DTC S SRSDATE=X

CK4 I SRSNUM=5 S X1=SRSDATE,X2=7,X5=$E(SRSDATE,4,5) D C^%DTC S SRSDATE=X G:$E(SRSDATE,4,5)=X5 CK4 S X=-7 D UPDATE G:X CK5

 Q

UPDATE S X1=SRSDATE,X2=X D C^%DTC S SRSDATE=X D:$D(^SRS(SRSOR,"S",SRSDATE)) DEL S X=1 S:$O(^SRS(SRSOR,"S",SRSDATE))="" X=0 Q

TIME S TIME=0 F I=0:0 S TIME=$O(^SRS("SER",SRSSER,OR,DAY,TIME)) Q:TIME=""  S CNT=CNT+1,ETIME=$P(^(TIME),"^",2) D DAY S SRSOR(CNT)=CNT_".  "_SRSOR_" on "_DAY2_" from "_TIME_" to "_ETIME_"^"_OR_"^"_DAY_"^"_TIME_"^"_ETIME

 Q

MULD ; delete all

 S X=0 D UPDATE,CK1 S DA(3)=SRSOR,DA(2)=$O(^SRS(DA(3),1,"B",DAY,0)),DA(1)=$O(^SRS(DA(3),1,DA(2),1,"B",SRSSER,0)),DA=$O(^SRS(DA(3),1,DA(2),1,DA(1),1,"B",SRSST,0))

 S DIK="^SRS("_DA(3)_",1,"_DA(2)_",1,"_DA(1)_",1," D ^DIK

 I '$O(^SRS(DA(3),1,DA(2),1,DA(1),1,0)) S DA=DA(1),DA(1)=DA(2),DA(2)=DA(3) K DA(3) S DIK="^SRS("_DA(2)_",1,"_DA(1)_",1," D ^DIK I '$O(^SRS(DA(2),1,DA(1),1,0)) S DA=DA(1),DA(1)=DA(2) S DIK="^SRS("_DA(1)_",1," D ^DIK

 K ^SRS("R",DAY,SRSOR,SRSST,SRSNUM),^SRS("SER",SRSSER,SRSOR,DAY,SRSST)

END I 'SRSOUT W !!,"Press RETURN to continue  " R X:DTIME

 D ^SRSKILL W @IOF

 Q

QUES W !!,"Choose from: " S SERV=0 F I=0:0 S SERV=$O(^SRS("C",SERV)) Q:SERV=""  W !,?5,SERV

 Q

SRSBDEL   ;B'HAM ISC/MAM - DELETE SERVICE BLOCKOUT ; [ 01/08/98   9:54 AM ]

 +1       ;;3.0; Surgery ;**26,77,104**;24 Jun 93

SER       ; service abbreviation

 +1        SET SRSOUT=0

 +2        READ !!,"Select service you wish to delete. (3-4 characters)  ",SRSSER:DTIME

           IF '$TEST!("^"[SRSSER)

               SET SRSOUT=1

               GOTO END

 +3        IF SRSSER["?"!(SRSSER["=")

               DO QUES

               GOTO SER

 +4        FOR SRMM=1:1:$LENGTH(SRSSER)

               IF $EXTRACT(SRSSER,SRMM)?1U

                   SET SRSSER=$EXTRACT(SRSSER,0,SRMM-1)_$CHAR($ASCII(SRSSER,SRMM)+32)_$EXTRACT(SRSSER,SRMM+1,999)

 +5        IF '$DATA(^SRS("SER",SRSSER))

               WRITE !!!,SRSSER_" does not exist.",!

               GOTO SER

 +6        SET (OR,CNT)=0

           FOR I=0:0

               SET OR=$ORDER(^SRS("SER",SRSSER,OR))

               IF OR=""

                   QUIT 

               Begin DoDot:1

 +7                IF $DATA(SRSITE("DIV"))

                       IF '($$ORDIV^SROUTL0(OR,SRSITE("DIV")))

                           QUIT 

 +8                SET SRSOR=$PIECE(^SC($PIECE(^SRS(OR,0),"^"),0),"^")

                   SET DAY=0

                   FOR I=0:0

                       SET DAY=$ORDER(^SRS("SER",SRSSER,OR,DAY))

                       IF DAY=""

                           QUIT 

                       DO TIME

               End DoDot:1

 +9        WRITE !!!,"The service '"_SRSSER_"' has the following time(s) scheduled: "

           FOR I=1:1:CNT

               WRITE !,?2,$PIECE(SRSOR(I),"^")

NUM        READ !!!,"Which number would you like to delete ?  ",NUM:DTIME

           IF '$TEST!("^"[NUM)

               SET SRSOUT=1

               GOTO END

 +1        IF NUM<1!(NUM>CNT)!(NUM'?.N)

               WRITE !!,"Enter a number from 1 to "_CNT_", or '^' to leave this option.",!

               GOTO NUM

STDATE     SET SRSOR=$PIECE(SRSOR(NUM),"^",2)

           SET DAY=$PIECE(SRSOR(NUM),"^",3)

           SET SRSST=$PIECE(SRSOR(NUM),"^",4)

           SET SRSET=$PIECE(SRSOR(NUM),"^",5)

DATE       WRITE !

           SET %DT("A")="Delete the Blockout starting with which date ?  "

           SET %DT="AEFX"

           DO ^%DT

           IF Y<1

               WRITE !!,"No action taken.",!

           IF Y<1

               GOTO END

           SET (X,SRSDATE)=Y

           DO DW^%DTC

           SET DAYOFW=X

 +1        IF SRSDATE<DT

               WRITE !!,"Past dates cannot be entered.",!

               GOTO DATE

 +2        IF $EXTRACT(DAYOFW,1,2)'=DAY

               WRITE !!,"The date you entered is not a "

               DO DAY

               WRITE DAY2_".",!!

               GOTO STDATE

 +3        DO DAYCHK^SRSBD1

           IF SRCHK=1

               WRITE !!,"The service '"_SRSSER_"' is not scheduled for this date at the time period you",!,"have entered.  The option 'Display Availability' may be used to determine",!,"the proper date."

               HANG 4

               GOTO END

 +4        SET SRSNUM=$PIECE(^SRS("SER",SRSSER,SRSOR,DAY,SRSST),"^",4)

ASK        WRITE !!,"Do you want to delete the blockout for this service on this",!,"date only ?  NO// "

           READ Z:DTIME

           IF '$TEST!(Z="^")

               GOTO END

 +1        IF Z=""

               SET Z="N"

           SET Z=$EXTRACT(Z)

 +2        IF "NnYy"'[Z

               WRITE !!,"If you only want to delete the blockout for this date, enter 'YES'.  Enter",!,"RETURN to delete the blockout from this date on."

               GOTO ASK

 +3        WRITE !!,"Updating Schedules...",!!

           SET SRSALL=$SELECT("Nn"[Z:1,1:0)

           IF SRSALL=1

               GOTO MULD

DEL        SET SRS1=11+($PIECE(SRSST,".")*5)+(SRSST-$PIECE(SRSST,".")*100\15)

           SET SRS2=11+($PIECE(SRSET,".")*5)+(SRSET-$PIECE(SRSET,".")*100\15)

           SET S=""

           FOR I=SRS1:1:SRS2-1

               SET S=S_$SELECT('(I#5):"|",1:"_")

 +1        SET X0=^SRS(SRSOR,"SS",SRSDATE,1)

           SET (X0,^(1))=$EXTRACT(X0,1,SRS1)_S_$EXTRACT(X0,SRS2+1,200)

 +2        SET X1=^SRS(SRSOR,"S",SRSDATE,1)

 +3        FOR I=SRS1:1:SRS2+1

               IF $EXTRACT(X1,I)'="X"

                   SET X1=$EXTRACT(X1,1,I-1)_$EXTRACT(X0,I)_$EXTRACT(X1,I+1,200)

 +4        SET ^SRS(SRSOR,"S",SRSDATE,1)=X1

 +5        IF 'SRSALL

               GOTO END

           QUIT 

DAY        SET DAY2=$SELECT(DAY="MO":"Monday",DAY="TU":"Tuesday",DAY="WE":"Wednesday",DAY="TH":"Thursday",DAY="FR":"Friday",DAY="SA":"Saturday",1:"Sunday")

 +1        QUIT 

CK1        IF SRSNUM=0

               SET X=7

               DO UPDATE

               IF X

                   GOTO CK1

CK2        IF SRSNUM>7

               SET X=14

               DO UPDATE

               IF X

                   GOTO CK2

CK0        IF SRSNUM>0

               IF (SRSNUM<5)

                   SET X5=$EXTRACT(SRSDATE,4,5)

                   SET X1=SRSDATE

                   SET X2=7

                   DO C^%DTC

                   SET SRSDATE=X

                   IF $EXTRACT(X,4,5)=X5

                       GOTO CK0

CK3        IF SRSNUM>0

               IF (SRSNUM<5)

                   SET X=SRSNUM-1*7

                   DO UPDATE

                   IF X

                       GOTO CK0

CK5        IF SRSNUM=5

               SET X1=SRSDATE

               SET X2=21

               DO C^%DTC

               SET SRSDATE=X

CK4        IF SRSNUM=5

               SET X1=SRSDATE

               SET X2=7

               SET X5=$EXTRACT(SRSDATE,4,5)

               DO C^%DTC

               SET SRSDATE=X

               IF $EXTRACT(SRSDATE,4,5)=X5

                   GOTO CK4

               SET X=-7

               DO UPDATE

               IF X

                   GOTO CK5

 +1        QUIT 

UPDATE     SET X1=SRSDATE

           SET X2=X

           DO C^%DTC

           SET SRSDATE=X

           IF $DATA(^SRS(SRSOR,"S",SRSDATE))

               DO DEL

           SET X=1

           IF $ORDER(^SRS(SRSOR,"S",SRSDATE))=""

               SET X=0

           QUIT 

TIME       SET TIME=0

           FOR I=0:0

               SET TIME=$ORDER(^SRS("SER",SRSSER,OR,DAY,TIME))

               IF TIME=""

                   QUIT 

               SET CNT=CNT+1

               SET ETIME=$PIECE(^(TIME),"^",2)

               DO DAY

               SET SRSOR(CNT)=CNT_".  "_SRSOR_" on "_DAY2_" from "_TIME_" to "_ETIME_"^"_OR_"^"_DAY_"^"_TIME_"^"_ETIME

 +1        QUIT 

MULD      ; delete all

 +1        SET X=0

           DO UPDATE

           DO CK1

           SET DA(3)=SRSOR

           SET DA(2)=$ORDER(^SRS(DA(3),1,"B",DAY,0))

           SET DA(1)=$ORDER(^SRS(DA(3),1,DA(2),1,"B",SRSSER,0))

           SET DA=$ORDER(^SRS(DA(3),1,DA(2),1,DA(1),1,"B",SRSST,0))

 +2        SET DIK="^SRS("_DA(3)_",1,"_DA(2)_",1,"_DA(1)_",1,"

           DO ^DIK

 +3        IF '$ORDER(^SRS(DA(3),1,DA(2),1,DA(1),1,0))

               SET DA=DA(1)

               SET DA(1)=DA(2)

               SET DA(2)=DA(3)

               KILL DA(3)

               SET DIK="^SRS("_DA(2)_",1,"_DA(1)_",1,"

               DO ^DIK

               IF '$ORDER(^SRS(DA(2),1,DA(1),1,0))

                   SET DA=DA(1)

                   SET DA(1)=DA(2)

                   SET DIK="^SRS("_DA(1)_",1,"

                   DO ^DIK

 +4        KILL ^SRS("R",DAY,SRSOR,SRSST,SRSNUM),^SRS("SER",SRSSER,SRSOR,DAY,SRSST)

END        IF 'SRSOUT

               WRITE !!,"Press RETURN to continue  "

               READ X:DTIME

 +1        DO ^SRSKILL

           WRITE @IOF

 +2        QUIT 

QUES       WRITE !!,"Choose from: "

           SET SERV=0

           FOR I=0:0

               SET SERV=$ORDER(^SRS("C",SERV))

               IF SERV=""

                   QUIT 

               WRITE !,?5,SERV

 +1        QUIT