source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SDCNL.m@ 767

Last change on this file since 767 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.5 KB
Line 
1SDCNL ;ALB/LDB - CANCELLED APPOINTMENT LETTER ; 25 MAR 88@13:00
2 ;;5.3;Scheduling;**330,340,407,398**;Aug 13, 1993
3 N SDBAD S (SDOK,SDV)=0 I $D(^DG(43,1,"GL")),$P(^("GL"),"^",2) S SDV=1
4 G:"Cc"[S1 ASDCN
5PT S (SDPT,SDINP)=0 F B=0:0 S SDPT=$O(VAUTN(SDPT)) Q:SDPT="" D
6 .S SDBAD=$$BADADR^DGUTL3(SDPT) I SDBAD S ^TMP($J,"BADADD",$P(^DPT(+SDPT,0),"^"),+SDPT)="" Q
7 .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
8 D:$O(^UTILITY($J,0)) PR Q
9START 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
10 Q
11PR N SDFIRST S SDFIRST=1
12 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
13 I $D(^UTILITY($J,"NO")) D NO W:$D(DUZ) !!,"Printed by: ",$P(^VA(200,DUZ,0),"^")
14 I $D(^TMP($J,"BADADD")) D BADADD^SDLT K ^TMP($J,"BADADD")
15 D END
16 Q
17END 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
18 K BEGDATE,DTOUT,DUOUT,ENDDATE,SDBD,SDBD1,SDCP,SDED,SDLET,SDLET1,SDV,SDV2,X8,Y Q
19MDIV S SDAP=^DPT(SDPT,"S",SDX,0),SDV=$P(^SC(+SDAP,0),"^",15) I SDV=SDV1 S SDV2=1 Q
20 Q
21CAN S SDAP=^DPT(SDPT,"S",SDX,0),SDC=+SDAP
22 S SDLET="" I $D(^SC(SDC,"LTR")),'SDLT1 S SDLET=$S('SD9:$P(^("LTR"),"^",4),1:$P(^("LTR"),"^",3))
23 I 'SDLET&'SDLT1 S ^UTILITY($J,"NO",SDPT,SDC,SDX)=""
24 S SDAP=^DPT(SDPT,"S",SDX,0) I SDLET!SDLT1 S ^UTILITY($J,$S(SDLET:SDLET,1:SDLT1),SDPT,SDX)=SDC
25 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)
26 Q
27ASDCN I 'VAUTC S SDC=0 F Z=0:0 S SDC=$O(VAUTC(SDC)) Q:SDC="" S SDAP=SDC D ASDCN1
28 G:'VAUTC PR
29 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
30 G:VAUTC PR
31ASDCN1 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
32 Q
33R S SDR=0,SDX8="",SDA=A5
34 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
35 D REST^SDLT Q
36S S A=B0,SDX=X7,SDS=^DPT(A,"S",SDX,0),SDC=+^(0) Q
37NO W @IOF S SDPT=""
38 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
39 Q
40NOAP W !!,$P(^DPT(SDPT,0),"^")," ",$P(^(0),"^",9),!,"has the following cancelled appointment(s) in ",$P(^SC(SDC,0),"^")," CLINIC" Q
41NOAP1 S Y=SDAP D DT^DIQ Q
42NOAP2 W !,"but no letter is assigned to the clinic" Q
43 S Y=SDAP D DT^DIQ W ! Q
44 Q
45CHK S DFN=SDPT D DEM^VADPT I VADM(6) D KVAR^VADPT Q
46 S SDBAD=$$BADADR^DGUTL3(SDPT) I SDBAD S ^TMP($J,"BADADD",$P(^DPT(+SDPT,0),"^"),+SDPT)="" Q
47 D CAN:$D(^DPT("ASDCN",SDC,SDX,SDPT)),KVAR^VADPT Q
48CHK1 S SDOK=0 I '$D(^SC(+SDAP,"S",SDX)) Q
49 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
50 Q
Note: See TracBrowser for help on using the repository browser.