| 1 | PSXBKG ;BIR/WPB-Routine to schedule background jobs [ 05/01/97 12:56 PM ]
|
|---|
| 2 | ;;2.0;CMOP;**1**;11 Apr 97
|
|---|
| 3 | DREL 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="@"
|
|---|
| 16 | EXIT K Y,%DT("A"),%DT("B"),N,PSXDATE,STDATE,TIME,DIR,DIRUT,DIROUT,DTOUT,DUOUT,KEEP,REC,ZTIO,ZTDESC,ZTDTH,ZTRTN
|
|---|
| 17 | Q
|
|---|
| 18 | UNSCH 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
|
|---|
| 31 | RDPRG 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
|
|---|
