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