SDC3.m

SDC3 ;ALB/LDB - CANCELLATION LETTERS; 23-DEC-88@12:30

 ;;5.3;Scheduling;**330,340,398**;Aug 13, 1993

EN N SDBAD F L1=0:0 S L1=$O(^SC(+SC,"S",SD,1,L1)) Q:L1'>0  S A=+^(L1,0) D CHECK,SET:$D(SDOK)

 Q

CHECK K SDOK I $S('$D(^DPT(+A,.35)):1,$P(^DPT(+A,.35),"^",1)']"":1,1:0),$D(^DPT(+A,"S",SD)),$P(^DPT(+A,"S",SD,0),"^",2)="C"!($P(^(0),"^",2)="CA") S SDOK=1

 D B I SDBAD K SDOK

 Q

SET S ^UTILITY("SDLT",$J,+SDLET,+A,SD,+SC)="" I $P(^DPT(+A,"S",SD,0),"^",2)="CA"&($P(^(0),"^",10)]"") S SD8=$P(^(0),"^",10) I $D(^DPT(+A,"S",SD8,0)),$P(^(0),"^",2)'["C" S ^UTILITY("SDLT",$J,+SDLET,"A",+A,SD8,+SC)=""

 Q

PR F SD1=0:0 S SD1=$O(^UTILITY("SDLT",$J,SD1)) Q:SD1=""  S SDLET=SD1 D PR0

 I $D(^TMP($J,"BADADD")) D BADADD^SDLT K ^TMP($J,"BADADD")

 Q

PR0 S S81=0 F SD8=0:0 D:SD8'=S81 PR1 S S81=SD8,SD8=$O(^UTILITY("SDLT",$J,SD1,SD8)) Q:SD8'>0  S A=SD8 D B Q:SDBAD  D ^SDLT F S82=0:0 S S82=$O(^UTILITY("SDLT",$J,SD1,SD8,S82)) Q:S82'>0  S SDC=$O(^(S82,-1)),SDX=S82,S=^DPT(+A,"S",S82,0) D WRAPP^SDLT

 K SD8,S81,S82

 Q

PR1 I $D(^UTILITY("SDLT",$J,SD1,"A",SD8)),A=SD8 W !!,"The cancelled appointments have been rescheduled as follows:",! D PR2

 D REST^SDLT Q

PR2 F SD82=0:0 S SD82=$O(^UTILITY("SDLT",$J,SD1,"A",SD8,SD82)),SDX=SD82 Q:SD82'>0  S SC=$O(^(SD82,-1)),S=^DPT(+A,"S",SD82,0) D WRAPP^SDLT

 K SD82

 Q

 ;CHECK FOR BAD ADDRESS

B S SDBAD=$$BADADR^DGUTL3(+A)

 S:SDBAD ^TMP($J,"BADADD",$P(^DPT(+A,0),"^"),+A)=""

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---SDC3   1416     printed  Apr 09, 2024@21:51:31                                                                                                                                                                                                        Page 2

SDC3      ;ALB/LDB - CANCELLATION LETTERS; 23-DEC-88@12:30

 +1       ;;5.3;Scheduling;**330,340,398**;Aug 13, 1993

EN         NEW SDBAD

           FOR L1=0:0

               SET L1=$ORDER(^SC(+SC,"S",SD,1,L1))

               if L1'>0

                   QUIT 

               SET A=+^(L1,0)

               DO CHECK

               if $DATA(SDOK)

                   DO SET

 +1        QUIT 

CHECK      KILL SDOK

           IF $SELECT('$DATA(^DPT(+A,.35)):1,$PIECE(^DPT(+A,.35),"^",1)']"":1,1:0)

               IF $DATA(^DPT(+A,"S",SD))

                   IF $PIECE(^DPT(+A,"S",SD,0),"^",2)="C"!($PIECE(^(0),"^",2)="CA")

                       SET SDOK=1

 +1        DO B

           IF SDBAD

               KILL SDOK

 +2        QUIT 

SET        SET ^UTILITY("SDLT",$JOB,+SDLET,+A,SD,+SC)=""

           IF $PIECE(^DPT(+A,"S",SD,0),"^",2)="CA"&($PIECE(^(0),"^",10)]"")

               SET SD8=$PIECE(^(0),"^",10)

               IF $DATA(^DPT(+A,"S",SD8,0))

                   IF $PIECE(^(0),"^",2)'["C"

                       SET ^UTILITY("SDLT",$JOB,+SDLET,"A",+A,SD8,+SC)=""

 +1        QUIT 

PR         FOR SD1=0:0

               SET SD1=$ORDER(^UTILITY("SDLT",$JOB,SD1))

               if SD1=""

                   QUIT 

               SET SDLET=SD1

               DO PR0

 +1        IF $DATA(^TMP($JOB,"BADADD"))

               DO BADADD^SDLT

               KILL ^TMP($JOB,"BADADD")

 +2        QUIT 

PR0        SET S81=0

           FOR SD8=0:0

               if SD8'=S81

                   DO PR1

               SET S81=SD8

               SET SD8=$ORDER(^UTILITY("SDLT",$JOB,SD1,SD8))

               if SD8'>0

                   QUIT 

               SET A=SD8

               DO B

               if SDBAD

                   QUIT 

               DO ^SDLT

               FOR S82=0:0

                   SET S82=$ORDER(^UTILITY("SDLT",$JOB,SD1,SD8,S82))

                   if S82'>0

                       QUIT 

                   SET SDC=$ORDER(^(S82,-1))

                   SET SDX=S82

                   SET S=^DPT(+A,"S",S82,0)

                   DO WRAPP^SDLT

 +1        KILL SD8,S81,S82

 +2        QUIT 

PR1        IF $DATA(^UTILITY("SDLT",$JOB,SD1,"A",SD8))

               IF A=SD8

                   WRITE !!,"The cancelled appointments have been rescheduled as follows:",!

                   DO PR2

 +1        DO REST^SDLT

           QUIT 

PR2        FOR SD82=0:0

               SET SD82=$ORDER(^UTILITY("SDLT",$JOB,SD1,"A",SD8,SD82))

               SET SDX=SD82

               if SD82'>0

                   QUIT 

               SET SC=$ORDER(^(SD82,-1))

               SET S=^DPT(+A,"S",SD82,0)

               DO WRAPP^SDLT

 +1        KILL SD82

 +2        QUIT 

 +3       ;CHECK FOR BAD ADDRESS

B          SET SDBAD=$$BADADR^DGUTL3(+A)

 +1        if SDBAD

               SET ^TMP($JOB,"BADADD",$PIECE(^DPT(+A,0),"^"),+A)=""

 +2        QUIT