Routine: HLEVUTI2

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)

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)

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)

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

 ;==================================================================

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

TEST ; Call here to test M code

 D SAVE("Line of text saved by SAVE(TXT).")

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")

MAILADD(T) S NO=$G(NO)+1,^TMP($J,"HLMAILMSG",NO)=T

 ;==================================================================

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)

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... ")

KILLXTMP(XTMP) ; Kill one XTMP entry... (Pass TASK or full reference)

 I XTMP=+XTMP S XTMP="HLEVREQ-"_XTMP

 KILL ^XTMP(XTMP)

EOR ;HLEVUTI2 - Event Monitor UTILITIES ;5/16/03 14:42

HLEVUTI2.m