- SDC3 ;ALB/LDB - CANCELLATION LETTERS; 23-DEC-88@12:30
- ;;5.3;Scheduling;**330,340,398,1015**;Aug 13, 1993;Build 21
- ;IHS/ANMC/LJF 8/18/2000 changed $N to $O
- ; 11/24/2000 moved letter's left margin in 5 spaces
- ; 11/29/2000 added count of rescheduled appts (BSDCNT)
- ;
- 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
- I $D(^UTILITY("SDLT",$J,SD1,"A",SD8)),A=SD8 W !!,?5,"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 BSDCNT 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 S BSDCNT=$G(BSDCNT)+1 ;IHS/ANMC/LJF 8/18/2000;11/29/2000
- K SD82
- Q
- ;CHECK FOR BAD ADDRESS
- B S SDBAD=$$BADADR^DGUTL3(+A)
- S:SDBAD ^TMP($J,"BADADD",$P(^DPT(+A,0),"^"),+A)=""
- Q
- SDC3 ;ALB/LDB - CANCELLATION LETTERS; 23-DEC-88@12:30
- +1 ;;5.3;Scheduling;**330,340,398,1015**;Aug 13, 1993;Build 21
- +2 ;IHS/ANMC/LJF 8/18/2000 changed $N to $O
- +3 ; 11/24/2000 moved letter's left margin in 5 spaces
- +4 ; 11/29/2000 added count of rescheduled appts (BSDCNT)
- +5 ;
- 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 ;I $D(^UTILITY("SDLT",$J,SD1,"A",SD8)),A=SD8 W !!,"The cancelled appointments have been rescheduled as follows:",! D PR2
- +1 IF $DATA(^UTILITY("SDLT",$JOB,SD1,"A",SD8))
- IF A=SD8
- WRITE !!,?5,"The cancelled appointments have been rescheduled as follows:",!
- DO PR2
- +2 DO REST^SDLT
- QUIT
- 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
- +1 ;IHS/ANMC/LJF 8/18/2000;11/29/2000
- KILL BSDCNT
- 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
- SET BSDCNT=$GET(BSDCNT)+1
- +2 KILL SD82
- +3 QUIT
- +4 ;CHECK FOR BAD ADDRESS
- B SET SDBAD=$$BADADR^DGUTL3(+A)
- +1 IF SDBAD
- SET ^TMP($JOB,"BADADD",$PIECE(^DPT(+A,0),"^"),+A)=""
- +2 QUIT
