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

HLEVAPI3.m

Go to the documentation of this file.
  1. 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
  1. ;Per VA Directive 6402, this routine should not be modified.
  1. EVENTONE(HLEVIENM,HLEVNM,HLEVIENE) ; Master job check of an event...
  1. ; ZTSKMST -- req
  1. N CONT,CURR,CURRNOW,IEN,LAPSEMIN,LASTRUN,MAILGRP,MCHECK,MSTART,NO,NODE
  1. N NODE0,NODE40,PAR1,PAR2,PAR3,PAR4,PAR5,PAR6,PAR7,PAR8,RUNNOW
  1. N START,STAT,ZTDESC,ZTDTH,ZTIO,ZTRTN,HLDT,HLIEN
  1. ;
  1. S NODE0=$G(^HLEV(776.1,+$G(HLEVIENE),0))
  1. I NODE0']"" D RECEVM(HLEVIENM,HLEVIENE,"X^NO-0-NODE") QUIT ;->
  1. S STAT=$P(NODE0,U,2) I STAT'="A" D RECEVM(HLEVIENM,HLEVIENE,"I") QUIT ;->
  1. ; Requeue minutes for monitor...
  1. S LAPSE=$P(NODE0,U,4) I LAPSE'?1.N D RECEVM(HLEVIENM,HLEVIENE,"X^INVALID-LAPSE") QUIT ;->
  1. ;
  1. ; Required M TAG^RTN for monitor...
  1. S MSTART=$TR($P(NODE0,U,6),"~",U) I '$$OKMCODE^HLEVAPI0(MSTART) D QUIT ;->
  1. . D RECEVM(HLEVIENM,HLEVIENE,"X^INVALID-M ["_$TR(MSTART,U,"~")_"]")
  1. ;
  1. ; Optional M $$EXTFUNCTION^RTN for determining whether new job should start
  1. S MCHECK=$TR($P(NODE0,U,7),"~",U)
  1. ;
  1. ; If M check for start code exists, but is not valid M code, quit...
  1. I MCHECK]"",'$$OKMCODE^HLEVAPI0($P(MCHECK,"$$",2,99)) D QUIT ;->
  1. . D RECEVM(HLEVIENM,HLEVIENE,"X-INVALID-M-CHK ["_$TR(MCHECK,U,"~")_"]")
  1. ;
  1. ; When last run (started)? Return NULL if not completed...
  1. ;Use the "B" x-ref to get the most recently run monitors, and then check monitor value - Start HL*1.6*173 changes
  1. ;S IEN=$O(^HLEV(776,"M",+HLEVIENE,":"),-1)
  1. S HLDT=":" F S HLDT=$O(^HLEV(776,"B",HLDT),-1) Q:'HLDT Q:$G(IEN) D
  1. .S HLIEN=":" F S HLIEN=$O(^HLEV(776,"B",HLDT,HLIEN),-1) Q:'HLIEN Q:$G(IEN) D
  1. ..I $P($G(^HLEV(776,HLIEN,0)),U,3)=HLEVIENE S IEN=HLIEN Q
  1. I $G(IEN) S (NODE,LASTRUN(1))=$G(^HLEV(776,+IEN,0)) D
  1. .S LASTRUN=$P(NODE,U),LASTRUN=$S(LASTRUN?7N1"."1.N:LASTRUN,1:"")
  1. .S X=$P(NODE,U,2) I X?7N1"."1.N S LASTRUN=X
  1. S:'$G(IEN) LASTRUN=""
  1. ;End HL*1.6*173 code changes
  1. ;
  1. ; Set start new job default to YES...
  1. S CONT=1
  1. ;
  1. ; If M start check code doesn't exist, check usual fields...
  1. I MCHECK']"" D QUIT:'CONT ;->
  1. .
  1. . ;Start new monitor if last job running and timestamp is current,
  1. . ;or monitor never run...
  1. .
  1. . ; Never run, so start new monitor...
  1. . QUIT:LASTRUN']""
  1. .
  1. . ; Monitor running now, and is current, so don't do anything...
  1. . S CURRNOW=$$CURR^HLEVAPI1(+IEN) I CURRNOW D QUIT ;->
  1. . . I CURRNOW S CONT=0
  1. . . D RECEVM(HLEVIENM,HLEVIENE,"R") ; Monitor running already...
  1. .
  1. . ; Monitor run, and if time to run new monitor, quit...
  1. . S RUNNOW=$$RUNEV^HLEVAPI0(LASTRUN,LAPSE) QUIT:RUNNOW ;->
  1. .
  1. . S CONT=0 ; Set "no new monitor job needed" variable...
  1. . D RECEVM(HLEVIENM,HLEVIENE,"E") QUIT ;-> Too early...
  1. ;
  1. I MCHECK]"" D QUIT:'CONT ;->
  1. . N HLEVRUN
  1. . D RUNS(HLEVIENE,.HLEVRUN) ; Define recent monitor runs for API call...
  1. . S CONT="S CONT="_MCHECK X CONT
  1. . S CONT=$S(CONT=1:1,1:0) QUIT:CONT ;->
  1. . D RECEVM(HLEVIENM,HLEVIENE,"M") ; Package API check failed...
  1. ;
  1. S HLEVIENJ=$$NEWEVENT^HLEVAPI(HLEVIENE) I HLEVIENJ'>0 D QUIT ;->
  1. . KILL HLPAR1D,HLPAR2D,HLPAR3D,HLPAR4D,HLPAR5D,HLPAR6D,HLPAR7D,HLPAR8D
  1. ;
  1. ; Queue a new job...
  1. S ZTIO="",ZTDTH=$H,ZTDESC="HL Event Monitor - #"_HLEVIENE
  1. S ZTRTN="QUEUEV^HLEVAPI3"
  1. S ZTSAVE("HLEVIENJ")="",ZTSAVE("HLEVIENE")=""
  1. S ZTSAVE("HLEVNM")="",ZTSAVE("HLEVIENM")=""
  1. D ^%ZTLOAD
  1. ;
  1. ; Save info in 776.2...
  1. D RECEVM(HLEVIENM,HLEVIENE,"Q",ZTSK,+HLEVIENJ)
  1. ;
  1. ; Save task number in 776...
  1. D UPDFLDE^HLEVAPI(+HLEVIENJ,8,ZTSK)
  1. ;
  1. ; Reset back...
  1. S ZTSK=ZTSKMST
  1. ;
  1. QUIT
  1. ;
  1. RUNS(HLEVIENE,RUN) ; Find latest 10 runs for calling API...
  1. N CT,IEN,NODE
  1. KILL RUN
  1. S CT=0,IEN=":"
  1. F S IEN=$O(^HLEV(776,"M",HLEVIENE,IEN),-1) Q:'IEN D QUIT:CT>9
  1. . S NODE=$G(^HLEV(776,+IEN,0)) QUIT:NODE']"" ;->
  1. . S CT=CT+1
  1. . S RUN(CT)=NODE
  1. Q
  1. ;
  1. RECEVM(HLEVIENM,HLEVIENE,RES,ZTSK,HLEVIENJ) ;
  1. N CT,DATA,REA
  1. ;
  1. I $E(RES)="X" S REA=$P(RES,U,2),RES="X"
  1. ;
  1. S RES=$S($G(RES)]"":RES,1:"?")
  1. S NOEVCHK(RES)=$G(NOEVCHK(RES))+1
  1. ;
  1. QUIT:$G(^HLEV(776.2,+$G(HLEVIENM),0))']"" ;->
  1. QUIT:$G(^HLEV(776.1,+$G(HLEVIENE),0))']"" ;->
  1. ;
  1. S CT=$O(^HLEV(776.2,+HLEVIENM,51,":"),-1)+1
  1. S ^HLEV(776.2,+HLEVIENM,51,0)="^776.2051PA^"_CT_U_CT
  1. S DATA=HLEVIENE_U_$G(RES)_U_$$NOW^XLFDT
  1. I $G(ZTSK) S $P(DATA,U,4)=ZTSK
  1. I $G(REA)]"" S $P(DATA,U,7)=REA
  1. I $G(HLEVIENJ)>0 S $P(DATA,U,8)=HLEVIENJ
  1. S ^HLEV(776.2,+HLEVIENM,51,+CT,0)=DATA
  1. S ^HLEV(776.2,+HLEVIENM,51,"B",HLEVIENE,CT)=""
  1. ;
  1. Q
  1. ;
  1. QUEUEV ; Queued event job starts here...
  1. ; HLEVIENE,HLEVIENJ,HLEVIENM -- req
  1. N EVMCODE,EVMGRP,EVNAME,NODE,EVPAR1,EVPAR2,EVPAR3,EVPAR4,EVPAR5
  1. N EVPAR6,DVPAR7,EVPAR8
  1. ;
  1. S ZTREQ="@"
  1. ;
  1. ; Mark RUNNING before doing anything else...
  1. D EVRES^HLEVAPI0(+HLEVIENM,+HLEVIENE,"R",+HLEVIENJ)
  1. ;
  1. ;*** P153 START CJM ***
  1. L +^HLEV(776.1,+$G(HLEVIENE),0):1 Q:'$T
  1. ;*** P153 END CJM
  1. S NODE=$G(^HLEV(776.1,+$G(HLEVIENE),0)) I NODE']"" D QUIT ;->
  1. . D EVRES^HLEVAPI0(+HLEVIENM,+HLEVIENE,"XE",+HLEVIENJ)
  1. . ;*** Begin HL7*1.6*153 - pij ***
  1. . L -^HLEV(776.1,+$G(HLEVIENE),0)
  1. . ;*** End HL7*1.6*153 - pij ***
  1. S EVNAME=$P(NODE,U),EVMGRP=$P(NODE,U,5)
  1. S EVMCODE=$TR($P(NODE,U,6),"~",U) I EVMCODE'?1.8E1"^"1.8E D QUIT ;->
  1. . D EVRES^HLEVAPI0(+HLEVIENM,+HLEVIENE,"XE",+HLEVIENJ)
  1. . ;*** Begin HL7*1.6*153 - pij ***
  1. . L -^HLEV(776.1,+$G(HLEVIENE),0)
  1. . ;*** End HL7*1.6*153 - pij ***
  1. ;
  1. ; Node 40...
  1. S NODE40=$G(^HLEV(776.1,+HLEVIENE,40))
  1. F NO=1:1:8 S @("EVPAR"_NO)=$P(NODE40,U,NO)
  1. ;
  1. ; Final M code check...
  1. I '$$OKMCODE^HLEVAPI0(EVMCODE) D QUIT ;->
  1. . D EVRES^HLEVAPI0(+HLEVIENM,+HLEVIENE,"XM",+HLEVIENJ)
  1. . ;*** Begin HL7*1.6*153 - pij ***
  1. . L -^HLEV(776.1,+$G(HLEVIENE),0)
  1. . ;*** End HL7*1.6*153 - pij ***
  1. ;
  1. D @EVMCODE
  1. ;*** Begin HL7*1.6*153 - pij ***
  1. L -^HLEV(776.1,+$G(HLEVIENE),0)
  1. ;*** End HL7*1.6*153 - pij ***
  1. ;
  1. D EVRES^HLEVAPI0(+HLEVIENM,+HLEVIENE,"F",+HLEVIENJ)
  1. ;
  1. Q
  1. ;
  1. MAILIT ; Generic mail out call...
  1. ; HLEVIENE,HLEVIENJ -- req
  1. ; XMY(...) can be created before this call...
  1. N MGRP
  1. ;
  1. D DEBUG^HLEVAPI2("MAILIT") ; Debug data created conditionally
  1. ;
  1. ; Stop all event monitoring to enable on-site debugging...
  1. QUIT:$G(^TMP("HLEVFLAG",$J))["STOP" ;->
  1. ;
  1. D ADDXMYS^HLEVAPI2(HLEVIENE,$G(XTMP))
  1. ;
  1. ; If no mail group, and no passed in XMY, use DUZ...
  1. I '$D(XMY),$G(DUZ)>0 S XMY(DUZ)=""
  1. ;
  1. QUIT:'$D(XMY)
  1. ;
  1. D SENDMAIL^HLEVAPI(HLEVIENE,+$G(HLEVIENJ),.XMY) ; Use generic email...
  1. ;
  1. KILL XMSUB,XMTEXT,XMY
  1. ;
  1. Q
  1. ;
  1. MONFLAG(VAL) ; Set ^TMP("HLEVFLAG",$J), or return it's value...
  1. ; User may pass in the following values for VAL...
  1. ;
  1. ; * ABORT,STOP -> Will set ^TMP("HLEVFLAG",$J)="STOP"
  1. ; * START,RUN,XEC -> Will kill ^TMP("HLEVFLAG",$J)
  1. ; * SHOW,"" -> Will return value of ^TMP("HLEVFLAG",$J)
  1. ;
  1. ; What did user pass in?
  1. S VAL=$$UP^XLFSTR($G(VAL))
  1. S VAL=$S(VAL="STOP":"STOP",VAL="ABORT":"STOP",VAL="SET":"STOP",VAL="KILL":"@",VAL="START":"@",VAL="RUN":"@",VAL="XEC":"@",1:"")
  1. ;
  1. I VAL']"" QUIT $G(^TMP("HLEVFLAG",$J)) ;-> Just show value...
  1. I VAL="@" KILL ^TMP("HLEVFLAG",$J) QUIT "" ;->
  1. I VAL="STOP" S ^TMP("HLEVFLAG",$J)="STOP" QUIT "STOP" ;->
  1. ;
  1. Q $G(^TMP("HLEVFLAG",$J))
  1. ;
  1. COUNT(MON,STATUS,GBL,LIM) ; Number of entries for monitor with STATUS...
  1. ;
  1. ; Pass in... MON -> Name or IEN of monitor
  1. ;
  1. ; STATUS -> 776's STATUS field code or full expansion
  1. ; -- Default = RUNNING
  1. ; -- Pass in ALL for all entries
  1. ;
  1. ; [GBL] -> Global for entry storage. [OPTIONAL]
  1. ; Creates @GBL@(#)=IEN ~ 776 zero node
  1. ; (KILL @GBL at beginning!)
  1. ;
  1. ; [LIM] -> Limit to # entries/status to store in GBL.
  1. ;
  1. ;
  1. ; Examples:
  1. ;
  1. ; $$COUNT("FAST HL7 PURGE #2") -> # events running (default)
  1. ; $$COUNT("FAST HL7 PURGE #2","R") -> # events running
  1. ; $$COUNT("FAST HL7 PURGE #2","ALL") -> # events of all statuses
  1. ;
  1. ; The call... $$COUNT("FAST HL7 PURGE #2","ALL","HLEV",1)
  1. ;
  1. ; Returns... (1) # event entries that exist of all statuses.
  1. ; (2) Stores entries in HLEV(#)=zero node
  1. ; (3) Stores only the most recent entry (LIM=1)
  1. ;
  1. ; If LIM>2, for example, the most recent two entries
  1. ; would be returned. But, note that the subscripting
  1. ; is not oldest to newest, but newest (with subscript
  1. ; of 1) to oldest (with subscript of 2.)
  1. ;
  1. N CT,IEN,NO
  1. ;
  1. QUIT:$G(MON)']"" "" ;->
  1. S:$G(STATUS)']"" STATUS="R" ; Default to RUNNING...
  1. S:STATUS="ALL" STATUS="EFQR"
  1. I STATUS'="EFQR" S STATUS=$$UP^XLFSTR($E($G(STATUS)_" "))
  1. QUIT:"EFQR"'[STATUS "" ;->
  1. ;
  1. ; If passed GBL, check/set limit..
  1. S GBL=$G(GBL),LIM=$G(LIM)
  1. S LIM=$S(LIM:LIM,1:999999)
  1. ;
  1. ; It's OK to pass in the IEN...
  1. I MON'=+MON S MON=$O(^HLEV(776.1,"B",MON,0)) QUIT:MON'>0 "" ;->
  1. ;
  1. ; Remove any data hanging around from before call...
  1. I GBL]"" KILL @GBL
  1. ;
  1. S CT=0,IEN=":"
  1. F S IEN=$O(^HLEV(776,"M",+MON,IEN),-1) Q:'IEN D
  1. . S DATA=$G(^HLEV(776,+IEN,0))
  1. . ; Don't count if doesn't even have a status!
  1. . QUIT:$P(DATA,U,4)']"" ;->
  1. . ; If STATUS="EFQR", every status should be counted...
  1. . I STATUS'="EFQR" QUIT:$P(DATA,U,4)'=STATUS ;->
  1. . S CT=CT+1
  1. . QUIT:$G(GBL)']"" ;-> Don't store and return...
  1. . S CT(1)=$O(@GBL@($P(DATA,U,4),":"),-1)+1
  1. . QUIT:CT(1)>LIM ;->
  1. . S @GBL@($P(DATA,U,4),+CT(1))=IEN_"~"_DATA
  1. ;
  1. Q $S(CT:CT,1:"")
  1. ;
  1. MARKERR ; Mark any RUNNING, but non-current entry's status to ERROR...
  1. N DATA,IEN776,HLEVIENE,HLEVIENM,STAT
  1. ;
  1. S IEN776=0
  1. F S IEN776=$O(^HLEV(776,IEN776)) Q:'IEN776 D
  1. . S DATA=$G(^HLEV(776,+IEN776,0))
  1. . S STAT=$P(DATA,U,4) QUIT:STAT'="R"&(STAT'="Q") ;->
  1. . QUIT:$$CURR^HLEVAPI1(+IEN776) ;->
  1. . S HLEVIENE=$P(DATA,U,3) QUIT:$G(^HLEV(776.1,+HLEVIENE,0))']"" ;->
  1. . S HLEVIENM=$P(DATA,U,9) QUIT:$G(^HLEV(776.2,+HLEVIENM,0))']"" ;->
  1. . D EVRES^HLEVAPI0(HLEVIENM,HLEVIENE,"XE",IEN776)
  1. ;
  1. Q
  1. ;
  1. EOR ;HLEVAPI3 - Event Monitor APIs ;5/16/03 14:42