- 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 Feb 18, 2025@23:24:09 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