SDNACT1 ;ALB/TMP - Inactivate a Clinic (continued) ; 30 APR 85 9:02 am
;;5.3;Scheduling;**167,781**;Aug 13, 1993;Build 11
;
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
R I 'SD0 S SD=SDX G SEL
S Y=$S(SDX1:SDX1,1:SDX) D D^DIQ
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
S SDREACT="" G:%<0 END^SDNACT I (%-1) S SD=SDX G SEL
F I=0:1:6 I $D(SDN(I,1)) D D1
S SD=$S(SDX1:SDX1,1:SDX) D SET
D G1^SDB G DD
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
Q:(%-1) S SDREACT=1 I SDX1 Q:$O(^SC(SC,"T"_I,0))=SDN(I) K ^SC(SC,"T"_I,SDN(I)) Q
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))
Q
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),!
W !! Q
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
S SDH1=$S($D(SDIN):SDIN,1:""),SDH2=$S($D(SDRE):SDRE,1:"") K SDINH,SDIN,SDRE
D EN1^SDB0 S SDRE=SDH2,SDIN=SDH1 K SDH1,SDH2,CNT,D0,DH,DO,H1,H2,HSI,LT,M1,M2,NSL
DD I $S('$D(SDREACT):1,1:0) W *7,!,"Inactivation date not deleted" G END^SDNACT
D SDEC(SC) ;lab 781
K ^SC(SC,"I") W !,*7,"Inactivation date deleted" G END^SDNACT
;
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
Q
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
K SDZ Q
SDEC(SC) ;remove inactivation and reactivation date from SDEC RESOURCE (lab 781)
N SDFDA,SDI,SDJ,SDRES,SDREACT
S SDRES=$$GETRES^SDECUTL(SC,1) ;lab 781 need, "1" sent to assign resource
Q:SDRES=""
S SDFDA(409.831,SDRES_",",.021)="@"
S SDFDA(409.831,SDRES_",",.022)="@"
S SDFDA(409.831,SDRES_",",.025)="@"
S SDFDA(409.831,SDRES_",",.026)="@"
D FILE^DIE("","SDFDA")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDNACT1 2233 printed Dec 13, 2024@02:58:52 Page 2
SDNACT1 ;ALB/TMP - Inactivate a Clinic (continued) ; 30 APR 85 9:02 am
+1 ;;5.3;Scheduling;**167,781**;Aug 13, 1993;Build 11
+2 ;
+3 SET SDREACT=""
SET SD0=0
SET X=$SELECT(SDX1:SDX1,1:SDX)
DO DOW^SDM0
SET SDN(Y)=X
DO PAT
FOR I=1:1:6
SET X1=X
SET X2=1
DO C^%DTC
DO DOW^SDM0
SET SDN(Y)=X
DO PAT
R IF 'SD0
SET SD=SDX
GOTO SEL
+1 SET Y=$SELECT(SDX1:SDX1,1:SDX)
DO D^DIQ
+2 WRITE !,"Do you want to restore to the existing patterns from the ",$SELECT(SDX1:"re",1:"in"),"activate date ",Y
SET %=2
DO YN^DICN
IF '%
DO LIST
GOTO R
+3 SET SDREACT=""
if %<0
GOTO END^SDNACT
IF (%-1)
SET SD=SDX
GOTO SEL
+4 FOR I=0:1:6
IF $DATA(SDN(I,1))
DO D1
+5 SET SD=$SELECT(SDX1:SDX1,1:SDX)
DO SET
+6 DO G1^SDB
GOTO DD
D1 WRITE !!,"Do you want to restore this pattern ",!,SDN(I,1),!,?7,"for ",$PIECE(SDAY,"^",I+1),"days "
SET Y=SDN(I)
DO D^DIQ
WRITE "from ",Y
SET %=1
DO YN^DICN
IF '%
WRITE !,"RESPOND YES (Y) OR NO (N)"
GOTO D1
+1 if (%-1)
QUIT
SET SDREACT=1
IF SDX1
if $ORDER(^SC(SC,"T"_I,0))=SDN(I)
QUIT
KILL ^SC(SC,"T"_I,SDN(I))
QUIT
+2 SET SD=$ORDER(^SC(SC,"T"_I,SDN(I)))
if SD'>0
QUIT
SET ^SC(SC,"T"_I,SD,1)=SDN(I,1)
SET ^(0)=SD
KILL ^SC(SC,"T"_I,SDN(I))
+3 QUIT
LIST WRITE !!!,"EXISTING PATTERNS: ",!
FOR A=0:1:6
IF $DATA(SDN(A,1))
WRITE !,$PIECE(SDAY,"^",A+1),"day "
SET Y=SDN(A)
DO DT^DIQ
WRITE " : ",!,SDN(A,1),!
+1 WRITE !!
QUIT
SEL WRITE !!,"AVAILABILITY DATE: ",$EXTRACT(SDX,4,5),"-",$EXTRACT(SDX,6,7),"-",$EXTRACT(SDX,2,3)," ("
SET Y=SDX
DO DT^DIQ
WRITE ")"
DO SET
+1 SET SDH1=$SELECT($DATA(SDIN):SDIN,1:"")
SET SDH2=$SELECT($DATA(SDRE):SDRE,1:"")
KILL SDINH,SDIN,SDRE
+2 DO EN1^SDB0
SET SDRE=SDH2
SET SDIN=SDH1
KILL SDH1,SDH2,CNT,D0,DH,DO,H1,H2,HSI,LT,M1,M2,NSL
DD IF $SELECT('$DATA(SDREACT):1,1:0)
WRITE *7,!,"Inactivation date not deleted"
GOTO END^SDNACT
+1 ;lab 781
DO SDEC(SC)
+2 KILL ^SC(SC,"I")
WRITE !,*7,"Inactivation date deleted"
GOTO END^SDNACT
+3 ;
SET SET (POP,SDEL)=0
SET DA=SC
SET SL=^SC(SC,"SL")
SET X=$PIECE(^("SL"),"^",3)
SET STARTDAY=$SELECT($LENGTH(X):X,1:8)
SET SI=$PIECE(^("SL"),"^",6)
SET SDFSW=""
SET X=SD
SET D0=SD
DO DOW^SDM0
SET DOW=Y
+1 QUIT
PAT IF $DATA(^SC(SC,"T"_Y,X,1))
SET SDZ=$SELECT(SDX1:+$ORDER(^SC(SC,"T"_Y,X)),1:X)
IF SDZ>0
IF $DATA(^SC(SC,"T"_Y,SDZ,1))
IF ^(1)]""
SET SDN(Y,1)=^(1)
if 'SD0
SET SD0=1
+1 KILL SDZ
QUIT
SDEC(SC) ;remove inactivation and reactivation date from SDEC RESOURCE (lab 781)
+1 NEW SDFDA,SDI,SDJ,SDRES,SDREACT
+2 ;lab 781 need, "1" sent to assign resource
SET SDRES=$$GETRES^SDECUTL(SC,1)
+3 if SDRES=""
QUIT
+4 SET SDFDA(409.831,SDRES_",",.021)="@"
+5 SET SDFDA(409.831,SDRES_",",.022)="@"
+6 SET SDFDA(409.831,SDRES_",",.025)="@"
+7 SET SDFDA(409.831,SDRES_",",.026)="@"
+8 DO FILE^DIE("","SDFDA")
+9 QUIT
