SDC0 ;MAN/GRR,ALB/TMP/LDB - Continuation of SDC (cancel a clinic) ; 16 JUL 2003  1:27 pm
 ;;5.3;Scheduling;**303,330,379,398,467,478,545,682**;Aug 13, 1993;Build 10
 ;
 ;SD/467 - open matched EWL entries with canceled appointments
 ;
CHKEND G:NOAP END
 W !,"AUTO-REBOOK IS NO LONGER ALLOWED!" G ASKL ;Patch SD*5.3*682
 S %=1,DTOUT=0 W !,"WANT TO AUTO-REBOOK APPOINTMENTS NOW" D YN^DICN I '% W !,"REPLY YES (Y) OR NO (N)" G CHKEND
 S ANS=$S('(%-1):"Y",1:"N") I %<0 W " NO" Q:'DTOUT
ASKL S ANS="N",SDLT1="",%=1,(SDLET,SDFORM)="" W !,"WANT LETTERS PRINTED NOW" D YN^DICN I '% W !,"REPLY YES (Y) OR NO (N)" G ASKL
 W:%<0 " NO" S ALS=$S('(%-1):"Y",1:"N") G:ALS'["Y" AOR
EN Q:($P(^SC(SC,0),"^",3)'="C")!($D(SDVAUTC(+SC)))  S SDIV=$P(^SC(SC,0),"^",15),SDIV=$S(SDIV:SDIV,1:$O(^DG(40.8,0))) I $D(SDLT),SDIV'=SDV1 Q
 K SDRE,SDIN I $D(SDLT)&($D(^SC(SC,"I"))) S SDIN=+^("I"),SDRE=+$P(^("I"),"^",2) I $D(SDIN),SDIN,SDIN'>SDBD&('$D(SDRE)!('SDRE)!(SDRE>SDED)) Q
 S:'SDLT1 SDLET=$S($D(^SC(SC,"LTR")):$P(^("LTR"),"^",3),1:"") S ALS=$S(SDLET:"Y",1:"N")
 I ALS="N"!(ANS="Y") S SDFFFF=1
 I ALS="N" W !,"NO LETTERS ARE ASSIGNED TO THE ",$P(^SC(SC,0),"^")," CLINIC" Q:$D(SDLT)
 I SDFORM="",$D(^DG(40.8,SDIV,"LTR")),^("LTR") S SDFORM=^("LTR")
 I $D(SDLT),(ALS'="N") D CHK Q
 Q:$D(SDLT)
AOR G:ANS'["Y"&(ALS'["Y") END
 I '$D(SDLT) S DGPGM="START^SDC0",DGVAR="SC^SI^CDATE^ALS^ANS^SDLET^SDTIME"_$S($D(SDIN):"^SDIN^SDRE",1:"")_"^SDFORM^SDV1^SDFFFF^AUTO#"
 I '$D(SDLT) D FZIS^DGUTQ G:POP END
START U IO I ANS'["Y"&('$D(SDLT)) D:ALS["Y" APP D END Q
BEG1 N SDFIRST
 I $D(SDLT) S SDAR=$S('VAUTC:"VAUTC",1:"^SC"),ANS="N",ALS="Y" D
 .F SC=0:0 S SC=$O(@(SDAR_"("_SC_")")) Q:SC'>0  D
 ..K SDOK1 D EN I $D(SDOK1),SDLET D
 ...F SD=(SDBD-.1):0 S SD=$O(^SC(SC,"S",SD)) S CDATE=SD Q:SD>(SDED+.999999)!(SD'>0)  D
 ....D DUP
 S SDFIRST=$S($G(SDFFFF)=1:0,1:1)
 I $D(SDLT),$D(^UTILITY("SDLT",$J)) D PR^SDC3,END Q
 Q:$D(SDLT)  D ^SDAUT1
 I MAX=0 W !,"AUTO-REBOOKING NOT ALLOWED FOR THIS CLINIC" G APP:ALS["Y",END
 F GDATE=CDATE:0 S GDATE=$O(^SC(SC,"S",GDATE)) Q:GDATE=""!(GDATE>(CDATE+1))  D
 .F L=0:0 S L=$O(^SC(SC,"S",GDATE,1,L)) Q:L=""  D  Q:POP  S A=^SC(SC,"S",GDATE,1,L,0) I $D(^DPT(+A,"S",GDATE,0)),$P(^(0),"^",2)="C",$P(^(0),"^",14)=SDTIME D ^SDAUT2,^SDCCP
 ..S POP=0
 ..I '$D(^SC(SC,"S",GDATE,1,L,0)) I $D(^("C")) S J=GDATE,J2=L D DELETE^SDC1 K J,J2 S POP=1 Q  ;SD*545 delete corrupt record
 ..I '+$G(^SC(SC,"S",GDATE,1,L,0)) S J=GDATE,J2=L D DELETE^SDC1 K J,J2 S POP=1 Q  ;SD*545 delete corrupt record
 K POP
 D:ALS["Y" APP
END ;
 D:$G(SC)>0&($G(CDATE)>0) RESOLVE
 K %,%DT,%H,%I,%DT,%IS,%ZIS,A,ALS,ANS,BY,CDATE,CHAR,DA,DFN,DH,DHD,DIC,DIS,DO,DOW,FLDS,FR,GDATE,I,L,LET,MAX,NOAP,P,POP,SI,SL,SS,ST,SDSTRTDT,TO,X,Y,ADDR,B,CLIN,HX,L0,L1,L2,LL,PDAT,S,TIME,Z,D,ENDATE,J,SM,STIME,X1,X2,SDX1,SDX2,SDRE,SDRE1,SDIN,FSW
 K ^TMP("SDC0",$J),SDAP,SDAPNUM
 K SC,SD,Z0,Z5,DGPGM,DUPE,J2,MESS,NDATE,SDDIF,SDFORM,SDINP,SDFORM,SDLET,SDLT1,SDNODE,SDRT,SDSOH,SDST,SDV1,DGVAR,SD1,SD8,SD81,SDANS,SDCNT,SDERR,SDHTO,SDJ,SDTIME,SDZ,STARTDAY,SD82,SDOK,SDOK1,SDLE,SDZ,SDOK1,TST,W,^UTILITY("SD")
 K SDFFFF,DIW,DIWF,DIWL,DIWR,DIWT,DN,DUPE,J2,MESS,NDATE,SDADD,SDC,SDCL,SDDAT,SDDIF,SDFORM,SDHX,SDINP,SDIV,SDLET,SDNODE,SDRT,SDSOH,SDST,SDT0,TST,SDV1,^TMP($J,"BADADD") D CLOSE^DGUTQ Q
CHK K SDOK1 I $D(^SC(SC,"SL")) S SL=^("SL"),%=$P(SL,"^",6),SI=$S(%="":4,%<3:4,%:%,1:4) S SDOK1=1 K SL,% E  W $P(^SC(SC,0),"^")," does not have an appointment length indicated."
 Q
RESOLVE ;evaluate canceled and rebooked appointments with relation to EWL
 S GDATE=CDATE K ^TMP("SDWLREB",$J),^TMP($J,"SDWLPL")
 F  S GDATE=$O(^SC(SC,"S",GDATE)) Q:GDATE=""!(GDATE>(CDATE+1))  S L=0 F  S L=$O(^SC(SC,"S",GDATE,1,L)) Q:L=""  D
 .I '$D(^SC(SC,"S",GDATE,1,L,0)) I $D(^("C")) S J=GDATE,J2=L D DELETE^SDC1 K J,J2 Q  ;SD*5.3*545 delete corrupt record
 .I '+$G(^SC(SC,"S",GDATE,1,L,0)) S J=GDATE,J2=L D DELETE^SDC1 K J,J2 Q  ;SD*5.3*545 delete corrupt record with missing DFN
 .S DFN=+^SC(SC,"S",GDATE,1,L,0)
 .N RBFLG,SDTRB,SDCAN,SDREB S SDREB=0 D REBOOK^SDWLREB(DFN,GDATE,SC,.RBFLG,.SDTRB,.SDCAN) Q:SDCAN'=SDTIME
 .I $E(RBFLG,1,2)'="CC" Q  ;not canceled by clinic
 .I RBFLG="CCR" S SDREB=1 D DISREB^SDWLREB(DFN,SDTRB,SC)
 .D OPENEWL^SDWLREB(DFN,GDATE,SC,SDREB) K ^TMP($J,"APPT"),^TMP($J,"SDWLPL")
 I $D(^TMP("SDWLREB",$J)) D MESS^SDWLREB
 Q
 ;
DUP ;SCREEN FOR DUPLICATE PATIENTS - SD*5.3*379
 S SDAP="" F  S SDAP=$O(^SC(SC,"S",SD,SDAP)) Q:SDAP=""  D
 .S SDAPNUM="" F  S SDAPNUM=$O(^SC(SC,"S",SD,SDAP,SDAPNUM)) Q:SDAPNUM=""  D
 ..I '$D(^SC(SC,"S",SD,SDAP,SDAPNUM,0)) I $D(^("C")) S J=SD,J2=SDAPNUM D DELETE^SDC1 Q  ;SD*545 delete corrupt record
 ..I '+$G(^SC(SC,"S",SD,SDAP,SDAPNUM,0)) S J=SD,J2=SDAPNUM D DELETE^SDC1 Q  ;SD*545 if DFN missing delete record
 ..I $D(^SC(SC,"S",SD,SDAP,SDAPNUM,0)) D
 ...S A=$P(^SC(SC,"S",SD,SDAP,SDAPNUM,0),"^",1)
 ...I '$D(^TMP("SDC0",$J,SD,A)) S ^TMP("SDC0",$J,SD,A)="" D ^SDC3
 Q
APP I $G(SDFFFF)=1 S SDFIRST=0
 F GDATE=CDATE:0 S GDATE=$O(^SC(+SC,"S",GDATE)) Q:GDATE=""!(GDATE>(CDATE+1))  F L=0:0 S L=$O(^SC(+SC,"S",GDATE,1,L)) Q:L=""  D  Q:POP  S A=^SC(+SC,"S",GDATE,1,L,0) D CHECK
 .S POP=0
 .I '$D(^SC(+SC,"S",GDATE,1,L,0)) I $D(^("C")) S J=GDATE,J2=L D DELETE^SDC1 K J,J2 S POP=1 Q  ;SD*545 delete corrupt record
 .I '+$G(^SC(+SC,"S",GDATE,1,L,0)) S J=GDATE,J2=L D DELETE^SDC1 K J,J2 S POP=1 Q  ;SD*545 if DFN missing delete record
 .Q
 K POP
 I $D(^TMP($J,"BADADD")) D BADADD^SDLT K ^TMP($J,"BADADD")
 Q
CHK1 S (SDX,X)=GDATE D WRAPP^SDLT
 I $P(S,"^",2)'["A" D REST^SDLT Q
 S SDX=$P(S,"^",10) I '$D(^DPT(+A,"S",SDX,0)) D REST^SDLT Q
 W !!,"The cancelled appointment(s) were rescheduled as follows:",!
 S S=^DPT(+A,"S",SDX,0) D WRAPP^SDLT,REST^SDLT
 Q
CHECK I $$BADADR^DGUTL3(+A) S ^TMP($J,"BADADD",$P(^DPT(+A,0),"^"),+A)="" Q
 ;
 ;SCREEN FOR DUPLICATES - SD*5.3*379
 ;
 I $D(^TMP("SDC0",$J,GDATE,A)) Q
 S ^TMP("SDC0",$J,GDATE,A)=""
 I $S('$D(^DPT(+A,.35)):1,$P(^DPT(+A,.35),"^",1)']"":1,1:0),$D(^DPT(+A,"S",GDATE)),$P(^DPT(+A,"S",GDATE,0),"^",2)["C",$P(^(0),"^",14)=SDTIME!(SDTIME="*") S S=^DPT(+A,"S",GDATE,0) D ^SDLT,CHK1
 
--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDC0   6055     printed  Sep 23, 2025@20:25:08                                                                                                                                                                                                        Page 2
SDC0      ;MAN/GRR,ALB/TMP/LDB - Continuation of SDC (cancel a clinic) ; 16 JUL 2003  1:27 pm
 +1       ;;5.3;Scheduling;**303,330,379,398,467,478,545,682**;Aug 13, 1993;Build 10
 +2       ;
 +3       ;SD/467 - open matched EWL entries with canceled appointments
 +4       ;
CHKEND     if NOAP
               GOTO END
 +1       ;Patch SD*5.3*682
           WRITE !,"AUTO-REBOOK IS NO LONGER ALLOWED!"
           GOTO ASKL
 +2        SET %=1
           SET DTOUT=0
           WRITE !,"WANT TO AUTO-REBOOK APPOINTMENTS NOW"
           DO YN^DICN
           IF '%
               WRITE !,"REPLY YES (Y) OR NO (N)"
               GOTO CHKEND
 +3        SET ANS=$SELECT('(%-1):"Y",1:"N")
           IF %<0
               WRITE " NO"
               if 'DTOUT
                   QUIT 
ASKL       SET ANS="N"
           SET SDLT1=""
           SET %=1
           SET (SDLET,SDFORM)=""
           WRITE !,"WANT LETTERS PRINTED NOW"
           DO YN^DICN
           IF '%
               WRITE !,"REPLY YES (Y) OR NO (N)"
               GOTO ASKL
 +1        if %<0
               WRITE " NO"
           SET ALS=$SELECT('(%-1):"Y",1:"N")
           if ALS'["Y"
               GOTO AOR
EN         if ($PIECE(^SC(SC,0),"^",3)'="C")!($DATA(SDVAUTC(+SC)))
               QUIT 
           SET SDIV=$PIECE(^SC(SC,0),"^",15)
           SET SDIV=$SELECT(SDIV:SDIV,1:$ORDER(^DG(40.8,0)))
           IF $DATA(SDLT)
               IF SDIV'=SDV1
                   QUIT 
 +1        KILL SDRE,SDIN
           IF $DATA(SDLT)&($DATA(^SC(SC,"I")))
               SET SDIN=+^("I")
               SET SDRE=+$PIECE(^("I"),"^",2)
               IF $DATA(SDIN)
                   IF SDIN
                       IF SDIN'>SDBD&('$DATA(SDRE)!('SDRE)!(SDRE>SDED))
                           QUIT 
 +2        if 'SDLT1
               SET SDLET=$SELECT($DATA(^SC(SC,"LTR")):$PIECE(^("LTR"),"^",3),1:"")
           SET ALS=$SELECT(SDLET:"Y",1:"N")
 +3        IF ALS="N"!(ANS="Y")
               SET SDFFFF=1
 +4        IF ALS="N"
               WRITE !,"NO LETTERS ARE ASSIGNED TO THE ",$PIECE(^SC(SC,0),"^")," CLINIC"
               if $DATA(SDLT)
                   QUIT 
 +5        IF SDFORM=""
               IF $DATA(^DG(40.8,SDIV,"LTR"))
                   IF ^("LTR")
                       SET SDFORM=^("LTR")
 +6        IF $DATA(SDLT)
               IF (ALS'="N")
                   DO CHK
                   QUIT 
 +7        if $DATA(SDLT)
               QUIT 
AOR        if ANS'["Y"&(ALS'["Y")
               GOTO END
 +1        IF '$DATA(SDLT)
               SET DGPGM="START^SDC0"
               SET DGVAR="SC^SI^CDATE^ALS^ANS^SDLET^SDTIME"_$SELECT($DATA(SDIN):"^SDIN^SDRE",1:"")_"^SDFORM^SDV1^SDFFFF^AUTO#"
 +2        IF '$DATA(SDLT)
               DO FZIS^DGUTQ
               if POP
                   GOTO END
START      USE IO
           IF ANS'["Y"&('$DATA(SDLT))
               if ALS["Y"
                   DO APP
               DO END
               QUIT 
BEG1       NEW SDFIRST
 +1        IF $DATA(SDLT)
               SET SDAR=$SELECT('VAUTC:"VAUTC",1:"^SC")
               SET ANS="N"
               SET ALS="Y"
               Begin DoDot:1
 +2                FOR SC=0:0
                       SET SC=$ORDER(@(SDAR_"("_SC_")"))
                       if SC'>0
                           QUIT 
                       Begin DoDot:2
 +3                        KILL SDOK1
                           DO EN
                           IF $DATA(SDOK1)
                               IF SDLET
                                   Begin DoDot:3
 +4                                    FOR SD=(SDBD-.1):0
                                           SET SD=$ORDER(^SC(SC,"S",SD))
                                           SET CDATE=SD
                                           if SD>(SDED+.999999)!(SD'>0)
                                               QUIT 
                                           Begin DoDot:4
 +5                                            DO DUP
                                           End DoDot:4
                                   End DoDot:3
                       End DoDot:2
               End DoDot:1
 +6        SET SDFIRST=$SELECT($GET(SDFFFF)=1:0,1:1)
 +7        IF $DATA(SDLT)
               IF $DATA(^UTILITY("SDLT",$JOB))
                   DO PR^SDC3
                   DO END
                   QUIT 
 +8        if $DATA(SDLT)
               QUIT 
           DO ^SDAUT1
 +9        IF MAX=0
               WRITE !,"AUTO-REBOOKING NOT ALLOWED FOR THIS CLINIC"
               if ALS["Y"
                   GOTO APP
               GOTO END
 +10       FOR GDATE=CDATE:0
               SET GDATE=$ORDER(^SC(SC,"S",GDATE))
               if GDATE=""!(GDATE>(CDATE+1))
                   QUIT 
               Begin DoDot:1
 +11               FOR L=0:0
                       SET L=$ORDER(^SC(SC,"S",GDATE,1,L))
                       if L=""
                           QUIT 
                       Begin DoDot:2
 +12                       SET POP=0
 +13      ;SD*545 delete corrupt record
                           IF '$DATA(^SC(SC,"S",GDATE,1,L,0))
                               IF $DATA(^("C"))
                                   SET J=GDATE
                                   SET J2=L
                                   DO DELETE^SDC1
                                   KILL J,J2
                                   SET POP=1
                                   QUIT 
 +14      ;SD*545 delete corrupt record
                           IF '+$GET(^SC(SC,"S",GDATE,1,L,0))
                               SET J=GDATE
                               SET J2=L
                               DO DELETE^SDC1
                               KILL J,J2
                               SET POP=1
                               QUIT 
                       End DoDot:2
                       if POP
                           QUIT 
                       SET A=^SC(SC,"S",GDATE,1,L,0)
                       IF $DATA(^DPT(+A,"S",GDATE,0))
                           IF $PIECE(^(0),"^",2)="C"
                               IF $PIECE(^(0),"^",14)=SDTIME
                                   DO ^SDAUT2
                                   DO ^SDCCP
               End DoDot:1
 +15       KILL POP
 +16       if ALS["Y"
               DO APP
END       ;
 +1        if $GET(SC)>0&($GET(CDATE)>0)
               DO RESOLVE
 +2        KILL %,%DT,%H,%I,%DT,%IS,%ZIS,A,ALS,ANS,BY,CDATE,CHAR,DA,DFN,DH,DHD,DIC,DIS,DO,DOW,FLDS,FR,GDATE,I,L,LET,MAX,NOAP,P,POP,SI,SL,SS,ST,SDSTRTDT,TO,X,Y,ADDR,B,CLIN,HX,L0,L1,L2,LL,PDAT,S,TIME,Z,D,ENDATE,J,SM,STIME,X1,X2,SDX1,SDX2,SDRE,SDRE1,SDIN,FSW
 +3        KILL ^TMP("SDC0",$JOB),SDAP,SDAPNUM
 +4        KILL SC,SD,Z0,Z5,DGPGM,DUPE,J2,MESS,NDATE,SDDIF,SDFORM,SDINP,SDFORM,SDLET,SDLT1,SDNODE,SDRT,SDSOH,SDST,SDV1,DGVAR,SD1,SD8,SD81,SDANS,SDCNT,SDERR,SDHTO,SDJ,SDTIME,SDZ,STARTDAY,SD82,SDOK,SDOK1,SDLE,SDZ,SDOK1,TST,W,^UTILITY("SD")
 +5        KILL SDFFFF,DIW,DIWF,DIWL,DIWR,DIWT,DN,DUPE,J2,MESS,NDATE,SDADD,SDC,SDCL,SDDAT,SDDIF,SDFORM,SDHX,SDINP,SDIV,SDLET,SDNODE,SDRT,SDSOH,SDST,SDT0,TST,SDV1,^TMP($JOB,"BADADD")
           DO CLOSE^DGUTQ
           QUIT 
CHK        KILL SDOK1
           IF $DATA(^SC(SC,"SL"))
               SET SL=^("SL")
               SET %=$PIECE(SL,"^",6)
               SET SI=$SELECT(%="":4,%<3:4,%:%,1:4)
               SET SDOK1=1
               KILL SL,%
              IF '$TEST
                   WRITE $PIECE(^SC(SC,0),"^")," does not have an appointment length indicated."
 +1        QUIT 
RESOLVE   ;evaluate canceled and rebooked appointments with relation to EWL
 +1        SET GDATE=CDATE
           KILL ^TMP("SDWLREB",$JOB),^TMP($JOB,"SDWLPL")
 +2        FOR 
               SET GDATE=$ORDER(^SC(SC,"S",GDATE))
               if GDATE=""!(GDATE>(CDATE+1))
                   QUIT 
               SET L=0
               FOR 
                   SET L=$ORDER(^SC(SC,"S",GDATE,1,L))
                   if L=""
                       QUIT 
                   Begin DoDot:1
 +3       ;SD*5.3*545 delete corrupt record
                       IF '$DATA(^SC(SC,"S",GDATE,1,L,0))
                           IF $DATA(^("C"))
                               SET J=GDATE
                               SET J2=L
                               DO DELETE^SDC1
                               KILL J,J2
                               QUIT 
 +4       ;SD*5.3*545 delete corrupt record with missing DFN
                       IF '+$GET(^SC(SC,"S",GDATE,1,L,0))
                           SET J=GDATE
                           SET J2=L
                           DO DELETE^SDC1
                           KILL J,J2
                           QUIT 
 +5                    SET DFN=+^SC(SC,"S",GDATE,1,L,0)
 +6                    NEW RBFLG,SDTRB,SDCAN,SDREB
                       SET SDREB=0
                       DO REBOOK^SDWLREB(DFN,GDATE,SC,.RBFLG,.SDTRB,.SDCAN)
                       if SDCAN'=SDTIME
                           QUIT 
 +7       ;not canceled by clinic
                       IF $EXTRACT(RBFLG,1,2)'="CC"
                           QUIT 
 +8                    IF RBFLG="CCR"
                           SET SDREB=1
                           DO DISREB^SDWLREB(DFN,SDTRB,SC)
 +9                    DO OPENEWL^SDWLREB(DFN,GDATE,SC,SDREB)
                       KILL ^TMP($JOB,"APPT"),^TMP($JOB,"SDWLPL")
                   End DoDot:1
 +10       IF $DATA(^TMP("SDWLREB",$JOB))
               DO MESS^SDWLREB
 +11       QUIT 
 +12      ;
DUP       ;SCREEN FOR DUPLICATE PATIENTS - SD*5.3*379
 +1        SET SDAP=""
           FOR 
               SET SDAP=$ORDER(^SC(SC,"S",SD,SDAP))
               if SDAP=""
                   QUIT 
               Begin DoDot:1
 +2                SET SDAPNUM=""
                   FOR 
                       SET SDAPNUM=$ORDER(^SC(SC,"S",SD,SDAP,SDAPNUM))
                       if SDAPNUM=""
                           QUIT 
                       Begin DoDot:2
 +3       ;SD*545 delete corrupt record
                           IF '$DATA(^SC(SC,"S",SD,SDAP,SDAPNUM,0))
                               IF $DATA(^("C"))
                                   SET J=SD
                                   SET J2=SDAPNUM
                                   DO DELETE^SDC1
                                   QUIT 
 +4       ;SD*545 if DFN missing delete record
                           IF '+$GET(^SC(SC,"S",SD,SDAP,SDAPNUM,0))
                               SET J=SD
                               SET J2=SDAPNUM
                               DO DELETE^SDC1
                               QUIT 
 +5                        IF $DATA(^SC(SC,"S",SD,SDAP,SDAPNUM,0))
                               Begin DoDot:3
 +6                                SET A=$PIECE(^SC(SC,"S",SD,SDAP,SDAPNUM,0),"^",1)
 +7                                IF '$DATA(^TMP("SDC0",$JOB,SD,A))
                                       SET ^TMP("SDC0",$JOB,SD,A)=""
                                       DO ^SDC3
                               End DoDot:3
                       End DoDot:2
               End DoDot:1
 +8        QUIT 
APP        IF $GET(SDFFFF)=1
               SET SDFIRST=0
 +1        FOR GDATE=CDATE:0
               SET GDATE=$ORDER(^SC(+SC,"S",GDATE))
               if GDATE=""!(GDATE>(CDATE+1))
                   QUIT 
               FOR L=0:0
                   SET L=$ORDER(^SC(+SC,"S",GDATE,1,L))
                   if L=""
                       QUIT 
                   Begin DoDot:1
 +2                    SET POP=0
 +3       ;SD*545 delete corrupt record
                       IF '$DATA(^SC(+SC,"S",GDATE,1,L,0))
                           IF $DATA(^("C"))
                               SET J=GDATE
                               SET J2=L
                               DO DELETE^SDC1
                               KILL J,J2
                               SET POP=1
                               QUIT 
 +4       ;SD*545 if DFN missing delete record
                       IF '+$GET(^SC(+SC,"S",GDATE,1,L,0))
                           SET J=GDATE
                           SET J2=L
                           DO DELETE^SDC1
                           KILL J,J2
                           SET POP=1
                           QUIT 
 +5                    QUIT 
                   End DoDot:1
                   if POP
                       QUIT 
                   SET A=^SC(+SC,"S",GDATE,1,L,0)
                   DO CHECK
 +6        KILL POP
 +7        IF $DATA(^TMP($JOB,"BADADD"))
               DO BADADD^SDLT
               KILL ^TMP($JOB,"BADADD")
 +8        QUIT 
CHK1       SET (SDX,X)=GDATE
           DO WRAPP^SDLT
 +1        IF $PIECE(S,"^",2)'["A"
               DO REST^SDLT
               QUIT 
 +2        SET SDX=$PIECE(S,"^",10)
           IF '$DATA(^DPT(+A,"S",SDX,0))
               DO REST^SDLT
               QUIT 
 +3        WRITE !!,"The cancelled appointment(s) were rescheduled as follows:",!
 +4        SET S=^DPT(+A,"S",SDX,0)
           DO WRAPP^SDLT
           DO REST^SDLT
 +5        QUIT 
CHECK      IF $$BADADR^DGUTL3(+A)
               SET ^TMP($JOB,"BADADD",$PIECE(^DPT(+A,0),"^"),+A)=""
               QUIT 
 +1       ;
 +2       ;SCREEN FOR DUPLICATES - SD*5.3*379
 +3       ;
 +4        IF $DATA(^TMP("SDC0",$JOB,GDATE,A))
               QUIT 
 +5        SET ^TMP("SDC0",$JOB,GDATE,A)=""
 +6        IF $SELECT('$DATA(^DPT(+A,.35)):1,$PIECE(^DPT(+A,.35),"^",1)']"":1,1:0)
               IF $DATA(^DPT(+A,"S",GDATE))
                   IF $PIECE(^DPT(+A,"S",GDATE,0),"^",2)["C"
                       IF $PIECE(^(0),"^",14)=SDTIME!(SDTIME="*")
                           SET S=^DPT(+A,"S",GDATE,0)
                           DO ^SDLT
                           DO CHK1