Routine: BMXMON

BMXMON ; IHS/OIT/HMW - BMXNet MONITOR ; 04 Jun 2010  3:10 PM

 ;;4.0;BMX;**2**;OCT 27, 2011;Build 2

 ;IHS/OIT/HMW Patch 1 added validity check for passed-in namespace

STRT(BMXPORT,NS,IS,VB) ;EP

 ;Interactive monitor start

 ;Optional NS = namespace.  If undefined, start in current ns

 ;Optional IS = Integrated Security.  Default is 1

 ;Optional VB = Verbose. Default is 1

 N Y,BMXNS,BMXWIN

 ;Verbose

 S BMXVB=$G(VB,1)

 ;Check if port already running

 I '$$SEMAPHOR(BMXPORT,"LOCK") W:BMXVB "BMXNet Monitor on port "_BMXPORT_" appears to be running already.",! Q

 S %=$$SEMAPHOR(BMXPORT,"UNLOCK")

 D MARKER(BMXPORT,1) ;record problem marker

 ; -- start the monitor

 ;Namespace

 X ^%ZOSF("UCI")

 S BMXNS=$G(NS,$P(Y,","))

 ;Integrated security

 S BMXWIN=$G(IS,1)

 ;J DEBUG^%Serenji("MON^BMXMON("_BMXPORT_","_BMXNS_","_BMXWIN_")")

 J MON^BMXMON(BMXPORT,BMXNS,BMXWIN)::5 I '$T W:BMXVB "Unable to run BMXNet Monitor in background.",! Q  ;IHS/OIT/HMW SAC Exemption Applied For

 F %=1:1:5 D  Q:%=0

 . W:BMXVB "Checking if BMXNet Monitor has started...",!

 . H 1

 . S:'$$MARKER(BMXPORT,0) %=0

 I $$MARKER(BMXPORT,0) D

 . W:BMXVB !,"BMXNet Monitor could not be started!",!

 . W:BMXVB "Check if port "_BMXPORT_" is busy on this CPU.",!

 . D MARKER(BMXPORT,-1) ;clear marker

 E  W:BMXVB "BMXNet Monitor started successfully."

RESTART ;EP

 ;Stop and Start all monitors in BMX MONITOR file

 ;Called by option BMX MONITOR START

 D STOPALL

 D STRTALL

STRTALL ;EP

 ;Start all monitors in BMX MONITOR file

 N BMXIEN

 S BMXIEN=0 F  S BMXIEN=$O(^BMXMON(BMXIEN)) Q:'+BMXIEN  D

 . S BMXNOD=$G(^BMXMON(BMXIEN,0))

 . Q:'+BMXNOD

 . Q:'+$P(BMXNOD,U,2)

 . S BMXWIN=$P(BMXNOD,U,3)

 . S BMXNS=$P(BMXNOD,U,4)

 . D STRT($P(BMXNOD,U),BMXNS,BMXWIN,0)

. Q

STOPALL ;EP

 ;Stop all monitors in BMXNET MONITOR file

 N BMXIEN,BMXPORT

 S BMXIEN=0 F  S BMXIEN=$O(^BMXMON(BMXIEN)) Q:'+BMXIEN  D

 . S BMXNOD=$G(^BMXMON(BMXIEN,0))

 . Q:'+BMXNOD

 . S BMXPORT=+BMXNOD

 . D STOP(BMXPORT,0)

STOP(BMXPORT,VB) ;EP Stop monitor on BMXPORT

 ;Open a channel to monitor on BMXPORT and send shutdown request

 ;Optional VB = Verbose. Default is 1

 N IP,REF,X,DEV

 S U="^" D HOME^%ZIS

 ;Verbose

 S BMXVB=$G(VB,1)

 D:BMXVB EN^DDIOL("Stop BMXNet Monitor...")

 X ^%ZOSF("UCI") S REF=Y

 S IP="0.0.0.0" ;get server IP

 IF $G(BMXPORT)="" S BMXPORT=9200

 ; -- make sure the listener is running

 I $$SEMAPHOR(BMXPORT,"LOCK") D  Q

 . S %=$$SEMAPHOR(BMXPORT,"UNLOCK")

 . D:BMXVB EN^DDIOL("BMXNet Monitor does not appear to be running.")

 ; -- send the shutdown message to the TCP Listener process

 D CALL^%ZISTCP("127.0.0.1",BMXPORT) I POP D  Q

 . S %=$$SEMAPHOR(BMXPORT,"UNLOCK")

 . D:BMXVB EN^DDIOL("BMXNet Monitor does not appear to be running.")

 U IO

 S X=$T(+2),X=$P(X,";;",2),X=$P(X,";")

 IF X="" S X=0

 S X=$C($L(X))_X

 W "{BMX}00011TCPshutdown",!

 R X#3:5 ;IHS/OIT/HMW SAC Exemption Applied For

 D CLOSE^%ZISTCP

 I X="ack" D:BMXVB EN^DDIOL("BMXNet Monitor has been shutdown.")

 E  D:BMXVB EN^DDIOL("Shutdown Failed!")

 ;change process name

 D CHPRN($J)

MON(BMXPORT,NS,IS) ;Monitor port for connection & shutdown requests

 ;NS = Namespace to Start monitor

 ;IS = 1: Enable integrated security

 N BMXDEV,BMXQUIT,BMXDTIME,BMXLEN,BMXACT,BMXWIN,BMXNS

 S BMXQUIT=0,BMXDTIME=999999

 ;Set lock

 Q:'$$SEMAPHOR(BMXPORT,"LOCK")

 ;Clear problem marker

 D MARKER(BMXPORT,-1)

 ;H 1

 ;Namespace

 X ^%ZOSF("UCI")

 I $G(NS)="" S BMXNS=$P(Y,",")

 E  S BMXNS=NS

 ;Integrated security

 S BMXWIN=$G(IS,1)

 ;Open server port;

 S BMXDEV="|TCP|"_BMXPORT

