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