source: FOIAVistA/tag/r/SCHEDULING-SD-SC/SDCD.m@ 1796

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

initial load of FOIAVistA 6/30/08 version

File size: 2.2 KB
Line 
1SDCD ;BSN/GRR - DISCHARGE PATIENT FROM CLINIC ;3/15/91 11:24 ;
2 ;;5.3;Scheduling;**41,148**;AUG 13, 1993
315 D:'$D(DT) DT^SDUTL I '$G(SDFN) S DIC="^DPT(",DIC(0)="AEQM" D ^DIC G:Y=-1 QUIT
4 S:$G(SDFN) Y=+SDFN S DA(2)=+Y
5 I '$G(SDCLN) G:'$D(^DPT(+Y,"DE")) NOPE S DIC="^DPT("_DA(2)_",""DE"",",DIC("S")="I $P(^(0),""^"",2)']""""",VAUTSTR="clinic",VAUTNI=2,VAUTVB="VAUTC" D FIRST^VAUTOMA K DIC("S") Q:Y<0
6 I $G(SDCLN) D G QUIT:'$O(VAUTC(0))
7 .S VAUTC=0,VAUTC(+$O(^DPT(DA(2),"DE","B",+SDCLN,99999),-1))=+SDCLN
8 .I '$O(VAUTC(0)) W !!,*7,">>> Patient not enrolled in '",$S($D(^SC(+SDCLN,0)):$P(^(0),"^"),1:"Unknown"),"' clinic." S SDAMERR=1
9 I VAUTC=1 F I=0:0 S I=$O(^DPT(DA(2),"DE",I)) Q:'I S CLINIC=^DPT(DA(2),"DE",I,0) I $P(CLINIC,U,2)']"" S VAUTC(I)=+CLINIC
10 D BEFORE^SCMCEV3(DA(2)) ;setup before values
11 F I=0:0 S I=$O(VAUTC(I)) Q:'I S DA(1)=I,SC=VAUTC(I) D DIS
12 I '$O(VAUTC(0)) W !!,*7,">>> Patient is not actively enrolled in any clinics." S SDAMERR=1
13 I '$D(SDAMERR) D AFTER^SCMCEV3(DA(2)) ;setup after values
14 ;call team event driver
15 I '$D(SDAMERR) D INVOKE^SCMCEV3(DA(2))
16 G 15:'$G(SDFN)
17QUIT ;
18 K CLINIC,DFN,SC,SDF,SDST,VAUTC,VAUTD,VAUTNI,VAUSTR,VAUTVB,DIC
19 Q
20DIS ;
21 S SDF=0
22 I $P(^DPT(DA(2),"DE",DA(1),0),"^",2)]"" W *7,*7,!,"PATIENT ALREADY DISCHARGED FROM '",$S($D(^SC(SC,0)):$P(^(0),U),1:"UNKNOWN"),"' CLINIC",*7,*7 S SDAMERR=1 Q
23 W !!,"***Discharging patient from ",$S($D(^SC(SC,0)):$P(^(0),U),1:"UNKNOWN")," Clinic***",!
24 F XX=DT_.2359:0 S XX=$O(^DPT(DA(2),"S",XX)) Q:XX'>0 I $P(^(XX,0),"^",1)=SC,$P(^(0),"^",2)=""!($P(^(0),"^",2)="I") W !?10,*7,"PATIENT HAS FUTURE APPOINTMENT(S) IN THIS CLINIC" S SDF=1
25 I 'SDF F XX=0:0 S XX=$O(^DPT(DA(2),"DE",DA(1),1,XX)) Q:XX="" D STAT I SDST']"" S DIE="^DPT("_DA(2)_",""DE"","_DA(1)_",1,",DA=XX,DR="3"_$S($G(SCDISCH):"///"_SCDISCH,1:"")_";I 'X S Y=0;I X S XD=1;4" D ^DIE
26 W !,*7,"Patient ",$S('$D(XD):"NOT ",XD=2:"ALREADY ",1:""),"Discharged from clinic !!",! S:SDF SDF=0,SDAMERR=1 K XD
27 Q
28NOPE W !,*7,"PATIENT NOT ENROLLED IN ANY CLINICS!!" G QUIT:$G(SDFN),15
29STAT ;ck if already discharged
30 S SDST=$P(^DPT(DA(2),"DE",DA(1),1,XX,0),U,3) Q:SDST']""
31 S DIE="^DPT("_DA(2)_",""DE"","_DA(1)_",1,",DA=XX,DR="3////^S X=SDST"
32 L @(DIE_XX_")"):2 G:'$T STAT D ^DIE L S:'$D(XD) XD=2 Q
Note: See TracBrowser for help on using the repository browser.