339 lines
8.7 KiB
Mathematica
339 lines
8.7 KiB
Mathematica
HLEVUTI2 ;O-OIFO/LJA - Event Monitor UTILITIES ;02/04/2004 14:42
|
|
;;1.6;HEALTH LEVEL SEVEN;**109**;Oct 13, 1995
|
|
;
|
|
; This routine is used to queue M code tasks that automatically
|
|
; requeue themselves (within limits.)
|
|
;
|
|
INIT ;
|
|
N A7UOK
|
|
D HEADER,EX
|
|
F Q:(+$Y+3)>IOSL W !
|
|
QUIT:$$BTE^HLCSMON("Press RETURN to continue, or '^' to exit... ") ;->
|
|
;
|
|
CTRL ;
|
|
D HEADER
|
|
W !
|
|
D M
|
|
D ASK I 'A7UOK QUIT ;->
|
|
D XEC
|
|
D BT QUIT:'A7UOK ;->
|
|
G CTRL ;->
|
|
;
|
|
BT ;
|
|
W !
|
|
S A7UOK=0
|
|
N DIR
|
|
S DIR(0)="EA",DIR("A")="Press RETURN to continue, or '^' to exit... "
|
|
D ^DIR
|
|
QUIT:+Y'=1 ;->
|
|
S A7UOK=1
|
|
QUIT
|
|
;
|
|
HEADER ;
|
|
W @IOF,$$CJ^XLFSTR("M Code Requeue Utility",IOM)
|
|
W !,$$REPEAT^XLFSTR("=",80)
|
|
QUIT
|
|
;
|
|
M KILL A7UMENU F I=1:1 S T=$T(M+I) QUIT:T'[";;" S T=$P(T,";;",2,99),A7UMENU(I)=$P(T,"~",2,99) W !,$J(I,2),". ",$P(T,"~")
|
|
;;Start M code jobs~D START
|
|
;;Show M code job runs~D SHOW
|
|
QUIT
|
|
;
|
|
ASK ;
|
|
W !
|
|
S A7UOK=0
|
|
N DIR
|
|
S DIR(0)="NO^1:"_(+I-1),DIR("A")="Select option"
|
|
D ^DIR
|
|
QUIT:'$D(A7UMENU(+Y)) ;->
|
|
S A7UOPT=+Y
|
|
S A7UOK=1
|
|
QUIT
|
|
;
|
|
XEC ;
|
|
S X=A7UMENU(+A7UOPT) X X
|
|
QUIT
|
|
;
|
|
;==================================================================
|
|
;
|
|
SHOW ; Show M code job "runs"...
|
|
N C2,C3,C4,C5,X,XTMP,Y
|
|
;
|
|
I $O(^XTMP("HLEVREQ"))'["HLEVREQ" D QUIT ;->
|
|
. W !!,"No M Code API run data exists..."
|
|
. W !
|
|
;
|
|
S C2=14,C3=28,C4=41,C5=59
|
|
W !,"Task#",?C2,"Start",?C3,"Finish",?C4,"|"
|
|
W ?(C4+2),"Next task#",?C5,"Queue time"
|
|
W !,$$REPEAT^XLFSTR("=",C4),"|",$$REPEAT^XLFSTR("=",IOM-$X)
|
|
;
|
|
S XTMP="HLEVREQ"
|
|
F S XTMP=$O(^XTMP(XTMP)) Q:$E(XTMP,1,7)'="HLEVREQ" D
|
|
. D SXTMPT(XTMP)
|
|
;
|
|
;
|
|
S C2=14,C3=28,C4=41,C5=59
|
|
W !!,"Task#",?C2,"Start",?C3,"Finish",?C4,"M API"
|
|
W !,$$REPEAT^XLFSTR("=",IOM)
|
|
;
|
|
S XTMP="HLEVREQ"
|
|
F S XTMP=$O(^XTMP(XTMP)) Q:$E(XTMP,1,7)'="HLEVREQ" D
|
|
. D SXTMPM(XTMP)
|
|
;
|
|
Q
|
|
;
|
|
SXTMPM(XTMP) ; Show individual XTMP entry...
|
|
; C2 to C5 -- req
|
|
N I,XTMP0
|
|
S XTMP0=$G(^XTMP(XTMP,0)) QUIT:XTMP0']"" ;->
|
|
W !
|
|
D P(4,C2),P(2,C3),P(7,C4)
|
|
W $P(XTMP0,U,8,9)," "
|
|
S XTMP0=$P(XTMP0,U,8,9) QUIT:XTMP0']"" ;->
|
|
S XTMP0=$P($T(@XTMP0)," ",2,999) QUIT:XTMP0']"" ;->
|
|
I $E(XTMP0)=";",$E(XTMP0,1,2)'=";;" S XTMP0=$E(XTMP0,2,999)
|
|
X "F I=1:1:$L(XTMP0) Q:$E(XTMP0,I)'="" """ S XTMP0=$E(XTMP0,I,999)
|
|
W $E(XTMP0,1,IOM-$X)
|
|
Q
|
|
;
|
|
SXTMPT(XTMP) ; Show individual XTMP entry...
|
|
; C2 to C5 -- req
|
|
N XTMP0
|
|
S XTMP0=$G(^XTMP(XTMP,0)) QUIT:XTMP0']"" ;->
|
|
W !
|
|
D P(4,C2),P(2,C3),P(7,C4)
|
|
W "| "
|
|
D P(5,C5),P(6,IOM)
|
|
Q
|
|
;
|
|
P(PCE,COL) ; Print value and "tab" over to COL...
|
|
; XTMP0 -- req
|
|
N DATA
|
|
S DATA=$P(XTMP0,U,PCE)
|
|
I DATA?7N1"."1.N S DATA=$$SDT^HLEVX001(DATA)
|
|
W DATA,?COL
|
|
Q
|
|
;
|
|
;==================================================================
|
|
;
|
|
START ;
|
|
N MREQ,MRTN,MTIME,ZTSK
|
|
;
|
|
W !
|
|
S MRTN=$$FTMRTN QUIT:MRTN']"" ;->
|
|
W !
|
|
S MTIME=$$TIME QUIT:'MTIME ;->
|
|
W !
|
|
S MREQ=$$REQNO QUIT:MREQ'>0 ;->
|
|
;
|
|
W !
|
|
I '$$YN^HLCSRPT4("OK to queue job") D QUIT ;->
|
|
. W " job not started..."
|
|
;
|
|
S ZTSK=$$NEWJOB($$NOW^XLFDT)
|
|
W !!,"Queued to task# ",ZTSK,"..."
|
|
;
|
|
QUIT
|
|
;
|
|
;
|
|
NEWJOB(TIME) ; Start job...
|
|
; MREQ,MRTN,MTIME -- req
|
|
N ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSK
|
|
S ZTIO="",ZTDTH=TIME,ZTDESC="HLEVUTI2-Queued Jobs"
|
|
S ZTRTN="QUEUE^HLEVUTI2"
|
|
S ZTSAVE("MREQ")="",ZTSAVE("MRTN")="",ZTSAVE("MTIME")=""
|
|
S ZTSAVE("HLRUNS*")=""
|
|
D ^%ZTLOAD
|
|
QUIT ZTSK
|
|
;
|
|
QUEUE ; Queue point for the starting of all queued HLEVUTI2 jobs...
|
|
; MREQ,MRTN,MTIME -- req
|
|
N I,NEWJOB,NOW,TASKNO,XTMP
|
|
;
|
|
S ZTREQ="@",NOW=$$NOW^XLFDT,TASKNO=ZTSK
|
|
;
|
|
; Store run's ZTSK in HLRUNS...
|
|
S HLRUNS=$G(HLRUNS)+1,HLRUNS(+ZTSK)=NOW
|
|
I HLRUNS>30 S I=0 F S I=$O(HLRUNS(I)) KILL HLRUNS(I) ; No STORE errors!
|
|
;
|
|
S XTMP="HLEVREQ-"_ZTSK
|
|
S ^XTMP(XTMP,0)=$$FMADD^XLFDT(MTIME,1)_U_NOW_U_"Event Monitor HLEVUTI2 Requeue"_U_ZTSK_"^^^^"_MRTN
|
|
;
|
|
; Piece 1 = Vaporization date/time
|
|
; Piece 2 = NOW
|
|
; Piece 3 = Description
|
|
; Piece 4 = Current task#
|
|
; Piece 5 = Next task number or END OF QUEUING
|
|
; Piece 6 = Next queue time
|
|
; Piece 7 = M code API finish time
|
|
; Piece 8 = Tag
|
|
; Piece 9 = Routine
|
|
;
|
|
; Calculate time for next queued job...
|
|
S NEXTIME=$$FMADD^XLFDT(NOW,"","",MREQ)
|
|
;
|
|
; If next queue time is not greater, then queue next job...
|
|
I NEXTIME<MTIME D
|
|
. S NEWJOB=$$NEWJOB(NEXTIME)
|
|
. S $P(^XTMP(XTMP,0),U,5,6)=NEWJOB_U_NEXTIME
|
|
;
|
|
; Run the M code...
|
|
D @MRTN
|
|
;
|
|
; M code finish time...
|
|
S NOW=$$NOW^XLFDT,$P(^XTMP(XTMP,0),U,7)=NOW,$P(HLRUNS(ZTSK),U,2)=NOW
|
|
;
|
|
; If next queue time < then end time quit (for new job already que'd)
|
|
QUIT:NEXTIME<MTIME ;->
|
|
;
|
|
S $P(^XTMP(XTMP,0),U,5)="END OF QUEUING"
|
|
D MAIL
|
|
;
|
|
Q
|
|
;
|
|
TEST ; Call here to test M code
|
|
D SAVE("Line of text saved by SAVE(TXT).")
|
|
Q
|
|
;
|
|
EX N I,T F I=1:1 S T=$T(EX+I) QUIT:T'[";;" W !,$P(T,";;",2,99)
|
|
;;This utility runs M code in a background job on a repetitive basis up to the
|
|
;;date/time you specify. To use this utility you must supply the following:
|
|
;;
|
|
;; * M code API (tag~routine.)
|
|
;; * Requeue frequency (in minutes.)
|
|
;; * Time to stop all requeues (up to 7 days in future.)
|
|
;;
|
|
;;As soon as the background job starts, the following actions occur:
|
|
;;
|
|
;; * The time for the next "run" of the 'M code API' is calculated using the
|
|
;; 'requeue frequency.'
|
|
;; * If the new run time is not past the 'time to stop all requeues', a new
|
|
;; future job is queued.
|
|
;; * The M code API is called. (This occurs even when no future jobs are
|
|
;; queued.
|
|
QUIT
|
|
;
|
|
FTMRTN() ;
|
|
N ANS,DIR,DIRUT,DTOUT,DUOUT,X,Y
|
|
S DIR(0)="F^3:17",DIR("A")="Enter TAG~ROUTINE"
|
|
W !,"Enter the M code API to be called by background jobs. Enter it in the format"
|
|
W !,"'TAG~ROUTINE'. (Use the tilde (~) character in place of the up-arrow.)"
|
|
W !
|
|
D ^DIR
|
|
QUIT:$D(DIRUT)!($D(DTOUT))!($D(DUOUT)) "" ;->
|
|
S ANS=$TR(Y,"~",U)
|
|
S X="D "_ANS D ^DIM QUIT:'$D(X) "" ;->
|
|
Q ANS
|
|
;
|
|
TIME() ;
|
|
N ANS,DIR,DIRUT,DTOUT,DUOUT,NOW,X,Y
|
|
S NOW=$$NOW^XLFDT
|
|
S DIR(0)="DA^"_NOW_":"_$$FMADD^XLFDT(NOW,7)_":AEFRS"
|
|
S DIR("A")="Enter STOP TIME: "
|
|
S DIR("?")="Enter a future date/time up to "_$$FMTE^XLFDT($$FMADD^XLFDT(NOW,7))_"..."
|
|
S DIR("B")=$$FMTE^XLFDT($$FMADD^XLFDT(NOW,1))
|
|
W !,"New jobs will be requeued until the date/time you enter now. You cannot queue"
|
|
W !,"jobs past seven days in the future."
|
|
W !
|
|
D ^DIR
|
|
QUIT:$D(DIRUT)!($D(DTOUT))!($D(DUOUT)) "" ;->
|
|
S ANS=Y
|
|
I ANS'>NOW D QUIT "" ;->
|
|
. W !!,"Date/time you enter must not be in the past..."
|
|
Q ANS
|
|
;
|
|
REQNO() ;
|
|
N ANS,DIR,DIRUT,DTOUT,DUOUT,NOW,X,Y
|
|
S DIR(0)="N^10:1440",DIR("A")="Enter REQUEUE FREQUENCY (min)"
|
|
W !,"New jobs will be requeued for the number of 'requeue frequency' minutes"
|
|
W !,"in the future you specify now."
|
|
W !
|
|
D ^DIR
|
|
QUIT:$D(DIRUT)!($D(DTOUT))!($D(DUOUT)) "" ;->
|
|
Q Y
|
|
;
|
|
MAIL ; All queues are done. Mail notification to DUZ...
|
|
N NO,TEXT,XMDUZ,XMSUB,XMTEXT,XMZ
|
|
S XMDUZ=.5,XMSUB="M Code Requeue Utility"
|
|
S XMTEXT="^TMP("_$J_",""HLMAILMSG"","
|
|
KILL ^TMP($J,"HLMAILMSG")
|
|
S NO=0
|
|
D MAILADD("The queuing of jobs to "_$TR($G(MRTN),"~",U)_" has finished. #"_$G(HLRUNS)_" jobs were queued.")
|
|
;
|
|
I HLRUNS<31 D
|
|
. N DATA,LN,TASK,TXT
|
|
. S LN=$$REPEAT^XLFSTR(" ",74)
|
|
. D MAILADD("")
|
|
. D MAILADD("Task# Start Finish")
|
|
. D MAILADD($$REPEAT^XLFSTR("-",74))
|
|
. S TASK=0
|
|
. F S TASK=$O(HLRUNS(TASK)) Q:'TASK D
|
|
. . S DATA=HLRUNS(TASK)
|
|
. . S TXT=$E(TASK_LN,1,14) ; Task#
|
|
. . S TXT=TXT_$E($$SDT^HLEVX001(+DATA)_LN,1,13) ; Start time
|
|
. . S TXT=TXT_$E($$SDT^HLEVX001($P(DATA,U,2))_LN,1,13) ; End time
|
|
. . I $D(^XTMP("HLEVREQ-"_TASK,"T")) D
|
|
. . . S TXT=TXT_"Data in ^XTMP(""HLEVREQ-"_TASK_""",""T"")"
|
|
. . D MAILADD(TXT)
|
|
;
|
|
S XMY(DUZ)=""
|
|
D ^XMD
|
|
I '$D(ZTQUEUED) W !!,"Mail message #",$G(XMZ),"..."
|
|
KILL ^TMP($J,"HLMAILMSG")
|
|
;
|
|
Q
|
|
;
|
|
MAILADD(T) S NO=$G(NO)+1,^TMP($J,"HLMAILMSG",NO)=T
|
|
Q
|
|
;
|
|
;==================================================================
|
|
;
|
|
SAVE(TXT) ; Save one line of text into ^XTMP
|
|
; XTMP -- req
|
|
N NO
|
|
QUIT:$G(XTMP)']"" ;->
|
|
QUIT:$G(^XTMP(XTMP,0))']"" ;->
|
|
S NO=$O(^XTMP(XTMP,"T",":"),-1)+1
|
|
S ^XTMP(XTMP,"T",+NO)=$G(TXT)
|
|
Q
|
|
;
|
|
KILLALL ; Kill **ALL** run data for all jobs!!!! (BE CARFUL)
|
|
N DATA,XTMP
|
|
;
|
|
I $O(^XTMP("HLEVREQ-"))'["HLEVREQ-" D QUIT ;->
|
|
. W !!,"No data exists... "
|
|
. W !
|
|
;
|
|
W !!,"Existing M code job run data..."
|
|
;
|
|
W !
|
|
S XTMP="HLEVREQ-"
|
|
F S XTMP=$O(^XTMP(XTMP)) Q:$E(XTMP,1,8)'="HLEVREQ-" D
|
|
. S DATA=$G(^XTMP(XTMP,0)) Q:DATA']"" ;->
|
|
. W !,"Started: ",$$SDT^HLEVX001($P(DATA,U,2))
|
|
. W $S($P(DATA,U,7)']"":" Job still running!!",1:" finished: "_$$SDT^HLEVX001(+$P(DATA,U,7)))
|
|
. W " ",$P(DATA,U,8,9),"..."
|
|
;
|
|
W !
|
|
I '$$YN^HLCSRPT4("OK to delete ALL M Code requeue data","No") D QUIT ;->
|
|
. W " nothing deleted..."
|
|
;
|
|
W !
|
|
S XTMP="HLEVREQ-"
|
|
F S XTMP=$O(^XTMP(XTMP)) Q:$E(XTMP,1,8)'="HLEVREQ-" D
|
|
. W !,"Killing ^XTMP(",XTMP,")..."
|
|
. D KILLXTMP(XTMP)
|
|
;
|
|
W !
|
|
S X=$$BTE^HLCSMON("Press RETURN to exit... ")
|
|
;
|
|
Q
|
|
;
|
|
KILLXTMP(XTMP) ; Kill one XTMP entry... (Pass TASK or full reference)
|
|
I XTMP=+XTMP S XTMP="HLEVREQ-"_XTMP
|
|
KILL ^XTMP(XTMP)
|
|
Q
|
|
;
|
|
EOR ;HLEVUTI2 - Event Monitor UTILITIES ;5/16/03 14:42
|