HLEVAPI3 ;O-OIFO/LJA/PIJ - Event Monitor APIs ; Mar 02, 2021@08:28
;;1.6;HEALTH LEVEL SEVEN;**109,153,173**;Oct 13, 1995;Build 14
;Per VA Directive 6402, this routine should not be modified.
EVENTONE(HLEVIENM,HLEVNM,HLEVIENE) ; Master job check of an event...
; ZTSKMST -- req
N CONT,CURR,CURRNOW,IEN,LAPSEMIN,LASTRUN,MAILGRP,MCHECK,MSTART,NO,NODE
N NODE0,NODE40,PAR1,PAR2,PAR3,PAR4,PAR5,PAR6,PAR7,PAR8,RUNNOW
N START,STAT,ZTDESC,ZTDTH,ZTIO,ZTRTN,HLDT,HLIEN
;
S NODE0=$G(^HLEV(776.1,+$G(HLEVIENE),0))
I NODE0']"" D RECEVM(HLEVIENM,HLEVIENE,"X^NO-0-NODE") QUIT ;->
S STAT=$P(NODE0,U,2) I STAT'="A" D RECEVM(HLEVIENM,HLEVIENE,"I") QUIT ;->
; Requeue minutes for monitor...
S LAPSE=$P(NODE0,U,4) I LAPSE'?1.N D RECEVM(HLEVIENM,HLEVIENE,"X^INVALID-LAPSE") QUIT ;->
;
; Required M TAG^RTN for monitor...
S MSTART=$TR($P(NODE0,U,6),"~",U) I '$$OKMCODE^HLEVAPI0(MSTART) D QUIT ;->
. D RECEVM(HLEVIENM,HLEVIENE,"X^INVALID-M ["_$TR(MSTART,U,"~")_"]")
;
; Optional M $$EXTFUNCTION^RTN for determining whether new job should start
S MCHECK=$TR($P(NODE0,U,7),"~",U)
;
; If M check for start code exists, but is not valid M code, quit...
I MCHECK]"",'$$OKMCODE^HLEVAPI0($P(MCHECK,"$$",2,99)) D QUIT ;->
. D RECEVM(HLEVIENM,HLEVIENE,"X-INVALID-M-CHK ["_$TR(MCHECK,U,"~")_"]")
;
; When last run (started)? Return NULL if not completed...
;Use the "B" x-ref to get the most recently run monitors, and then check monitor value - Start HL*1.6*173 changes
;S IEN=$O(^HLEV(776,"M",+HLEVIENE,":"),-1)
S HLDT=":" F S HLDT=$O(^HLEV(776,"B",HLDT),-1) Q:'HLDT Q:$G(IEN) D
.S HLIEN=":" F S HLIEN=$O(^HLEV(776,"B",HLDT,HLIEN),-1) Q:'HLIEN Q:$G(IEN) D
..I $P($G(^HLEV(776,HLIEN,0)),U,3)=HLEVIENE S IEN=HLIEN Q
I $G(IEN) S (NODE,LASTRUN(1))=$G(^HLEV(776,+IEN,0)) D
.S LASTRUN=$P(NODE,U),LASTRUN=$S(LASTRUN?7N1"."1.N:LASTRUN,1:"")
.S X=$P(NODE,U,2) I X?7N1"."1.N S LASTRUN=X
S:'$G(IEN) LASTRUN=""
;End HL*1.6*173 code changes
;
; Set start new job default to YES...
S CONT=1
;
; If M start check code doesn't exist, check usual fields...
I MCHECK']"" D QUIT:'CONT ;->
.
. ;Start new monitor if last job running and timestamp is current,
. ;or monitor never run...
.
. ; Never run, so start new monitor...
. QUIT:LASTRUN']""
.
. ; Monitor running now, and is current, so don't do anything...
. S CURRNOW=$$CURR^HLEVAPI1(+IEN) I CURRNOW D QUIT ;->
. . I CURRNOW S CONT=0
. . D RECEVM(HLEVIENM,HLEVIENE,"R") ; Monitor running already...
.
. ; Monitor run, and if time to run new monitor, quit...
. S RUNNOW=$$RUNEV^HLEVAPI0(LASTRUN,LAPSE) QUIT:RUNNOW ;->
.
. S CONT=0 ; Set "no new monitor job needed" variable...
. D RECEVM(HLEVIENM,HLEVIENE,"E") QUIT ;-> Too early...
;
I MCHECK]"" D QUIT:'CONT ;->
. N HLEVRUN
. D RUNS(HLEVIENE,.HLEVRUN) ; Define recent monitor runs for API call...
. S CONT="S CONT="_MCHECK X CONT
. S CONT=$S(CONT=1:1,1:0) QUIT:CONT ;->
. D RECEVM(HLEVIENM,HLEVIENE,"M") ; Package API check failed...
;
S HLEVIENJ=$$NEWEVENT^HLEVAPI(HLEVIENE) I HLEVIENJ'>0 D QUIT ;->
. KILL HLPAR1D,HLPAR2D,HLPAR3D,HLPAR4D,HLPAR5D,HLPAR6D,HLPAR7D,HLPAR8D
;
; Queue a new job...
S ZTIO="",ZTDTH=$H,ZTDESC="HL Event Monitor - #"_HLEVIENE
S ZTRTN="QUEUEV^HLEVAPI3"
S ZTSAVE("HLEVIENJ")="",ZTSAVE("HLEVIENE")=""
S ZTSAVE("HLEVNM")="",ZTSAVE("HLEVIENM")=""
D ^%ZTLOAD
;
; Save info in 776.2...
D RECEVM(HLEVIENM,HLEVIENE,"Q",ZTSK,+HLEVIENJ)
;
; Save task number in 776...
D UPDFLDE^HLEVAPI(+HLEVIENJ,8,ZTSK)
;
; Reset back...
S ZTSK=ZTSKMST
;
QUIT
;
RUNS(HLEVIENE,RUN) ; Find latest 10 runs for calling API...
N CT,IEN,NODE
KILL RUN
S CT=0,IEN=":"
F S IEN=$O(^HLEV(776,"M",HLEVIENE,IEN),-1) Q:'IEN D QUIT:CT>9
. S NODE=$G(^HLEV(776,+IEN,0)) QUIT:NODE']"" ;->
. S CT=CT+1
. S RUN(CT)=NODE
Q
;
RECEVM(HLEVIENM,HLEVIENE,RES,ZTSK,HLEVIENJ) ;
N CT,DATA,REA
;
I $E(RES)="X" S REA=$P(RES,U,2),RES="X"
;
S RES=$S($G(RES)]"":RES,1:"?")
S NOEVCHK(RES)=$G(NOEVCHK(RES))+1
;
QUIT:$G(^HLEV(776.2,+$G(HLEVIENM),0))']"" ;->
QUIT:$G(^HLEV(776.1,+$G(HLEVIENE),0))']"" ;->
;
S CT=$O(^HLEV(776.2,+HLEVIENM,51,":"),-1)+1
S ^HLEV(776.2,+HLEVIENM,51,0)="^776.2051PA^"_CT_U_CT
S DATA=HLEVIENE_U_$G(RES)_U_$$NOW^XLFDT
I $G(ZTSK) S $P(DATA,U,4)=ZTSK
I $G(REA)]"" S $P(DATA,U,7)=REA
I $G(HLEVIENJ)>0 S $P(DATA,U,8)=HLEVIENJ
S ^HLEV(776.2,+HLEVIENM,51,+CT,0)=DATA
S ^HLEV(776.2,+HLEVIENM,51,"B",HLEVIENE,CT)=""
;
Q
;
QUEUEV ; Queued event job starts here...
; HLEVIENE,HLEVIENJ,HLEVIENM -- req
N EVMCODE,EVMGRP,EVNAME,NODE,EVPAR1,EVPAR2,EVPAR3,EVPAR4,EVPAR5
N EVPAR6,DVPAR7,EVPAR8
;
S ZTREQ="@"
;
; Mark RUNNING before doing anything else...
D EVRES^HLEVAPI0(+HLEVIENM,+HLEVIENE,"R",+HLEVIENJ)
;
;*** P153 START CJM ***
L +^HLEV(776.1,+$G(HLEVIENE),0):1 Q:'$T
;*** P153 END CJM
S NODE=$G(^HLEV(776.1,+$G(HLEVIENE),0)) I NODE']"" D QUIT ;->
. D EVRES^HLEVAPI0(+HLEVIENM,+HLEVIENE,"XE",+HLEVIENJ)
. ;*** Begin HL7*1.6*153 - pij ***
. L -^HLEV(776.1,+$G(HLEVIENE),0)
. ;*** End HL7*1.6*153 - pij ***
S EVNAME=$P(NODE,U),EVMGRP=$P(NODE,U,5)
S EVMCODE=$TR($P(NODE,U,6),"~",U) I EVMCODE'?1.8E1"^"1.8E D QUIT ;->
. D EVRES^HLEVAPI0(+HLEVIENM,+HLEVIENE,"XE",+HLEVIENJ)
. ;*** Begin HL7*1.6*153 - pij ***
. L -^HLEV(776.1,+$G(HLEVIENE),0)
. ;*** End HL7*1.6*153 - pij ***
;
; Node 40...
S NODE40=$G(^HLEV(776.1,+HLEVIENE,40))
F NO=1:1:8 S @("EVPAR"_NO)=$P(NODE40,U,NO)
;
; Final M code check...
I '$$OKMCODE^HLEVAPI0(EVMCODE) D QUIT ;->
. D EVRES^HLEVAPI0(+HLEVIENM,+HLEVIENE,"XM",+HLEVIENJ)
. ;*** Begin HL7*1.6*153 - pij ***
. L -^HLEV(776.1,+$G(HLEVIENE),0)
. ;*** End HL7*1.6*153 - pij ***
;
D @EVMCODE
;*** Begin HL7*1.6*153 - pij ***
L -^HLEV(776.1,+$G(HLEVIENE),0)
;*** End HL7*1.6*153 - pij ***
;
D EVRES^HLEVAPI0(+HLEVIENM,+HLEVIENE,"F",+HLEVIENJ)
;
Q
;
MAILIT ; Generic mail out call...
; HLEVIENE,HLEVIENJ -- req
; XMY(...) can be created before this call...
N MGRP
;
D DEBUG^HLEVAPI2("MAILIT") ; Debug data created conditionally
;
; Stop all event monitoring to enable on-site debugging...
QUIT:$G(^TMP("HLEVFLAG",$J))["STOP" ;->
;
D ADDXMYS^HLEVAPI2(HLEVIENE,$G(XTMP))
;
; If no mail group, and no passed in XMY, use DUZ...
I '$D(XMY),$G(DUZ)>0 S XMY(DUZ)=""
;
QUIT:'$D(XMY)
;
D SENDMAIL^HLEVAPI(HLEVIENE,+$G(HLEVIENJ),.XMY) ; Use generic email...
;
KILL XMSUB,XMTEXT,XMY
;
Q
;
MONFLAG(VAL) ; Set ^TMP("HLEVFLAG",$J), or return it's value...
; User may pass in the following values for VAL...
;
; * ABORT,STOP -> Will set ^TMP("HLEVFLAG",$J)="STOP"
; * START,RUN,XEC -> Will kill ^TMP("HLEVFLAG",$J)
; * SHOW,"" -> Will return value of ^TMP("HLEVFLAG",$J)
;
; What did user pass in?
S VAL=$$UP^XLFSTR($G(VAL))
S VAL=$S(VAL="STOP":"STOP",VAL="ABORT":"STOP",VAL="SET":"STOP",VAL="KILL":"@",VAL="START":"@",VAL="RUN":"@",VAL="XEC":"@",1:"")
;
I VAL']"" QUIT $G(^TMP("HLEVFLAG",$J)) ;-> Just show value...
I VAL="@" KILL ^TMP("HLEVFLAG",$J) QUIT "" ;->
I VAL="STOP" S ^TMP("HLEVFLAG",$J)="STOP" QUIT "STOP" ;->
;
Q $G(^TMP("HLEVFLAG",$J))
;
COUNT(MON,STATUS,GBL,LIM) ; Number of entries for monitor with STATUS...
;
; Pass in... MON -> Name or IEN of monitor
;
; STATUS -> 776's STATUS field code or full expansion
; -- Default = RUNNING
; -- Pass in ALL for all entries
;
; [GBL] -> Global for entry storage. [OPTIONAL]
; Creates @GBL@(#)=IEN ~ 776 zero node
; (KILL @GBL at beginning!)
;
; [LIM] -> Limit to # entries/status to store in GBL.
;
;
; Examples:
;
; $$COUNT("FAST HL7 PURGE #2") -> # events running (default)
; $$COUNT("FAST HL7 PURGE #2","R") -> # events running
; $$COUNT("FAST HL7 PURGE #2","ALL") -> # events of all statuses
;
; The call... $$COUNT("FAST HL7 PURGE #2","ALL","HLEV",1)
;
; Returns... (1) # event entries that exist of all statuses.
; (2) Stores entries in HLEV(#)=zero node
; (3) Stores only the most recent entry (LIM=1)
;
; If LIM>2, for example, the most recent two entries
; would be returned. But, note that the subscripting
; is not oldest to newest, but newest (with subscript
; of 1) to oldest (with subscript of 2.)
;
N CT,IEN,NO
;
QUIT:$G(MON)']"" "" ;->
S:$G(STATUS)']"" STATUS="R" ; Default to RUNNING...
S:STATUS="ALL" STATUS="EFQR"
I STATUS'="EFQR" S STATUS=$$UP^XLFSTR($E($G(STATUS)_" "))
QUIT:"EFQR"'[STATUS "" ;->
;
; If passed GBL, check/set limit..
S GBL=$G(GBL),LIM=$G(LIM)
S LIM=$S(LIM:LIM,1:999999)
;
; It's OK to pass in the IEN...
I MON'=+MON S MON=$O(^HLEV(776.1,"B",MON,0)) QUIT:MON'>0 "" ;->
;
; Remove any data hanging around from before call...
I GBL]"" KILL @GBL
;
S CT=0,IEN=":"
F S IEN=$O(^HLEV(776,"M",+MON,IEN),-1) Q:'IEN D
. S DATA=$G(^HLEV(776,+IEN,0))
. ; Don't count if doesn't even have a status!
. QUIT:$P(DATA,U,4)']"" ;->
. ; If STATUS="EFQR", every status should be counted...
. I STATUS'="EFQR" QUIT:$P(DATA,U,4)'=STATUS ;->
. S CT=CT+1
. QUIT:$G(GBL)']"" ;-> Don't store and return...
. S CT(1)=$O(@GBL@($P(DATA,U,4),":"),-1)+1
. QUIT:CT(1)>LIM ;->
. S @GBL@($P(DATA,U,4),+CT(1))=IEN_"~"_DATA
;
Q $S(CT:CT,1:"")
;
MARKERR ; Mark any RUNNING, but non-current entry's status to ERROR...
N DATA,IEN776,HLEVIENE,HLEVIENM,STAT
;
S IEN776=0
F S IEN776=$O(^HLEV(776,IEN776)) Q:'IEN776 D
. S DATA=$G(^HLEV(776,+IEN776,0))
. S STAT=$P(DATA,U,4) QUIT:STAT'="R"&(STAT'="Q") ;->
. QUIT:$$CURR^HLEVAPI1(+IEN776) ;->
. S HLEVIENE=$P(DATA,U,3) QUIT:$G(^HLEV(776.1,+HLEVIENE,0))']"" ;->
. S HLEVIENM=$P(DATA,U,9) QUIT:$G(^HLEV(776.2,+HLEVIENM,0))']"" ;->
. D EVRES^HLEVAPI0(HLEVIENM,HLEVIENE,"XE",IEN776)
;
Q
;
EOR ;HLEVAPI3 - Event Monitor APIs ;5/16/03 14:42
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHLEVAPI3 10164 printed Dec 13, 2024@01:57:44 Page 2
HLEVAPI3 ;O-OIFO/LJA/PIJ - Event Monitor APIs ; Mar 02, 2021@08:28
+1 ;;1.6;HEALTH LEVEL SEVEN;**109,153,173**;Oct 13, 1995;Build 14
+2 ;Per VA Directive 6402, this routine should not be modified.
EVENTONE(HLEVIENM,HLEVNM,HLEVIENE) ; Master job check of an event...
+1 ; ZTSKMST -- req
+2 NEW CONT,CURR,CURRNOW,IEN,LAPSEMIN,LASTRUN,MAILGRP,MCHECK,MSTART,NO,NODE
+3 NEW NODE0,NODE40,PAR1,PAR2,PAR3,PAR4,PAR5,PAR6,PAR7,PAR8,RUNNOW
+4 NEW START,STAT,ZTDESC,ZTDTH,ZTIO,ZTRTN,HLDT,HLIEN
+5 ;
+6 SET NODE0=$GET(^HLEV(776.1,+$GET(HLEVIENE),0))
+7 ;->
IF NODE0']""
DO RECEVM(HLEVIENM,HLEVIENE,"X^NO-0-NODE")
QUIT
+8 ;->
SET STAT=$PIECE(NODE0,U,2)
IF STAT'="A"
DO RECEVM(HLEVIENM,HLEVIENE,"I")
QUIT
+9 ; Requeue minutes for monitor...
+10 ;->
SET LAPSE=$PIECE(NODE0,U,4)
IF LAPSE'?1.N
DO RECEVM(HLEVIENM,HLEVIENE,"X^INVALID-LAPSE")
QUIT
+11 ;
+12 ; Required M TAG^RTN for monitor...
+13 ;->
SET MSTART=$TRANSLATE($PIECE(NODE0,U,6),"~",U)
IF '$$OKMCODE^HLEVAPI0(MSTART)
Begin DoDot:1
+14 DO RECEVM(HLEVIENM,HLEVIENE,"X^INVALID-M ["_$TRANSLATE(MSTART,U,"~")_"]")
End DoDot:1
QUIT
+15 ;
+16 ; Optional M $$EXTFUNCTION^RTN for determining whether new job should start
+17 SET MCHECK=$TRANSLATE($PIECE(NODE0,U,7),"~",U)
+18 ;
+19 ; If M check for start code exists, but is not valid M code, quit...
+20 ;->
IF MCHECK]""
IF '$$OKMCODE^HLEVAPI0($PIECE(MCHECK,"$$",2,99))
Begin DoDot:1
+21 DO RECEVM(HLEVIENM,HLEVIENE,"X-INVALID-M-CHK ["_$TRANSLATE(MCHECK,U,"~")_"]")
End DoDot:1
QUIT
+22 ;
+23 ; When last run (started)? Return NULL if not completed...
+24 ;Use the "B" x-ref to get the most recently run monitors, and then check monitor value - Start HL*1.6*173 changes
+25 ;S IEN=$O(^HLEV(776,"M",+HLEVIENE,":"),-1)
+26 SET HLDT=":"
FOR
SET HLDT=$ORDER(^HLEV(776,"B",HLDT),-1)
if 'HLDT
QUIT
if $GET(IEN)
QUIT
Begin DoDot:1
+27 SET HLIEN=":"
FOR
SET HLIEN=$ORDER(^HLEV(776,"B",HLDT,HLIEN),-1)
if 'HLIEN
QUIT
if $GET(IEN)
QUIT
Begin DoDot:2
+28 IF $PIECE($GET(^HLEV(776,HLIEN,0)),U,3)=HLEVIENE
SET IEN=HLIEN
QUIT
End DoDot:2
End DoDot:1
+29 IF $GET(IEN)
SET (NODE,LASTRUN(1))=$GET(^HLEV(776,+IEN,0))
Begin DoDot:1
+30 SET LASTRUN=$PIECE(NODE,U)
SET LASTRUN=$SELECT(LASTRUN?7N1"."1.N:LASTRUN,1:"")
+31 SET X=$PIECE(NODE,U,2)
IF X?7N1"."1.N
SET LASTRUN=X
End DoDot:1
+32 if '$GET(IEN)
SET LASTRUN=""
+33 ;End HL*1.6*173 code changes
+34 ;
+35 ; Set start new job default to YES...
+36 SET CONT=1
+37 ;
+38 ; If M start check code doesn't exist, check usual fields...
+39 ;->
IF MCHECK']""
Begin DoDot:1
+40 +41 ;Start new monitor if last job running and timestamp is current,
+42 ;or monitor never run...
+43 +44 ; Never run, so start new monitor...
+45 if LASTRUN']""
QUIT
+46 +47 ; Monitor running now, and is current, so don't do anything...
+48 ;->
SET CURRNOW=$$CURR^HLEVAPI1(+IEN)
IF CURRNOW
Begin DoDot:2
+49 IF CURRNOW
SET CONT=0
+50 ; Monitor running already...
DO RECEVM(HLEVIENM,HLEVIENE,"R")
End DoDot:2
QUIT
+51 +52 ; Monitor run, and if time to run new monitor, quit...
+53 ;->
SET RUNNOW=$$RUNEV^HLEVAPI0(LASTRUN,LAPSE)
if RUNNOW
QUIT
+54 +55 ; Set "no new monitor job needed" variable...
SET CONT=0
+56 ;-> Too early...
DO RECEVM(HLEVIENM,HLEVIENE,"E")
QUIT
End DoDot:1
if 'CONT
QUIT
+57 ;
+58 ;->
IF MCHECK]""
Begin DoDot:1
+59 NEW HLEVRUN
+60 ; Define recent monitor runs for API call...
DO RUNS(HLEVIENE,.HLEVRUN)
+61 SET CONT="S CONT="_MCHECK
XECUTE CONT
+62 ;->
SET CONT=$SELECT(CONT=1:1,1:0)
if CONT
QUIT
+63 ; Package API check failed...
DO RECEVM(HLEVIENM,HLEVIENE,"M")
End DoDot:1
if 'CONT
QUIT
+64 ;
+65 ;->
SET HLEVIENJ=$$NEWEVENT^HLEVAPI(HLEVIENE)
IF HLEVIENJ'>0
Begin DoDot:1
+66 KILL HLPAR1D,HLPAR2D,HLPAR3D,HLPAR4D,HLPAR5D,HLPAR6D,HLPAR7D,HLPAR8D
End DoDot:1
QUIT
+67 ;
+68 ; Queue a new job...
+69 SET ZTIO=""
SET ZTDTH=$HOROLOG
SET ZTDESC="HL Event Monitor - #"_HLEVIENE
+70 SET ZTRTN="QUEUEV^HLEVAPI3"
+71 SET ZTSAVE("HLEVIENJ")=""
SET ZTSAVE("HLEVIENE")=""
+72 SET ZTSAVE("HLEVNM")=""
SET ZTSAVE("HLEVIENM")=""
+73 DO ^%ZTLOAD
+74 ;
+75 ; Save info in 776.2...
+76 DO RECEVM(HLEVIENM,HLEVIENE,"Q",ZTSK,+HLEVIENJ)
+77 ;
+78 ; Save task number in 776...
+79 DO UPDFLDE^HLEVAPI(+HLEVIENJ,8,ZTSK)
+80 ;
+81 ; Reset back...
+82 SET ZTSK=ZTSKMST
+83 ;
+84 QUIT
+85 ;
RUNS(HLEVIENE,RUN) ; Find latest 10 runs for calling API...
+1 NEW CT,IEN,NODE
+2 KILL RUN
+3 SET CT=0
SET IEN=":"
+4 FOR
SET IEN=$ORDER(^HLEV(776,"M",HLEVIENE,IEN),-1)
if 'IEN
QUIT
Begin DoDot:1
+5 ;->
SET NODE=$GET(^HLEV(776,+IEN,0))
if NODE']""
QUIT
+6 SET CT=CT+1
+7 SET RUN(CT)=NODE
End DoDot:1
if CT>9
QUIT
+8 QUIT
+9 ;
RECEVM(HLEVIENM,HLEVIENE,RES,ZTSK,HLEVIENJ) ;
+1 NEW CT,DATA,REA
+2 ;
+3 IF $EXTRACT(RES)="X"
SET REA=$PIECE(RES,U,2)
SET RES="X"
+4 ;
+5 SET RES=$SELECT($GET(RES)]"":RES,1:"?")
+6 SET NOEVCHK(RES)=$GET(NOEVCHK(RES))+1
+7 ;
+8 ;->
if $GET(^HLEV(776.2,+$GET(HLEVIENM),0))']""
QUIT
+9 ;->
if $GET(^HLEV(776.1,+$GET(HLEVIENE),0))']""
QUIT
+10 ;
+11 SET CT=$ORDER(^HLEV(776.2,+HLEVIENM,51,":"),-1)+1
+12 SET ^HLEV(776.2,+HLEVIENM,51,0)="^776.2051PA^"_CT_U_CT
+13 SET DATA=HLEVIENE_U_$GET(RES)_U_$$NOW^XLFDT
+14 IF $GET(ZTSK)
SET $PIECE(DATA,U,4)=ZTSK
+15 IF $GET(REA)]""
SET $PIECE(DATA,U,7)=REA
+16 IF $GET(HLEVIENJ)>0
SET $PIECE(DATA,U,8)=HLEVIENJ
+17 SET ^HLEV(776.2,+HLEVIENM,51,+CT,0)=DATA
+18 SET ^HLEV(776.2,+HLEVIENM,51,"B",HLEVIENE,CT)=""
+19 ;
+20 QUIT
+21 ;
QUEUEV ; Queued event job starts here...
+1 ; HLEVIENE,HLEVIENJ,HLEVIENM -- req
+2 NEW EVMCODE,EVMGRP,EVNAME,NODE,EVPAR1,EVPAR2,EVPAR3,EVPAR4,EVPAR5
+3 NEW EVPAR6,DVPAR7,EVPAR8
+4 ;
+5 SET ZTREQ="@"
+6 ;
+7 ; Mark RUNNING before doing anything else...
+8 DO EVRES^HLEVAPI0(+HLEVIENM,+HLEVIENE,"R",+HLEVIENJ)
+9 ;
+10 ;*** P153 START CJM ***
+11 LOCK +^HLEV(776.1,+$GET(HLEVIENE),0):1
if '$TEST
QUIT
+12 ;*** P153 END CJM
+13 ;->
SET NODE=$GET(^HLEV(776.1,+$GET(HLEVIENE),0))
IF NODE']""
Begin DoDot:1
+14 DO EVRES^HLEVAPI0(+HLEVIENM,+HLEVIENE,"XE",+HLEVIENJ)
+15 ;*** Begin HL7*1.6*153 - pij ***
+16 LOCK -^HLEV(776.1,+$GET(HLEVIENE),0)
+17 ;*** End HL7*1.6*153 - pij ***
End DoDot:1
QUIT
+18 SET EVNAME=$PIECE(NODE,U)
SET EVMGRP=$PIECE(NODE,U,5)
+19 ;->
SET EVMCODE=$TRANSLATE($PIECE(NODE,U,6),"~",U)
IF EVMCODE'?1.8E1"^"1.8E
Begin DoDot:1
+20 DO EVRES^HLEVAPI0(+HLEVIENM,+HLEVIENE,"XE",+HLEVIENJ)
+21 ;*** Begin HL7*1.6*153 - pij ***
+22 LOCK -^HLEV(776.1,+$GET(HLEVIENE),0)
+23 ;*** End HL7*1.6*153 - pij ***
End DoDot:1
QUIT
+24 ;
+25 ; Node 40...
+26 SET NODE40=$GET(^HLEV(776.1,+HLEVIENE,40))
+27 FOR NO=1:1:8
SET @("EVPAR"_NO)=$PIECE(NODE40,U,NO)
+28 ;
+29 ; Final M code check...
+30 ;->
IF '$$OKMCODE^HLEVAPI0(EVMCODE)
Begin DoDot:1
+31 DO EVRES^HLEVAPI0(+HLEVIENM,+HLEVIENE,"XM",+HLEVIENJ)
+32 ;*** Begin HL7*1.6*153 - pij ***
+33 LOCK -^HLEV(776.1,+$GET(HLEVIENE),0)
+34 ;*** End HL7*1.6*153 - pij ***
End DoDot:1
QUIT
+35 ;
+36 DO @EVMCODE
+37 ;*** Begin HL7*1.6*153 - pij ***
+38 LOCK -^HLEV(776.1,+$GET(HLEVIENE),0)
+39 ;*** End HL7*1.6*153 - pij ***
+40 ;
+41 DO EVRES^HLEVAPI0(+HLEVIENM,+HLEVIENE,"F",+HLEVIENJ)
+42 ;
+43 QUIT
+44 ;
MAILIT ; Generic mail out call...
+1 ; HLEVIENE,HLEVIENJ -- req
+2 ; XMY(...) can be created before this call...
+3 NEW MGRP
+4 ;
+5 ; Debug data created conditionally
DO DEBUG^HLEVAPI2("MAILIT")
+6 ;
+7 ; Stop all event monitoring to enable on-site debugging...
+8 ;->
if $GET(^TMP("HLEVFLAG",$JOB))["STOP"
QUIT
+9 ;
+10 DO ADDXMYS^HLEVAPI2(HLEVIENE,$GET(XTMP))
+11 ;
+12 ; If no mail group, and no passed in XMY, use DUZ...
+13 IF '$DATA(XMY)
IF $GET(DUZ)>0
SET XMY(DUZ)=""
+14 ;
+15 if '$DATA(XMY)
QUIT
+16 ;
+17 ; Use generic email...
DO SENDMAIL^HLEVAPI(HLEVIENE,+$GET(HLEVIENJ),.XMY)
+18 ;
+19 KILL XMSUB,XMTEXT,XMY
+20 ;
+21 QUIT
+22 ;
MONFLAG(VAL) ; Set ^TMP("HLEVFLAG",$J), or return it's value...
+1 ; User may pass in the following values for VAL...
+2 ;
+3 ; * ABORT,STOP -> Will set ^TMP("HLEVFLAG",$J)="STOP"
+4 ; * START,RUN,XEC -> Will kill ^TMP("HLEVFLAG",$J)
+5 ; * SHOW,"" -> Will return value of ^TMP("HLEVFLAG",$J)
+6 ;
+7 ; What did user pass in?
+8 SET VAL=$$UP^XLFSTR($GET(VAL))
+9 SET VAL=$SELECT(VAL="STOP":"STOP",VAL="ABORT":"STOP",VAL="SET":"STOP",VAL="KILL":"@",VAL="START":"@",VAL="RUN":"@",VAL="XEC":"@",1:"")
+10 ;
+11 ;-> Just show value...
IF VAL']""
QUIT $GET(^TMP("HLEVFLAG",$JOB))
+12 ;->
IF VAL="@"
KILL ^TMP("HLEVFLAG",$JOB)
QUIT ""
+13 ;->
IF VAL="STOP"
SET ^TMP("HLEVFLAG",$JOB)="STOP"
QUIT "STOP"
+14 ;
+15 QUIT $GET(^TMP("HLEVFLAG",$JOB))
+16 ;
COUNT(MON,STATUS,GBL,LIM) ; Number of entries for monitor with STATUS...
+1 ;
+2 ; Pass in... MON -> Name or IEN of monitor
+3 ;
+4 ; STATUS -> 776's STATUS field code or full expansion
+5 ; -- Default = RUNNING
+6 ; -- Pass in ALL for all entries
+7 ;
+8 ; [GBL] -> Global for entry storage. [OPTIONAL]
+9 ; Creates @GBL@(#)=IEN ~ 776 zero node
+10 ; (KILL @GBL at beginning!)
+11 ;
+12 ; [LIM] -> Limit to # entries/status to store in GBL.
+13 ;
+14 ;
+15 ; Examples:
+16 ;
+17 ; $$COUNT("FAST HL7 PURGE #2") -> # events running (default)
+18 ; $$COUNT("FAST HL7 PURGE #2","R") -> # events running
+19 ; $$COUNT("FAST HL7 PURGE #2","ALL") -> # events of all statuses
+20 ;
+21 ; The call... $$COUNT("FAST HL7 PURGE #2","ALL","HLEV",1)
+22 ;
+23 ; Returns... (1) # event entries that exist of all statuses.
+24 ; (2) Stores entries in HLEV(#)=zero node
+25 ; (3) Stores only the most recent entry (LIM=1)
+26 ;
+27 ; If LIM>2, for example, the most recent two entries
+28 ; would be returned. But, note that the subscripting
+29 ; is not oldest to newest, but newest (with subscript
+30 ; of 1) to oldest (with subscript of 2.)
+31 ;
+32 NEW CT,IEN,NO
+33 ;
+34 ;->
if $GET(MON)']""
QUIT ""
+35 ; Default to RUNNING...
if $GET(STATUS)']""
SET STATUS="R"
+36 if STATUS="ALL"
SET STATUS="EFQR"
+37 IF STATUS'="EFQR"
SET STATUS=$$UP^XLFSTR($EXTRACT($GET(STATUS)_" "))
+38 ;->
if "EFQR"'[STATUS
QUIT ""
+39 ;
+40 ; If passed GBL, check/set limit..
+41 SET GBL=$GET(GBL)
SET LIM=$GET(LIM)
+42 SET LIM=$SELECT(LIM:LIM,1:999999)
+43 ;
+44 ; It's OK to pass in the IEN...
+45 ;->
IF MON'=+MON
SET MON=$ORDER(^HLEV(776.1,"B",MON,0))
if MON'>0
QUIT ""
+46 ;
+47 ; Remove any data hanging around from before call...
+48 IF GBL]""
KILL @GBL
+49 ;
+50 SET CT=0
SET IEN=":"
+51 FOR
SET IEN=$ORDER(^HLEV(776,"M",+MON,IEN),-1)
if 'IEN
QUIT
Begin DoDot:1
+52 SET DATA=$GET(^HLEV(776,+IEN,0))
+53 ; Don't count if doesn't even have a status!
+54 ;->
if $PIECE(DATA,U,4)']""
QUIT
+55 ; If STATUS="EFQR", every status should be counted...
+56 ;->
IF STATUS'="EFQR"
if $PIECE(DATA,U,4)'=STATUS
QUIT
+57 SET CT=CT+1
+58 ;-> Don't store and return...
if $GET(GBL)']""
QUIT
+59 SET CT(1)=$ORDER(@GBL@($PIECE(DATA,U,4),":"),-1)+1
+60 ;->
if CT(1)>LIM
QUIT
+61 SET @GBL@($PIECE(DATA,U,4),+CT(1))=IEN_"~"_DATA
End DoDot:1
+62 ;
+63 QUIT $SELECT(CT:CT,1:"")
+64 ;
MARKERR ; Mark any RUNNING, but non-current entry's status to ERROR...
+1 NEW DATA,IEN776,HLEVIENE,HLEVIENM,STAT
+2 ;
+3 SET IEN776=0
+4 FOR
SET IEN776=$ORDER(^HLEV(776,IEN776))
if 'IEN776
QUIT
Begin DoDot:1
+5 SET DATA=$GET(^HLEV(776,+IEN776,0))
+6 ;->
SET STAT=$PIECE(DATA,U,4)
if STAT'="R"&(STAT'="Q")
QUIT
+7 ;->
if $$CURR^HLEVAPI1(+IEN776)
QUIT
+8 ;->
SET HLEVIENE=$PIECE(DATA,U,3)
if $GET(^HLEV(776.1,+HLEVIENE,0))']""
QUIT
+9 ;->
SET HLEVIENM=$PIECE(DATA,U,9)
if $GET(^HLEV(776.2,+HLEVIENM,0))']""
QUIT
+10 DO EVRES^HLEVAPI0(HLEVIENM,HLEVIENE,"XE",IEN776)
End DoDot:1
+11 ;
+12 QUIT
+13 ;
EOR ;HLEVAPI3 - Event Monitor APIs ;5/16/03 14:42
