SDCNL ;ALB/LDB - CANCELLED APPOINTMENT LETTER ; 25 MAR 88@13:00
;;5.3;Scheduling;**330,340,407,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)
;
N SDBAD S (SDOK,SDV)=0 I $D(^DG(43,1,"GL")),$P(^("GL"),"^",2) S SDV=1
G:"Cc"[S1 ASDCN
PT S (SDPT,SDINP)=0 F B=0:0 S SDPT=$O(VAUTN(SDPT)) Q:SDPT="" D
.S SDBAD=$$BADADR^DGUTL3(SDPT) I SDBAD S ^TMP($J,"BADADD",$P(^DPT(+SDPT,0),"^"),+SDPT)="" Q
.W:$D(^DPT(SDPT,.1)) !,$P(^DPT(SDPT,0),"^")," ",$P(^(0),"^",9)," is currently an inpatient!" S:$D(^DPT(SDPT,.1)) SDINP=1 D:'SDINP START S SDINP=0
D:$O(^UTILITY($J,0)) PR Q
START ;F SDX=SDBD:0 S SDX=$N(^DPT(SDPT,"S",SDX)) Q:SDX>(SDED+.9999)!(SDX'>0) S SDAP=^DPT(SDPT,"S",SDX,0),SDV2=0 I $P(SDAP,"^",2)["C" D MDIV I SDV2!'SDV S SDC=+SDAP D CHK1 I 'SDOK D CHK ;IHS/ANMC/LJF 8/18/2000
F SDX=SDBD:0 S SDX=$O(^DPT(SDPT,"S",SDX)) Q:SDX>(SDED+.9999)!(SDX'>0) S SDAP=^DPT(SDPT,"S",SDX,0),SDV2=0 I $P(SDAP,"^",2)["C" D MDIV I SDV2!'SDV S SDC=+SDAP D CHK1 I 'SDOK D CHK ;IHS/ANMC/LJF 8/18/2000
Q
PR N SDFIRST S SDFIRST=1
S SDLET="" F A0=0:0 S SDLET=$O(^UTILITY($J,SDLET)) Q:'SDLET S (B0,X7)="" F A1=0:0 S A5=B0,B0=$O(^UTILITY($J,SDLET,B0)) D:B0="" R Q:B0="" D R:A5&(B0'=A5) S A=B0 D ^SDLT F A2=0:0 S X7=$O(^UTILITY($J,SDLET,B0,X7)) Q:X7="" D S,WRAPP^SDLT
I $D(^UTILITY($J,"NO")) D NO W:$D(DUZ) !!,"Printed by: ",$P(^VA(200,DUZ,0),"^")
I $D(^TMP($J,"BADADD")) D BADADD^SDLT K ^TMP($J,"BADADD")
D END
Q
END D END^SDN1 K ^UTILITY($J),A0,A1,A3,A5,ALL,B0,SDA,SDINP,SDOK,SDS,SDV,SDV21,SDX,SDX1,SDX8,Z0,Z5,ZTSK,SDAP,X7,DIC,DGPGM,DGVAR,SDPT
K BEGDATE,DTOUT,DUOUT,ENDDATE,SDBD,SDBD1,SDCP,SDED,SDLET,SDLET1,SDV,SDV2,X8,Y Q
MDIV S SDAP=^DPT(SDPT,"S",SDX,0),SDV=$P(^SC(+SDAP,0),"^",15) I SDV=SDV1 S SDV2=1 Q
Q
CAN S SDAP=^DPT(SDPT,"S",SDX,0),SDC=+SDAP
S SDLET="" I $D(^SC(SDC,"LTR")),'SDLT1 S SDLET=$S('SD9:$P(^("LTR"),"^",4),1:$P(^("LTR"),"^",3))
I 'SDLET&'SDLT1 S ^UTILITY($J,"NO",SDPT,SDC,SDX)=""
S SDAP=^DPT(SDPT,"S",SDX,0) I SDLET!SDLT1 S ^UTILITY($J,$S(SDLET:SDLET,1:SDLT1),SDPT,SDX)=SDC
I (SDLET!SDLT1),$P(SDAP,"^",10),$D(^DPT(SDPT,"S",$P(SDAP,"^",10))),$P(^DPT(SDPT,"S",$P(SDAP,"^",10),0),"^",2)'["C" S ^UTILITY($J,$S(SDLET:SDLET,1:SDLT1),SDPT,SDX)=$P(SDAP,"^")_"^"_$P(SDAP,"^",10)
Q
ASDCN I 'VAUTC S SDC=0 F Z=0:0 S SDC=$O(VAUTC(SDC)) Q:SDC="" S SDAP=SDC D ASDCN1
G:'VAUTC PR
I VAUTC S SDC=0 F Z=0:0 S SDC=$O(^SC(SDC)) Q:'SDC I $P(^SC(SDC,0),"^",3)="C",$S($P(^(0),"^",15)=SDV1:1,'$P(^(0),"^",15):1,1:0),'$D(SDVAUTC(SDC)) S SDAP=SDC D ASDCN1
G:VAUTC PR
ASDCN1 S SDX=SDBD F W=0:0 S SDX=$O(^DPT("ASDCN",SDC,SDX)) Q:(SDX>(SDED+.9))!(SDX="") S SDPT=0 F T=0:0 S SDPT=$O(^DPT("ASDCN",SDC,SDX,SDPT)) Q:SDPT="" I $D(^DPT(SDPT,"S",SDX,0)),$P(^(0),"^")=SDC,'$D(^DPT(SDPT,.1)) D CHK1 D:'SDOK CHK
Q
R S SDR=0,SDX8="",SDA=A5
;
;IHS/ANMC/LJF 11/24/2000;11/29/2000
;F A3=0:0 S SDX8=$O(^UTILITY($J,SDLET,A5,SDX8)) Q:SDX8="" I ^(SDX8),$P(^(SDX8),"^",2) S SDX=$P(^(SDX8),"^",2),SDC=$P(^(SDX8),"^"),(DFN,A)=A5,SDS=^DPT(DFN,"S",SDX,0) W:'SDR !!,"The rescheduled appointment(s) follow:",! D WRAPP^SDLT S SDR=1
K BSDCNT
F A3=0:0 S SDX8=$O(^UTILITY($J,SDLET,A5,SDX8)) Q:SDX8="" I ^(SDX8),$P(^(SDX8),"^",2) D
. S SDX=$P(^(SDX8),"^",2),SDC=$P(^(SDX8),"^"),(DFN,A)=A5,SDS=^DPT(DFN,"S",SDX,0)
. W:'SDR !!?5,"The rescheduled appointment(s) follow:",! D WRAPP^SDLT S BSDCNT=$G(BSDCNT)+1 S SDR=1
;
D REST^SDLT Q
S S A=B0,SDX=X7,SDS=^DPT(A,"S",SDX,0),SDC=+^(0) Q
NO W @IOF S SDPT=""
F A3=0:0 S SDPT=$O(^UTILITY($J,"NO",SDPT)) Q:SDPT="" S SDC="" F A4=0:0 S SDC=$O(^UTILITY($J,"NO",SDPT,SDC)) Q:SDC="" D NOAP S SDAP="" F A5=0:0 S SDAP=$O(^UTILITY($J,"NO",SDPT,SDC,SDAP)) D:SDAP="" NOAP2 Q:SDAP="" W ! D NOAP1
Q
NOAP W !!,$P(^DPT(SDPT,0),"^")," ",$P(^(0),"^",9),!,"has the following cancelled appointment(s) in ",$P(^SC(SDC,0),"^")," CLINIC" Q
NOAP1 S Y=SDAP D DT^DIQ Q
NOAP2 W !,"but no letter is assigned to the clinic" Q
S Y=SDAP D DT^DIQ W ! Q
Q
CHK S DFN=SDPT D DEM^VADPT I VADM(6) D KVAR^VADPT Q
S SDBAD=$$BADADR^DGUTL3(SDPT) I SDBAD S ^TMP($J,"BADADD",$P(^DPT(+SDPT,0),"^"),+SDPT)="" Q
D CAN:$D(^DPT("ASDCN",SDC,SDX,SDPT)),KVAR^VADPT Q
CHK1 S SDOK=0 I '$D(^SC(+SDAP,"S",SDX)) Q
I $D(^SC(+SDAP,"S",SDX)) F P=0:0 S P=$O(^SC(+SDAP,"S",SDX,1,P)) Q:P'>0 I $P(^(P,0),"^")=SDPT S SDOK=1
Q
SDCNL ;ALB/LDB - CANCELLED APPOINTMENT LETTER ; 25 MAR 88@13:00
+1 ;;5.3;Scheduling;**330,340,407,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 ;
+6 NEW SDBAD
SET (SDOK,SDV)=0
IF $DATA(^DG(43,1,"GL"))
IF $PIECE(^("GL"),"^",2)
SET SDV=1
+7 IF "Cc"[S1
GOTO ASDCN
PT SET (SDPT,SDINP)=0
FOR B=0:0
SET SDPT=$ORDER(VAUTN(SDPT))
IF SDPT=""
QUIT
Begin DoDot:1
+1 SET SDBAD=$$BADADR^DGUTL3(SDPT)
IF SDBAD
SET ^TMP($JOB,"BADADD",$PIECE(^DPT(+SDPT,0),"^"),+SDPT)=""
QUIT
+2 IF $DATA(^DPT(SDPT,.1))
WRITE !,$PIECE(^DPT(SDPT,0),"^")," ",$PIECE(^(0),"^",9)," is currently an inpatient!"
IF $DATA(^DPT(SDPT,.1))
SET SDINP=1
IF 'SDINP
DO START
SET SDINP=0
End DoDot:1
+3 IF $ORDER(^UTILITY($JOB,0))
DO PR
QUIT
START ;F SDX=SDBD:0 S SDX=$N(^DPT(SDPT,"S",SDX)) Q:SDX>(SDED+.9999)!(SDX'>0) S SDAP=^DPT(SDPT,"S",SDX,0),SDV2=0 I $P(SDAP,"^",2)["C" D MDIV I SDV2!'SDV S SDC=+SDAP D CHK1 I 'SDOK D CHK ;IHS/ANMC/LJF 8/18/2000
+1 ;IHS/ANMC/LJF 8/18/2000
FOR SDX=SDBD:0
SET SDX=$ORDER(^DPT(SDPT,"S",SDX))
IF SDX>(SDED+.9999)!(SDX'>0)
QUIT
SET SDAP=^DPT(SDPT,"S",SDX,0)
SET SDV2=0
IF $PIECE(SDAP,"^",2)["C"
DO MDIV
IF SDV2!'SDV
SET SDC=+SDAP
DO CHK1
IF 'SDOK
DO CHK
+2 QUIT
PR NEW SDFIRST
SET SDFIRST=1
+1 SET SDLET=""
FOR A0=0:0
SET SDLET=$ORDER(^UTILITY($JOB,SDLET))
IF 'SDLET
QUIT
SET (B0,X7)=""
FOR A1=0:0
SET A5=B0
SET B0=$ORDER(^UTILITY($JOB,SDLET,B0))
IF B0=""
DO R
IF B0=""
QUIT
IF A5&(B0'=A5)
DO R
SET A=B0
DO ^SDLT
FOR A2=0:0
SET X7=$ORDER(^UTILITY($JOB,SDLET,B0,X7))
IF X7=""
QUIT
DO S
DO WRAPP^SDLT
+2 IF $DATA(^UTILITY($JOB,"NO"))
DO NO
IF $DATA(DUZ)
WRITE !!,"Printed by: ",$PIECE(^VA(200,DUZ,0),"^")
+3 IF $DATA(^TMP($JOB,"BADADD"))
DO BADADD^SDLT
KILL ^TMP($JOB,"BADADD")
+4 DO END
+5 QUIT
END DO END^SDN1
KILL ^UTILITY($JOB),A0,A1,A3,A5,ALL,B0,SDA,SDINP,SDOK,SDS,SDV,SDV21,SDX,SDX1,SDX8,Z0,Z5,ZTSK,SDAP,X7,DIC,DGPGM,DGVAR,SDPT
+1 KILL BEGDATE,DTOUT,DUOUT,ENDDATE,SDBD,SDBD1,SDCP,SDED,SDLET,SDLET1,SDV,SDV2,X8,Y
QUIT
MDIV SET SDAP=^DPT(SDPT,"S",SDX,0)
SET SDV=$PIECE(^SC(+SDAP,0),"^",15)
IF SDV=SDV1
SET SDV2=1
QUIT
+1 QUIT
CAN SET SDAP=^DPT(SDPT,"S",SDX,0)
SET SDC=+SDAP
+1 SET SDLET=""
IF $DATA(^SC(SDC,"LTR"))
IF 'SDLT1
SET SDLET=$SELECT('SD9:$PIECE(^("LTR"),"^",4),1:$PIECE(^("LTR"),"^",3))
+2 IF 'SDLET&'SDLT1
SET ^UTILITY($JOB,"NO",SDPT,SDC,SDX)=""
+3 SET SDAP=^DPT(SDPT,"S",SDX,0)
IF SDLET!SDLT1
SET ^UTILITY($JOB,$SELECT(SDLET:SDLET,1:SDLT1),SDPT,SDX)=SDC
+4 IF (SDLET!SDLT1)
IF $PIECE(SDAP,"^",10)
IF $DATA(^DPT(SDPT,"S",$PIECE(SDAP,"^",10)))
IF $PIECE(^DPT(SDPT,"S",$PIECE(SDAP,"^",10),0),"^",2)'["C"
SET ^UTILITY($JOB,$SELECT(SDLET:SDLET,1:SDLT1),SDPT,SDX)=$PIECE(SDAP,"^")_"^"_$PIECE(SDAP,"^",10)
+5 QUIT
ASDCN IF 'VAUTC
SET SDC=0
FOR Z=0:0
SET SDC=$ORDER(VAUTC(SDC))
IF SDC=""
QUIT
SET SDAP=SDC
DO ASDCN1
+1 IF 'VAUTC
GOTO PR
+2 IF VAUTC
SET SDC=0
FOR Z=0:0
SET SDC=$ORDER(^SC(SDC))
IF 'SDC
QUIT
IF $PIECE(^SC(SDC,0),"^",3)="C"
IF $SELECT($PIECE(^(0),"^",15)=SDV1:1,'$PIECE(^(0),"^",15):1,1:0)
IF '$DATA(SDVAUTC(SDC))
SET SDAP=SDC
DO ASDCN1
+3 IF VAUTC
GOTO PR
ASDCN1 SET SDX=SDBD
FOR W=0:0
SET SDX=$ORDER(^DPT("ASDCN",SDC,SDX))
IF (SDX>(SDED+.9))!(SDX="")
QUIT
SET SDPT=0
FOR T=0:0
SET SDPT=$ORDER(^DPT("ASDCN",SDC,SDX,SDPT))
IF SDPT=""
QUIT
IF $DATA(^DPT(SDPT,"S",SDX,0))
IF $PIECE(^(0),"^")=SDC
IF '$DATA(^DPT(SDPT,.1))
DO CHK1
IF 'SDOK
DO CHK
+1 QUIT
R SET SDR=0
SET SDX8=""
SET SDA=A5
+1 ;
+2 ;IHS/ANMC/LJF 11/24/2000;11/29/2000
+3 ;F A3=0:0 S SDX8=$O(^UTILITY($J,SDLET,A5,SDX8)) Q:SDX8="" I ^(SDX8),$P(^(SDX8),"^",2) S SDX=$P(^(SDX8),"^",2),SDC=$P(^(SDX8),"^"),(DFN,A)=A5,SDS=^DPT(DFN,"S",SDX,0) W:'SDR !!,"The rescheduled appointment(s) follow:",! D WRAPP^SDLT S SDR=1
+4 KILL BSDCNT
+5 FOR A3=0:0
SET SDX8=$ORDER(^UTILITY($JOB,SDLET,A5,SDX8))
IF SDX8=""
QUIT
IF ^(SDX8)
IF $PIECE(^(SDX8),"^",2)
Begin DoDot:1
+6 SET SDX=$PIECE(^(SDX8),"^",2)
SET SDC=$PIECE(^(SDX8),"^")
SET (DFN,A)=A5
SET SDS=^DPT(DFN,"S",SDX,0)
+7 IF 'SDR
WRITE !!?5,"The rescheduled appointment(s) follow:",!
DO WRAPP^SDLT
SET BSDCNT=$GET(BSDCNT)+1
SET SDR=1
End DoDot:1
+8 ;
+9 DO REST^SDLT
QUIT
S SET A=B0
SET SDX=X7
SET SDS=^DPT(A,"S",SDX,0)
SET SDC=+^(0)
QUIT
NO WRITE @IOF
SET SDPT=""
+1 FOR A3=0:0
SET SDPT=$ORDER(^UTILITY($JOB,"NO",SDPT))
IF SDPT=""
QUIT
SET SDC=""
FOR A4=0:0
SET SDC=$ORDER(^UTILITY($JOB,"NO",SDPT,SDC))
IF SDC=""
QUIT
DO NOAP
SET SDAP=""
FOR A5=0:0
SET SDAP=$ORDER(^UTILITY($JOB,"NO",SDPT,SDC,SDAP))
IF SDAP=""
DO NOAP2
IF SDAP=""
QUIT
WRITE !
DO NOAP1
+2 QUIT
NOAP WRITE !!,$PIECE(^DPT(SDPT,0),"^")," ",$PIECE(^(0),"^",9),!,"has the following cancelled appointment(s) in ",$PIECE(^SC(SDC,0),"^")," CLINIC"
QUIT
NOAP1 SET Y=SDAP
DO DT^DIQ
QUIT
NOAP2 WRITE !,"but no letter is assigned to the clinic"
QUIT
+1 SET Y=SDAP
DO DT^DIQ
WRITE !
QUIT
+2 QUIT
CHK SET DFN=SDPT
DO DEM^VADPT
IF VADM(6)
DO KVAR^VADPT
QUIT
+1 SET SDBAD=$$BADADR^DGUTL3(SDPT)
IF SDBAD
SET ^TMP($JOB,"BADADD",$PIECE(^DPT(+SDPT,0),"^"),+SDPT)=""
QUIT
+2 IF $DATA(^DPT("ASDCN",SDC,SDX,SDPT))
DO CAN
DO KVAR^VADPT
QUIT
CHK1 SET SDOK=0
IF '$DATA(^SC(+SDAP,"S",SDX))
QUIT
+1 IF $DATA(^SC(+SDAP,"S",SDX))
FOR P=0:0
SET P=$ORDER(^SC(+SDAP,"S",SDX,1,P))
IF P'>0
QUIT
IF $PIECE(^(P,0),"^")=SDPT
SET SDOK=1
+2 QUIT
