source: FOIAVistA/trunk/r/CMOP-PSX/PSXBKG.m@ 1397

Last change on this file since 1397 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 2.6 KB
Line 
1PSXBKG ;BIR/WPB-Routine to schedule background jobs [ 05/01/97 12:56 PM ]
2 ;;2.0;CMOP;**1**;11 Apr 97
3DREL W !!
4 I $D(^PSX(554,"AS")) D Q
5 .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
6 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
7 K Y,X,DTOUT,DUOUT,DIRUT,DIROUT,DIR,DIR("A"),DIR("?"),DIR(0)
8 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
9 K Y,X,DTOUT,DUOUT,DIRUT,DIROUT,DIR,DIR("A"),DIR("?"),DIR(0)
10 S ZTIO="",ZTDTH=PSXDATE,ZTDESC="CMOP Background Purge for Release Data",ZTRTN="RDPRG^PSXBKG" D ^%ZTLOAD
11 I $G(ZTSK)>0 W !,"Job Queued.",! D
12 .K DD,DO
13 .S:'$D(^PSX(554,1,1,0)) ^PSX(554,1,1,0)="^554.01SA^^"
14 .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
15 S ZTREQ="@"
16EXIT K Y,%DT("A"),%DT("B"),N,PSXDATE,STDATE,TIME,DIR,DIRUT,DIROUT,DTOUT,DUOUT,KEEP,REC,ZTIO,ZTDESC,ZTDTH,ZTRTN
17 Q
18UNSCH N ZTSK
19 S REC=$O(^PSX(554,"AS",""))
20 S ZTSK=$P(^PSX(554,1,1,REC,0),"^",3)
21 I $G(ZTSK)'>0 W !,"This job doesn't exist.",! Q
22 D STAT^%ZTLOAD
23 I ZTSK(1)=2 W !,"This task is currently running, wait until the task has finished before stopping the job.",! Q
24 I ZTSK(1)'=2 D KILL^%ZTLOAD
25 I ZTSK(0)=1 W !,"Job stopped.",! D
26 .D NOW^%DTC
27 .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
28 K Y,ZTSK
29 G EXIT
30 ;Called by Taskman to schedule background purge of Release Data
31RDPRG Q:'$D(^PSX(554,"AS"))
32 S RC=$O(^PSX(554,"AS",""))
33 D NOW^%DTC
34 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
35 Q:$P(^PSX(554,1,1,RC,0),"^",4)="R"
36 S $P(^PSX(554,1,1,RC,0),"^",4)="R",$P(^PSX(554,1,1,RC,0),"^",9)=% K %
37 S RC=$O(^PSX(554,"AS","")),KEEP=$P(^PSX(554,1,1,RC,0),"^",8) S:$G(KEEP)'>0 KEEP=14
38 D NOW^%DTC S END=$$FMADD^XLFDT(%,-KEEP,0,0,0) K %
39 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
40 .Q:$P(^PSX(554,1,3,REC,0),"^",7)=""
41 .Q:$P(^PSX(554,1,3,REC,0),"^")>$G(END)
42 .S DA(1)=1,DA=REC,DIK="^PSX(554,"_DA(1)_",3," D ^DIK K DA,DIK
43 S $P(^PSX(554,1,1,RC,0),"^",4)="S"
44 K RC,END,MDT,REC,KEEP,PSXTSK,ZTRTN,ZTDESC,ZTIO,ZTDTH
45 Q
Note: See TracBrowser for help on using the repository browser.