46 lines
2.6 KiB
Mathematica
46 lines
2.6 KiB
Mathematica
PSXBKG ;BIR/WPB-Routine to schedule background jobs [ 05/01/97 12:56 PM ]
|
|
;;2.0;CMOP;**1**;11 Apr 97
|
|
DREL W !!
|
|
I $D(^PSX(554,"AS")) D Q
|
|
.S DIR(0)="Y",DIR("B")="NO",DIR("A",1)="This job is already scheduled.",DIR("A")="Do you want to unschedule this job" D ^DIR K DIR G:(Y<1)!($D(DIRUT)) EXIT G:Y=1 UNSCH
|
|
S %DT="AEXR",%DT("A")="Enter starting date/time: ",%DT("B")="TODAY@2330" D ^%DT G:Y<0!($D(DTOUT)) EXIT S PSXDATE=Y K %DT,%DT("A"),%DT("B"),Y,X
|
|
K Y,X,DTOUT,DUOUT,DIRUT,DIROUT,DIR,DIR("A"),DIR("?"),DIR(0)
|
|
S DIR(0)="N",DIR("B")="10",DIR("A")="Enter number of days of data to keep",DIR("?")="This is the number of days of data to keep on file." D ^DIR K DIR S KEEP=Y G:$D(DIRUT)!($D(DUOUT))!($D(DTOUT))!($D(DIROUT)) EXIT
|
|
K Y,X,DTOUT,DUOUT,DIRUT,DIROUT,DIR,DIR("A"),DIR("?"),DIR(0)
|
|
S ZTIO="",ZTDTH=PSXDATE,ZTDESC="CMOP Background Purge for Release Data",ZTRTN="RDPRG^PSXBKG" D ^%ZTLOAD
|
|
I $G(ZTSK)>0 W !,"Job Queued.",! D
|
|
.K DD,DO
|
|
.S:'$D(^PSX(554,1,1,0)) ^PSX(554,1,1,0)="^554.01SA^^"
|
|
.S DIC(0)="LZ",DA(1)=1,DIC="^PSX(554,"_DA(1)_",1,",X=4,DIC("DR")="1////"_PSXDATE_";2////"_ZTSK_";3////S;4////"_DUZ_";7////"_KEEP D FILE^DICN K DIC,DIC(0),DIC("DR"),Y,X
|
|
S ZTREQ="@"
|
|
EXIT K Y,%DT("A"),%DT("B"),N,PSXDATE,STDATE,TIME,DIR,DIRUT,DIROUT,DTOUT,DUOUT,KEEP,REC,ZTIO,ZTDESC,ZTDTH,ZTRTN
|
|
Q
|
|
UNSCH N ZTSK
|
|
S REC=$O(^PSX(554,"AS",""))
|
|
S ZTSK=$P(^PSX(554,1,1,REC,0),"^",3)
|
|
I $G(ZTSK)'>0 W !,"This job doesn't exist.",! Q
|
|
D STAT^%ZTLOAD
|
|
I ZTSK(1)=2 W !,"This task is currently running, wait until the task has finished before stopping the job.",! Q
|
|
I ZTSK(1)'=2 D KILL^%ZTLOAD
|
|
I ZTSK(0)=1 W !,"Job stopped.",! D
|
|
.D NOW^%DTC
|
|
.S DA=REC,DA(1)=1,DIE="^PSX(554,"_DA(1)_",1,",DR="2////@;3////S;5////"_%_";6////"_DUZ D ^DIE K DA,DIE,DR
|
|
K Y,ZTSK
|
|
G EXIT
|
|
;Called by Taskman to schedule background purge of Release Data
|
|
RDPRG Q:'$D(^PSX(554,"AS"))
|
|
S RC=$O(^PSX(554,"AS",""))
|
|
D NOW^%DTC
|
|
S ZTSK=$P(^PSX(554,1,1,RC,0),"^",3),TIME="24H",ZTIO="",ZTDESC="CMOP Background Purge for Release Data",ZTRTN="RDPRG^PSXBKG",ZTDTH=TIME D REQ^%ZTLOAD
|
|
Q:$P(^PSX(554,1,1,RC,0),"^",4)="R"
|
|
S $P(^PSX(554,1,1,RC,0),"^",4)="R",$P(^PSX(554,1,1,RC,0),"^",9)=% K %
|
|
S RC=$O(^PSX(554,"AS","")),KEEP=$P(^PSX(554,1,1,RC,0),"^",8) S:$G(KEEP)'>0 KEEP=14
|
|
D NOW^%DTC S END=$$FMADD^XLFDT(%,-KEEP,0,0,0) K %
|
|
S MDT=0 F S MDT=$O(^PSX(554,1,3,"B",MDT)) Q:MDT'>0 S REC=0 F S REC=$O(^PSX(554,1,3,"B",MDT,REC)) Q:REC'>0 D
|
|
.Q:$P(^PSX(554,1,3,REC,0),"^",7)=""
|
|
.Q:$P(^PSX(554,1,3,REC,0),"^")>$G(END)
|
|
.S DA(1)=1,DA=REC,DIK="^PSX(554,"_DA(1)_",3," D ^DIK K DA,DIK
|
|
S $P(^PSX(554,1,1,RC,0),"^",4)="S"
|
|
K RC,END,MDT,REC,KEEP,PSXTSK,ZTRTN,ZTDESC,ZTIO,ZTDTH
|
|
Q
|