source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SDREACT.m@ 1766

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

initial load of WorldVistAEHR

File size: 3.8 KB
Line 
1SDREACT ;ALB/TMP - REACTIVATE A CLINIC ; 30 APR 85 9:02 am
2 ;;5.3;Scheduling;**63,167,380**;Aug 13, 1993
3 S:'$D(DTIME) DTIME=300 I '$D(DT) D DT^SDUTL
4 S DIC="^SC(",DIC(0)="AEMZQ",DIC("A")="Select CLINIC NAME: ",DIC("S")="I $P(^(0),""^"",3)=""C"",'$G(^(""OOS""))"
5 D ^DIC K DIC G:Y<0 END S DA=+Y I $S('$D(^SC(DA,"I")):1,'$P(^("I"),"^",1):1,1:0) W *7,!,"NOT INACTIVE!!" G SDREACT
6 S SDX=+^SC(DA,"I"),SDX1=+$P(^("I"),"^",2) G:'SDX1 PREACT
7 I SDX1>DT W !,*7,"Clinic is inactive as of " S Y=SDX D DTS^SDUTL W Y S Y=SDX1 D DTS^SDUTL W !,?5,"and is already scheduled to be reactivated as of ",Y G CHG
8 W *7,!,"Clinic cannot be reactivated - not inactive" G SDREACT
9PREACT N SDRES S SDRES=$$CLNCK^SDUTL2(DA,1)
10 I 'SDRES W !,?5,"Clinic MUST be corrected before continuing." G SDREACT
11REACT S SDREACT="" S %DT("A")="Enter date clinic is to be reactivated: ",%DT="AEX" D ^%DT G:Y<0 SDREACT
12 K %DT S (SD,SDH,SDRE)=Y,(SDINACT,SDIN)=SDX
13 I SD'>SDINACT W !,*7,"Reactivate date must be later than inactivate date" G REACT
14 G:'$D(^SC(DA,"SL")) SDREACT S SL=^("SL"),X=$P(^("SL"),"^",3),STARTDAY=$S($L(X):X,1:8),SI=$P(^("SL"),"^",6),SDFSW="",X=SD,SDRE1=SDRE D DOW^SDM0 S DOW=Y
15 S Y=SD D DTS^SDUTL W !!,"AVAILABILITY DATE: ",Y," (" S Y=SD D DT^DIQ W ")" S (SDZQ,SDEL,POP)=0 D EN1^SDB0
16 I '$D(SDREACT) W *7,!,"Clinic not reactivated!!!" G END
17 F I=0:1:6 F I1=0:0 S I1=$O(^SC(DA,"T"_I,I1)),I2=$S(I1'>0:0,'$D(^(I1,1)):0,^(1)]"":1,1:0) Q:I2 I I1'>0 D CLEAN Q
18 S $P(^SC(DA,"I"),"^",2)=SDH,Y=SDH D DTS^SDUTL W !,*7,"Clinic will be reactivated effective ",Y
19MORE W !,"Do you want to set up additional availabilities for this clinic now" S %=1 D YN^DICN I '% W !,"ANSWER (Y)ES OR (N)O" G MORE
20 G:(%-1)!(%<0) END S SDZQ=1 G EN^SDB
21 ;
22CHG W !,"Do you want to change the reactivate date" S %=1 D YN^DICN I '% W !,"RESPOND YES (Y) OR NO (N)" G CHG
23 G END:(%<0),DEL:(%-1)
24DT R !,"Enter new reactivate date: ",X:DTIME G:"^"[X END S %DT="EX" D ^%DT G:Y<0 DT
25 I Y'>SDX W *7,!,"Must be > inactivate date" G DT
26 I Y=SDX1 W *7,!,"That is the current reactivate date" G DT
27 S SDRE=+Y
28 S POP=0 I SDRE>SDX1 S K=SDRE_.9 F I=SDX1-.1:0 S I=$O(^SC(DA,"S",I)) Q:I'>0!(I>K) F J=0:0 S J=$O(^SC(DA,"S",I,1,J)) Q:J'>0 I $P(^(J,0),"^",9)'["C" S POP=1 Q
29 I POP W !,"Valid appointments exist before the new reactivate date ... must reactivate before " S Y=I D DTS^SDUTL W Y G REACT
30 K SDN S X=SDRE D NEW
31 K SDO S X=SDX1 D DOW^SDM0 S SDO(Y)=X F I=1:1:6 S X1=X,X2=1 D C^%DTC,DOW^SDM0 S SDO(Y)=X
32 I SDRE>SDX1 D C1
33 F I=0:1:6 I $D(^SC(DA,"T"_I,SDO(I),1)) S ^SC(DA,"T"_I,SDN(I),1)=^SC(DA,"T"_I,SDO(I),1),^(0)=SDN(I) I SDN(I)'=SDO(I) K ^SC(DA,"T"_I,SDO(I))
34 S $P(^SC(DA,"I"),"^",2)=SDRE W !,"Clinic will now be reactivated effective " S Y=SDRE D DTS^SDUTL W Y G END
35C1 F I=SDX-.1:0 S I=$O(^SC(DA,"ST",I)) Q:I'>0!(I'<SDRE) K ^(I)
36 F I=SDX-.1:0 S I=$O(^SC(DA,"T",I)) Q:I'>0!(I'<SDRE) K ^(I)
37 F I=SDX-.1:0 S I=$O(^SC(DA,"OST",I)) Q:I'>0!(I'<SDRE) K ^(I)
38 Q
39DEL S POP=0 F I=SDX1-.1:0 S I=$O(^SC(DA,"S",I)) Q:I'>0 F J=0:0 S J=$O(^SC(DA,"S",I,1,J)) Q:J'>0 I $P(^(J,0),"^",9)'["C" S POP=1 Q
40 G:POP END
41D1 S %=2 W !,"Do you want to delete the reactivate date" D YN^DICN I '% W !,"RESPOND YES (Y) OR NO (N)" G D1
42 G END:(%-1)
43 F I=SDX1-.1:0 S I=$O(^SC(DA,"T",I)) Q:I'>0 K ^(I)
44 K SDN S X=SDX D NEW
45 F I=0:1:6 F J=SDN(I):0 S J=$O(^SC(DA,"T"_I,J)) S:J'>0 ^SC(DA,"T"_I,9999999,1)="",^(0)=9999999 Q:J'>0 K:J'=9999999 ^SC(DA,"T"_I,J) I J=9999999 S ^SC(DA,"T"_I,J,1)="",^(0)=J Q
46 F I=SDX1-.1:0 S I=$O(^SC(DA,"OST",I)) Q:I'>0 K ^(I)
47 F I=SDX1-.1:0 S I=$O(^SC(DA,"ST",I)) Q:I'>0 K ^(I)
48 S ^SC(DA,"I")=SDX
49 W !,*7,"Reactivation date DELETED!!" G END
50 ;
51NEW D DOW^SDM0 S SDN(Y)=X F I=1:1:6 S X1=X,X2=1 D C^%DTC,DOW^SDM0 S SDN(Y)=X
52 Q
53CLEAN F I2=0:0 S I2=$O(^SC(DA,"T"_I,I2)) Q:I2'>0 K ^(I2)
54 Q
55 ;
56END K CNT,D0,DA,DIC,DH,DO,DOW,H1,H2,HSDX,SDX1,SDZQ,SI,I,I1,I2,J,K,LT,M1,M2,NSL,POP,SC,SD,SDH,SDFSW,SDIN,SDINACT,SDN,SDO,SDRE,SDRE1,SDREACT,SDTOP,SI,SL,SLT,STARTDAY,STIME,T1,T2,X,X1,X2,Y Q
Note: See TracBrowser for help on using the repository browser.