Routine: BMXMEVN

BMXMEVN ; IHS/OIT/HMW - BMXNet MONITOR ;

 ;;4.0;BMX;;JUN 28, 2010

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)

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)

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)

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)

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")

POLLD(BMXY) ;EP

 ;Debug Entry Point

 ;D DEBUG^%Serenji("POLLD^BMXMEVN(.BMXY)")

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")

TTESTD(BMXY,BMXTIME) ;Debug entry point

 ;D DEBUG^%Serenji("TTEST^BMXMEVN(.BMXY,BMXTIME)")

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)

UNREGALL ;EP

 ;Unregister all events for current session

 ;Called on exit of each session

 N BMXEVENT

 S BMXEVENT=""

 K ^TMP("BMX EVENT",$J)

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)

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)

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)

ASYNCQUD(BMXY,BMXRPC,BMXEVN) ;EP

 ;D DEBUG^%Serenji("ASYNCQUD^BMXMEVN(.BMXY,BMXRPC,BMXEVN)")

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)

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,"")

 ;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

ASYNCET ;EP

 ;Error trap from ASYNCQUE

 I '$D(BMXI) N BMXI S BMXI=999

 S BMXI=BMXI+1

 D ASYNCERR(BMXI,0)

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)

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

BMXMEVN.m