BMXMEVN ; IHS/OIT/HMW - BMXNet MONITOR ;
;;4.0;BMX;;JUN 28, 2010
;
Q
;
REGET ;EP
;Error trap from REGEVNT, RAISEVNT, and UNREG
;
I '$D(BMXI) N BMXI S BMXI=999
S BMXI=BMXI+1
D REGERR(BMXI,99)
Q
;
REGERR(BMXI,BMXERID) ;Error processing
S BMXI=BMXI+1
S ^TMP("BMX",$J,BMXI)=BMXERID_$C(30)
S BMXI=BMXI+1
S ^TMP("BMX",$J,BMXI)=$C(31)
Q
;
REGEVNT(BMXY,BMXEVENT) ;EP
;RPC Called by BMX REGISTER EVENT to inform RPMS server
;of client's interest in BMXEVENT
;Returns RECORDSET with field ERRORID.
;If everything ok then ERRORID = 0;
;
N BMXI
S BMXI=0
S X="REGET^BMXMEVN",@^%ZOSF("TRAP")
S BMXY=$NA(^TMP("BMX",$J)) K @BMXY
S ^TMP("BMX",$J,0)="I00020ERRORID"_$C(30)
S ^TMP("BMX EVENT",$J,BMXEVENT)=$G(DUZ)
;
S BMXI=BMXI+1
S ^TMP("BMX",$J,BMXI)="0"_$C(30)_$C(31)
Q
;
RAISEVNT(BMXY,BMXEVENT,BMXPARAM,BMXBACK,BMXKEY) ;EP
;RPC Called to raise event BMXEVENT with parameter BMXPARAM
;If BMXBACK = 'TRUE' then event will be raised back to originator
;Calls EVENT
;Returns a RECORDSET wit the field ERRORID.
;If everything ok then ERRORID = 0;
;
N BMXI,BMXORIG
S BMXI=0
S BMXORIG=$S($G(BMXBACK)="TRUE":"",1:$J)
S BMXY=$NA(^TMP("BMX",$J)) K @BMXY
S ^TMP("BMX",$J,0)="I00020ERRORID"_$C(30)
S X="REGET^BMXMEVN",@^%ZOSF("TRAP")
;
D EVENT(BMXEVENT,BMXPARAM,BMXORIG,$G(BMXKEY))
;
S BMXI=BMXI+1
S ^TMP("BMX",$J,BMXI)="0"_$C(30)_$C(31)
Q
;
EVENT(BMXEVENT,BMXPARAM,BMXORIG,BMXKEY) ;PEP - Raise event to interested clients
;Clients are listed in ^TMP("BMX EVENT",BMXEVENT,BMXSESS)=DUZ
;BMXORIG represents the event originator's session
;The event will not be raised back to the originator if BMXORIG is the session of the originator
;BMXKEY is a ~-delimited list of security keys. Only holders of one of these keys
;will receive event notification. If BMXKEY is "" then all registered sessions
;will be notified.
;
L +^TMP("BMX EVENT RAISED"):30
N BMXSESS,BMXINC
S BMXSESS=0 F S BMXSESS=$O(^TMP("BMX EVENT",BMXSESS)) Q:'+BMXSESS D
. I BMXSESS=$G(BMXORIG) Q
. I '$D(^TMP("BMX EVENT",BMXSESS,BMXEVENT)) Q
. ;S BMXDUZ=^TMP("BMX EVENT",BMXEVENT,BMXSESS)
. S BMXDUZ=^TMP("BMX EVENT",BMXSESS,BMXEVENT)
. ;TODO: Test if DUZ holds at least one of the keys in BMXKEY
. S BMXINC=$O(^TMP("BMX EVENT RAISED",BMXSESS,BMXEVENT,99999999),-1)
. S:BMXINC="" BMXINC=0
. ;S ^TMP("BMXTRACK",$P($H,",",2))="Job "_$J_" Set "_$NA(^TMP("BMX EVENT RAISED",BMXSESS,BMXEVENT,BMXINC+1))_"="_$G(BMXPARAM)
. S ^TMP("BMX EVENT RAISED",BMXSESS,BMXEVENT,BMXINC+1)=$G(BMXPARAM) ;IHS/OIT/HMW SAC Exemption Applied For
. Q
L -^TMP("BMX EVENT RAISED")
Q
;
POLLD(BMXY) ;EP
;Debug Entry Point
;D DEBUG^%Serenji("POLLD^BMXMEVN(.BMXY)")
Q
;
POLL(BMXY) ;EP
;Check event queue for events of interest to current session
;Return DataSet of events and parameters
;Called by BMX EVENT POLL
;
N BMXI,BMXEVENT
S BMXI=0
S X="POLLET^BMXMEVN",@^%ZOSF("TRAP")
S BMXY=$NA(^TMP("BMX",$J)) K @BMXY
S ^TMP("BMX",$J,0)="T00030EVENT"_U_"T00030PARAM"_$C(30)
L +^TMP("BMX EVENT RAISED"):1 G:'$T POLLEND
;
G:'$D(^TMP("BMX EVENT RAISED",$J)) POLLEND
S BMXEVENT=0 F S BMXEVENT=$O(^TMP("BMX EVENT RAISED",$J,BMXEVENT)) Q:BMXEVENT']"" D
. N BMXINC
. S BMXINC=0
. F S BMXINC=$O(^TMP("BMX EVENT RAISED",$J,BMXEVENT,BMXINC)) Q:'+BMXINC D
. . ;Set output array node
. . S BMXPARAM=$G(^TMP("BMX EVENT RAISED",$J,BMXEVENT,BMXINC))
. . S BMXI=BMXI+1
. . S ^TMP("BMX",$J,BMXI)=BMXEVENT_U_BMXPARAM_$C(30)
. . Q
. Q
;S ^TMP("BMXTRACK",$P($H,",",2))="Job "_$J_" Killed "_$NA(^TMP("BMX EVENT RAISED",$J))
K ^TMP("BMX EVENT RAISED",$J)
;
POLLEND S BMXI=BMXI+1
S ^TMP("BMX",$J,BMXI)=$C(31)
L -^TMP("BMX EVENT RAISED")
Q
;
TTESTD(BMXY,BMXTIME) ;Debug entry point
;
;D DEBUG^%Serenji("TTEST^BMXMEVN(.BMXY,BMXTIME)")
Q
;
TTEST(BMXY,BMXTIME) ;EP Timer Test
;
S X="REGET^BMXMEVN",@^%ZOSF("TRAP")
S BMXY=$NA(^BMXTMP("BMX",$J)) K @BMXY
S ^BMXTMP("BMX",$J,0)="I00020HANGTIME"_$C(30)
I +BMXTIME H BMXTIME
;
S BMXI=1
S BMXI=BMXI+1
S ^BMXTMP("BMX",$J,BMXI)=BMXTIME_$C(30)_$C(31)
;
Q
;
UNREGALL ;EP
;Unregister all events for current session
;Called on exit of each session
;
N BMXEVENT
S BMXEVENT=""
K ^TMP("BMX EVENT",$J)
Q
;
UNREG(BMXY,BMXEVENT) ;EP
;RPC Called by client to Unregister client's interest in BMXEVENT
;Returns RECORDSET with field ERRORID.
;If everything ok then ERRORID = 0;
;
N BMXI
S BMXI=0
S X="REGET^BMXMEVN",@^%ZOSF("TRAP")
S BMXY=$NA(^TMP("BMX",$J)) K @BMXY
S ^TMP("BMX",$J,0)="I00020ERRORID"_$C(30)
K ^TMP("BMX EVENT",$J,BMXEVENT)
;
S BMXI=BMXI+1
S ^TMP("BMX",$J,BMXI)="0"_$C(30)_$C(31)
Q
;
POLLET ;EP
;Error trap from REGEVNT, RAISEVNT, ASYNCQUE and UNREG
;
I '$D(BMXI) N BMXI S BMXI=999
S BMXI=BMXI+1
D POLLERR(BMXI,99)
Q
;
POLLERR(BMXI,BMXERID) ;Error processing
S BMXI=BMXI+1
S ^TMP("BMX",$J,BMXI)=BMXERID_U_$C(30)
S BMXI=BMXI+1
S ^TMP("BMX",$J,BMXI)=$C(31)
Q
;
ASYNCQUD(BMXY,BMXRPC,BMXEVN) ;EP
;D DEBUG^%Serenji("ASYNCQUD^BMXMEVN(.BMXY,BMXRPC,BMXEVN)")
Q
;
ASYNCQUE(BMXY,BMXRPC,BMXEVN) ;EP
;RPC Queues taskman to job wrapper ASYNCZTM
N BMXRPCX
S BMXRPCX=$P(BMXRPC,$C(30))
;RETURNS EVENT NAME, ZTSK in PARAM
S X="POLLET^BMXMEVN",@^%ZOSF("TRAP")
S BMXY=$NA(^TMP("BMX ASYNC QUEUE",$J)) K @BMXY
S ^TMP("BMX ASYNC QUEUE",$J,0)="I00030ERRORID"_U_"I00030PARAM"_$C(30)
;
K BMXSEC
S BMXSEC=""
D CHKPRMIT^BMXMSEC(BMXRPCX) ;checks if RPC allowed to run
N OLDCTXT
I $L($G(BMXSEC)) D
. S OLDCTXT=""
. F S OLDCTXT=$O(XWBSTATE("ALLCTX",OLDCTXT)) Q:'$L($G(OLDCTXT)) D I '$L($G(BMXSEC)) Q
. . D ADDCTXT^BMXMSEC(DUZ,OLDCTXT)
. . D CHKPRMIT^BMXMSEC(BMXRPCX)
. . Q
. Q
I $L($G(BMXSEC)) D Q
. S ^TMP("BMX ASYNC QUEUE",$J,1)=2_U_$G(BMXSEC)_$C(30) ;IHS/OIT/HMW SAC Exemption Applied For
. S ^TMP("BMX ASYNC QUEUE",$J,2)=$C(31) ;IHS/OIT/HMW SAC Exemption Applied For
. Q
;K ZTSK
CHKOLDOK N ZTSK,ZTRTN,ZTSAVE,ZTDESC,ZTIO,ZTDTH
S ZTRTN="ASYNCZTM^BMXMEVN"
S BMXRPC=$TR(BMXRPC,"~",$C(30))
S ZTSAVE("BMXRPC")=""
S ZTSAVE("BMXEVN")=""
S ZTDESC="BMX ASYNC JOB"
S ZTIO="",ZTDTH=DT
D ^%ZTLOAD
;D @ZTRTN ;Debugging call
;
S ^TMP("BMX ASYNC QUEUE",$J,1)=1_U_$G(ZTSK)_$C(30)
S ^TMP("BMX ASYNC QUEUE",$J,2)=$C(31)
;
Q
;
ASYNCZTM ;EP
;Called by Taskman with BMXRPC and BMXEVN defined to
; 1) invoke the BMXRPC (RPC NAME^PARAM1^...^PARAMN)
; 2) when done, raises event BMXEVN with ZTSK^$J in BMXPARAM
;
N BMXRTN,BMXTAG,BMXRPCD,BMXCALL,BMXJ,BMXY,BMXNOD,BMXY
N BMXT S BMXT=$C(30)
I $E(BMXRPC,1,6)="SELECT" S BMXRPC="BMX SQL"_$C(30)_BMXRPC
S BMXRPCD=$O(^XWB(8994,"B",$P(BMXRPC,BMXT),0))
S BMXNOD=^XWB(8994,BMXRPCD,0)
S BMXRTN=$P(BMXNOD,U,3)
S BMXTAG=$P(BMXNOD,U,2)
S BMXCALL="D "_BMXTAG_"^"_BMXRTN_"(.BMXY,"
F BMXJ=2:1:$L(BMXRPC,BMXT) D
. S BMXCALL=BMXCALL_$C(34)_$P(BMXRPC,BMXT,BMXJ)_$C(34)
. S:BMXJ<$L(BMXRPC,BMXT) BMXCALL=BMXCALL_","
. Q
S BMXCALL=BMXCALL_")"
X BMXCALL
D EVENT(BMXEVN,$G(ZTSK)_"~"_$P($G(BMXY),U,2),$J,"")
Q
;
;
;Windows event handler:
;Catches event with ZTSK^DataLocation parameter
;Matches ZTSK to process that called event
;Calls ASYNCGET rpc with DATALOCATION parameter
;
ASYNCGET(BMXY,BMXDATA) ;EP
;RPC Retrieves data queued by ASYNCZTM
;by setting BMXY to BMXDATA
;
S BMXY="^"_BMXDATA
Q
;
ASYNCET ;EP
;Error trap from ASYNCQUE
;
I '$D(BMXI) N BMXI S BMXI=999
S BMXI=BMXI+1
D ASYNCERR(BMXI,0)
Q
;
ASYNCERR(BMXI,BMXERID) ;Error processing
S BMXI=BMXI+1
S ^TMP("BMX ASYNC QUEUE",$J,BMXI)=BMXERID_U_$C(30)
S BMXI=BMXI+1
S ^TMP("BMX ASYNC QUEUE",$J,BMXI)=$C(31)
Q
BMXMEVN ; IHS/OIT/HMW - BMXNet MONITOR ;
+1 ;;4.0;BMX;;JUN 28, 2010
+2 ;
+3 QUIT
+4 ;
REGET ;EP
+1 ;Error trap from REGEVNT, RAISEVNT, and UNREG
+2 ;
+3 IF '$DATA(BMXI)
NEW BMXI
SET BMXI=999
+4 SET BMXI=BMXI+1
+5 DO REGERR(BMXI,99)
+6 QUIT
+7 ;
REGERR(BMXI,BMXERID) ;Error processing
+1 SET BMXI=BMXI+1
+2 SET ^TMP("BMX",$JOB,BMXI)=BMXERID_$CHAR(30)
+3 SET BMXI=BMXI+1
+4 SET ^TMP("BMX",$JOB,BMXI)=$CHAR(31)
+5 QUIT
+6 ;
REGEVNT(BMXY,BMXEVENT) ;EP
+1 ;RPC Called by BMX REGISTER EVENT to inform RPMS server
+2 ;of client's interest in BMXEVENT
+3 ;Returns RECORDSET with field ERRORID.
+4 ;If everything ok then ERRORID = 0;
+5 ;
+6 NEW BMXI
+7 SET BMXI=0
+8 SET X="REGET^BMXMEVN"
SET @^%ZOSF("TRAP")
+9 SET BMXY=$NAME(^TMP("BMX",$JOB))
KILL @BMXY
+10 SET ^TMP("BMX",$JOB,0)="I00020ERRORID"_$CHAR(30)
+11 SET ^TMP("BMX EVENT",$JOB,BMXEVENT)=$GET(DUZ)
+12 ;
+13 SET BMXI=BMXI+1
+14 SET ^TMP("BMX",$JOB,BMXI)="0"_$CHAR(30)_$CHAR(31)
+15 QUIT
+16 ;
RAISEVNT(BMXY,BMXEVENT,BMXPARAM,BMXBACK,BMXKEY) ;EP
+1 ;RPC Called to raise event BMXEVENT with parameter BMXPARAM
+2 ;If BMXBACK = 'TRUE' then event will be raised back to originator
+3 ;Calls EVENT
+4 ;Returns a RECORDSET wit the field ERRORID.
+5 ;If everything ok then ERRORID = 0;
+6 ;
+7 NEW BMXI,BMXORIG
+8 SET BMXI=0
+9 SET BMXORIG=$SELECT($GET(BMXBACK)="TRUE":"",1:$JOB)
+10 SET BMXY=$NAME(^TMP("BMX",$JOB))
KILL @BMXY
+11 SET ^TMP("BMX",$JOB,0)="I00020ERRORID"_$CHAR(30)
+12 SET X="REGET^BMXMEVN"
SET @^%ZOSF("TRAP")
+13 ;
+14 DO EVENT(BMXEVENT,BMXPARAM,BMXORIG,$GET(BMXKEY))
+15 ;
+16 SET BMXI=BMXI+1
+17 SET ^TMP("BMX",$JOB,BMXI)="0"_$CHAR(30)_$CHAR(31)
+18 QUIT
+19 ;
EVENT(BMXEVENT,BMXPARAM,BMXORIG,BMXKEY) ;PEP - Raise event to interested clients
+1 ;Clients are listed in ^TMP("BMX EVENT",BMXEVENT,BMXSESS)=DUZ
+2 ;BMXORIG represents the event originator's session
+3 ;The event will not be raised back to the originator if BMXORIG is the session of the originator
+4 ;BMXKEY is a ~-delimited list of security keys. Only holders of one of these keys
+5 ;will receive event notification. If BMXKEY is "" then all registered sessions
+6 ;will be notified.
+7 ;
+8 LOCK +^TMP("BMX EVENT RAISED"):30
+9 NEW BMXSESS,BMXINC
+10 SET BMXSESS=0
FOR
SET BMXSESS=$ORDER(^TMP("BMX EVENT",BMXSESS))
IF '+BMXSESS
QUIT
Begin DoDot:1
+11 IF BMXSESS=$GET(BMXORIG)
QUIT
+12 IF '$DATA(^TMP("BMX EVENT",BMXSESS,BMXEVENT))
QUIT
+13 ;S BMXDUZ=^TMP("BMX EVENT",BMXEVENT,BMXSESS)
+14 SET BMXDUZ=^TMP("BMX EVENT",BMXSESS,BMXEVENT)
+15 ;TODO: Test if DUZ holds at least one of the keys in BMXKEY
+16 SET BMXINC=$ORDER(^TMP("BMX EVENT RAISED",BMXSESS,BMXEVENT,99999999),-1)
+17 IF BMXINC=""
SET BMXINC=0
+18 ;S ^TMP("BMXTRACK",$P($H,",",2))="Job "_$J_" Set "_$NA(^TMP("BMX EVENT RAISED",BMXSESS,BMXEVENT,BMXINC+1))_"="_$G(BMXPARAM)
+19 ;IHS/OIT/HMW SAC Exemption Applied For
SET ^TMP("BMX EVENT RAISED",BMXSESS,BMXEVENT,BMXINC+1)=$GET(BMXPARAM)
+20 QUIT
End DoDot:1
+21 LOCK -^TMP("BMX EVENT RAISED")
+22 QUIT
+23 ;
POLLD(BMXY) ;EP
+1 ;Debug Entry Point
+2 ;D DEBUG^%Serenji("POLLD^BMXMEVN(.BMXY)")
+3 QUIT
+4 ;
POLL(BMXY) ;EP
+1 ;Check event queue for events of interest to current session
+2 ;Return DataSet of events and parameters
+3 ;Called by BMX EVENT POLL
+4 ;
+5 NEW BMXI,BMXEVENT
+6 SET BMXI=0
+7 SET X="POLLET^BMXMEVN"
SET @^%ZOSF("TRAP")
+8 SET BMXY=$NAME(^TMP("BMX",$JOB))
KILL @BMXY
+9 SET ^TMP("BMX",$JOB,0)="T00030EVENT"_U_"T00030PARAM"_$CHAR(30)
+10 LOCK +^TMP("BMX EVENT RAISED"):1
IF '$TEST
GOTO POLLEND
+11 ;
+12 IF '$DATA(^TMP("BMX EVENT RAISED",$JOB))
GOTO POLLEND
+13 SET BMXEVENT=0
FOR
SET BMXEVENT=$ORDER(^TMP("BMX EVENT RAISED",$JOB,BMXEVENT))
IF BMXEVENT']""
QUIT
Begin DoDot:1
+14 NEW BMXINC
+15 SET BMXINC=0
+16 FOR
SET BMXINC=$ORDER(^TMP("BMX EVENT RAISED",$JOB,BMXEVENT,BMXINC))
IF '+BMXINC
QUIT
Begin DoDot:2
+17 ;Set output array node
+18 SET BMXPARAM=$GET(^TMP("BMX EVENT RAISED",$JOB,BMXEVENT,BMXINC))
+19 SET BMXI=BMXI+1
+20 SET ^TMP("BMX",$JOB,BMXI)=BMXEVENT_U_BMXPARAM_$CHAR(30)
+21 QUIT
End DoDot:2
+22 QUIT
End DoDot:1
+23 ;S ^TMP("BMXTRACK",$P($H,",",2))="Job "_$J_" Killed "_$NA(^TMP("BMX EVENT RAISED",$J))
+24 KILL ^TMP("BMX EVENT RAISED",$JOB)
+25 ;
POLLEND SET BMXI=BMXI+1
+1 SET ^TMP("BMX",$JOB,BMXI)=$CHAR(31)
+2 LOCK -^TMP("BMX EVENT RAISED")
+3 QUIT
+4 ;
TTESTD(BMXY,BMXTIME) ;Debug entry point
+1 ;
+2 ;D DEBUG^%Serenji("TTEST^BMXMEVN(.BMXY,BMXTIME)")
+3 QUIT
+4 ;
TTEST(BMXY,BMXTIME) ;EP Timer Test
+1 ;
+2 SET X="REGET^BMXMEVN"
SET @^%ZOSF("TRAP")
+3 SET BMXY=$NAME(^BMXTMP("BMX",$JOB))
KILL @BMXY
+4 SET ^BMXTMP("BMX",$JOB,0)="I00020HANGTIME"_$CHAR(30)
+5 IF +BMXTIME
HANG BMXTIME
+6 ;
+7 SET BMXI=1
+8 SET BMXI=BMXI+1
+9 SET ^BMXTMP("BMX",$JOB,BMXI)=BMXTIME_$CHAR(30)_$CHAR(31)
+10 ;
+11 QUIT
+12 ;
UNREGALL ;EP
+1 ;Unregister all events for current session
+2 ;Called on exit of each session
+3 ;
+4 NEW BMXEVENT
+5 SET BMXEVENT=""
+6 KILL ^TMP("BMX EVENT",$JOB)
+7 QUIT
+8 ;
UNREG(BMXY,BMXEVENT) ;EP
+1 ;RPC Called by client to Unregister client's interest in BMXEVENT
+2 ;Returns RECORDSET with field ERRORID.
+3 ;If everything ok then ERRORID = 0;
+4 ;
+5 NEW BMXI
+6 SET BMXI=0
+7 SET X="REGET^BMXMEVN"
SET @^%ZOSF("TRAP")
+8 SET BMXY=$NAME(^TMP("BMX",$JOB))
KILL @BMXY
+9 SET ^TMP("BMX",$JOB,0)="I00020ERRORID"_$CHAR(30)
+10 KILL ^TMP("BMX EVENT",$JOB,BMXEVENT)
+11 ;
+12 SET BMXI=BMXI+1
+13 SET ^TMP("BMX",$JOB,BMXI)="0"_$CHAR(30)_$CHAR(31)
+14 QUIT
+15 ;
POLLET ;EP
+1 ;Error trap from REGEVNT, RAISEVNT, ASYNCQUE and UNREG
+2 ;
+3 IF '$DATA(BMXI)
NEW BMXI
SET BMXI=999
+4 SET BMXI=BMXI+1
+5 DO POLLERR(BMXI,99)
+6 QUIT
+7 ;
POLLERR(BMXI,BMXERID) ;Error processing
+1 SET BMXI=BMXI+1
+2 SET ^TMP("BMX",$JOB,BMXI)=BMXERID_U_$CHAR(30)
+3 SET BMXI=BMXI+1
+4 SET ^TMP("BMX",$JOB,BMXI)=$CHAR(31)
+5 QUIT
+6 ;
ASYNCQUD(BMXY,BMXRPC,BMXEVN) ;EP
+1 ;D DEBUG^%Serenji("ASYNCQUD^BMXMEVN(.BMXY,BMXRPC,BMXEVN)")
+2 QUIT
+3 ;
ASYNCQUE(BMXY,BMXRPC,BMXEVN) ;EP
+1 ;RPC Queues taskman to job wrapper ASYNCZTM
+2 NEW BMXRPCX
+3 SET BMXRPCX=$PIECE(BMXRPC,$CHAR(30))
+4 ;RETURNS EVENT NAME, ZTSK in PARAM
+5 SET X="POLLET^BMXMEVN"
SET @^%ZOSF("TRAP")
+6 SET BMXY=$NAME(^TMP("BMX ASYNC QUEUE",$JOB))
KILL @BMXY
+7 SET ^TMP("BMX ASYNC QUEUE",$JOB,0)="I00030ERRORID"_U_"I00030PARAM"_$CHAR(30)
+8 ;
+9 KILL BMXSEC
+10 SET BMXSEC=""
+11 ;checks if RPC allowed to run
DO CHKPRMIT^BMXMSEC(BMXRPCX)
+12 NEW OLDCTXT
+13 IF $LENGTH($GET(BMXSEC))
Begin DoDot:1
+14 SET OLDCTXT=""
+15 FOR
SET OLDCTXT=$ORDER(XWBSTATE("ALLCTX",OLDCTXT))
IF '$LENGTH($GET(OLDCTXT))
QUIT
Begin DoDot:2
+16 DO ADDCTXT^BMXMSEC(DUZ,OLDCTXT)
+17 DO CHKPRMIT^BMXMSEC(BMXRPCX)
+18 QUIT
End DoDot:2
IF '$LENGTH($GET(BMXSEC))
QUIT
+19 QUIT
End DoDot:1
+20 IF $LENGTH($GET(BMXSEC))
Begin DoDot:1
+21 ;IHS/OIT/HMW SAC Exemption Applied For
SET ^TMP("BMX ASYNC QUEUE",$JOB,1)=2_U_$GET(BMXSEC)_$CHAR(30)
+22 ;IHS/OIT/HMW SAC Exemption Applied For
SET ^TMP("BMX ASYNC QUEUE",$JOB,2)=$CHAR(31)
+23 QUIT
End DoDot:1
QUIT
+24 ;K ZTSK
CHKOLDOK NEW ZTSK,ZTRTN,ZTSAVE,ZTDESC,ZTIO,ZTDTH
+1 SET ZTRTN="ASYNCZTM^BMXMEVN"
+2 SET BMXRPC=$TRANSLATE(BMXRPC,"~",$CHAR(30))
+3 SET ZTSAVE("BMXRPC")=""
+4 SET ZTSAVE("BMXEVN")=""
+5 SET ZTDESC="BMX ASYNC JOB"
+6 SET ZTIO=""
SET ZTDTH=DT
+7 DO ^%ZTLOAD
+8 ;D @ZTRTN ;Debugging call
+9 ;
+10 SET ^TMP("BMX ASYNC QUEUE",$JOB,1)=1_U_$GET(ZTSK)_$CHAR(30)
+11 SET ^TMP("BMX ASYNC QUEUE",$JOB,2)=$CHAR(31)
+12 ;
+13 QUIT
+14 ;
ASYNCZTM ;EP
+1 ;Called by Taskman with BMXRPC and BMXEVN defined to
+2 ; 1) invoke the BMXRPC (RPC NAME^PARAM1^...^PARAMN)
+3 ; 2) when done, raises event BMXEVN with ZTSK^$J in BMXPARAM
+4 ;
+5 NEW BMXRTN,BMXTAG,BMXRPCD,BMXCALL,BMXJ,BMXY,BMXNOD,BMXY
+6 NEW BMXT
SET BMXT=$CHAR(30)
+7 IF $EXTRACT(BMXRPC,1,6)="SELECT"
SET BMXRPC="BMX SQL"_$CHAR(30)_BMXRPC
+8 SET BMXRPCD=$ORDER(^XWB(8994,"B",$PIECE(BMXRPC,BMXT),0))
+9 SET BMXNOD=^XWB(8994,BMXRPCD,0)
+10 SET BMXRTN=$PIECE(BMXNOD,U,3)
+11 SET BMXTAG=$PIECE(BMXNOD,U,2)
+12 SET BMXCALL="D "_BMXTAG_"^"_BMXRTN_"(.BMXY,"
+13 FOR BMXJ=2:1:$LENGTH(BMXRPC,BMXT)
Begin DoDot:1
+14 SET BMXCALL=BMXCALL_$CHAR(34)_$PIECE(BMXRPC,BMXT,BMXJ)_$CHAR(34)
+15 IF BMXJ<$LENGTH(BMXRPC,BMXT)
SET BMXCALL=BMXCALL_","
+16 QUIT
End DoDot:1
+17 SET BMXCALL=BMXCALL_")"
+18 XECUTE BMXCALL
+19 DO EVENT(BMXEVN,$GET(ZTSK)_"~"_$PIECE($GET(BMXY),U,2),$JOB,"")
+20 QUIT
+21 ;
+22 ;
+23 ;Windows event handler:
+24 ;Catches event with ZTSK^DataLocation parameter
+25 ;Matches ZTSK to process that called event
+26 ;Calls ASYNCGET rpc with DATALOCATION parameter
+27 ;
ASYNCGET(BMXY,BMXDATA) ;EP
+1 ;RPC Retrieves data queued by ASYNCZTM
+2 ;by setting BMXY to BMXDATA
+3 ;
+4 SET BMXY="^"_BMXDATA
+5 QUIT
+6 ;
ASYNCET ;EP
+1 ;Error trap from ASYNCQUE
+2 ;
+3 IF '$DATA(BMXI)
NEW BMXI
SET BMXI=999
+4 SET BMXI=BMXI+1
+5 DO ASYNCERR(BMXI,0)
+6 QUIT
+7 ;
ASYNCERR(BMXI,BMXERID) ;Error processing
+1 SET BMXI=BMXI+1
+2 SET ^TMP("BMX ASYNC QUEUE",$JOB,BMXI)=BMXERID_U_$CHAR(30)
+3 SET BMXI=BMXI+1
+4 SET ^TMP("BMX ASYNC QUEUE",$JOB,BMXI)=$CHAR(31)
+5 QUIT
