source: FOIAVistA/tag/r/SCHEDULING-SD-SC/SDNACT1.m@ 636

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

initial load of FOIAVistA 6/30/08 version

File size: 1.7 KB
Line 
1SDNACT1 ;ALB/TMP - Inactivate a Clinic (continued) ; 30 APR 85 9:02 am
2 ;;5.3;Scheduling;**167**;Aug 13, 1993
3 S SDREACT="",SD0=0,X=$S(SDX1:SDX1,1:SDX) D DOW^SDM0 S SDN(Y)=X D PAT F I=1:1:6 S X1=X,X2=1 D C^%DTC,DOW^SDM0 S SDN(Y)=X D PAT
4R I 'SD0 S SD=SDX G SEL
5 S Y=$S(SDX1:SDX1,1:SDX) D D^DIQ
6 W !,"Do you want to restore to the existing patterns from the ",$S(SDX1:"re",1:"in"),"activate date ",Y S %=2 D YN^DICN I '% D LIST G R
7 S SDREACT="" G:%<0 END^SDNACT I (%-1) S SD=SDX G SEL
8 F I=0:1:6 I $D(SDN(I,1)) D D1
9 S SD=$S(SDX1:SDX1,1:SDX) D SET
10 D G1^SDB G DD
11D1 W !!,"Do you want to restore this pattern ",!,SDN(I,1),!,?7,"for ",$P(SDAY,"^",I+1),"days " S Y=SDN(I) D D^DIQ W "from ",Y S %=1 D YN^DICN I '% W !,"RESPOND YES (Y) OR NO (N)" G D1
12 Q:(%-1) S SDREACT=1 I SDX1 Q:$O(^SC(SC,"T"_I,0))=SDN(I) K ^SC(SC,"T"_I,SDN(I)) Q
13 S SD=$O(^SC(SC,"T"_I,SDN(I))) Q:SD'>0 S ^SC(SC,"T"_I,SD,1)=SDN(I,1),^(0)=SD K ^SC(SC,"T"_I,SDN(I))
14 Q
15LIST W !!!,"EXISTING PATTERNS: ",! F A=0:1:6 I $D(SDN(A,1)) W !,$P(SDAY,"^",A+1),"day " S Y=SDN(A) D DT^DIQ W " : ",!,SDN(A,1),!
16 W !! Q
17SEL W !!,"AVAILABILITY DATE: ",$E(SDX,4,5),"-",$E(SDX,6,7),"-",$E(SDX,2,3)," (" S Y=SDX D DT^DIQ W ")" D SET
18 S SDH1=$S($D(SDIN):SDIN,1:""),SDH2=$S($D(SDRE):SDRE,1:"") K SDINH,SDIN,SDRE
19 D EN1^SDB0 S SDRE=SDH2,SDIN=SDH1 K SDH1,SDH2,CNT,D0,DH,DO,H1,H2,HSI,LT,M1,M2,NSL
20DD I $S('$D(SDREACT):1,1:0) W *7,!,"Inactivation date not deleted" G END^SDNACT
21 K ^SC(SC,"I") W !,*7,"Inactivation date deleted" G END^SDNACT
22 ;
23SET S (POP,SDEL)=0,DA=SC,SL=^SC(SC,"SL"),X=$P(^("SL"),"^",3),STARTDAY=$S($L(X):X,1:8),SI=$P(^("SL"),"^",6),SDFSW="",X=SD,D0=SD D DOW^SDM0 S DOW=Y
24 Q
25PAT I $D(^SC(SC,"T"_Y,X,1)) S SDZ=$S(SDX1:+$O(^SC(SC,"T"_Y,X)),1:X) I SDZ>0,$D(^SC(SC,"T"_Y,SDZ,1)),^(1)]"" S SDN(Y,1)=^(1) S:'SD0 SD0=1
26 K SDZ Q
Note: See TracBrowser for help on using the repository browser.