- SDREACT ;ALB/TMP - REACTIVATE A CLINIC ; 30 APR 85 9:02 am
- ;;5.3;PIMS;**63,167,380,1015,1016**;JUN 30, 2012;Build 20
- 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")
- 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")
- 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")
- 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
- SDREACT ;ALB/TMP - REACTIVATE A CLINIC ; 30 APR 85 9:02 am
- +1 ;;5.3;PIMS;**63,167,380,1015,1016**;JUN 30, 2012;Build 20
- +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 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 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 WRITE !,*7,"Reactivation date DELETED!!"
- GOTO END
- +9 ;
- 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
