BSDC ;MAN/GRR,ALB/LDB - CANCEL A CLINIC'S AVAILABILITY BY DATE RANGE ; [ 01/09/2003 1:52 PM ]
;;5.3;Scheduling;**15,32,79,132,167,1003,1011**;Aug 13, 1993
;IHS/ANMC/LJF 8/18/2000 added DIC("W") to warn if clinic inactivated
; 12/13/2000 added setting of cancellation comment into
; each patient's record
; 12/18/2002 added check so only onwers could cancel clinic
;IHS/ITSC/LJF 06/09/2005 PATCH 1003 added message to whole day cancellations
;
N SDATA,SDCNHDL ; for evt dvr
SDC1 K SDLT,SDCP S NOAP="" D LO^DGUTL
;S DIC=44,DIC(0)="MEQA",DIC("S")="I $P(^(0),""^"",3)=""C"",'$G(^(""OOS""))",DIC("A")="Select CLINIC NAME: " D ^DIC K DIC("S"),DIC("A") G:'$D(^SC(+Y,"SL")) END^SDC0 ;IHS/ANMC/LJF 8/18/2000
S DIC=44,DIC(0)="MEQA",DIC("S")="I $P(^(0),""^"",3)=""C"",'$G(^(""OOS""))",DIC("A")="Select CLINIC NAME: ",DIC("W")=$$INACTMSG^BSDU D ^DIC K DIC("S"),DIC("A") G:'$D(^SC(+Y,"SL")) END^SDC0 ;IHS/ANMC/LJF 8/18/2000
;1/9/2003 WAR per P46,LJF37
I '$$OWNER^BSDU(+Y,+$G(DUZ)) D MSG^BDGF("You are NOT an owner of this clinic. Please select again.",2,1) G SDC1 ;IHS/ANMC/LJF 12/18/2002
I $D(^SC(+Y,0)) ;IHS/ANMC/LJF 12/18/2002 restoring naked reference
N BSDCLN,BSDSL,BSDQ
S BSDQ=0
S SC=+Y,SL=^("SL")
S BSDCLN=SC,BSDSL=$G(^SC(SC,"SL"))
D GETDATES($P(Y,U,2))
Q:'$G(BSDBDT)
Q:$$READ^BDGF("Y","Are you sure you want to cancel appointments for "_$$FMTE^XLFDT(BSDBDT)_" to "_$$FMTE^XLFDT(BSDEDT),"YES")'=1
N BSDII
F BSDII=1:1 D Q:$G(BSDQ)
. I BSDII=1 S BSDI=BSDBDT
. S BSDI=$S(BSDII=1:BSDBDT,1:$$FMADD^XLFDT(BSDI,+1))
. I BSDI>BSDEDT S BSDQ=1 Q
. S SC=BSDCLN,SL=BSDSL
. S (SD,CDATE)=BSDI
. W !,"Cancelling clinic for date: "_$$FMTE^XLFDT(SD)
. ;S %DT="AEXF",%DT("A")="CANCEL '"_$P(Y,U,2)_"' FOR WHAT DATE: " D ^%DT K %DT G:Y<0 END^SDC0 ;NAKED REFERNCE - ^SC(IFN,"SL")
. S %=$P(SL,U,6),SI=$S(%="":4,%<3:4,%:%,1:4),%=$P(SL,U,3),STARTDAY=$S($L(%):%,1:8) D NOW^%DTC S SDTIME=%
. K SDRE,SDIN,SDRE1 I $D(^SC(SC,"I")) S SDIN=+^("I"),SDRE=+$P(^("I"),"^",2),Y=SDRE D:Y DTS^SDUTL S SDRE1=$S(SDRE:" to "_Y,1:"")
. I $S('$D(SDIN):0,SDIN'>0!(SDIN>SD):0,SDRE'>SD&(SDRE):0,1:1) W !,*7,"Clinic is inactive ",$S('SDRE:"as of ",1:"from ") S Y=SDIN D DTS^SDUTL W Y,SDRE1 Q
. I '$D(^SC(SC,"ST",SD,1)) S DH="" D B S ^SC(SC,"ST",SD,1)=$P("SU^MO^TU^WE^TH^FR^SA",U,DOW+1)_" "_$E(SD,6,7)_$J("",SI+SI-6)_DH,^(0)=SD G N
. I ^(1)["CANCELLED" W !,"APPOINTMENTS HAVE ALREADY BEEN CANCELLED",!,*7 S ANS="N",SDTIME="*",SDV1=$S($P(^SC(SC,0),"^",15):$P(^(0),"^",15),1:+$O(^DG(40.8,0))) K SDX G ASKL^SDC0 ;NAKED REFERENCE - ^SC(IFN,"ST",Date,1)
N . I '$F(^SC(SC,"ST",SD,1),"[") K:^(1)?2U.E ^SC(SC,"ST",SD) W !,*7,"CLINIC DOES NOT MEET ON "_$$FMTE^XLFDT(SD) Q ; KILLs node if not holiday
. I $O(^SC(SC,"S",SD))\1-SD W *7,!?5,"NO APPOINTMENTS SCHEDULED" S NOAP=1 G W
. W !,"FIRST, I'LL LIST THE EXISTING APPOINTMENTS",!
. K DUOUT,DTOUT D ^SDC1 I $D(DUOUT)!$D(DTOUT) D END^SDC0 S BSDQ=1 Q
. I ^SC(SC,"ST",SD,1)["X" G ^SDC2
W . S DH=0,%="" W !,"WANT TO CANCEL THE WHOLE DAY" D YN^DICN I '% W !,"REPLY YES (Y) OR NO (N)" G W
. I %=1 G WP:$$COED^SDC4(SC,SD,SD+.2359,1),ALL
. I %<1 S BSDQ=1 Q
WP . S %="" W !,"WANT TO CANCEL PART OF THE DAY" D YN^DICN I '% W !,"REPLY YES (Y) OR NO (N)" G WP
. I %-1 S BSDQ=1 Q
F . R !,"STARTING TIME: ",X:DTIME Q:U[X D TC^SDC2 G F:Y<0 S FR=Y,ST=%
T . R !,"ENDING TIME: ",X:DTIME Q:U[X D TC^SDC2 G T:Y<0 S SDHTO=X,TO=Y I TO'>FR W !,"Ending time must be greater than starting time",*7 G T
. I $$COED^SDC4(SC,FR,TO,1) K FR,SDHTO,TO,ST W ! G F
ROPT . R !,"(OPTIONAL) MESSAGE: ",I:DTIME I I?1"?".E W !,"YOU MAY ENTER A MESSAGE CONCERNING THE CANCELLATION HERE" G ROPT
. Q:I["^" I '$D(^SC(SC,"SDCAN",0)) S ^SC(SC,"SDCAN",0)="^44.05D^"_FR_"^1" G SKIP
. NEW BSDMSG I I]"" S BSDMSG=I ;IHS/ANMC/LJF 12/13/2000
. S A=^SC(SC,"SDCAN",0),SDCNT=$P(A,"^",4),^SC(SC,"SDCAN",0)=$P(A,"^",1,2)_"^"_FR_"^"_(SDCNT+1)
SKIP . S ^SC(SC,"SDCAN",FR,0)=FR_"^"_SDHTO
. S NOAP=$S($O(^SC(SC,"S",(FR-.0001)))'>0:1,$O(^SC(SC,"S",(FR-.0001)))>TO:1,1:0) I 'NOAP S NOAP=$S($O(^SC(SC,"S",+$O(^SC(SC,"S",(FR-.0001))),0))="MES":1,1:0)
. S ^SC(SC,"S",FR,0)=FR,^("MES")="CANCELLED UNTIL "_X_$S(I?.P:"",1:" ("_I_")") D S S I=^(1),I=I_$J("",%-$L(I)),Y=""
. F X=0:2:% S DH=$E(I,X+SI+SI),P=$S(X<ST:DH_$E(I,X+1+SI+SI),X=%:$S(Y="[":Y,1:DH)_$E(I,X+1+SI+SI),1:$S(Y="["&(X=ST):"]",1:"X")_"X"),Y=$S(DH="]":"",DH="[":DH,1:Y),I=$E(I,1,X-1+SI+SI)_P_$E(I,X+2+SI+SI,999)
. S:'$F(I,"[") I5=$F(I,"X"),I=$E(I,1,(I5-2))_"["_$E(I,I5,999) K I5
. S DH=0,^(1)=I,FR=FR-.0001 G C ;NAKED REFERENCE - ^SC(IFN,"ST",Date,1)
;
Q
S S ^("CAN")=^SC(SC,"ST",SD,1) Q
;
;IHS/ITSC/LJF 6/9/2005 PATCH 1003 add message to stored cancel message
ALL ;D S S ^(1)=" "_$E(SD,6,7)_" **CANCELLED**",FR=SD,TO=SD+.9 ;NAKED REFERENCE - ^SC(IFN,"ST",Date,1)
NEW BSDMSG S BSDMSG=$$READ^BDGF("FO^1:50","(OPTIONAL) MESSAGE") ;IHS/ANMC/LJF 12/13/2000
D S S ^SC(SC,"ST",SD,1)=" "_$E(SD,6,7)_" **CANCELLED** "_BSDMSG,FR=SD,TO=SD+.9
;end of PATCH 1003 changes
;
C S FR=$O(^SC(SC,"S",FR)) I FR<1!(FR'<TO) W !!,"CANCELLED! " K SDX G CHKEND^SDC0
F I=0:0 S I=$O(^SC(SC,"S",FR,1,I)) Q:I'>0 D
.S DFN=+^SC(SC,"S",FR,1,I,0),SDCNHDL=$$HANDLE^SDAMEVT(1)
.D BEFORE^SDAMEVT(.SDATA,DFN,FR,SC,I,SDCNHDL)
.S $P(^SC(SC,"S",FR,1,I,0),"^",9)="C"
.I $D(^DPT(DFN,"S",FR,0)),$P(^(0),"^",2)'["C" S $P(^(0),"^",2)="C",$P(^(0),"^",12)=DUZ,$P(^(0),"^",14)=SDTIME,DH=DH+1 D MORE
G C
;
B S X=SD D DOW^SDM0 S DOW=Y,SS=+$O(^SC(SC,"T"_Y,X)) I $D(^(SS,1)),^(1)]"" S DH=^(1),DO=X+1,DA(1)=SC
Q
MORE I $D(^SC("ARAD",SC,FR,DFN)) S ^(DFN)="N"
I $G(BSDMSG)]"" S ^DPT(DFN,"S",FR,"R")=BSDMSG ;IHS/ANMC/LJF 12/13/2000
S SDIV=$S($P(^SC(SC,0),"^",15)]"":$P(^(0),"^",15),1:" 1"),SDV1=$S(SDIV:SDIV,1:+$O(^DG(40.8,0))) I $D(^DPT("ASDPSD","C",SDIV,SC,FR,DFN)) K ^(DFN)
S SDH=DH,SDTTM=FR,SDSC=SC,SDPL=I,SDRT="D" D RT^SDUTL
S DH=SDH K SDH D CK1,EVT
K SD1,SDIV,SDPL,SDRT,SDSC,SDTTM,SDX Q
CK1 S SDX=0 F SD1=FR\1:0 S SD1=$O(^DPT(DFN,"S",SD1)) Q:'SD1!((SD1\1)'=(FR\1)) I $P(^(SD1,0),"^",2)'["C",$P(^(0),"^",2)'["N" S SDX=1 Q
Q:SDX F SD1=2,4 I $D(^SC("AAS",SD1,FR\1,DFN)) S SDX=1 Q
Q:SDX IF $D(^SCE(+$$EXAE^SDOE(DFN,FR\1,FR\1),0)) S SDX=1
Q:SDX K ^DPT("ASDPSD","B",SDIV,FR\1,DFN) Q
;
EVT ; -- separate tag if need to NEW vars
; -- cancel event
N FR,I,SDTIME,DH,SC
D CANCEL^SDAMEVT(.SDATA,DFN,SDTTM,SDSC,SDPL,0,SDCNHDL) K SDATA,SDCNHDL
Q
;
GETDATES(CLNE) ;-- get date range to cancel availability
S %DT="AEXF",%DT("A")="CANCEL '"_CLNE_"' FOR WHAT BEGIN DATE: " D ^%DT K %DT ;NAKED REFERNCE - ^SC(IFN,"SL")
I Y<0 K BSDBDT Q
S BSDBDT=+Y
S %DT="AEXF",%DT("A")="CANCEL '"_CLNE_"' FOR WHAT END DATE: " D ^%DT K %DT ;NAKED REFERNCE - ^SC(IFN,"SL")
I Y<0 K BSDBDT,BSDEDT Q
S BSDEDT=+Y
Q
;
ASKQUIT ;-- ask if they want to quit cancelling
N BSDQUIT
S BSDQUIT=$$READ^BDGF("Y","Do you want to quit cancelling the clinic availability","YES")
Q BSDQUIT
;
BSDC ;MAN/GRR,ALB/LDB - CANCEL A CLINIC'S AVAILABILITY BY DATE RANGE ; [ 01/09/2003 1:52 PM ]
+1 ;;5.3;Scheduling;**15,32,79,132,167,1003,1011**;Aug 13, 1993
+2 ;IHS/ANMC/LJF 8/18/2000 added DIC("W") to warn if clinic inactivated
+3 ; 12/13/2000 added setting of cancellation comment into
+4 ; each patient's record
+5 ; 12/18/2002 added check so only onwers could cancel clinic
+6 ;IHS/ITSC/LJF 06/09/2005 PATCH 1003 added message to whole day cancellations
+7 ;
+8 ; for evt dvr
NEW SDATA,SDCNHDL
SDC1 KILL SDLT,SDCP
SET NOAP=""
DO LO^DGUTL
+1 ;S DIC=44,DIC(0)="MEQA",DIC("S")="I $P(^(0),""^"",3)=""C"",'$G(^(""OOS""))",DIC("A")="Select CLINIC NAME: " D ^DIC K DIC("S"),DIC("A") G:'$D(^SC(+Y,"SL")) END^SDC0 ;IHS/ANMC/LJF 8/18/2000
+2 ;IHS/ANMC/LJF 8/18/2000
SET DIC=44
SET DIC(0)="MEQA"
SET DIC("S")="I $P(^(0),""^"",3)=""C"",'$G(^(""OOS""))"
SET DIC("A")="Select CLINIC NAME: "
SET DIC("W")=$$INACTMSG^BSDU
DO ^DIC
KILL DIC("S"),DIC("A")
IF '$DATA(^SC(+Y,"SL"))
GOTO END^SDC0
+3 ;1/9/2003 WAR per P46,LJF37
+4 ;IHS/ANMC/LJF 12/18/2002
IF '$$OWNER^BSDU(+Y,+$GET(DUZ))
DO MSG^BDGF("You are NOT an owner of this clinic. Please select again.",2,1)
GOTO SDC1
+5 ;IHS/ANMC/LJF 12/18/2002 restoring naked reference
IF $DATA(^SC(+Y,0))
+6 NEW BSDCLN,BSDSL,BSDQ
+7 SET BSDQ=0
+8 SET SC=+Y
SET SL=^("SL")
+9 SET BSDCLN=SC
SET BSDSL=$GET(^SC(SC,"SL"))
+10 DO GETDATES($PIECE(Y,U,2))
+11 IF '$GET(BSDBDT)
QUIT
+12 IF $$READ^BDGF("Y","Are you sure you want to cancel appointments for "_$$FMTE^XLFDT(BSDBDT)_" to "_$$FMTE^XLFDT(BSDEDT),"YES")'=1
QUIT
+13 NEW BSDII
+14 FOR BSDII=1:1
Begin DoDot:1
+15 IF BSDII=1
SET BSDI=BSDBDT
+16 SET BSDI=$SELECT(BSDII=1:BSDBDT,1:$$FMADD^XLFDT(BSDI,+1))
+17 IF BSDI>BSDEDT
SET BSDQ=1
QUIT
+18 SET SC=BSDCLN
SET SL=BSDSL
+19 SET (SD,CDATE)=BSDI
+20 WRITE !,"Cancelling clinic for date: "_$$FMTE^XLFDT(SD)
+21 ;S %DT="AEXF",%DT("A")="CANCEL '"_$P(Y,U,2)_"' FOR WHAT DATE: " D ^%DT K %DT G:Y<0 END^SDC0 ;NAKED REFERNCE - ^SC(IFN,"SL")
+22 SET %=$PIECE(SL,U,6)
SET SI=$SELECT(%="":4,%<3:4,%:%,1:4)
SET %=$PIECE(SL,U,3)
SET STARTDAY=$SELECT($LENGTH(%):%,1:8)
DO NOW^%DTC
SET SDTIME=%
+23 KILL SDRE,SDIN,SDRE1
IF $DATA(^SC(SC,"I"))
SET SDIN=+^("I")
SET SDRE=+$PIECE(^("I"),"^",2)
SET Y=SDRE
IF Y
DO DTS^SDUTL
SET SDRE1=$SELECT(SDRE:" to "_Y,1:"")
+24 IF $SELECT('$DATA(SDIN):0,SDIN'>0!(SDIN>SD):0,SDRE'>SD&(SDRE):0,1:1)
WRITE !,*7,"Clinic is inactive ",$SELECT('SDRE:"as of ",1:"from ")
SET Y=SDIN
DO DTS^SDUTL
WRITE Y,SDRE1
QUIT
+25 IF '$DATA(^SC(SC,"ST",SD,1))
SET DH=""
DO B
SET ^SC(SC,"ST",SD,1)=$PIECE("SU^MO^TU^WE^TH^FR^SA",U,DOW+1)_" "_$EXTRACT(SD,6,7)_$JUSTIFY("",SI+SI-6)_DH
SET ^(0)=SD
GOTO N
+26 ;NAKED REFERENCE - ^SC(IFN,"ST",Date,1)
IF ^(1)["CANCELLED"
WRITE !,"APPOINTMENTS HAVE ALREADY BEEN CANCELLED",!,*7
SET ANS="N"
SET SDTIME="*"
SET SDV1=$SELECT($PIECE(^SC(SC,0),"^",15):$PIECE(^(0),"^",15),1:+$ORDER(^DG(40.8,0)))
KILL SDX
GOTO ASKL^SDC0
N ; KILLs node if not holiday
IF '$FIND(^SC(SC,"ST",SD,1),"[")
IF ^(1)?2U.E
KILL ^SC(SC,"ST",SD)
WRITE !,*7,"CLINIC DOES NOT MEET ON "_$$FMTE^XLFDT(SD)
QUIT
+1 IF $ORDER(^SC(SC,"S",SD))\1-SD
WRITE *7,!?5,"NO APPOINTMENTS SCHEDULED"
SET NOAP=1
GOTO W
+2 WRITE !,"FIRST, I'LL LIST THE EXISTING APPOINTMENTS",!
+3 KILL DUOUT,DTOUT
DO ^SDC1
IF $DATA(DUOUT)!$DATA(DTOUT)
DO END^SDC0
SET BSDQ=1
QUIT
+4 IF ^SC(SC,"ST",SD,1)["X"
GOTO ^SDC2
W SET DH=0
SET %=""
WRITE !,"WANT TO CANCEL THE WHOLE DAY"
DO YN^DICN
IF '%
WRITE !,"REPLY YES (Y) OR NO (N)"
GOTO W
+1 IF %=1
IF $$COED^SDC4(SC,SD,SD+.2359,1)
GOTO WP
GOTO ALL
+2 IF %<1
SET BSDQ=1
QUIT
WP SET %=""
WRITE !,"WANT TO CANCEL PART OF THE DAY"
DO YN^DICN
IF '%
WRITE !,"REPLY YES (Y) OR NO (N)"
GOTO WP
+1 IF %-1
SET BSDQ=1
QUIT
F READ !,"STARTING TIME: ",X:DTIME
IF U[X
QUIT
DO TC^SDC2
IF Y<0
GOTO F
SET FR=Y
SET ST=%
T READ !,"ENDING TIME: ",X:DTIME
IF U[X
QUIT
DO TC^SDC2
IF Y<0
GOTO T
SET SDHTO=X
SET TO=Y
IF TO'>FR
WRITE !,"Ending time must be greater than starting time",*7
GOTO T
+1 IF $$COED^SDC4(SC,FR,TO,1)
KILL FR,SDHTO,TO,ST
WRITE !
GOTO F
ROPT READ !,"(OPTIONAL) MESSAGE: ",I:DTIME
IF I?1"?".E
WRITE !,"YOU MAY ENTER A MESSAGE CONCERNING THE CANCELLATION HERE"
GOTO ROPT
+1 IF I["^"
QUIT
IF '$DATA(^SC(SC,"SDCAN",0))
SET ^SC(SC,"SDCAN",0)="^44.05D^"_FR_"^1"
GOTO SKIP
+2 ;IHS/ANMC/LJF 12/13/2000
NEW BSDMSG
IF I]""
SET BSDMSG=I
+3 SET A=^SC(SC,"SDCAN",0)
SET SDCNT=$PIECE(A,"^",4)
SET ^SC(SC,"SDCAN",0)=$PIECE(A,"^",1,2)_"^"_FR_"^"_(SDCNT+1)
SKIP SET ^SC(SC,"SDCAN",FR,0)=FR_"^"_SDHTO
+1 SET NOAP=$SELECT($ORDER(^SC(SC,"S",(FR-.0001)))'>0:1,$ORDER(^SC(SC,"S",(FR-.0001)))>TO:1,1:0)
IF 'NOAP
SET NOAP=$SELECT($ORDER(^SC(SC,"S",+$ORDER(^SC(SC,"S",(FR-.0001))),0))="MES":1,1:0)
+2 SET ^SC(SC,"S",FR,0)=FR
SET ^("MES")="CANCELLED UNTIL "_X_$SELECT(I?.P:"",1:" ("_I_")")
DO S
SET I=^(1)
SET I=I_$JUSTIFY("",%-$LENGTH(I))
SET Y=""
+3 FOR X=0:2:%
SET DH=$EXTRACT(I,X+SI+SI)
SET P=$SELECT(X<ST:DH_$EXTRACT(I,X+1+SI+SI),X=%:$SELECT(Y="[":Y,1:DH)_$EXTRACT(I,X+1+SI+SI),1:$SELECT(Y="["&(X=ST):"]",1:"X")_"X")
SET Y=$SELECT(DH="]":"",DH="[":DH,1:Y)
SET I=$EXTRACT(I,1,X-1+SI+SI)_P_$EXTRACT(I,X+2+SI+SI,999)
+4 IF '$FIND(I,"[")
SET I5=$FIND(I,"X")
SET I=$EXTRACT(I,1,(I5-2))_"["_$EXTRACT(I,I5,999)
KILL I5
+5 ;NAKED REFERENCE - ^SC(IFN,"ST",Date,1)
SET DH=0
SET ^(1)=I
SET FR=FR-.0001
GOTO C
End DoDot:1
IF $GET(BSDQ)
QUIT
+6 ;
+7 QUIT
S SET ^("CAN")=^SC(SC,"ST",SD,1)
QUIT
+1 ;
+2 ;IHS/ITSC/LJF 6/9/2005 PATCH 1003 add message to stored cancel message
ALL ;D S S ^(1)=" "_$E(SD,6,7)_" **CANCELLED**",FR=SD,TO=SD+.9 ;NAKED REFERENCE - ^SC(IFN,"ST",Date,1)
+1 ;IHS/ANMC/LJF 12/13/2000
NEW BSDMSG
SET BSDMSG=$$READ^BDGF("FO^1:50","(OPTIONAL) MESSAGE")
+2 DO S
SET ^SC(SC,"ST",SD,1)=" "_$EXTRACT(SD,6,7)_" **CANCELLED** "_BSDMSG
SET FR=SD
SET TO=SD+.9
+3 ;end of PATCH 1003 changes
+4 ;
C SET FR=$ORDER(^SC(SC,"S",FR))
IF FR<1!(FR'<TO)
WRITE !!,"CANCELLED! "
KILL SDX
GOTO CHKEND^SDC0
+1 FOR I=0:0
SET I=$ORDER(^SC(SC,"S",FR,1,I))
IF I'>0
QUIT
Begin DoDot:1
+2 SET DFN=+^SC(SC,"S",FR,1,I,0)
SET SDCNHDL=$$HANDLE^SDAMEVT(1)
+3 DO BEFORE^SDAMEVT(.SDATA,DFN,FR,SC,I,SDCNHDL)
+4 SET $PIECE(^SC(SC,"S",FR,1,I,0),"^",9)="C"
+5 IF $DATA(^DPT(DFN,"S",FR,0))
IF $PIECE(^(0),"^",2)'["C"
SET $PIECE(^(0),"^",2)="C"
SET $PIECE(^(0),"^",12)=DUZ
SET $PIECE(^(0),"^",14)=SDTIME
SET DH=DH+1
DO MORE
End DoDot:1
+6 GOTO C
+7 ;
B SET X=SD
DO DOW^SDM0
SET DOW=Y
SET SS=+$ORDER(^SC(SC,"T"_Y,X))
IF $DATA(^(SS,1))
IF ^(1)]""
SET DH=^(1)
SET DO=X+1
SET DA(1)=SC
+1 QUIT
MORE IF $DATA(^SC("ARAD",SC,FR,DFN))
SET ^(DFN)="N"
+1 ;IHS/ANMC/LJF 12/13/2000
IF $GET(BSDMSG)]""
SET ^DPT(DFN,"S",FR,"R")=BSDMSG
+2 SET SDIV=$SELECT($PIECE(^SC(SC,0),"^",15)]"":$PIECE(^(0),"^",15),1:" 1")
SET SDV1=$SELECT(SDIV:SDIV,1:+$ORDER(^DG(40.8,0)))
IF $DATA(^DPT("ASDPSD","C",SDIV,SC,FR,DFN))
KILL ^(DFN)
+3 SET SDH=DH
SET SDTTM=FR
SET SDSC=SC
SET SDPL=I
SET SDRT="D"
DO RT^SDUTL
+4 SET DH=SDH
KILL SDH
DO CK1
DO EVT
+5 KILL SD1,SDIV,SDPL,SDRT,SDSC,SDTTM,SDX
QUIT
CK1 SET SDX=0
FOR SD1=FR\1:0
SET SD1=$ORDER(^DPT(DFN,"S",SD1))
IF 'SD1!((SD1\1)'=(FR\1))
QUIT
IF $PIECE(^(SD1,0),"^",2)'["C"
IF $PIECE(^(0),"^",2)'["N"
SET SDX=1
QUIT
+1 IF SDX
QUIT
FOR SD1=2,4
IF $DATA(^SC("AAS",SD1,FR\1,DFN))
SET SDX=1
QUIT
+2 IF SDX
QUIT
IF $DATA(^SCE(+$$EXAE^SDOE(DFN,FR\1,FR\1),0))
SET SDX=1
+3 IF SDX
QUIT
KILL ^DPT("ASDPSD","B",SDIV,FR\1,DFN)
QUIT
+4 ;
EVT ; -- separate tag if need to NEW vars
+1 ; -- cancel event
+2 NEW FR,I,SDTIME,DH,SC
+3 DO CANCEL^SDAMEVT(.SDATA,DFN,SDTTM,SDSC,SDPL,0,SDCNHDL)
KILL SDATA,SDCNHDL
+4 QUIT
+5 ;
GETDATES(CLNE) ;-- get date range to cancel availability
+1 ;NAKED REFERNCE - ^SC(IFN,"SL")
SET %DT="AEXF"
SET %DT("A")="CANCEL '"_CLNE_"' FOR WHAT BEGIN DATE: "
DO ^%DT
KILL %DT
+2 IF Y<0
KILL BSDBDT
QUIT
+3 SET BSDBDT=+Y
+4 ;NAKED REFERNCE - ^SC(IFN,"SL")
SET %DT="AEXF"
SET %DT("A")="CANCEL '"_CLNE_"' FOR WHAT END DATE: "
DO ^%DT
KILL %DT
+5 IF Y<0
KILL BSDBDT,BSDEDT
QUIT
+6 SET BSDEDT=+Y
+7 QUIT
+8 ;
ASKQUIT ;-- ask if they want to quit cancelling
+1 NEW BSDQUIT
+2 SET BSDQUIT=$$READ^BDGF("Y","Do you want to quit cancelling the clinic availability","YES")
+3 QUIT BSDQUIT
+4 ;
