SDCNL ;ALB/LDB - CANCELLED APPOINTMENT LETTER ; 25 MAR 88@13:00 ;;5.3;Scheduling;**330,340,407,398**;Aug 13, 1993 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=$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 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 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 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