source: WorldVistAEHR/trunk/r/CMOP-PSX/PSXBKG.m@ 861

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