SDN ;SF/GFT,ALB/LDB - RECORD NO SHOWS ;JUL 19, 2016
;;5.3;Scheduling;**32,79,398,478,627,651,682**;Aug 13, 1993;Build 10
;
N SDATA ; for evt driver
S U="^" D NOW^%DTC S SDTIME=%,SDLT1="" K ^UTILITY($J),SDCP,SDLT D LO^DGUTL
S SDDT=DT,SDV1=$O(^DG(40.8,0)) D DIV^SDUTL I $T S DIC=40.8,DIC(0)="AEQM" S SDLT=1 D NSLET1^SDDIV K SDLT G:Y<0 END^SDN0 S SDV1=DIV
7 R !!,"NO-SHOWS FOR WHAT DATE: ",X:DTIME Q:U[X S %DT="EP",%DT(0)=-DT D ^%DT G 7:Y<0 S SDT=Y,SDYES=""
S SM="S SDCT=0 F I=SD1:0:SD2 S I=$N(^DPT(+Y,""S"",I)) S:I<0!(I'<SD2) I=9999999 I I\1=SDT,$D(^(I,0)),+^(0)=SC,$P(^(0),U,2)'[""C"",'$$CODT^SDCOU(+Y,I,SC) Q"
S SM1="S SDCT=0 F I=SD1:0 S I=$N(^DPT(+Y,""S"",I)) Q:I<0!(I'<SD2) I I\1=SDT,$D(^(I,0)),+^(0)=SC,$P(^(0),""^"",2)'[""C"",'$$CODT^SDCOU(+Y,I,SC) S SDCT=SDCT+1,SDT(SDCT)=I"
71 W ! K DIC S SC=0,DIC="^SC(",DIC(0)="AEMQ",DIC("A")="Select CLINIC NAME: ",DIC("S")="I $P(^(0),""^"",3)=""C"",'$G(^(""OOS"")),$S($P(^(0),""^"",15)=SDV1:1,'$P(^(0),""^"",15):1,'SDV1:1,1:0)"
D ^DIC K DIC("A"),DIC("S") G 73:Y<0 S SC=+Y,SD1=SDT,SD2=SDT+1 S SDMSG=" DOES NOT HAVE A NO-SHOW LETTER ASSIGNED TO IT!"
72 Q:$D(SDNSACT) S SD1=SDT,DIC="^DPT(",DIC(0)="AEMQ",DIC("S")=SM
K SDT S SDT=SD1
D ^DIC K DIC("S") G 71:"^"[X,72:Y<0 S DFN=+Y X SM1 D SDMLT Q:'SDCT S I=SDT(SDCT)
EN1 ; -- entry pt for protocol action
S SDSTAT=$P(^DPT(+DFN,"S",I,0),U,2) I SDSTAT="I" D NS^SDN2 G 72
I SDSTAT=""!(SDSTAT="NT") D G 72
.N SDNSHDL,SDDA S SDNSHDL=$$HANDLE^SDAMEVT(1),SDDA=$$FIND^SDAM2(DFN,I,SC)
.S SDDTM=I D BEFORE^SDAMEVT(.SDATA,DFN,SDDTM,SC,SDDA,SDNSHDL)
.S $P(^DPT(+DFN,"S",I,0),U,2)="N",$P(^(0),"^",14)=SDTIME S:$D(DUZ) $P(^(0),"^",12)=DUZ
.;update SDEC APPOINTMENT ;alb/sat SD/627
.N SDECAPPT S SDECAPPT=$$APPTGET^SDECUTL(DFN,SDDTM,SC)
.D SDECNOS^SDEC31(SDECAPPT,1,DUZ,SDTIME)
.;end addition/modification ;alb/sat SD/627
.S:'SDYES SDYES=1
.S:'$D(^UTILITY($J,"CL",DFN,SC,I))&(SDSTAT'="C") ^(I)=""
.W "...OK New Status: ",$P($$STATUS^SDAM1(DFN,I,SC,^DPT(DFN,"S",I,0),SDDA),";",3)
.D EVT K SDATA
W:$P(^DPT(+DFN,"S",I,0),U,2)["A" *7,!,"THIS APPOINTMENT ALREADY A NO-SHOW AND REBOOKED... ARE YOU SURE YOU"
ALNS S %=2 W:$P(^DPT(+DFN,"S",I,0),U,2)'["A" !,*7," ALREADY RECORDED AS NO-SHOW..." W " WANT TO ERASE" D YN^DICN I '% W !,"RESPOND YES OR NO" G ALNS
I (%-1) G 72
I '(%-1) W "...NO LONGER A NO-SHOW!" D
.N SDNSHDL,SDDA S SDNSHDL=$$HANDLE^SDAMEVT(1),SDDA=$$FIND^SDAM2(DFN,I,SC)
.S SDDTM=I D BEFORE^SDAMEVT(.SDATA,DFN,SDDTM,SC,SDDA,SDNSHDL)
.S SDINP=$$INP^SDAM2(DFN,SDDTM),X=I,Y=DFN
.S $P(^DPT(+Y,"S",SDDTM,0),U,2)=$S(SDINP["I":SDINP,1:""),$P(^(0),"^",14)="",$P(^(0),"^",12)=""
.;update SDEC APPOINTMENT ;alb/sat 651
.N SDECAPPT S SDECAPPT=$$APPTGET^SDECUTL(DFN,SDDTM,SC)
.D SDECNOS^SDEC31(SDECAPPT,0)
.;end addition/modification ;alb/sat 651
.I SDINP="",$$CHK^SDM1A(SC,SDDTM),+$$STATUS^SDAM1(DFN,SDDTM,SC,^DPT(DFN,"S",SDDTM,0),SDDA)'=1 S $P(^DPT(DFN,"S",SDDTM,0),U,2)="NT" ; not inpt and not ci
.D EVT K SDATA
.K SDINP,^UTILITY($J,"CL",+Y,SC,SDDTM),SDDTM
G 72
73 ;
G:SDYES ASKA G END^SDN0
CK1 S SD1=I X SM I I<SD2,$P(^DPT(+Y,"S",I,0),U,2)["C" S POP=1
S:I'<SD2 POP=1 Q:'POP I I'<SD2 S POP=1 Q
G CK1
ASKA G ASKL ;REMOVE AUTO-REBOOK SD*5.3*682
;S %=2,DTOUT=0 W !,"WANT TO AUTO-REBOOK NO-SHOW APPOINTMENTS NOW" D YN^DICN I '% W !,"RESPOND YES (Y) OR NO (N)" G ASKA
;W:DTOUT " NO" S ANS=$S(%=1:"Y",1:"N"),(SDED,DATEND)=SDT+.9
;I $D(SDNSACT),'SDNSACT,%=1 S SDNSACT=1 ;No-show action flag
ASKL S ANS="N",(SDED,DATEND)=SDT+.9
S %=1,DTOUT=0,SDLET="" W !,"WANT LETTERS PRINTED NOW" D YN^DICN I '% W !,"RESPOND YES (Y) OR NO (N)" G ASKL
W:DTOUT " NO" S ALS=$S(%=1:"Y",1:"N")
I $D(SDNSACT),(ALS="Y"),$$BADADR^DGUTL3(+DFN) D ;display, don't print BAI list
. W *7,!,"** THIS PATIENT HAS BEEN FLAGGED WITH A BAD ADDRESS INDICATOR, NO LETTER"
. W !,"WILL BE PRINTED."
. S ALS="N"
. S DIR(0)="E" D ^DIR K DIR(0)
I ALS'["Y"&(ANS'["Y") D DIS^SDNDIS G END^SDN0
RD1 I $D(SDNSACT) S Y=SC G RD2
R !!,"FOR CLINIC: ALL// ",X:DTIME K C,DIC Q:X="^" S X=$$UP^XLFSTR(X) G AOR:X="ALL"!(X="") I X?.E1"?" W !,?3,"ENTER A CLINIC NAME, OR 'ALL' FOR ALL CLINICS" G RD1
S DIC(0)="QEM",DIC=44,DIC("S")="I $P(^(0),""^"",3)=""C""" D ^DIC K DIC("S") G:Y<0 RD1
RD2 S C=+Y I '$D(^SC(C,"LTR")) W !,$P(^SC(C,0),"^")_SDMSG S ALS="N"
I $D(^SC(C,"LTR")),'+^("LTR") W !,$P(^SC(C,0),"^")_SDMSG S ALS="N"
I $D(^SC(C,"LTR")),+^("LTR") S SDLET=+^("LTR")
AOR S:'$D(C) C="ALL" I ANS'["Y"&(ALS'["Y") D DIS^SDNDIS G END^SDN0
D DIS^SDNDIS
;S DGPGM="START^SDN0",DGVAR="SC^SDDT^ALS^ANS^SDLET^SDV1^SDT^C^DATEND^SDTIME^SDLT1"
;S POP=0 D ZIS^DGUTQ G:POP END^SDN0
S %ZIS="MQ" K IO("Q") D ^%ZIS G:POP END^SDN0
I $D(IO("Q")) D D:IO'=IO(0) NSLTR W @IOF G END^SDN0
.S ZTRTN="START^SDN0" F ZTS="SC","SDDT","ALS","ANS","SDLET","SDV1","SDT","C","DATEND","SDTIME","SDLT1","AUTO(" S ZTSAVE(ZTS)=""
.K ZTS D ^%ZTLOAD
D:IO'=IO(0) NSLTR D START^SDN0,^%ZISC W @IOF G END^SDN0
;G START^SDN0 ;???
Q
NSLTR I ANS["Y",ALS["Y" S:$D(NSDIE) @(NSDIE_NSDA_",1,2,0)")="NO-SHOW AUTO-REBOOK letter printed." K NSDIE,NSDA ;SD/478 AT THIS POINT NO SHOW AUTO REBOOK LETTER IS PRINTED.
I ALS["Y" S:$D(NSDIE) @(NSDIE_NSDA_",1,2,0)")="NO-SHOW letter printed." K NSDIE,NSDA ;SD/478 AT THIS POINT NO SHOW LETTER IS PRINTED.
Q
SDMLT ;
N SDCNT,SDSTAT
S SDCNT=SDCT,SDCT=0
F S SDCT=$O(SDT(SDCT)) Q:'SDCT D
.S SDSTAT=$$STATUS^SDAM1(DFN,SDT(SDCT),SC,^DPT(DFN,"S",SDT(SDCT),0))
.W !,SDCT,"). ",$$FTIME^VALM1(SDT(SDCT))," Status: ",$P(SDSTAT,";",3) W:$P(SDSTAT,";",4) *7
S SDCT=SDCNT
ASK I SDCT>1!($P(SDSTAT,";",4)) R !!,"SELECT APPOINTMENT: ",SDCT:DTIME Q:'$T!(U[SDCT) I SDCT["?"!('$D(SDT(SDCT))) W !,"Please enter one number to indicate which appointment." S SDCT=SDCNT G ASK
W ! Q
;
EVT ; -- separate tag if need to NEW vars
N I,SDINP,Y,SDSTAT,SDTIME,SDYES,SM,SM1,SD1,SD2,SDMSG,SDT,SDCT,CNSTLNK,CN,CNPAT
D NOSHOW^SDAMEVT(.SDATA,DFN,SDDTM,SC,SDDA,0,SDNSHDL)
S CNSTLNK="",CN=0 F S CN=$O(^SC(SC,"S",SDDTM,1,CN)) Q:'+CN S CNPAT=$P($G(^SC(SC,"S",SDDTM,1,CN,0)),U) I CNPAT=DFN S CNSTLNK=$P($G(^SC(SC,"S",SDDTM,1,CN,"CONS")),U) Q ;SD/478
D:+CNSTLNK NOSHOW^SDCNSLT(SC,SDDTM,CNPAT,CNSTLNK,CN,.AUTO,.NSDIE,.NSDA) ;SD/478
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDN 6195 printed Oct 16, 2024@18:59:11 Page 2
SDN ;SF/GFT,ALB/LDB - RECORD NO SHOWS ;JUL 19, 2016
+1 ;;5.3;Scheduling;**32,79,398,478,627,651,682**;Aug 13, 1993;Build 10
+2 ;
+3 ; for evt driver
NEW SDATA
+4 SET U="^"
DO NOW^%DTC
SET SDTIME=%
SET SDLT1=""
KILL ^UTILITY($JOB),SDCP,SDLT
DO LO^DGUTL
+5 SET SDDT=DT
SET SDV1=$ORDER(^DG(40.8,0))
DO DIV^SDUTL
IF $TEST
SET DIC=40.8
SET DIC(0)="AEQM"
SET SDLT=1
DO NSLET1^SDDIV
KILL SDLT
if Y<0
GOTO END^SDN0
SET SDV1=DIV
7 READ !!,"NO-SHOWS FOR WHAT DATE: ",X:DTIME
if U[X
QUIT
SET %DT="EP"
SET %DT(0)=-DT
DO ^%DT
if Y<0
GOTO 7
SET SDT=Y
SET SDYES=""
+1 SET SM="S SDCT=0 F I=SD1:0:SD2 S I=$N(^DPT(+Y,""S"",I)) S:I<0!(I'<SD2) I=9999999 I I\1=SDT,$D(^(I,0)),+^(0)=SC,$P(^(0),U,2)'[""C"",'$$CODT^SDCOU(+Y,I,SC) Q"
+2 SET SM1="S SDCT=0 F I=SD1:0 S I=$N(^DPT(+Y,""S"",I)) Q:I<0!(I'<SD2) I I\1=SDT,$D(^(I,0)),+^(0)=SC,$P(^(0),""^"",2)'[""C"",'$$CODT^SDCOU(+Y,I,SC) S SDCT=SDCT+1,SDT(SDCT)=I"
71 WRITE !
KILL DIC
SET SC=0
SET DIC="^SC("
SET DIC(0)="AEMQ"
SET DIC("A")="Select CLINIC NAME: "
SET DIC("S")="I $P(^(0),""^"",3)=""C"",'$G(^(""OOS"")),$S($P(^(0),""^"",15)=SDV1:1,'$P(^(0),""^"",15):1,'SDV1:1,1:0)"
+1 DO ^DIC
KILL DIC("A"),DIC("S")
if Y<0
GOTO 73
SET SC=+Y
SET SD1=SDT
SET SD2=SDT+1
SET SDMSG=" DOES NOT HAVE A NO-SHOW LETTER ASSIGNED TO IT!"
72 if $DATA(SDNSACT)
QUIT
SET SD1=SDT
SET DIC="^DPT("
SET DIC(0)="AEMQ"
SET DIC("S")=SM
+1 KILL SDT
SET SDT=SD1
+2 DO ^DIC
KILL DIC("S")
if "^"[X
GOTO 71
if Y<0
GOTO 72
SET DFN=+Y
XECUTE SM1
DO SDMLT
if 'SDCT
QUIT
SET I=SDT(SDCT)
EN1 ; -- entry pt for protocol action
+1 SET SDSTAT=$PIECE(^DPT(+DFN,"S",I,0),U,2)
IF SDSTAT="I"
DO NS^SDN2
GOTO 72
+2 IF SDSTAT=""!(SDSTAT="NT")
Begin DoDot:1
+3 NEW SDNSHDL,SDDA
SET SDNSHDL=$$HANDLE^SDAMEVT(1)
SET SDDA=$$FIND^SDAM2(DFN,I,SC)
+4 SET SDDTM=I
DO BEFORE^SDAMEVT(.SDATA,DFN,SDDTM,SC,SDDA,SDNSHDL)
+5 SET $PIECE(^DPT(+DFN,"S",I,0),U,2)="N"
SET $PIECE(^(0),"^",14)=SDTIME
if $DATA(DUZ)
SET $PIECE(^(0),"^",12)=DUZ
+6 ;update SDEC APPOINTMENT ;alb/sat SD/627
+7 NEW SDECAPPT
SET SDECAPPT=$$APPTGET^SDECUTL(DFN,SDDTM,SC)
+8 DO SDECNOS^SDEC31(SDECAPPT,1,DUZ,SDTIME)
+9 ;end addition/modification ;alb/sat SD/627
+10 if 'SDYES
SET SDYES=1
+11 if '$DATA(^UTILITY($JOB,"CL",DFN,SC,I))&(SDSTAT'="C")
SET ^(I)=""
+12 WRITE "...OK New Status: ",$PIECE($$STATUS^SDAM1(DFN,I,SC,^DPT(DFN,"S",I,0),SDDA),";",3)
+13 DO EVT
KILL SDATA
End DoDot:1
GOTO 72
+14 if $PIECE(^DPT(+DFN,"S",I,0),U,2)["A"
WRITE *7,!,"THIS APPOINTMENT ALREADY A NO-SHOW AND REBOOKED... ARE YOU SURE YOU"
ALNS SET %=2
if $PIECE(^DPT(+DFN,"S",I,0),U,2)'["A"
WRITE !,*7," ALREADY RECORDED AS NO-SHOW..."
WRITE " WANT TO ERASE"
DO YN^DICN
IF '%
WRITE !,"RESPOND YES OR NO"
GOTO ALNS
+1 IF (%-1)
GOTO 72
+2 IF '(%-1)
WRITE "...NO LONGER A NO-SHOW!"
Begin DoDot:1
+3 NEW SDNSHDL,SDDA
SET SDNSHDL=$$HANDLE^SDAMEVT(1)
SET SDDA=$$FIND^SDAM2(DFN,I,SC)
+4 SET SDDTM=I
DO BEFORE^SDAMEVT(.SDATA,DFN,SDDTM,SC,SDDA,SDNSHDL)
+5 SET SDINP=$$INP^SDAM2(DFN,SDDTM)
SET X=I
SET Y=DFN
+6 SET $PIECE(^DPT(+Y,"S",SDDTM,0),U,2)=$SELECT(SDINP["I":SDINP,1:"")
SET $PIECE(^(0),"^",14)=""
SET $PIECE(^(0),"^",12)=""
+7 ;update SDEC APPOINTMENT ;alb/sat 651
+8 NEW SDECAPPT
SET SDECAPPT=$$APPTGET^SDECUTL(DFN,SDDTM,SC)
+9 DO SDECNOS^SDEC31(SDECAPPT,0)
+10 ;end addition/modification ;alb/sat 651
+11 ; not inpt and not ci
IF SDINP=""
IF $$CHK^SDM1A(SC,SDDTM)
IF +$$STATUS^SDAM1(DFN,SDDTM,SC,^DPT(DFN,"S",SDDTM,0),SDDA)'=1
SET $PIECE(^DPT(DFN,"S",SDDTM,0),U,2)="NT"
+12 DO EVT
KILL SDATA
+13 KILL SDINP,^UTILITY($JOB,"CL",+Y,SC,SDDTM),SDDTM
End DoDot:1
+14 GOTO 72
73 ;
+1 if SDYES
GOTO ASKA
GOTO END^SDN0
CK1 SET SD1=I
XECUTE SM
IF I<SD2
IF $PIECE(^DPT(+Y,"S",I,0),U,2)["C"
SET POP=1
+1 if I'<SD2
SET POP=1
if 'POP
QUIT
IF I'<SD2
SET POP=1
QUIT
+2 GOTO CK1
ASKA ;REMOVE AUTO-REBOOK SD*5.3*682
GOTO ASKL
+1 ;S %=2,DTOUT=0 W !,"WANT TO AUTO-REBOOK NO-SHOW APPOINTMENTS NOW" D YN^DICN I '% W !,"RESPOND YES (Y) OR NO (N)" G ASKA
+2 ;W:DTOUT " NO" S ANS=$S(%=1:"Y",1:"N"),(SDED,DATEND)=SDT+.9
+3 ;I $D(SDNSACT),'SDNSACT,%=1 S SDNSACT=1 ;No-show action flag
ASKL SET ANS="N"
SET (SDED,DATEND)=SDT+.9
+1 SET %=1
SET DTOUT=0
SET SDLET=""
WRITE !,"WANT LETTERS PRINTED NOW"
DO YN^DICN
IF '%
WRITE !,"RESPOND YES (Y) OR NO (N)"
GOTO ASKL
+2 if DTOUT
WRITE " NO"
SET ALS=$SELECT(%=1:"Y",1:"N")
+3 ;display, don't print BAI list
IF $DATA(SDNSACT)
IF (ALS="Y")
IF $$BADADR^DGUTL3(+DFN)
Begin DoDot:1
+4 WRITE *7,!,"** THIS PATIENT HAS BEEN FLAGGED WITH A BAD ADDRESS INDICATOR, NO LETTER"
+5 WRITE !,"WILL BE PRINTED."
+6 SET ALS="N"
+7 SET DIR(0)="E"
DO ^DIR
KILL DIR(0)
End DoDot:1
+8 IF ALS'["Y"&(ANS'["Y")
DO DIS^SDNDIS
GOTO END^SDN0
RD1 IF $DATA(SDNSACT)
SET Y=SC
GOTO RD2
+1 READ !!,"FOR CLINIC: ALL// ",X:DTIME
KILL C,DIC
if X="^"
QUIT
SET X=$$UP^XLFSTR(X)
if X="ALL"!(X="")
GOTO AOR
IF X?.E1"?"
WRITE !,?3,"ENTER A CLINIC NAME, OR 'ALL' FOR ALL CLINICS"
GOTO RD1
+2 SET DIC(0)="QEM"
SET DIC=44
SET DIC("S")="I $P(^(0),""^"",3)=""C"""
DO ^DIC
KILL DIC("S")
if Y<0
GOTO RD1
RD2 SET C=+Y
IF '$DATA(^SC(C,"LTR"))
WRITE !,$PIECE(^SC(C,0),"^")_SDMSG
SET ALS="N"
+1 IF $DATA(^SC(C,"LTR"))
IF '+^("LTR")
WRITE !,$PIECE(^SC(C,0),"^")_SDMSG
SET ALS="N"
+2 IF $DATA(^SC(C,"LTR"))
IF +^("LTR")
SET SDLET=+^("LTR")
AOR if '$DATA(C)
SET C="ALL"
IF ANS'["Y"&(ALS'["Y")
DO DIS^SDNDIS
GOTO END^SDN0
+1 DO DIS^SDNDIS
+2 ;S DGPGM="START^SDN0",DGVAR="SC^SDDT^ALS^ANS^SDLET^SDV1^SDT^C^DATEND^SDTIME^SDLT1"
+3 ;S POP=0 D ZIS^DGUTQ G:POP END^SDN0
+4 SET %ZIS="MQ"
KILL IO("Q")
DO ^%ZIS
if POP
GOTO END^SDN0
+5 IF $DATA(IO("Q"))
Begin DoDot:1
+6 SET ZTRTN="START^SDN0"
FOR ZTS="SC","SDDT","ALS","ANS","SDLET","SDV1","SDT","C","DATEND","SDTIME","SDLT1","AUTO("
SET ZTSAVE(ZTS)=""
+7 KILL ZTS
DO ^%ZTLOAD
End DoDot:1
if IO'=IO(0)
DO NSLTR
WRITE @IOF
GOTO END^SDN0
+8 if IO'=IO(0)
DO NSLTR
DO START^SDN0
DO ^%ZISC
WRITE @IOF
GOTO END^SDN0
+9 ;G START^SDN0 ;???
+10 QUIT
NSLTR ;SD/478 AT THIS POINT NO SHOW AUTO REBOOK LETTER IS PRINTED.
IF ANS["Y"
IF ALS["Y"
if $DATA(NSDIE)
SET @(NSDIE_NSDA_",1,2,0)")="NO-SHOW AUTO-REBOOK letter printed."
KILL NSDIE,NSDA
+1 ;SD/478 AT THIS POINT NO SHOW LETTER IS PRINTED.
IF ALS["Y"
if $DATA(NSDIE)
SET @(NSDIE_NSDA_",1,2,0)")="NO-SHOW letter printed."
KILL NSDIE,NSDA
+2 QUIT
SDMLT ;
+1 NEW SDCNT,SDSTAT
+2 SET SDCNT=SDCT
SET SDCT=0
+3 FOR
SET SDCT=$ORDER(SDT(SDCT))
if 'SDCT
QUIT
Begin DoDot:1
+4 SET SDSTAT=$$STATUS^SDAM1(DFN,SDT(SDCT),SC,^DPT(DFN,"S",SDT(SDCT),0))
+5 WRITE !,SDCT,"). ",$$FTIME^VALM1(SDT(SDCT))," Status: ",$PIECE(SDSTAT,";",3)
if $PIECE(SDSTAT,";",4)
WRITE *7
End DoDot:1
+6 SET SDCT=SDCNT
ASK IF SDCT>1!($PIECE(SDSTAT,";",4))
READ !!,"SELECT APPOINTMENT: ",SDCT:DTIME
if '$TEST!(U[SDCT)
QUIT
IF SDCT["?"!('$DATA(SDT(SDCT)))
WRITE !,"Please enter one number to indicate which appointment."
SET SDCT=SDCNT
GOTO ASK
+1 WRITE !
QUIT
+2 ;
EVT ; -- separate tag if need to NEW vars
+1 NEW I,SDINP,Y,SDSTAT,SDTIME,SDYES,SM,SM1,SD1,SD2,SDMSG,SDT,SDCT,CNSTLNK,CN,CNPAT
+2 DO NOSHOW^SDAMEVT(.SDATA,DFN,SDDTM,SC,SDDA,0,SDNSHDL)
+3 ;SD/478
SET CNSTLNK=""
SET CN=0
FOR
SET CN=$ORDER(^SC(SC,"S",SDDTM,1,CN))
if '+CN
QUIT
SET CNPAT=$PIECE($GET(^SC(SC,"S",SDDTM,1,CN,0)),U)
IF CNPAT=DFN
SET CNSTLNK=$PIECE($GET(^SC(SC,"S",SDDTM,1,CN,"CONS")),U)
QUIT
+4 ;SD/478
if +CNSTLNK
DO NOSHOW^SDCNSLT(SC,SDDTM,CNPAT,CNSTLNK,CN,.AUTO,.NSDIE,.NSDA)
+5 QUIT
+6 ;