RELOAD C BMXDEV ;IHS/OIT/HMW SAC Exemption Applied For ; IHS/OIT/GIS 10/4/2011

 O BMXDEV:(:BMXPORT:"S"):5 I '$T Q  ;IHS/OIT/HMW SAC Exemption Applied For

 ;S BMXDTIME(1)=BMXDTIME ; TODO: Set timeouts

 S BMXDTIME(1)=.5 ;HMW 20050120

 U BMXDEV

 F  D  Q:BMXQUIT

 . R BMXACT#5:BMXDTIME ;Read first 5 chars from TCP buffer, timeout=BMXDTIME ;IHS/OIT/HMW SAC Exemption Applied For

 . I BMXACT="" S BMXQUIT=1 Q  ; LISTENER TIMED OUT AFTER 999999 SECONDS (10 DAYS) ; IHS/OIT/GIS 10/4/2011

 . I BMXACT'="{BMX}" S BMXQUIT=2 Q  ; PRIMARY MESSSAGE IS INVALID.  NEED TO CLEAN OUT TCP BUFFER AND START OVER ; IHS/OIT/GIS 10/4/2011

 . R BMXACT#5:BMXDTIME ;Read next 5 chars - message length ;IHS/OIT/HMW SAC Exemption Applied For

 . S BMXLEN=+BMXACT

 . R BMXACT#BMXLEN:BMXDTIME ;IHS/OIT/HMW SAC Exemption Applied For

 . I $P(BMXACT,"^")="TCPconnect" D  Q

 . . N BMXNSJ,X,Y,ZCHILD,%

 . . S BMXNSJ=$P(BMXACT,"^",2) ;Namespace

 . . S BMXNSJ=$P(BMXNSJ,",")

 . . I BMXNSJ="" S BMXNSJ=BMXNS

 . . S X=BMXNSJ

 . . X ^%ZOSF("UCICHECK") I Y=0 S BMXNSJ=BMXNS

 . . S STATUS=$S(Y'=0:"CONNECTION OK",1:"CONNECTION FAILED, INVALID NAMESPACE") ; SET CONNECTION STATUS BASED ON NAMESPACE VALIDITY

 . . J SESSION^BMXMON(BMXWIN)[BMXNSJ]:(:5:BMXDEV:BMXDEV):5 ;IHS/OIT/HMW SAC Exemption Applied For

 . . X ("S ZCHILD="_$C(36,90)_"CHILD")

 . . I ZCHILD S ^BMXTMP("CONNECT STATUS",ZCHILD)=STATUS

 . . Q

 . I $P(BMXACT,"^")="TCPshutdown" S BMXQUIT=1 W "ack",!

 I BMXQUIT=2 S BMXQUIT=0 G RELOAD ; PRIMARY MSG IS INVALID.  CLEAR TCP BUFFER AND START ITERATING AGAIN. ; IHS/OIT/GIS 10/4/2011

 S %=$$SEMAPHOR(BMXPORT,"UNLOCK") ; destroy 'running flag'

SESSION(BMXWIN) ;EP

 ;Start session monitor

 ;BMXWIN = 1: Enable integrated security

SESSRES ;EP - reentry point from trap

 ;IHS/OIT/HMW SAC Exemption Applied For

 N $ESTACK S $ETRAP="D ETRAP^BMXMON"

 S DIQUIET=1,U="^" D DT^DICRW

 D UNREGALL^BMXMEVN ;Unregister all events for this session

 U $P D SESSMAIN

 ;Turn off the error trap for the exit

 S $ETRAP=""

 I $G(DUZ) D LOGOUT^XUSRB

 K BMXR,BMXARY

 C $P ;IHS/OIT/HMW SAC Exemption Applied For

SESSMAIN ;

 N BMXTBUF

 D SETUP^BMXMSEC(.RET) ;Setup required system vars

 S U="^"

 U $P

 F  D  Q:BMXTBUF="#BYE#"

 . R BMXTBUF#11:BMXDTIME IF '$T D TIMEOUT S BMXTBUF="#BYE#" Q  ;IHS/OIT/HMW SAC Exemption Applied For

 . I BMXTBUF["XQKEY" S HWMP=1

 . I BMXTBUF="#BYE#" Q

 . S BMXHTYPE=$S($E(BMXTBUF,1,5)="{BMX}":1,1:0)  ;check HDR

 . I 'BMXHTYPE S BMXTBUF="#BYE#" D SNDERR W BMXTBUF,$C(4),! Q

 . S BMXTLEN=$E(BMXTBUF,6,10),L=$E(BMXTBUF,11,11)

 . R BMXTBUF#4:BMXDTIME(1) S BMXTBUF=L_BMXTBUF ;IHS/OIT/HMW SAC Exemption Applied For

 . S BMXPLEN=BMXTBUF

 . R BMXTBUF#BMXPLEN:BMXDTIME(1) ;IHS/OIT/HMW SAC Exemption Applied For

 . I $P(BMXTBUF,U)="TCPconnect" D  Q

 . . D SNDERR W "accept",$C(4),!  ;Ack

 . IF BMXHTYPE D

 . . K BMXR,BMXARY

 . . IF BMXTBUF="#BYE#" D SNDERR W "#BYE#",$C(4),! Q

 . . S BMXTLEN=BMXTLEN-15

 . . D CALLP^BMXMBRK(.BMXR,BMXTBUF)

 . . S BMXPTYPE=$S('$D(BMXPTYPE):1,BMXPTYPE<1:1,BMXPTYPE>6:1,1:BMXPTYPE)

 . IF BMXTBUF="#BYE#" Q

 . U $P

 . D SNDERR ;Clears SNDERR parameters

 . D SND

 . D WRITE($C(4)) W *-3 ;send eot and flush buffer

 D UNREGALL^BMXMEVN ;Unregister all events for this session

 Q  ;End Of Main

SNDERR ;send error information

 ;BMXSEC is the security packet, BMXERROR is application packet

N X

 S X=$E($G(BMXSEC),1,255)

 W $C($L(X))_X W *-3

 S X=$E($G(BMXERROR),1,255)

 W $C($L(X))_X W *-3

 S BMXERROR="",BMXSEC="" ;clears parameters

WRITE(BMXSTR) ;Write a data string

 I $L(BMXSTR)<511 W *-3 W BMXSTR Q

 ;Handle a long string

 W *-3 ;Flush the buffer

 F  Q:'$L(BMXSTR)  W $E(BMXSTR,1,510),*-3 S BMXSTR=$E(BMXSTR,511,99999)

SND ; -- send data for all, Let WRITE sort it out

 N I,T

 ; -- error or abort occurred, send null

 IF $L(BMXSEC)>0 D WRITE("") Q

 ; -- single value

 IF BMXPTYPE=1 S BMXR=$G(BMXR) D WRITE(BMXR) Q

 ; -- table delimited by CR+LF

 IF BMXPTYPE=2 D  Q

 . S I="" F  S I=$O(BMXR(I)) Q:I=""  D WRITE(BMXR(I)),WRITE($C(13,10))

 ; -- word processing

 IF BMXPTYPE=3 D  Q

 . S I="" F  S I=$O(BMXR(I)) Q:I=""  D WRITE(BMXR(I)) D:BMXWRAP WRITE($C(13,10))

 ; -- global array

 IF BMXPTYPE=4 D  Q

 . S I=$G(BMXR) Q:I=""  S T=$E(I,1,$L(I)-1) D:$D(@I)>10 WRITE(@I)

 . F  S I=$Q(@I) Q:I=""!(I'[T)  W *-3 W @I W:BMXWRAP&(@I'=$C(13,10)) $C(13,10)

 . IF $D(@BMXR) K @BMXR

 ; -- global instance

 IF BMXPTYPE=5 S BMXR=$G(@BMXR) D WRITE(BMXR) Q

 ; -- variable length records only good upto 255 char)

 IF BMXPTYPE=6 S I="" F  S I=$O(BMXR(I)) Q:I=""  D WRITE($C($L(BMXR(I)))),WRITE(BMXR(I))

TIMEOUT ;Do this on MAIN  loop timeout

 I $G(DUZ)>0 D SNDERR,WRITE("#BYE#"_$C(4)) Q

 ;Sign-on timeout

 S BMXR(0)=0,BMXR(1)=1,BMXR(2)="",BMXR(3)="TIME-OUT",BMXPTYPE=2

 D SNDERR,SND,WRITE($C(4))

SEMAPHOR(BMXTSKT,BMXACT) ;Lock/Unlock BMXMON semaphore

 N RESULT

 S U="^",RESULT=1

 D GETENV^%ZOSV ;get Y=UCI^VOL^NODE^BOXLOOKUP of current system

 I BMXACT="LOCK" D

 . L +^BMXMON("BMXMON",$P(Y,U,2),$P(Y,U),$P(Y,U,4),BMXTSKT):1

 . S RESULT=$T

 E  L -^BMXMON("BMXMON",$P(Y,U,2),$P(Y,U),$P(Y,U,4),BMXTSKT)

 Q RESULT

CHPRN(N) ;Change process name to N.

 D SETNM^%ZOSV($E(N,1,15))

CKSTAT(OUT,IN) ; EP - RPC: BMX CONNECT STATUS ; CONFIRMS THAT THAT A VALID PROCESS HAS BEEN SPAWNED BY BMXMON

 N PORT,STATUS,JOBID

 S PORT=+$P($P,"|",3)

 S JOBID=$P($J,":",1)

 I $G(^BMXTMP("CONNECT STATUS",JOBID))="" HANG 1  ;Wait for job to spawn ZCHILD to be set in MON^

 I $G(^BMXTMP("CONNECT STATUS",JOBID))="" HANG 1

 I $G(^BMXTMP("CONNECT STATUS",JOBID))="" HANG 1

 S STATUS=$G(^BMXTMP("CONNECT STATUS",JOBID))

 K ^BMXTMP("CONNECT STATUS",JOBID)

 I STATUS="" S STATUS="CONNECTION STATUS UNKNOWN"

 S OUT=PORT_"|"_STATUS_"|"_JOBID

MARKER(BMXPORT,BMXMODE) ;Set/Test/Clear Problem Marker, BMXMODE=0 is a function

 N IP,Y,%,REF X ^%ZOSF("UCI") S REF=Y,IP="0.0.0.0",%=0

 L +^BMX(IP,REF,BMXPORT,"PROBLEM MARKER"):1

 I BMXMODE=1 S ^BMX(IP,REF,BMXPORT,"PROBLEM MARKER")=1

 I BMXMODE=0 S:$D(^BMX(IP,REF,BMXPORT,"PROBLEM MARKER")) %=1

 I BMXMODE=-1 K ^BMX(IP,REF,BMXPORT,"PROBLEM MARKER")

 L -^BMX(IP,REF,BMXPORT,"PROBLEM MARKER")

 Q:BMXMODE=0 % Q

ETRAP ; -- on trapped error, send error info to client

 N BMXERC,BMXERR,BMXLGR

 ;Change trapping during trap.

 S $ETRAP="D ^%ZTER HALT" ;IHS/OIT/HMW SAC Exemption Applied For

 S BMXERC=$$EC^%ZOSV

 S BMXERR="M ERROR="_BMXERC_$C(13,10)_"LAST REF="

 S BMXLGR=$$LGR^%ZOSV_$C(4)

 S BMXERR=BMXERR_BMXLGR

 D ^%ZTER ;%ZTER clears $ZE and $ECODE

 I (BMXERC["READ")!(BMXERC["WRITE")!(BMXERC["SYSTEM-F") D:$G(DUZ) LOGOUT^XUSRB G ^XUSCLEAN

 U $P

 D SNDERR,WRITE(BMXERR) W *-3

 S $ETRAP="Q:($ESTACK&'$QUIT)  Q:$ESTACK -9 S $ECODE="""" G SESSRES^BMXMON",$ECODE=",U99," ;IHS/OIT/HMW SAC Exemption Applied For

MENU ;EP - ENTRY ACTION FROM BMXMENU OPTION

 N BMX,BMXVER

 ;VERSION

 . S BMXN="BMXNET ADO.NET DATA PROVIDER" I $D(^DIC(9.4,"B",BMXN)) Q

 . S BMXN="BMXNET RPMS .NET UTILITIES" I $D(^DIC(9.4,"B",BMXN)) Q

 . S BMXN=""

. Q

 S BMXVER=""

 I BMXN]"",$D(^DIC(9.4,"B",BMXN)) D

 . S BMX=$O(^DIC(9.4,"B",BMXN,0))

 . I $D(^DIC(9.4,BMX,"VERSION")) S BMXVER=$P(^DIC(9.4,BMX,"VERSION"),"^")

 . E  S BMXVER="VERSION NOT FOUND"

 S:BMXVER="" BMXVER="VERSION NOT FOUND"

 ;LOCATION

 N BMXLOC

 S BMXLOC=""

 I $G(DUZ(2)),$D(^DIC(4,DUZ(2),0)) S BMXLOC=$P(^DIC(4,DUZ(2),0),"^")

 S:BMXLOC="" BMXLOC="LOCATION NOT FOUND"

 ;WRITE

W !

 W !,"BMXNet Version: ",BMXVER

 W !,"Location: ",BMXLOC

BMXMON    ; IHS/OIT/HMW - BMXNet MONITOR ; 04 Jun 2010  3:10 PM

 +1       ;;4.0;BMX;**2**;OCT 27, 2011;Build 2

 +2       ;

 +3       ;IHS/OIT/HMW Patch 1 added validity check for passed-in namespace

 +4       ;

STRT(BMXPORT,NS,IS,VB) ;EP

 +1       ;Interactive monitor start

 +2       ;Optional NS = namespace.  If undefined, start in current ns

 +3       ;Optional IS = Integrated Security.  Default is 1

 +4       ;Optional VB = Verbose. Default is 1

 +5       ;

 +6        NEW Y,BMXNS,BMXWIN

 +7       ;

 +8       ;Verbose

 +9        SET BMXVB=$GET(VB,1)

 +10      ;

 +11      ;Check if port already running

 +12       IF '$$SEMAPHOR(BMXPORT,"LOCK")

               IF BMXVB

                   WRITE "BMXNet Monitor on port "_BMXPORT_" appears to be running already.",!

               QUIT

 +13       SET %=$$SEMAPHOR(BMXPORT,"UNLOCK")

 +14      ;

 +15      ;record problem marker

           DO MARKER(BMXPORT,1)

 +16      ; -- start the monitor

 +17      ;

 +18      ;Namespace

 +19       XECUTE ^%ZOSF("UCI")

 +20       SET BMXNS=$GET(NS,$PIECE(Y,","))

 +21      ;

 +22      ;Integrated security

 +23       SET BMXWIN=$GET(IS,1)

 +24      ;

 +25      ;J DEBUG^%Serenji("MON^BMXMON("_BMXPORT_","_BMXNS_","_BMXWIN_")")

 +26      ;IHS/OIT/HMW SAC Exemption Applied For

           JOB MON^BMXMON(BMXPORT,BMXNS,BMXWIN)::5

           IF '$TEST

               IF BMXVB

                   WRITE "Unable to run BMXNet Monitor in background.",!

               QUIT

 +27       FOR %=1:1:5

               Begin DoDot:1

 +28               IF BMXVB

                       WRITE "Checking if BMXNet Monitor has started...",!

 +29               HANG 1

 +30               IF '$$MARKER(BMXPORT,0)

                       SET %=0

               End DoDot:1

               IF %=0

                   QUIT

 +31       IF $$MARKER(BMXPORT,0)

               Begin DoDot:1

 +32               IF BMXVB

                       WRITE !,"BMXNet Monitor could not be started!",!

 +33               IF BMXVB

                       WRITE "Check if port "_BMXPORT_" is busy on this CPU.",!

 +34      ;clear marker

                   DO MARKER(BMXPORT,-1)

               End DoDot:1

 +35      IF '$TEST

               IF BMXVB

                   WRITE "BMXNet Monitor started successfully."

 +36      ;

 +37       QUIT

 +38      ;

RESTART   ;EP

 +1       ;Stop and Start all monitors in BMX MONITOR file

 +2       ;Called by option BMX MONITOR START

 +3       ;

 +4        DO STOPALL

 +5        DO STRTALL

 +6        QUIT

 +7       ;

STRTALL   ;EP

 +1       ;Start all monitors in BMX MONITOR file

 +2       ;

 +3        NEW BMXIEN

 +4        SET BMXIEN=0

FOR

               SET BMXIEN=$ORDER(^BMXMON(BMXIEN))

               IF '+BMXIEN

                   QUIT

               Begin DoDot:1

 +5                SET BMXNOD=$GET(^BMXMON(BMXIEN,0))

 +6                IF '+BMXNOD

                       QUIT

 +7                IF '+$PIECE(BMXNOD,U,2)

                       QUIT

 +8                SET BMXWIN=$PIECE(BMXNOD,U,3)

 +9                SET BMXNS=$PIECE(BMXNOD,U,4)

 +10               DO STRT($PIECE(BMXNOD,U),BMXNS,BMXWIN,0)

 +11               QUIT

               End DoDot:1

 +12       QUIT

 +13      ;

STOPALL   ;EP

 +1       ;Stop all monitors in BMXNET MONITOR file

 +2       ;

 +3        NEW BMXIEN,BMXPORT

 +4        SET BMXIEN=0

FOR

               SET BMXIEN=$ORDER(^BMXMON(BMXIEN))

               IF '+BMXIEN

                   QUIT

               Begin DoDot:1

 +5                SET BMXNOD=$GET(^BMXMON(BMXIEN,0))

 +6                IF '+BMXNOD

                       QUIT

 +7                SET BMXPORT=+BMXNOD

 +8                DO STOP(BMXPORT,0)

               End DoDot:1

 +9        QUIT

 +10      ;

STOP(BMXPORT,VB) ;EP Stop monitor on BMXPORT

 +1       ;Open a channel to monitor on BMXPORT and send shutdown request

 +2       ;Optional VB = Verbose. Default is 1

 +3       ;

 +4        NEW IP,REF,X,DEV

 +5        SET U="^"

           DO HOME^%ZIS

 +6       ;

 +7       ;Verbose

 +8        SET BMXVB=$GET(VB,1)

 +9       ;

 +10       IF BMXVB

               DO EN^DDIOL("Stop BMXNet Monitor...")

 +11       XECUTE ^%ZOSF("UCI")

           SET REF=Y

 +12      ;get server IP

           SET IP="0.0.0.0"

 +13       IF $GET(BMXPORT)=""

               SET BMXPORT=9200

 +14      ; -- make sure the listener is running

 +15       IF $$SEMAPHOR(BMXPORT,"LOCK")

               Begin DoDot:1

 +16               SET %=$$SEMAPHOR(BMXPORT,"UNLOCK")

 +17               IF BMXVB

                       DO EN^DDIOL("BMXNet Monitor does not appear to be running.")

               End DoDot:1

               QUIT

 +18      ; -- send the shutdown message to the TCP Listener process

 +19       DO CALL^%ZISTCP("127.0.0.1",BMXPORT)

           IF POP

               Begin DoDot:1

 +20               SET %=$$SEMAPHOR(BMXPORT,"UNLOCK")

 +21               IF BMXVB

                       DO EN^DDIOL("BMXNet Monitor does not appear to be running.")

               End DoDot:1

               QUIT

 +22       USE IO

 +23       SET X=$TEXT(+2)

           SET X=$PIECE(X,";;",2)

           SET X=$PIECE(X,";")

 +24       IF X=""

               SET X=0

 +25       SET X=$CHAR($LENGTH(X))_X

 +26       WRITE "{BMX}00011TCPshutdown",!

 +27      ;IHS/OIT/HMW SAC Exemption Applied For

           READ X#3:5

 +28       DO CLOSE^%ZISTCP

 +29       IF X="ack"

               IF BMXVB

                   DO EN^DDIOL("BMXNet Monitor has been shutdown.")

 +30      IF '$TEST

               IF BMXVB

                   DO EN^DDIOL("Shutdown Failed!")

 +31      ;change process name

 +32       DO CHPRN($JOB)

 +33       QUIT

 +34      ;

MON(BMXPORT,NS,IS) ;Monitor port for connection & shutdown requests

 +1       ;NS = Namespace to Start monitor

 +2       ;IS = 1: Enable integrated security

 +3       ;

 +4        NEW BMXDEV,BMXQUIT,BMXDTIME,BMXLEN,BMXACT,BMXWIN,BMXNS

 +5        SET BMXQUIT=0

           SET BMXDTIME=999999

 +6       ;

 +7       ;Set lock

 +8        IF '$$SEMAPHOR(BMXPORT,"LOCK")

               QUIT

 +9       ;Clear problem marker

 +10       DO MARKER(BMXPORT,-1)

 +11      ;H 1

 +12      ;

 +13      ;Namespace

 +14       XECUTE ^%ZOSF("UCI")

 +15       IF $GET(NS)=""

               SET BMXNS=$PIECE(Y,",")

 +16      IF '$TEST

               SET BMXNS=NS

 +17      ;

 +18      ;Integrated security

 +19       SET BMXWIN=$GET(IS,1)

 +20      ;

 +21      ;Open server port;

 +22       SET BMXDEV="|TCP|"_BMXPORT

RELOAD    ;IHS/OIT/HMW SAC Exemption Applied For ; IHS/OIT/GIS 10/4/2011

           CLOSE BMXDEV

 +1       ;IHS/OIT/HMW SAC Exemption Applied For

           OPEN BMXDEV:(:BMXPORT:"S"):5

           IF '$TEST

               QUIT

 +2       ;

 +3       ;S BMXDTIME(1)=BMXDTIME ; TODO: Set timeouts

 +4       ;HMW 20050120

           SET BMXDTIME(1)=.5

 +5        USE BMXDEV

 +6        FOR

               Begin DoDot:1

 +7       ;Read first 5 chars from TCP buffer, timeout=BMXDTIME ;IHS/OIT/HMW SAC Exemption Applied For

                   READ BMXACT#5:BMXDTIME

 +8       ; LISTENER TIMED OUT AFTER 999999 SECONDS (10 DAYS) ; IHS/OIT/GIS 10/4/2011

                   IF BMXACT=""

                       SET BMXQUIT=1

                       QUIT

 +9       ; PRIMARY MESSSAGE IS INVALID.  NEED TO CLEAN OUT TCP BUFFER AND START OVER ; IHS/OIT/GIS 10/4/2011

                   IF BMXACT'="{BMX}"

                       SET BMXQUIT=2

                       QUIT

 +10      ;Read next 5 chars - message length ;IHS/OIT/HMW SAC Exemption Applied For

                   READ BMXACT#5:BMXDTIME

 +11               SET BMXLEN=+BMXACT

 +12      ;IHS/OIT/HMW SAC Exemption Applied For

                   READ BMXACT#BMXLEN:BMXDTIME

 +13               IF $PIECE(BMXACT,"^")="TCPconnect"

                       Begin DoDot:2

 +14                       NEW BMXNSJ,X,Y,ZCHILD,%

 +15      ;Namespace

                           SET BMXNSJ=$PIECE(BMXACT,"^",2)

 +16                       SET BMXNSJ=$PIECE(BMXNSJ,",")

 +17                       IF BMXNSJ=""

                               SET BMXNSJ=BMXNS

 +18                       SET X=BMXNSJ

 +19                       XECUTE ^%ZOSF("UCICHECK")

                           IF Y=0

                               SET BMXNSJ=BMXNS

 +20      ; SET CONNECTION STATUS BASED ON NAMESPACE VALIDITY

                           SET STATUS=$SELECT(Y'=0:"CONNECTION OK",1:"CONNECTION FAILED, INVALID NAMESPACE")

 +21      ;IHS/OIT/HMW SAC Exemption Applied For

                           JOB SESSION^BMXMON(BMXWIN)[BMXNSJ]:(:5:BMXDEV:BMXDEV):5

 +22                       XECUTE ("S ZCHILD="_$CHAR(36,90)_"CHILD")

 +23                       IF ZCHILD

                               SET ^BMXTMP("CONNECT STATUS",ZCHILD)=STATUS

 +24                       QUIT

                       End DoDot:2

                       QUIT

 +25               IF $PIECE(BMXACT,"^")="TCPshutdown"

                       SET BMXQUIT=1

                       WRITE "ack",!

               End DoDot:1

               IF BMXQUIT

                   QUIT

 +26      ; PRIMARY MSG IS INVALID.  CLEAR TCP BUFFER AND START ITERATING AGAIN. ; IHS/OIT/GIS 10/4/2011

           IF BMXQUIT=2

               SET BMXQUIT=0

               GOTO RELOAD

 +27      ; destroy 'running flag'

           SET %=$$SEMAPHOR(BMXPORT,"UNLOCK")

 +28       QUIT

 +29      ;

SESSION(BMXWIN) ;EP

 +1       ;Start session monitor

 +2       ;BMXWIN = 1: Enable integrated security

SESSRES   ;EP - reentry point from trap

 +1       ;IHS/OIT/HMW SAC Exemption Applied For

 +2        NEW $ESTACK

           SET $ETRAP="D ETRAP^BMXMON"

 +3        SET DIQUIET=1

           SET U="^"

           DO DT^DICRW

 +4       ;Unregister all events for this session

           DO UNREGALL^BMXMEVN

 +5        USE $PRINCIPAL

           DO SESSMAIN

 +6       ;Turn off the error trap for the exit

 +7        SET $ETRAP=""

 +8        IF $GET(DUZ)

               DO LOGOUT^XUSRB

 +9        KILL BMXR,BMXARY

 +10      ;IHS/OIT/HMW SAC Exemption Applied For

           CLOSE $PRINCIPAL

 +11       QUIT

 +12      ;

SESSMAIN  ;

 +1        NEW BMXTBUF

 +2       ;Setup required system vars

           DO SETUP^BMXMSEC(.RET)

 +3        SET U="^"

 +4        USE $PRINCIPAL

 +5        FOR

               Begin DoDot:1

 +6       ;IHS/OIT/HMW SAC Exemption Applied For

                   READ BMXTBUF#11:BMXDTIME

                   IF '$TEST

                       DO TIMEOUT

                       SET BMXTBUF="#BYE#"

                       QUIT

 +7                IF BMXTBUF["XQKEY"

                       SET HWMP=1

 +8                IF BMXTBUF="#BYE#"

                       QUIT

 +9       ;check HDR

                   SET BMXHTYPE=$SELECT($EXTRACT(BMXTBUF,1,5)="{BMX}":1,1:0)

 +10               IF 'BMXHTYPE

                       SET BMXTBUF="#BYE#"

                       DO SNDERR

                       WRITE BMXTBUF,$CHAR(4),!

                       QUIT

 +11               SET BMXTLEN=$EXTRACT(BMXTBUF,6,10)

                   SET L=$EXTRACT(BMXTBUF,11,11)

 +12      ;IHS/OIT/HMW SAC Exemption Applied For

                   READ BMXTBUF#4:BMXDTIME(1)

                   SET BMXTBUF=L_BMXTBUF

 +13               SET BMXPLEN=BMXTBUF

 +14      ;IHS/OIT/HMW SAC Exemption Applied For

                   READ BMXTBUF#BMXPLEN:BMXDTIME(1)

 +15               IF $PIECE(BMXTBUF,U)="TCPconnect"

                       Begin DoDot:2

 +16      ;Ack

                           DO SNDERR

                           WRITE "accept",$CHAR(4),!

                       End DoDot:2

                       QUIT

 +17               IF BMXHTYPE

                       Begin DoDot:2

 +18                       KILL BMXR,BMXARY

 +19                       IF BMXTBUF="#BYE#"

                               DO SNDERR

                               WRITE "#BYE#",$CHAR(4),!

                               QUIT

 +20                       SET BMXTLEN=BMXTLEN-15

 +21                       DO CALLP^BMXMBRK(.BMXR,BMXTBUF)

 +22                       SET BMXPTYPE=$SELECT('$DATA(BMXPTYPE):1,BMXPTYPE<1:1,BMXPTYPE>6:1,1:BMXPTYPE)

                       End DoDot:2

 +23               IF BMXTBUF="#BYE#"

                       QUIT

 +24               USE $PRINCIPAL

 +25      ;Clears SNDERR parameters

                   DO SNDERR

 +26               DO SND

 +27      ;send eot and flush buffer

                   DO WRITE($CHAR(4))

                   WRITE *-3

               End DoDot:1

               IF BMXTBUF="#BYE#"

                   QUIT

 +28      ;Unregister all events for this session

           DO UNREGALL^BMXMEVN

 +29      ;End Of Main

           QUIT

 +30      ;

 +31      ;

SNDERR    ;send error information

 +1       ;BMXSEC is the security packet, BMXERROR is application packet

 +2        NEW X

 +3        SET X=$EXTRACT($GET(BMXSEC),1,255)

 +4        WRITE $CHAR($LENGTH(X))_X

           WRITE *-3

 +5        SET X=$EXTRACT($GET(BMXERROR),1,255)

 +6        WRITE $CHAR($LENGTH(X))_X

           WRITE *-3

 +7       ;clears parameters

           SET BMXERROR=""

           SET BMXSEC=""

 +8        QUIT

 +9       ;

WRITE(BMXSTR) ;Write a data string

 +1       ;

 +2        IF $LENGTH(BMXSTR)<511

               WRITE *-3

               WRITE BMXSTR

               QUIT

 +3       ;Handle a long string

 +4       ;Flush the buffer

           WRITE *-3

 +5        FOR

               IF '$LENGTH(BMXSTR)

                   QUIT

               WRITE $EXTRACT(BMXSTR,1,510),*-3

               SET BMXSTR=$EXTRACT(BMXSTR,511,99999)

 +6        QUIT

SND       ; -- send data for all, Let WRITE sort it out

 +1        NEW I,T

 +2       ;

 +3       ; -- error or abort occurred, send null

 +4        IF $LENGTH(BMXSEC)>0

               DO WRITE("")

               QUIT

 +5       ; -- single value

 +6        IF BMXPTYPE=1

               SET BMXR=$GET(BMXR)

               DO WRITE(BMXR)

               QUIT

 +7       ; -- table delimited by CR+LF

 +8        IF BMXPTYPE=2

               Begin DoDot:1

 +9                SET I=""

FOR

                       SET I=$ORDER(BMXR(I))

                       IF I=""

                           QUIT

                       DO WRITE(BMXR(I))

                       DO WRITE($CHAR(13,10))

               End DoDot:1

               QUIT

 +10      ; -- word processing

 +11       IF BMXPTYPE=3

               Begin DoDot:1

 +12               SET I=""

FOR

                       SET I=$ORDER(BMXR(I))

                       IF I=""

                           QUIT

                       DO WRITE(BMXR(I))

                       IF BMXWRAP

                           DO WRITE($CHAR(13,10))

               End DoDot:1

               QUIT

 +13      ; -- global array

 +14       IF BMXPTYPE=4

               Begin DoDot:1

 +15               SET I=$GET(BMXR)

                   IF I=""

                       QUIT

                   SET T=$EXTRACT(I,1,$LENGTH(I)-1)

                   IF $DATA(@I)>10

                       DO WRITE(@I)

 +16               FOR

                       SET I=$QUERY(@I)

                       IF I=""!(I'[T)

                           QUIT

                       WRITE *-3

                       WRITE @I

                       IF BMXWRAP&(@I'=$CHAR(13,10))

                           WRITE $CHAR(13,10)

 +17               IF $DATA(@BMXR)

                       KILL @BMXR

               End DoDot:1

               QUIT

 +18      ; -- global instance

 +19       IF BMXPTYPE=5

               SET BMXR=$GET(@BMXR)

               DO WRITE(BMXR)

               QUIT

 +20      ; -- variable length records only good upto 255 char)

 +21       IF BMXPTYPE=6

               SET I=""

FOR

                   SET I=$ORDER(BMXR(I))

                   IF I=""

                       QUIT

                   DO WRITE($CHAR($LENGTH(BMXR(I))))

                   DO WRITE(BMXR(I))

 +22       QUIT

 +23      ;

TIMEOUT   ;Do this on MAIN  loop timeout

 +1        IF $GET(DUZ)>0

               DO SNDERR

               DO WRITE("#BYE#"_$CHAR(4))

               QUIT

 +2       ;Sign-on timeout

 +3        SET BMXR(0)=0

           SET BMXR(1)=1

           SET BMXR(2)=""

           SET BMXR(3)="TIME-OUT"

           SET BMXPTYPE=2

 +4        DO SNDERR

           DO SND

           DO WRITE($CHAR(4))

 +5        QUIT

 +6       ;

SEMAPHOR(BMXTSKT,BMXACT) ;Lock/Unlock BMXMON semaphore

 +1        NEW RESULT

 +2        SET U="^"

           SET RESULT=1

 +3       ;get Y=UCI^VOL^NODE^BOXLOOKUP of current system

           DO GETENV^%ZOSV

 +4        IF BMXACT="LOCK"

               Begin DoDot:1

 +5                LOCK +^BMXMON("BMXMON",$PIECE(Y,U,2),$PIECE(Y,U),$PIECE(Y,U,4),BMXTSKT):1

 +6                SET RESULT=$TEST

               End DoDot:1

 +7       IF '$TEST

               LOCK -^BMXMON("BMXMON",$PIECE(Y,U,2),$PIECE(Y,U),$PIECE(Y,U,4),BMXTSKT)

 +8        QUIT RESULT

 +9       ;

CHPRN(N)  ;Change process name to N.

 +1        DO SETNM^%ZOSV($EXTRACT(N,1,15))

 +2        QUIT

 +3       ;

CKSTAT(OUT,IN) ; EP - RPC: BMX CONNECT STATUS ; CONFIRMS THAT THAT A VALID PROCESS HAS BEEN SPAWNED BY BMXMON

 +1        NEW PORT,STATUS,JOBID

 +2        SET PORT=+$PIECE($PRINCIPAL,"|",3)

 +3        SET JOBID=$PIECE($JOB,":",1)

 +4       ;Wait for job to spawn ZCHILD to be set in MON^

           IF $GET(^BMXTMP("CONNECT STATUS",JOBID))=""

               HANG 1

 +5        IF $GET(^BMXTMP("CONNECT STATUS",JOBID))=""

               HANG 1

 +6        IF $GET(^BMXTMP("CONNECT STATUS",JOBID))=""

               HANG 1

 +7        SET STATUS=$GET(^BMXTMP("CONNECT STATUS",JOBID))

 +8        KILL ^BMXTMP("CONNECT STATUS",JOBID)

 +9        IF STATUS=""

               SET STATUS="CONNECTION STATUS UNKNOWN"

 +10       SET OUT=PORT_"|"_STATUS_"|"_JOBID

 +11       QUIT

 +12      ;

MARKER(BMXPORT,BMXMODE) ;Set/Test/Clear Problem Marker, BMXMODE=0 is a function

 +1        NEW IP,Y,%,REF

           XECUTE ^%ZOSF("UCI")

           SET REF=Y

           SET IP="0.0.0.0"

           SET %=0

 +2        LOCK +^BMX(IP,REF,BMXPORT,"PROBLEM MARKER"):1

 +3        IF BMXMODE=1

               SET ^BMX(IP,REF,BMXPORT,"PROBLEM MARKER")=1

 +4        IF BMXMODE=0

               IF $DATA(^BMX(IP,REF,BMXPORT,"PROBLEM MARKER"))

                   SET %=1

 +5        IF BMXMODE=-1

               KILL ^BMX(IP,REF,BMXPORT,"PROBLEM MARKER")

 +6        LOCK -^BMX(IP,REF,BMXPORT,"PROBLEM MARKER")

 +7        IF BMXMODE=0

               QUIT %

           QUIT

 +8       ;

ETRAP     ; -- on trapped error, send error info to client

 +1        NEW BMXERC,BMXERR,BMXLGR

 +2       ;Change trapping during trap.

 +3       ;IHS/OIT/HMW SAC Exemption Applied For

           SET $ETRAP="D ^%ZTER HALT"

 +4        SET BMXERC=$$EC^%ZOSV

 +5        SET BMXERR="M ERROR="_BMXERC_$CHAR(13,10)_"LAST REF="

 +6        SET BMXLGR=$$LGR^%ZOSV_$C(4)

 +7        SET BMXERR=BMXERR_BMXLGR

 +8       ;%ZTER clears $ZE and $ECODE

           DO ^%ZTER

 +9        IF (BMXERC["READ")!(BMXERC["WRITE")!(BMXERC["SYSTEM-F")

               IF $GET(DUZ)

                   DO LOGOUT^XUSRB

               GOTO ^XUSCLEAN

 +10       USE $PRINCIPAL

 +11       DO SNDERR

           DO WRITE(BMXERR)

           WRITE *-3

 +12      ;IHS/OIT/HMW SAC Exemption Applied For

           SET $ETRAP="Q:($ESTACK&'$QUIT)  Q:$ESTACK -9 S $ECODE="""" G SESSRES^BMXMON"

           SET $ECODE=",U99,"

 +13       QUIT

 +14      ;

MENU      ;EP - ENTRY ACTION FROM BMXMENU OPTION

 +1       ;

 +2        NEW BMX,BMXVER

 +3       ;VERSION

 +4        Begin DoDot:1

 +5            SET BMXN="BMXNET ADO.NET DATA PROVIDER"

               IF $DATA(^DIC(9.4,"B",BMXN))

                   QUIT

 +6            SET BMXN="BMXNET RPMS .NET UTILITIES"

               IF $DATA(^DIC(9.4,"B",BMXN))

                   QUIT

 +7            SET BMXN=""

 +8            QUIT

           End DoDot:1

 +9       ;

 +10       SET BMXVER=""

 +11       IF BMXN]""

               IF $DATA(^DIC(9.4,"B",BMXN))

                   Begin DoDot:1

 +12                   SET BMX=$ORDER(^DIC(9.4,"B",BMXN,0))

 +13                   IF $DATA(^DIC(9.4,BMX,"VERSION"))

                           SET BMXVER=$PIECE(^DIC(9.4,BMX,"VERSION"),"^")

 +14                  IF '$TEST

                           SET BMXVER="VERSION NOT FOUND"

                   End DoDot:1

 +15       IF BMXVER=""

               SET BMXVER="VERSION NOT FOUND"

 +16      ;

 +17      ;LOCATION

 +18       NEW BMXLOC

 +19       SET BMXLOC=""

 +20       IF $GET(DUZ(2))

               IF $DATA(^DIC(4,DUZ(2),0))

                   SET BMXLOC=$PIECE(^DIC(4,DUZ(2),0),"^")

 +21       IF BMXLOC=""

               SET BMXLOC="LOCATION NOT FOUND"

 +22      ;

 +23      ;WRITE

 +24       WRITE !

 +25       WRITE !,"BMXNet Version: ",BMXVER

 +26       WRITE !,"Location: ",BMXLOC

 +27       QUIT

BMXMON.m