SDCNP0 ;ALB/LDB - CANCEL APPT. FOR A PATIENT ; 3/2/05 3:13pm
;;5.3;Scheduling;**132,167,478,517,1015,1016**;Aug 13, 1993;Build 20
;ihs/cmi/maw 07/26/2012 PATCH 1016 added +$E(%,1,12) for correct date filing
EN2 D WAIT^DICD S NDT=HDT/1,L=0 F J=1:1 S NDT=$O(^DPT(DFN,"S",NDT)) Q:NDT'>0!(SDPV&(NDT'<SDTM)) S SD0=^(NDT,0) I $P(SD0,"^",2)'["C" S SC=+SD0,L=L\1+1,APL="" D FLEN^SDCNP1A S ^UTILITY($J,"SDCNP",L)=NDT_"^"_SC_"^"_COV_"^"_APL_"^^"_APL D CHKSO
WH1 G:L'>0 NO S (SDCTRL,SDCTR)=0,APP="" N SDITEM W:'SDERR @IOF
W ! F Z=0:0 S Z=$O(^UTILITY($J,"SDCNP",Z)) Q:Z'>0 S SDITEM=$J($S(Z\1=Z:"("_$J(Z,2)_") ",1:""),5) D Q:SDCTRL
.I SDITEM["(" W !,SDITEM S HLDCSND=""
.I SDITEM'["(" W SDITEM
.S AT=$S($P(^(Z),"^",2)'?.N:1,1:0),Y=$P($P(^(Z),"^"),".") D DT^SDM0 S X=$P(^(Z),"^"),^(Z,"CNT")="" X ^DD("FUNC",2,1) W " ",$J(X,8) D MORE W:AT ! Q:SDCTRL
S:SDERR SDCTRL=1 I Z>0 G:SDCTRL&(APP']"") NOPE^SDCNP1 G:SDCTRL DEL
D WH G NOPE^SDCNP1:APP']"",DEL
WH W !!,"SELECT APPOINTMENTS TO BE CANCELLED" W:Z>0 " OR HIT RETURN TO CONTINUE DISPLAY" R ": ",APP:DTIME I '$T!(APP="^") S SDCTRL=1,APP="" Q
S SDMSG="W !,""Enter appt. numbers separated by commas and/or a range separated"",!,""by dashes (ie 2,4,6-9)"" H 2" I APP["?" X SDMSG G WH
S SDCTRL=$S(APP']"":0,1:1) Q
DEL S SDERR=0 F J=1:1 S SDDH=$P(APP,",",J) Q:SDDH']"" D MTCH^SDCNP1
G:SDERR WH1
DEL1 F J=1:1 S SDDH=$P(APP,",",J) Q:SDDH']"" S SDDI=$P(SDDH,"-"),SDDM=$P(SDDH,"-",2) D CKK^SDCNP1A Q:SDERR D CKK1^SDCNP1A Q:SDERR Q:'SDDI F A1=SDDI:1:$S(SDDM:SDDM,1:SDDI) D BEGD
G:SDERR WH1 G NOPE^SDCNP1
BEGD S (SD,S)=$P(^UTILITY($J,"SDCNP",A1),"^",1),I=$P(^UTILITY($J,"SDCNP",A1),"^",2)
S SL=^SC(I,"SL"),X=$P(SL,U,3),STARTDAY=$S($L(X):X,1:8),SB=STARTDAY-1/100,X=$P(SL,U,6),HSI=$S(X:X,1:4),SI=$S(X="":4,X<3:4,X:X,1:4),STR="#@!$* XXWVUTSRQPONMLKJIHGFEDCBA0123456789jklmnopqrstuvwxyz",SDDIF=$S(HSI<3:8/HSI,1:2) K Y
I $$CODT^SDCOU(DFN,+^UTILITY($J,"SDCNP",A1),+$P(^(A1),U,2)) W !,*7,">>> Appointment #",A1," has a check out date and cannot be cancelled." Q
D PROT^SDCNP1A Q:SDPRT=1 D CAN S $P(^UTILITY($J,"SDCNP",A1),"^",4)="*** JUST CANCELLED ***" Q
CAN Q:$P(^UTILITY($J,"SDCNP",A1),"^",4)["JUST CANCELLED" S CNT=CNT+1,DIV=$S($P(^SC(I,0),"^",15)]"":" "_$P(^(0),"^",15),1:" 1") I $D(^DPT("ASDPSD","C",DIV,I,S,DFN)) K ^(DFN)
N SDATA,SDCPHDL S SDCPHDL=$$HANDLE^SDAMEVT(1) D BEFORE^SDAMEVT(.SDATA,DFN,S,I,"",SDCPHDL)
S:'$D(^DPT(DFN,"S",0)) ^(0)="^2.98P^^" I $D(SDREM) S DIE="^DPT("_DFN_",""S"",",(DA,Y)=S,DA(1)=DFN,DR="17///^S X="_"""""_SDREM_""""" D ^DIE K DIE,DR
S ^DPT("ASDCN",I,DA,DA(1))=$S(SDWH["P":1,1:"") K DA
S $P(^DPT(DFN,"S",S,0),"^",2)=SDWH S:$D(DUZ) $P(^(0),"^",12)=DUZ D NOW^%DTC S SDT=+$E(%,1,12),$P(^(0),"^",14)=SDT,$P(^(0),"^",15)=SDSCR,(DA,Y)=0 F X=0:0 S X=+$O(^SC(I,"S",S,1,X)) Q:'$D(^(X,0)) D C Q:Y&(DA)
I $D(^DPT("ASDPSD","B",DIV,S\1,DFN)) D CK1
Q:'Y S SL=$P(^SC(I,"S",S,1,Y,0),U,2) I DA,'$D(^("OB")) K ^SC(I,"S",S,1,DA,"OB")
S SDDA=DA,SDTTM=S,SDRT="D",SDPL=Y,SDSC=I D RT^SDUTL D CANCEL^SDCNSLT S Y=SDPL,S=SDTTM,I=SDSC,DA=SDDA K SDDA ;SD/478
S SDNODE=^SC(I,"S",S,1,Y,0),^SC("ARAD",I,S,DFN)="N",TLNK=$P($G(^SC(I,"S",S,1,Y,"CONS")),U) K ^SC(I,"S",S,1,Y) K:$O(^SC(I,"S",S,0))'>0 ^SC(I,"S",S,0) D CLRK^SDCNP1 ;SD/478
K:TLNK'="" ^SC("AWAS1",TLNK),TLNK ;SD/478
;S SDNODE=^SC(I,"S",S,1,Y,0),^SC("ARAD",I,S,DFN)="N" S DA(2)=I,DA(1)=S,DA=Y,DIK="^SC("_DA(2)_",""S"","_DA(1)_",1," D ^DIK K:$O(^SC(I,"S",S,0))'>0 ^SC(I,"S",S,0) D CLRK^SDCNP1 ;SD/478
D EVT
Q:'$D(^SC(I,"ST",SD\1,1))
EN01 S S=^SC(I,"ST",SD\1,1),Y=SD#1-SB*100,ST=Y#1*SI\.6+(Y\1*SI),SS=SL*HSI/60
I Y'<1 F I=ST+ST:SDDIF S Y=$E(STR,$F(STR,$E(S,I+1))) Q:Y="" S S=$E(S,1,I)_Y_$E(S,I+2,999),SS=SS-1 Q:SS'>0
S ^(1)=S Q ;NAKED REFERENCE - ^SC(IFN,"ST",Date,1)
C I +^SC(I,"S",S,1,X,0)=DFN S Y=X Q
Q:'$D(^("OB"))!DA S:^("OB")?1"O".E DA=X Q
NO W !,"NO ",$S('SDPV:"PENDING",1:"PREVIOUS")," APPOINTMENTS",*7,*7,*7
D END^SDCNP G RD^SDCNP
Q
CHKSO S COV=$S($P(^DPT(DFN,"S",NDT,0),"^",11)=1:" (COLLATERAL) ",1:"") F SDJ=3,4,5 I $P(^DPT(DFN,"S",NDT,0),"^",SDJ)]"" S L=L+.1,^UTILITY($J,"SDCNP",L)=$P(^(0),"^",SDJ)_"^"_$S(SDJ=3:"LAB",SDJ=4:"XRAY",1:"EKG")_"^0^0"
Q
MORE S SDCTR=SDCTR+2 I AT W ?41,$P(^UTILITY($J,"SDCNP",Z),"^",2) G OVR
W " ",$S($P(^UTILITY($J,"SDCNP",Z),"^",4)?.N:"("_$P(^(Z),"^",4)_" MIN) ",1:$P(^(Z),"^",4))," ",$S($D(^SC($P(^(Z),"^",2),0)):$P(^(0),"^",1),1:"DELETED CLINIC"),$P(^UTILITY($J,"SDCNP",Z),"^",3) ;SD/478
N CSND,CSDT,CSSD,CONSULT,Y
S CSND=^UTILITY($J,"SDCNP",Z),CSDT=$P(CSND,U),CSSD=$P(CSND,U,2),HLDCSND=CSND S CONSULT=$$CONSULT(CSSD,CSDT) I +$G(CONSULT) S Y=$P(^GMR(123,CONSULT,0),U) D DD^%DT W !?5,"CONSULT ",Y,"/ ",CONSULT
D STATUS($X>55)
OVR ;Following code added SD/517
I '$D(CSND) I $G(HLDCSND) I (($P(HLDCSND,U,4)="")!($P(HLDCSND,U,6)="")) D
.W !!,"**********************************************************************"
.W !,"* WARNING: There is a data inconsistency or data corruption problem *"
.W !,"* with the above appointment. Corrective action needs to be taken. *"
.W !,"* Please cancel the appointment above. If it is a valid appointment,*"
.W !,"* it will have to be re-entered via Appointment Management. *"
.W !,"**********************************************************************"
.S SDCTR=21
.K HLDCSND
;
I SDCTR>20,$O(^UTILITY($J,"SDCNP",Z)) S (SDCTRL,SDCTR)=0 W *7 D WH W:'SDCTRL @IOF
Q
;
CONSULT(CSSD,CSDT) ;
N CSI S CONSULT=""
S CSI=0 F S CSI=$O(^SC(CSSD,"S",CSDT,1,CSI)) Q:'+CSI I $P($G(^SC(CSSD,"S",CSDT,1,CSI,0)),U)=DFN S CONSULT=$P($G(^SC(CSSD,"S",CSDT,1,CSI,"CONS")),U) Q ;SD/478
Q CONSULT
CK1 S SDX=0 F SD1=S\1:0 S SD1=$O(^DPT(DFN,"S",SD1)) Q:'SD1!((SD1\1)'=(S\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,S\1,DFN)) S SDX=1 Q
Q:SDX IF $D(^SCE(+$$EXAE^SDOE(DFN,S\1,S\1),0)) S SDX=1
Q:SDX K ^DPT("ASDPSD","B",DIV,S\1,DFN) Q
;
STATUS(LF) ;
W:LF !
W ?55,"(",$E($$LOWER^VALM1($P($$STATUS^SDAM1(DFN,+^UTILITY($J,"SDCNP",Z),+$P(^(Z),U,2),$G(^DPT(DFN,"S",+^(Z),0))),";",3)),1,23),")"
W:'LF !
Q
;
EVT ; -- separate tag if need to NEW vars
N I,STR,SS,SL,SD,SB,SI,HSI,J,APP,S,A1,STARTDAY,CNT,DIV,SDERR,SDDIF
D CANCEL^SDAMEVT(.SDATA,DFN,SDTTM,SDSC,SDPL,0,SDCPHDL)
Q
SDCNP0 ;ALB/LDB - CANCEL APPT. FOR A PATIENT ; 3/2/05 3:13pm
+1 ;;5.3;Scheduling;**132,167,478,517,1015,1016**;Aug 13, 1993;Build 20
+2 ;ihs/cmi/maw 07/26/2012 PATCH 1016 added +$E(%,1,12) for correct date filing
EN2 DO WAIT^DICD
SET NDT=HDT/1
SET L=0
FOR J=1:1
SET NDT=$ORDER(^DPT(DFN,"S",NDT))
IF NDT'>0!(SDPV&(NDT'<SDTM))
QUIT
SET SD0=^(NDT,0)
IF $PIECE(SD0,"^",2)'["C"
SET SC=+SD0
SET L=L\1+1
SET APL=""
DO FLEN^SDCNP1A
SET ^UTILITY($JOB,"SDCNP",L)=NDT_"^"_SC_"^"_COV_"^"_APL_"^^"_APL
DO CHKSO
WH1 IF L'>0
GOTO NO
SET (SDCTRL,SDCTR)=0
SET APP=""
NEW SDITEM
IF 'SDERR
WRITE @IOF
+1 WRITE !
FOR Z=0:0
SET Z=$ORDER(^UTILITY($JOB,"SDCNP",Z))
IF Z'>0
QUIT
SET SDITEM=$JUSTIFY($SELECT(Z\1=Z:"("_$JUSTIFY(Z,2)_") ",1:""),5)
Begin DoDot:1
+2 IF SDITEM["("
WRITE !,SDITEM
SET HLDCSND=""
+3 IF SDITEM'["("
WRITE SDITEM
+4 SET AT=$SELECT($PIECE(^(Z),"^",2)'?.N:1,1:0)
SET Y=$PIECE($PIECE(^(Z),"^"),".")
DO DT^SDM0
SET X=$PIECE(^(Z),"^")
SET ^(Z,"CNT")=""
XECUTE ^DD("FUNC",2,1)
WRITE " ",$JUSTIFY(X,8)
DO MORE
IF AT
WRITE !
IF SDCTRL
QUIT
End DoDot:1
IF SDCTRL
QUIT
+5 IF SDERR
SET SDCTRL=1
IF Z>0
IF SDCTRL&(APP']"")
GOTO NOPE^SDCNP1
IF SDCTRL
GOTO DEL
+6 DO WH
IF APP']""
GOTO NOPE^SDCNP1
GOTO DEL
WH WRITE !!,"SELECT APPOINTMENTS TO BE CANCELLED"
IF Z>0
WRITE " OR HIT RETURN TO CONTINUE DISPLAY"
READ ": ",APP:DTIME
IF '$TEST!(APP="^")
SET SDCTRL=1
SET APP=""
QUIT
+1 SET SDMSG="W !,""Enter appt. numbers separated by commas and/or a range separated"",!,""by dashes (ie 2,4,6-9)"" H 2"
IF APP["?"
XECUTE SDMSG
GOTO WH
+2 SET SDCTRL=$SELECT(APP']"":0,1:1)
QUIT
DEL SET SDERR=0
FOR J=1:1
SET SDDH=$PIECE(APP,",",J)
IF SDDH']""
QUIT
DO MTCH^SDCNP1
+1 IF SDERR
GOTO WH1
DEL1 FOR J=1:1
SET SDDH=$PIECE(APP,",",J)
IF SDDH']""
QUIT
SET SDDI=$PIECE(SDDH,"-")
SET SDDM=$PIECE(SDDH,"-",2)
DO CKK^SDCNP1A
IF SDERR
QUIT
DO CKK1^SDCNP1A
IF SDERR
QUIT
IF 'SDDI
QUIT
FOR A1=SDDI:1:$SELECT(SDDM:SDDM,1:SDDI)
DO BEGD
+1 IF SDERR
GOTO WH1
GOTO NOPE^SDCNP1
BEGD SET (SD,S)=$PIECE(^UTILITY($JOB,"SDCNP",A1),"^",1)
SET I=$PIECE(^UTILITY($JOB,"SDCNP",A1),"^",2)
+1 SET SL=^SC(I,"SL")
SET X=$PIECE(SL,U,3)
SET STARTDAY=$SELECT($LENGTH(X):X,1:8)
SET SB=STARTDAY-1/100
SET X=$PIECE(SL,U,6)
SET HSI=$SELECT(X:X,1:4)
SET SI=$SELECT(X="":4,X<3:4,X:X,1:4)
SET STR="#@!$* XXWVUTSRQPONMLKJIHGFEDCBA0123456789jklmnopqrstuvwxyz"
SET SDDIF=$SELECT(HSI<3:8/HSI,1:2)
KILL Y
+2 IF $$CODT^SDCOU(DFN,+^UTILITY($JOB,"SDCNP",A1),+$PIECE(^(A1),U,2))
WRITE !,*7,">>> Appointment #",A1," has a check out date and cannot be cancelled."
QUIT
+3 DO PROT^SDCNP1A
IF SDPRT=1
QUIT
DO CAN
SET $PIECE(^UTILITY($JOB,"SDCNP",A1),"^",4)="*** JUST CANCELLED ***"
QUIT
CAN IF $PIECE(^UTILITY($JOB,"SDCNP",A1),"^",4)["JUST CANCELLED"
QUIT
SET CNT=CNT+1
SET DIV=$SELECT($PIECE(^SC(I,0),"^",15)]"":" "_$PIECE(^(0),"^",15),1:" 1")
IF $DATA(^DPT("ASDPSD","C",DIV,I,S,DFN))
KILL ^(DFN)
+1 NEW SDATA,SDCPHDL
SET SDCPHDL=$$HANDLE^SDAMEVT(1)
DO BEFORE^SDAMEVT(.SDATA,DFN,S,I,"",SDCPHDL)
+2 IF '$DATA(^DPT(DFN,"S",0))
SET ^(0)="^2.98P^^"
IF $DATA(SDREM)
SET DIE="^DPT("_DFN_",""S"","
SET (DA,Y)=S
SET DA(1)=DFN
SET DR="17///^S X="_"""""_SDREM_"""""
DO ^DIE
KILL DIE,DR
+3 SET ^DPT("ASDCN",I,DA,DA(1))=$SELECT(SDWH["P":1,1:"")
KILL DA
+4 SET $PIECE(^DPT(DFN,"S",S,0),"^",2)=SDWH
IF $DATA(DUZ)
SET $PIECE(^(0),"^",12)=DUZ
DO NOW^%DTC
SET SDT=+$EXTRACT(%,1,12)
SET $PIECE(^(0),"^",14)=SDT
SET $PIECE(^(0),"^",15)=SDSCR
SET (DA,Y)=0
FOR X=0:0
SET X=+$ORDER(^SC(I,"S",S,1,X))
IF '$DATA(^(X,0))
QUIT
DO C
IF Y&(DA)
QUIT
+5 IF $DATA(^DPT("ASDPSD","B",DIV,S\1,DFN))
DO CK1
+6 IF 'Y
QUIT
SET SL=$PIECE(^SC(I,"S",S,1,Y,0),U,2)
IF DA
IF '$DATA(^("OB"))
KILL ^SC(I,"S",S,1,DA,"OB")
+7 ;SD/478
SET SDDA=DA
SET SDTTM=S
SET SDRT="D"
SET SDPL=Y
SET SDSC=I
DO RT^SDUTL
DO CANCEL^SDCNSLT
SET Y=SDPL
SET S=SDTTM
SET I=SDSC
SET DA=SDDA
KILL SDDA
+8 ;SD/478
SET SDNODE=^SC(I,"S",S,1,Y,0)
SET ^SC("ARAD",I,S,DFN)="N"
SET TLNK=$PIECE($GET(^SC(I,"S",S,1,Y,"CONS")),U)
KILL ^SC(I,"S",S,1,Y)
IF $ORDER(^SC(I,"S",S,0))'>0
KILL ^SC(I,"S",S,0)
DO CLRK^SDCNP1
+9 ;SD/478
IF TLNK'=""
KILL ^SC("AWAS1",TLNK),TLNK
+10 ;S SDNODE=^SC(I,"S",S,1,Y,0),^SC("ARAD",I,S,DFN)="N" S DA(2)=I,DA(1)=S,DA=Y,DIK="^SC("_DA(2)_",""S"","_DA(1)_",1," D ^DIK K:$O(^SC(I,"S",S,0))'>0 ^SC(I,"S",S,0) D CLRK^SDCNP1 ;SD/478
+11 DO EVT
+12 IF '$DATA(^SC(I,"ST",SD\1,1))
QUIT
EN01 SET S=^SC(I,"ST",SD\1,1)
SET Y=SD#1-SB*100
SET ST=Y#1*SI\.6+(Y\1*SI)
SET SS=SL*HSI/60
+1 IF Y'<1
FOR I=ST+ST:SDDIF
SET Y=$EXTRACT(STR,$FIND(STR,$EXTRACT(S,I+1)))
IF Y=""
QUIT
SET S=$EXTRACT(S,1,I)_Y_$EXTRACT(S,I+2,999)
SET SS=SS-1
IF SS'>0
QUIT
+2 ;NAKED REFERENCE - ^SC(IFN,"ST",Date,1)
SET ^(1)=S
QUIT
C IF +^SC(I,"S",S,1,X,0)=DFN
SET Y=X
QUIT
+1 IF '$DATA(^("OB"))!DA
QUIT
IF ^("OB")?1"O".E
SET DA=X
QUIT
NO WRITE !,"NO ",$SELECT('SDPV:"PENDING",1:"PREVIOUS")," APPOINTMENTS",*7,*7,*7
+1 DO END^SDCNP
GOTO RD^SDCNP
+2 QUIT
CHKSO SET COV=$SELECT($PIECE(^DPT(DFN,"S",NDT,0),"^",11)=1:" (COLLATERAL) ",1:"")
FOR SDJ=3,4,5
IF $PIECE(^DPT(DFN,"S",NDT,0),"^",SDJ)]""
SET L=L+.1
SET ^UTILITY($JOB,"SDCNP",L)=$PIECE(^(0),"^",SDJ)_"^"_$SELECT(SDJ=3:"LAB",SDJ=4:"XRAY",1:"EKG")_"^0^0"
+1 QUIT
MORE SET SDCTR=SDCTR+2
IF AT
WRITE ?41,$PIECE(^UTILITY($JOB,"SDCNP",Z),"^",2)
GOTO OVR
+1 ;SD/478
WRITE " ",$SELECT($PIECE(^UTILITY($JOB,"SDCNP",Z),"^",4)?.N:"("_$PIECE(^(Z),"^",4)_" MIN) ",1:$PIECE(^(Z),"^",4))," ",$SELECT($DATA(^SC($PIECE(^(Z),"^",2),0)):$PIECE(^(0),"^",1),1:"DELETED CLINIC"),$PIECE(^UTILITY($JOB,"SDCNP",Z),"^",3)
+2 NEW CSND,CSDT,CSSD,CONSULT,Y
+3 SET CSND=^UTILITY($JOB,"SDCNP",Z)
SET CSDT=$PIECE(CSND,U)
SET CSSD=$PIECE(CSND,U,2)
SET HLDCSND=CSND
SET CONSULT=$$CONSULT(CSSD,CSDT)
IF +$GET(CONSULT)
SET Y=$PIECE(^GMR(123,CONSULT,0),U)
DO DD^%DT
WRITE !?5,"CONSULT ",Y,"/ ",CONSULT
+4 DO STATUS($X>55)
OVR ;Following code added SD/517
+1 IF '$DATA(CSND)
IF $GET(HLDCSND)
IF (($PIECE(HLDCSND,U,4)="")!($PIECE(HLDCSND,U,6)=""))
Begin DoDot:1
+2 WRITE !!,"**********************************************************************"
+3 WRITE !,"* WARNING: There is a data inconsistency or data corruption problem *"
+4 WRITE !,"* with the above appointment. Corrective action needs to be taken. *"
+5 WRITE !,"* Please cancel the appointment above. If it is a valid appointment,*"
+6 WRITE !,"* it will have to be re-entered via Appointment Management. *"
+7 WRITE !,"**********************************************************************"
+8 SET SDCTR=21
+9 KILL HLDCSND
End DoDot:1
+10 ;
+11 IF SDCTR>20
IF $ORDER(^UTILITY($JOB,"SDCNP",Z))
SET (SDCTRL,SDCTR)=0
WRITE *7
DO WH
IF 'SDCTRL
WRITE @IOF
+12 QUIT
+13 ;
CONSULT(CSSD,CSDT) ;
+1 NEW CSI
SET CONSULT=""
+2 ;SD/478
SET CSI=0
FOR
SET CSI=$ORDER(^SC(CSSD,"S",CSDT,1,CSI))
IF '+CSI
QUIT
IF $PIECE($GET(^SC(CSSD,"S",CSDT,1,CSI,0)),U)=DFN
SET CONSULT=$PIECE($GET(^SC(CSSD,"S",CSDT,1,CSI,"CONS")),U)
QUIT
+3 QUIT CONSULT
CK1 SET SDX=0
FOR SD1=S\1:0
SET SD1=$ORDER(^DPT(DFN,"S",SD1))
IF 'SD1!((SD1\1)'=(S\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,S\1,DFN))
SET SDX=1
QUIT
+2 IF SDX
QUIT
IF $DATA(^SCE(+$$EXAE^SDOE(DFN,S\1,S\1),0))
SET SDX=1
+3 IF SDX
QUIT
KILL ^DPT("ASDPSD","B",DIV,S\1,DFN)
QUIT
+4 ;
STATUS(LF) ;
+1 IF LF
WRITE !
+2 WRITE ?55,"(",$EXTRACT($$LOWER^VALM1($PIECE($$STATUS^SDAM1(DFN,+^UTILITY($JOB,"SDCNP",Z),+$PIECE(^(Z),U,2),$GET(^DPT(DFN,"S",+^(Z),0))),";",3)),1,23),")"
+3 IF 'LF
WRITE !
+4 QUIT
+5 ;
EVT ; -- separate tag if need to NEW vars
+1 NEW I,STR,SS,SL,SD,SB,SI,HSI,J,APP,S,A1,STARTDAY,CNT,DIV,SDERR,SDDIF
+2 DO CANCEL^SDAMEVT(.SDATA,DFN,SDTTM,SDSC,SDPL,0,SDCPHDL)
+3 QUIT
