SDREACT ;ALB/TMP - REACTIVATE A CLINIC ;JAN 15, 2016
;;5.3;Scheduling;**63,167,380,568,627,781**;Aug 13, 1993;Build 11
S:'$D(DTIME) DTIME=300 I '$D(DT) D DT^SDUTL
S DIC="^SC(",DIC(0)="AEMZQ",DIC("A")="Select CLINIC NAME: ",DIC("S")="I $P(^(0),""^"",3)=""C"",'$G(^(""OOS""))"
D TURNON^DIAUTL(44,".01;8;2502;2503;2505;2506")
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
S SDX=+^SC(DA,"I"),SDX1=+$P(^("I"),"^",2) G:'SDX1 PREACT
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
W *7,!,"Clinic cannot be reactivated - not inactive" G SDREACT
PREACT N SDRES S SDRES=$$CLNCK^SDUTL2(DA,1)
I 'SDRES W !,?5,"Clinic MUST be corrected before continuing." G SDREACT
REACT S SDREACT="" S %DT("A")="Enter date clinic is to be reactivated: ",%DT="AEX" D ^%DT G:Y<0 SDREACT
K %DT S (SD,SDH,SDRE)=Y,(SDINACT,SDIN)=SDX
I SD'>SDINACT W !,*7,"Reactivate date must be later than inactivate date" G REACT
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
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
I '$D(SDREACT) W *7,!,"Clinic not reactivated!!!" G END
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
K IENS,FDA S IENS=DA_",",FDA(44,IENS,2506)=SDH D FILE^DIE("","FDA")
D SDEC(DA,SDH) ;alb/sat 627
S Y=SDH D DTS^SDUTL W !,*7,"Clinic will be reactivated effective ",Y
MORE 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
G:(%-1)!(%<0) END S SDZQ=1 G EN^SDB
;
CHG W !,"Do you want to change the reactivate date" S %=1 D YN^DICN I '% W !,"RESPOND YES (Y) OR NO (N)" G CHG
G END:(%<0),DEL:(%-1)
DT R !,"Enter new reactivate date: ",X:DTIME G:"^"[X END S %DT="EX" D ^%DT G:Y<0 DT
I Y'>SDX W *7,!,"Must be > inactivate date" G DT
I Y=SDX1 W *7,!,"That is the current reactivate date" G DT
S SDRE=+Y
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
I POP W !,"Valid appointments exist before the new reactivate date ... must reactivate before " S Y=I D DTS^SDUTL W Y G REACT
K SDN S X=SDRE D NEW
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
I SDRE>SDX1 D C1
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))
K IENS,FDA S IENS=DA_",",FDA(44,IENS,2506)=SDRE D FILE^DIE("","FDA")
D SDEC(DA,SDRE) ;lab 781 update 409.831
W !,"Clinic will now be reactivated effective " S Y=SDRE D DTS^SDUTL W Y G END
C1 F I=SDX-.1:0 S I=$O(^SC(DA,"ST",I)) Q:I'>0!(I'<SDRE) K ^(I)
F I=SDX-.1:0 S I=$O(^SC(DA,"T",I)) Q:I'>0!(I'<SDRE) K ^(I)
F I=SDX-.1:0 S I=$O(^SC(DA,"OST",I)) Q:I'>0!(I'<SDRE) K ^(I)
Q
DEL 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
G:POP END
D1 S %=2 W !,"Do you want to delete the reactivate date" D YN^DICN I '% W !,"RESPOND YES (Y) OR NO (N)" G D1
G END:(%-1)
F I=SDX1-.1:0 S I=$O(^SC(DA,"T",I)) Q:I'>0 K ^(I)
K SDN S X=SDX D NEW
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
F I=SDX1-.1:0 S I=$O(^SC(DA,"OST",I)) Q:I'>0 K ^(I)
F I=SDX1-.1:0 S I=$O(^SC(DA,"ST",I)) Q:I'>0 K ^(I)
K IENS,FDA S IENS=DA_",",FDA(44,IENS,2506)="@" D FILE^DIE("","FDA")
D DELSDEC(DA) ;lab 781
W !,*7,"Reactivation date DELETED!!" G END
;
NEW 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
Q
CLEAN F I2=0:0 S I2=$O(^SC(DA,"T"_I,I2)) Q:I2'>0 K ^(I2)
Q
;
END 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
;
SDEC(SC,SDDATE) ;update REACTIVATED DATE/TIME in SDEC RESOURCE ;alb/sat 627
N SDFDA,SDRES
S SDRES=$$GETRES^SDECUTL(SC,1)
Q:SDRES=""
S SDFDA(409.831,SDRES_",",.025)=SDDATE
S SDFDA(409.831,SDRES_",",.026)=DUZ
D FILE^DIE("","SDFDA") ;lab 781 - changed update to
Q
DELSDEC(SC) ;delete reactavation date (lab 781)
N SDFDA,SDRES
S SDRES=$$GETRES^SDECUTL(SC,1)
Q:SDRES=""
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[HSDREACT 4772 printed Apr 09, 2024@21:50:43 Page 2
SDREACT ;ALB/TMP - REACTIVATE A CLINIC ;JAN 15, 2016
+1 ;;5.3;Scheduling;**63,167,380,568,627,781**;Aug 13, 1993;Build 11
+2 if '$DATA(DTIME)
SET DTIME=300
IF '$DATA(DT)
DO DT^SDUTL
+3 SET DIC="^SC("
SET DIC(0)="AEMZQ"
SET DIC("A")="Select CLINIC NAME: "
SET DIC("S")="I $P(^(0),""^"",3)=""C"",'$G(^(""OOS""))"
+4 DO TURNON^DIAUTL(44,".01;8;2502;2503;2505;2506")
+5 DO ^DIC
KILL DIC
if Y<0
GOTO END
SET DA=+Y
IF $SELECT('$DATA(^SC(DA,"I")):1,'$PIECE(^("I"),"^",1):1,1:0)
WRITE *7,!,"NOT INACTIVE!!"
GOTO SDREACT
+6 SET SDX=+^SC(DA,"I")
SET SDX1=+$PIECE(^("I"),"^",2)
if 'SDX1
GOTO PREACT
+7 IF SDX1>DT
WRITE !,*7,"Clinic is inactive as of "
SET Y=SDX
DO DTS^SDUTL
WRITE Y
SET Y=SDX1
DO DTS^SDUTL
WRITE !,?5,"and is already scheduled to be reactivated as of ",Y
GOTO CHG
+8 WRITE *7,!,"Clinic cannot be reactivated - not inactive"
GOTO SDREACT
PREACT NEW SDRES
SET SDRES=$$CLNCK^SDUTL2(DA,1)
+1 IF 'SDRES
WRITE !,?5,"Clinic MUST be corrected before continuing."
GOTO SDREACT
REACT SET SDREACT=""
SET %DT("A")="Enter date clinic is to be reactivated: "
SET %DT="AEX"
DO ^%DT
if Y<0
GOTO SDREACT
+1 KILL %DT
SET (SD,SDH,SDRE)=Y
SET (SDINACT,SDIN)=SDX
+2 IF SD'>SDINACT
WRITE !,*7,"Reactivate date must be later than inactivate date"
GOTO REACT
+3 if '$DATA(^SC(DA,"SL"))
GOTO SDREACT
SET SL=^("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 SDRE1=SDRE
DO DOW^SDM0
SET DOW=Y
+4 SET Y=SD
DO DTS^SDUTL
WRITE !!,"AVAILABILITY DATE: ",Y," ("
SET Y=SD
DO DT^DIQ
WRITE ")"
SET (SDZQ,SDEL,POP)=0
DO EN1^SDB0
+5 IF '$DATA(SDREACT)
WRITE *7,!,"Clinic not reactivated!!!"
GOTO END
+6 FOR I=0:1:6
FOR I1=0:0
SET I1=$ORDER(^SC(DA,"T"_I,I1))
SET I2=$SELECT(I1'>0:0,'$DATA(^(I1,1)):0,^(1)]"":1,1:0)
if I2
QUIT
IF I1'>0
DO CLEAN
QUIT
+7 KILL IENS,FDA
SET IENS=DA_","
SET FDA(44,IENS,2506)=SDH
DO FILE^DIE("","FDA")
+8 ;alb/sat 627
DO SDEC(DA,SDH)
+9 SET Y=SDH
DO DTS^SDUTL
WRITE !,*7,"Clinic will be reactivated effective ",Y
MORE WRITE !,"Do you want to set up additional availabilities for this clinic now"
SET %=1
DO YN^DICN
IF '%
WRITE !,"ANSWER (Y)ES OR (N)O"
GOTO MORE
+1 if (%-1)!(%<0)
GOTO END
SET SDZQ=1
GOTO EN^SDB
+2 ;
CHG WRITE !,"Do you want to change the reactivate date"
SET %=1
DO YN^DICN
IF '%
WRITE !,"RESPOND YES (Y) OR NO (N)"
GOTO CHG
+1 if (%<0)
GOTO END
if (%-1)
GOTO DEL
DT READ !,"Enter new reactivate date: ",X:DTIME
if "^"[X
GOTO END
SET %DT="EX"
DO ^%DT
if Y<0
GOTO DT
+1 IF Y'>SDX
WRITE *7,!,"Must be > inactivate date"
GOTO DT
+2 IF Y=SDX1
WRITE *7,!,"That is the current reactivate date"
GOTO DT
+3 SET SDRE=+Y
+4 SET POP=0
IF SDRE>SDX1
SET K=SDRE_.9
FOR I=SDX1-.1:0
SET I=$ORDER(^SC(DA,"S",I))
if I'>0!(I>K)
QUIT
FOR J=0:0
SET J=$ORDER(^SC(DA,"S",I,1,J))
if J'>0
QUIT
IF $PIECE(^(J,0),"^",9)'["C"
SET POP=1
QUIT
+5 IF POP
WRITE !,"Valid appointments exist before the new reactivate date ... must reactivate before "
SET Y=I
DO DTS^SDUTL
WRITE Y
GOTO REACT
+6 KILL SDN
SET X=SDRE
DO NEW
+7 KILL SDO
SET X=SDX1
DO DOW^SDM0
SET SDO(Y)=X
FOR I=1:1:6
SET X1=X
SET X2=1
DO C^%DTC
DO DOW^SDM0
SET SDO(Y)=X
+8 IF SDRE>SDX1
DO C1
+9 FOR I=0:1:6
IF $DATA(^SC(DA,"T"_I,SDO(I),1))
SET ^SC(DA,"T"_I,SDN(I),1)=^SC(DA,"T"_I,SDO(I),1)
SET ^(0)=SDN(I)
IF SDN(I)'=SDO(I)
KILL ^SC(DA,"T"_I,SDO(I))
+10 KILL IENS,FDA
SET IENS=DA_","
SET FDA(44,IENS,2506)=SDRE
DO FILE^DIE("","FDA")
+11 ;lab 781 update 409.831
DO SDEC(DA,SDRE)
+12 WRITE !,"Clinic will now be reactivated effective "
SET Y=SDRE
DO DTS^SDUTL
WRITE Y
GOTO END
C1 FOR I=SDX-.1:0
SET I=$ORDER(^SC(DA,"ST",I))
if I'>0!(I'<SDRE)
QUIT
KILL ^(I)
+1 FOR I=SDX-.1:0
SET I=$ORDER(^SC(DA,"T",I))
if I'>0!(I'<SDRE)
QUIT
KILL ^(I)
+2 FOR I=SDX-.1:0
SET I=$ORDER(^SC(DA,"OST",I))
if I'>0!(I'<SDRE)
QUIT
KILL ^(I)
+3 QUIT
DEL SET POP=0
FOR I=SDX1-.1:0
SET I=$ORDER(^SC(DA,"S",I))
if I'>0
QUIT
FOR J=0:0
SET J=$ORDER(^SC(DA,"S",I,1,J))
if J'>0
QUIT
IF $PIECE(^(J,0),"^",9)'["C"
SET POP=1
QUIT
+1 if POP
GOTO END
D1 SET %=2
WRITE !,"Do you want to delete the reactivate date"
DO YN^DICN
IF '%
WRITE !,"RESPOND YES (Y) OR NO (N)"
GOTO D1
+1 if (%-1)
GOTO END
+2 FOR I=SDX1-.1:0
SET I=$ORDER(^SC(DA,"T",I))
if I'>0
QUIT
KILL ^(I)
+3 KILL SDN
SET X=SDX
DO NEW
+4 FOR I=0:1:6
FOR J=SDN(I):0
SET J=$ORDER(^SC(DA,"T"_I,J))
if J'>0
SET ^SC(DA,"T"_I,9999999,1)=""
SET ^(0)=9999999
if J'>0
QUIT
if J'=9999999
KILL ^SC(DA,"T"_I,J)
IF J=9999999
SET ^SC(DA,"T"_I,J,1)=""
SET ^(0)=J
QUIT
+5 FOR I=SDX1-.1:0
SET I=$ORDER(^SC(DA,"OST",I))
if I'>0
QUIT
KILL ^(I)
+6 FOR I=SDX1-.1:0
SET I=$ORDER(^SC(DA,"ST",I))
if I'>0
QUIT
KILL ^(I)
+7 KILL IENS,FDA
SET IENS=DA_","
SET FDA(44,IENS,2506)="@"
DO FILE^DIE("","FDA")
+8 ;lab 781
DO DELSDEC(DA)
+9 WRITE !,*7,"Reactivation date DELETED!!"
GOTO END
+10 ;
NEW DO DOW^SDM0
SET SDN(Y)=X
FOR I=1:1:6
SET X1=X
SET X2=1
DO C^%DTC
DO DOW^SDM0
SET SDN(Y)=X
+1 QUIT
CLEAN FOR I2=0:0
SET I2=$ORDER(^SC(DA,"T"_I,I2))
if I2'>0
QUIT
KILL ^(I2)
+1 QUIT
+2 ;
END KILL 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
QUIT
+1 ;
SDEC(SC,SDDATE) ;update REACTIVATED DATE/TIME in SDEC RESOURCE ;alb/sat 627
+1 NEW SDFDA,SDRES
+2 SET SDRES=$$GETRES^SDECUTL(SC,1)
+3 if SDRES=""
QUIT
+4 SET SDFDA(409.831,SDRES_",",.025)=SDDATE
+5 SET SDFDA(409.831,SDRES_",",.026)=DUZ
+6 ;lab 781 - changed update to
DO FILE^DIE("","SDFDA")
+7 QUIT
DELSDEC(SC) ;delete reactavation date (lab 781)
+1 NEW SDFDA,SDRES
+2 SET SDRES=$$GETRES^SDECUTL(SC,1)
+3 if SDRES=""
QUIT
+4 SET SDFDA(409.831,SDRES_",",.025)="@"
+5 SET SDFDA(409.831,SDRES_",",.026)="@"
+6 DO FILE^DIE("","SDFDA")
+7 QUIT
