Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SDNACT1

SDNACT1.m

Go to the documentation of this file.
  1. SDNACT1 ;ALB/TMP - Inactivate a Clinic (continued) ; 30 APR 85 9:02 am
  1. ;;5.3;Scheduling;**167,781**;Aug 13, 1993;Build 11
  1. ;
  1. 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
  1. R I 'SD0 S SD=SDX G SEL
  1. S Y=$S(SDX1:SDX1,1:SDX) D D^DIQ
  1. 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
  1. S SDREACT="" G:%<0 END^SDNACT I (%-1) S SD=SDX G SEL
  1. F I=0:1:6 I $D(SDN(I,1)) D D1
  1. S SD=$S(SDX1:SDX1,1:SDX) D SET
  1. D G1^SDB G DD
  1. D1 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
  1. Q:(%-1) S SDREACT=1 I SDX1 Q:$O(^SC(SC,"T"_I,0))=SDN(I) K ^SC(SC,"T"_I,SDN(I)) Q
  1. 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))
  1. Q
  1. LIST 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),!
  1. W !! Q
  1. SEL W !!,"AVAILABILITY DATE: ",$E(SDX,4,5),"-",$E(SDX,6,7),"-",$E(SDX,2,3)," (" S Y=SDX D DT^DIQ W ")" D SET
  1. S SDH1=$S($D(SDIN):SDIN,1:""),SDH2=$S($D(SDRE):SDRE,1:"") K SDINH,SDIN,SDRE
  1. D EN1^SDB0 S SDRE=SDH2,SDIN=SDH1 K SDH1,SDH2,CNT,D0,DH,DO,H1,H2,HSI,LT,M1,M2,NSL
  1. DD I $S('$D(SDREACT):1,1:0) W *7,!,"Inactivation date not deleted" G END^SDNACT
  1. D SDEC(SC) ;lab 781
  1. K ^SC(SC,"I") W !,*7,"Inactivation date deleted" G END^SDNACT
  1. ;
  1. SET 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
  1. Q
  1. PAT 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
  1. K SDZ Q
  1. SDEC(SC) ;remove inactivation and reactivation date from SDEC RESOURCE (lab 781)
  1. N SDFDA,SDI,SDJ,SDRES,SDREACT
  1. S SDRES=$$GETRES^SDECUTL(SC,1) ;lab 781 need, "1" sent to assign resource
  1. Q:SDRES=""
  1. S SDFDA(409.831,SDRES_",",.021)="@"
  1. S SDFDA(409.831,SDRES_",",.022)="@"
  1. S SDFDA(409.831,SDRES_",",.025)="@"
  1. S SDFDA(409.831,SDRES_",",.026)="@"
  1. D FILE^DIE("","SDFDA")
  1. Q