| [613] | 1 | SRSBDEL ;B'HAM ISC/MAM - DELETE SERVICE BLOCKOUT ; [ 01/08/98 9:54 AM ]
|
|---|
| 2 | ;;3.0; Surgery ;**26,77,104**;24 Jun 93
|
|---|
| 3 | SER ; service abbreviation
|
|---|
| 4 | S SRSOUT=0
|
|---|
| 5 | R !!,"Select service you wish to delete. (3-4 characters) ",SRSSER:DTIME I '$T!("^"[SRSSER) S SRSOUT=1 G END
|
|---|
| 6 | I SRSSER["?"!(SRSSER["=") D QUES G SER
|
|---|
| 7 | 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)
|
|---|
| 8 | I '$D(^SRS("SER",SRSSER)) W !!!,SRSSER_" does not exist.",! G SER
|
|---|
| 9 | S (OR,CNT)=0 F I=0:0 S OR=$O(^SRS("SER",SRSSER,OR)) Q:OR="" D
|
|---|
| 10 | .I $D(SRSITE("DIV")) Q:'($$ORDIV^SROUTL0(OR,SRSITE("DIV")))
|
|---|
| 11 | .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
|
|---|
| 12 | W !!!,"The service '"_SRSSER_"' has the following time(s) scheduled: " F I=1:1:CNT W !,?2,$P(SRSOR(I),"^")
|
|---|
| 13 | NUM R !!!,"Which number would you like to delete ? ",NUM:DTIME I '$T!("^"[NUM) S SRSOUT=1 G END
|
|---|
| 14 | I NUM<1!(NUM>CNT)!(NUM'?.N) W !!,"Enter a number from 1 to "_CNT_", or '^' to leave this option.",! G NUM
|
|---|
| 15 | STDATE S SRSOR=$P(SRSOR(NUM),"^",2),DAY=$P(SRSOR(NUM),"^",3),SRSST=$P(SRSOR(NUM),"^",4),SRSET=$P(SRSOR(NUM),"^",5)
|
|---|
| 16 | 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
|
|---|
| 17 | I SRSDATE<DT W !!,"Past dates cannot be entered.",! G DATE
|
|---|
| 18 | I $E(DAYOFW,1,2)'=DAY W !!,"The date you entered is not a " D DAY W DAY2_".",!! G STDATE
|
|---|
| 19 | 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
|
|---|
| 20 | S SRSNUM=$P(^SRS("SER",SRSSER,SRSOR,DAY,SRSST),"^",4)
|
|---|
| 21 | 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
|
|---|
| 22 | S:Z="" Z="N" S Z=$E(Z)
|
|---|
| 23 | 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
|
|---|
| 24 | W !!,"Updating Schedules...",!! S SRSALL=$S("Nn"[Z:1,1:0) I SRSALL=1 G MULD
|
|---|
| 25 | 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:"_")
|
|---|
| 26 | S X0=^SRS(SRSOR,"SS",SRSDATE,1),(X0,^(1))=$E(X0,1,SRS1)_S_$E(X0,SRS2+1,200)
|
|---|
| 27 | S X1=^SRS(SRSOR,"S",SRSDATE,1)
|
|---|
| 28 | 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)
|
|---|
| 29 | S ^SRS(SRSOR,"S",SRSDATE,1)=X1
|
|---|
| 30 | G:'SRSALL END Q
|
|---|
| 31 | DAY S DAY2=$S(DAY="MO":"Monday",DAY="TU":"Tuesday",DAY="WE":"Wednesday",DAY="TH":"Thursday",DAY="FR":"Friday",DAY="SA":"Saturday",1:"Sunday")
|
|---|
| 32 | Q
|
|---|
| 33 | CK1 I SRSNUM=0 S X=7 D UPDATE G:X CK1
|
|---|
| 34 | CK2 I SRSNUM>7 S X=14 D UPDATE G:X CK2
|
|---|
| 35 | 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
|
|---|
| 36 | CK3 I SRSNUM>0,(SRSNUM<5) S X=SRSNUM-1*7 D UPDATE G:X CK0
|
|---|
| 37 | CK5 I SRSNUM=5 S X1=SRSDATE,X2=21 D C^%DTC S SRSDATE=X
|
|---|
| 38 | 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
|
|---|
| 39 | Q
|
|---|
| 40 | 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
|
|---|
| 41 | 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
|
|---|
| 42 | Q
|
|---|
| 43 | MULD ; delete all
|
|---|
| 44 | 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))
|
|---|
| 45 | S DIK="^SRS("_DA(3)_",1,"_DA(2)_",1,"_DA(1)_",1," D ^DIK
|
|---|
| 46 | 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
|
|---|
| 47 | K ^SRS("R",DAY,SRSOR,SRSST,SRSNUM),^SRS("SER",SRSSER,SRSOR,DAY,SRSST)
|
|---|
| 48 | END I 'SRSOUT W !!,"Press RETURN to continue " R X:DTIME
|
|---|
| 49 | D ^SRSKILL W @IOF
|
|---|
| 50 | Q
|
|---|
| 51 | QUES W !!,"Choose from: " S SERV=0 F I=0:0 S SERV=$O(^SRS("C",SERV)) Q:SERV="" W !,?5,SERV
|
|---|
| 52 | Q
|
|---|
