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 ---[H[J[2J[HSDC3 1416 printed Dec 13, 2024@02:48:47 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
