Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: HLEVUTI2

HLEVUTI2.m

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