- 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 Feb 19, 2025@00:25:23 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