51 lines
3.5 KiB
Mathematica
51 lines
3.5 KiB
Mathematica
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
|