BMX updated to v2.3. No actual routine changes from 2.21

This commit is contained in:
sam 2011-01-27 09:50:57 +00:00
parent 90e2de5b8e
commit cb2417af66
59 changed files with 450 additions and 413 deletions

View File

@ -1,5 +1,5 @@
BMXADE1 ; IHS/OIT/HMW - BMXNet ADO.NET PROVIDER ;
;;2.2;BMX;;Sep 07, 2010
;;2.3;BMX;;Jan 25, 2011
;
;
;Dental Excel report demo

Before

Width:  |  Height:  |  Size: 3.0 KiB

After

Width:  |  Height:  |  Size: 3.0 KiB

View File

@ -1,5 +1,5 @@
BMXADE2 ; IHS/OIT/HMW - BMXNet ADO.NET PROVIDER ;
;;2.2;BMX;;Sep 07, 2010
;;2.3;BMX;;Jan 25, 2011
;
;
;Dental Excel report demo

Before

Width:  |  Height:  |  Size: 3.3 KiB

After

Width:  |  Height:  |  Size: 3.3 KiB

View File

@ -1,5 +1,5 @@
BMXADO ; IHS/CIHA/GIS - RPC CALL: GENERATE AN ADO SCHEMA STRING AND DATA SET ;
;;2.2;BMX;;Sep 07, 2010
;;2.3;BMX;;Jan 25, 2011
; SS^BMXADO: RPC EP FROM WINDOWS/WEB APP TO GENERATE A SCHEMEA STRING (& OPTIONALLY, A DATA SET AS WELL)
; THE SCHEMA DEFINITION AND MAP IS STORED IN THE 'BMX ADO SCHEMA' FILE
; THIS ROUTINE GENERATES THE SCHEMA STRING. BMXADOV GENERATES THE DATA SET THAT GOES WITH THE SCHEMA STRING.

Before

Width:  |  Height:  |  Size: 6.5 KiB

After

Width:  |  Height:  |  Size: 6.5 KiB

View File

@ -1,5 +1,5 @@
BMXADO2 ; IHS/CIHA/GIS - BMX ADO RECORDSET UTILS ;
;;2.2;BMX;;Sep 07, 2010
;;2.3;BMX;;Jan 25, 2011
;
;
GEN(BMXY,BMXF) ;EP - Generate an ADO Schema string from a list of fields

Before

Width:  |  Height:  |  Size: 3.5 KiB

After

Width:  |  Height:  |  Size: 3.5 KiB

View File

@ -1,5 +1,5 @@
BMXADOF ; IHS/CIHA/GIS - RPC CALL FOR EXTENDED FUNCTIONALITY OF BMXNet UTILITIES ;
;;2.2;BMX;;Sep 07, 2010
;;2.3;BMX;;Jan 25, 2011
; THIS IS THE ADO RECORDSET FILER: ADO -> FILEMAN
; VISIT FILE UPDATES REPRESENT A SPECIAL CASE HTAT IS MANAGED IN BMXADOF1
; INCLUDES TRANSACTION CONTROLS

Before

Width:  |  Height:  |  Size: 12 KiB

After

Width:  |  Height:  |  Size: 12 KiB

View File

@ -1,5 +1,5 @@
BMXADOF1 ; IHS/CIHA/GIS - RPC CALL FOR EXTENDED FUNCTIONALITY OF BMXNet UTILITIES ;
;;2.2;BMX;;Sep 07, 2010
;;2.3;BMX;;Jan 25, 2011
; UPDATE FILEMAN WITH AN ADO RECORD SET FROM A WINDOWS/WEB APPLICATION
;
;

Before

Width:  |  Height:  |  Size: 3.3 KiB

After

Width:  |  Height:  |  Size: 3.3 KiB

View File

@ -1,5 +1,5 @@
BMXADOF2 ; IHS/CIHA/GIS - RPC CALL FOR EXTENDED FUNCTIONALITY OF BMXNet UTILITIES ;
;;2.2;BMX;;Sep 07, 2010
;;2.3;BMX;;Jan 25, 2011
; THIS ROUTINE CONTAINS SPECIAL ENTRY POINTS FOR UPDATING RPMS
;
;

Before

Width:  |  Height:  |  Size: 2.1 KiB

After

Width:  |  Height:  |  Size: 2.1 KiB

View File

@ -1,5 +1,5 @@
BMXADOFD ; IHS/CIHA/GIS - RPC CALL FOR EXTENDED FUNCTIONALITY OF BMXNet UTILITIES ;
;;2.2;BMX;;Sep 07, 2010
;;2.3;BMX;;Jan 25, 2011
; THIS IS THE ADO RECORDSET FILER: ADO -> FILEMAN
; CONTAINS SPECIAL ENTRY POINT FOR RPMS DATA ENTRY
;

Before

Width:  |  Height:  |  Size: 2.8 KiB

After

Width:  |  Height:  |  Size: 2.8 KiB

View File

@ -1,5 +1,5 @@
BMXADOFS ; IHS/CIHA/GIS - RPC CALL FOR EXTENDED FUNCTIONALITY OF BMXNet UTILITIES ;
;;2.2;BMX;;Sep 07, 2010
;;2.3;BMX;;Jan 25, 2011
; THIS IS THE ADO RECORDSET FILER: ADO -> FILEMAN
; CONTAINS SPECIAL CODE RELATED TO FILING PROPLEMS, POVS, FAMILY HX, PERSONAL HX AND NOTES.
;

Before

Width:  |  Height:  |  Size: 6.6 KiB

After

Width:  |  Height:  |  Size: 6.6 KiB

View File

@ -1,5 +1,5 @@
BMXADOI ; IHS/CIHA/GIS - RPC CALL: GENERATE DATA FOR AN ADO DATASET ;
;;2.2;BMX;;Sep 07, 2010
;;2.3;BMX;;Jan 25, 2011
; CUSTOM IDENTIFIERS
;
;

Before

Width:  |  Height:  |  Size: 2.2 KiB

After

Width:  |  Height:  |  Size: 2.2 KiB

View File

@ -1,6 +1,12 @@
BMXADOS ; IHS/CIHA/GIS - UPDATE THE BMX ADO SCHEMA FILE ;
;;2.2;BMX;;Sep 07, 2010
BMXADOS ; IHS/CIHA/GIS - UPDATE THE BMX ADO SCHEMA FILE ; 12/7/10 4:07pm
;;2.3;BMX;;Jan 25, 2011
; ENABLES NAVIGATION TO SUBFILES PRIOR TO UPDATING THE SCHEMA FILE ENTRY
;
; Change log:
; Sam Habiel - 3101212 v2.21
; - Changed the quit from the line in ASTG b/c it couldn't compile in GT.M
; F PCE=1:1:LEV S FNO=+$P(STG,",",PCE) D I '$L(STG) Q "" **OLD**
; F PCE=1:1:LEV S FNO=+$P(STG,",",PCE) D Q:'$L(STG) ; v 2.21 SMH
;
;
;
@ -231,7 +237,7 @@ PASS1 ; PASS 1. BUILD THE ARRAY OF ALL SUBFILES
ASTG(STG) ; CONVERT STRING FROM FILE NUMBERS TO FILE NAMES
N PCE,LEV,FNO,NAME
S LEV=$L(STG,",")
F PCE=1:1:LEV S FNO=+$P(STG,",",PCE) D I '$L(STG) Q ""
F PCE=1:1:LEV S FNO=+$P(STG,",",PCE) D Q:'$L(STG) ; v 2.21 SMH
. S NAME=$O(^DD(FNO,0,"NM",""))
. I $E(NAME)="*" S NAME=$E(NAME,2,99)
. I '$L(NAME) S STG="" Q

Before

Width:  |  Height:  |  Size: 9.2 KiB

After

Width:  |  Height:  |  Size: 9.5 KiB

View File

@ -1,5 +1,5 @@
BMXADOS1 ; IHS/CIHA/GIS - UPDATE THE BMX ADO SCHEMA FILE GUI VERSION ;
;;2.2;BMX;;Sep 07, 2010
;;2.3;BMX;;Jan 25, 2011
; RPC CALLS
;
;

Before

Width:  |  Height:  |  Size: 2.6 KiB

After

Width:  |  Height:  |  Size: 2.6 KiB

View File

@ -1,5 +1,5 @@
BMXADOV ; CIHA/CIHA/GIS - RPC CALL: GENERATE DATA FOR AN ADO DATASET
;;2.2;BMX;;Sep 07, 2010
;;2.3;BMX;;Jan 25, 2011
;
;
;

Before

Width:  |  Height:  |  Size: 5.7 KiB

After

Width:  |  Height:  |  Size: 5.7 KiB

View File

@ -1,9 +1,15 @@
BMXADOV1 ; IHS/CIHA/GIS - RPC CALL: GENERATE DATA FOR AN ADO DATASET ;
;;2.2;BMX;;Sep 07, 2010
BMXADOV1 ; IHS/CIHA/GIS - RPC CALL: GENERATE DATA FOR AN ADO DATASET ; 12/7/10 4:12pm
;;2.3;BMX;;Jan 25, 2011
; CONTINUATION FILE FOR BMXADOV
; MANAGES ITERATION FOR INDIVIDUAL INDEX TYPES
; ASSUMES CERTAIN LOCAL VARS: CREF,FIEN,IENS,DAS (<-THESE CAN'T BE NULL),START,STOP,MAX,TOT,NUM,IX
;
; Change Log
; Sam Habiel 3101212 v. 2.21
; Change line 140 from:
; I IX="AA" G AA to
; I IX="AA" Q $$AA
; to fix compilation error
;
;
DATA(IENS,DA,XCNT) ;EP - ADD DATA NODES TO ARRAY
@ -131,7 +137,7 @@ IXVAL(FIEN,IX,DAS) ; GIVEN A FILE IEN, INDEX NAME, AND DAS STRING, RETURN THE VA
S XREF=OREF_IX_")"
S DA=+IENS I 'DA Q CREF_"||"
I '$D(@CREF@(DA)) Q CREF_"||" ; NO ENTRY EXISTS
I IX="AA" G AA
I IX="AA" Q $$AA ; SMH v. 2.21
S FLD=+$$IXFLD^BMXADOV(FIEN,IX) I 'FLD Q "" ; INVALID DD
S VAL=$$GET1^DIQ(FIEN,IENS,FLD,"I") I VAL="" Q "" ; VALUE IS NULL - NOTHING TO INDEX
I '$D(@CREF@(IX,VAL,DA)) Q "" ; INVALID INDEX

Before

Width:  |  Height:  |  Size: 9.1 KiB

After

Width:  |  Height:  |  Size: 9.3 KiB

View File

@ -1,5 +1,5 @@
BMXADOV2 ; IHS/CIHA/GIS - RPC CALL: GENERATE DATA FOR AN ADO DATASET ;
;;2.2;BMX;;Sep 07, 2010
;;2.3;BMX;;Jan 25, 2011
; CUSTOM ITERATORS FOR RPMS
;
;

Before

Width:  |  Height:  |  Size: 4.7 KiB

After

Width:  |  Height:  |  Size: 4.7 KiB

View File

@ -1,5 +1,5 @@
BMXADOVJ ; IHS/CIHA/GIS - RPC CALL: GENERATE DATA FOR AN ADO DATASET ;
;;2.2;BMX;;Sep 07, 2010
;;2.3;BMX;;Jan 25, 2011
; THIS ROUTINE MANAGES THE JOINS
;
;

Before

Width:  |  Height:  |  Size: 3.5 KiB

After

Width:  |  Height:  |  Size: 3.5 KiB

View File

@ -1,5 +1,5 @@
BMXADOX ; IHS/CIHA/GIS - RPC CALL: GENERATE AN ADO SCHEMA STRING AND DATA SET ;
;;2.2;BMX;;Sep 07, 2010
;;2.3;BMX;;Jan 25, 2011
; EXMAPLES OF RPMS SCHEMAE GENERATION
;
;

Before

Width:  |  Height:  |  Size: 14 KiB

After

Width:  |  Height:  |  Size: 14 KiB

View File

@ -1,5 +1,5 @@
BMXADOX1 ; IHS/CIHA/GIS - RPC CALL: GENERATE AN ADO SCHEMA STRING AND DATA SET ;
;;2.2;BMX;;Sep 07, 2010
;;2.3;BMX;;Jan 25, 2011
; EXMAPLES OF FILEMAN SCHEMA GENERATION
;
;

Before

Width:  |  Height:  |  Size: 12 KiB

After

Width:  |  Height:  |  Size: 12 KiB

View File

@ -1,5 +1,5 @@
BMXADOX2 ; IHS/CIHA/GIS - RPC CALL: GENERATE AN ADO SCHEMA STRING AND DATA SET ;
;;2.2;BMX;;Sep 07, 2010
;;2.3;BMX;;Jan 25, 2011
; EXMAPLES OF FILEMAN SCHEMA GENERATION
;
DISP(OUT) ;

Before

Width:  |  Height:  |  Size: 3.2 KiB

After

Width:  |  Height:  |  Size: 3.2 KiB

View File

@ -1,5 +1,5 @@
BMXADOXX ; IHS/CIHA/GIS - RPC CALL: GENERATE AN ADO SCHEMA STRING AND DATA SET ;
;;2.2;BMX;;Sep 07, 2010
;;2.3;BMX;;Jan 25, 2011
; EXMAPLES OF RPMS SCHEMAE GENERATION
;
;

Before

Width:  |  Height:  |  Size: 12 KiB

After

Width:  |  Height:  |  Size: 12 KiB

View File

@ -1,5 +1,5 @@
BMXADOXY ; IHS/CIHA/GIS - RPC CALL: GENERATE AN ADO SCHEMA STRING AND DATA SET ;
;;2.2;BMX;;Sep 07, 2010
;;2.3;BMX;;Jan 25, 2011
; EXMAPLES OF FILEMAN SCHEMA GENERATION
;
;

Before

Width:  |  Height:  |  Size: 12 KiB

After

Width:  |  Height:  |  Size: 12 KiB

View File

@ -1,5 +1,5 @@
BMXE01 ; IHS/OIT/FJE - ENVIRONMENT CHECK FOR BMX 2.0 ;
;;2.2;BMX;;Sep 07, 2010
;;2.3;BMX;;Jan 25, 2011
;
S $P(LINE,"*",81)=""
S XPDNOQUE="NO QUE" ;NO QUEUING ALLOWED

Before

Width:  |  Height:  |  Size: 1.9 KiB

After

Width:  |  Height:  |  Size: 1.9 KiB

View File

@ -1,5 +1,5 @@
BMXFIND ; IHS/OIT/HMW - BMX GENERIC FIND ;
;;2.2;BMX;;Sep 07, 2010
;;2.3;BMX;;Jan 25, 2011
;
;
TABLE(BMXGBL,BMXFL) ;EP

Before

Width:  |  Height:  |  Size: 8.0 KiB

After

Width:  |  Height:  |  Size: 8.0 KiB

View File

@ -1,5 +1,5 @@
BMXG ; IHS/OIT/HMW - UTIL: GET DATA ;
;;2.2;BMX;;Sep 07, 2010
;;2.3;BMX;;Jan 25, 2011
;;Stolen from:* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
;
;

Before

Width:  |  Height:  |  Size: 2.0 KiB

After

Width:  |  Height:  |  Size: 2.0 KiB

View File

@ -1,5 +1,5 @@
BMXGETS ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ;
;;2.2;BMX;;Sep 07, 2010
;;2.3;BMX;;Jan 25, 2011
;
;;Horace Whitt
;;Interface to GETS^DIQ

Before

Width:  |  Height:  |  Size: 4.4 KiB

After

Width:  |  Height:  |  Size: 4.4 KiB

View File

@ -1,5 +1,5 @@
BMXMBRK ; IHS/OIT/HMW - BMXNet MONITOR ;
;;2.2;BMX;;Sep 07, 2010
;;2.3;BMX;;Jan 25, 2011
;
;
PRSP(P) ;EP -Parse Protocol

Before

Width:  |  Height:  |  Size: 6.0 KiB

After

Width:  |  Height:  |  Size: 6.0 KiB

View File

@ -1,5 +1,5 @@
BMXMBRK2 ; IHS/OIT/HMW - BMXNet MONITOR ;
;;2.2;BMX;;Sep 07, 2010
;;2.3;BMX;;Jan 25, 2011
;
;
CAPI(BMXY,TAG,NAM,PAR) ;EP - make API call

Before

Width:  |  Height:  |  Size: 3.7 KiB

After

Width:  |  Height:  |  Size: 3.7 KiB

View File

@ -1,5 +1,5 @@
BMXMEVN ; IHS/OIT/HMW - BMXNet MONITOR ;
;;2.2;BMX;;Sep 07, 2010
;;2.3;BMX;;Jan 25, 2011
;
Q
;

Before

Width:  |  Height:  |  Size: 6.7 KiB

After

Width:  |  Height:  |  Size: 6.7 KiB

View File

@ -1,360 +1,385 @@
BMXMON ; IHS/OIT/HMW - BMXNet MONITOR ; 7/20/2009 ; 9/7/10 7:47am
;;2.2;BMX;;Sep 07, 2010
;
;IHS/OIT/HMW Patch 1 added validity check for passed-in namespace
; 7/20/2009: Release of patch to support GT.M WV/SMH
; Changes:
; Addition of XINETD and GTMLNX entry points for support of GT.M
; Changes of W *-3 (which only works on Cache) to W !
; 9/7/2009: Minor bug fixes and enhancements
BMXMON ; IHS/OIT/HMW - BMXNet MONITOR ; 7/20/2009 ; 12/7/10 3:20pm
;;2.3;BMX;;Jan 25, 2011
;
;IHS/OIT/HMW Patch 1 added validity check for passed-in namespace
; 7/20/2009: Release of patch to support GT.M WV/SMH
; Changes:
; Addition of XINETD and GTMLNX entry points for support of GT.M
; Changes of W *-3 (which only works on Cache) to W !
; 9/7/2010: Minor bug fixes and enhancements
; In GTMLNX: Set process name
; In GTMLNX: Time out based now on the Kernel Broker Timeout field
; in kernel system parameters file
;
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."
;
Q
;
; 12/12/2010: Minor bug fixes
; ETRAP nows screens errors before logging them. If it is a network
; write error, it's not logged to the Error Trap
; Set Process Name crashed on Cache due to undefined IO("GT.M").
; Now this is surrounded by $Get to prevent this error.
;
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."
;
Q
;
RESTART ;EP
;Stop and Start all monitors in BMX MONITOR file
;Called by option BMX MONITOR START
;
D STOPALL
D STRTALL
Q
;
;Stop and Start all monitors in BMX MONITOR file
;Called by option BMX MONITOR START
;
D STOPALL
D STRTALL
Q
;
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
Q
;
;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
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)
Q
;
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
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)
Q
;
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")
S BMXNS=$G(NS,$P(Y,","))
;
;Integrated security
S BMXWIN=$G(IS,1)
;
;Open server port;
S BMXDEV="|TCP|"_BMXPORT
C BMXDEV ;IHS/OIT/HMW SAC Exemption Applied For
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
. I BMXACT'="{BMX}" S BMXQUIT=1 Q
. R BMXACT#5:BMXDTIME ;Read next 5 chars - message length
. S BMXLEN=+BMXACT
. R BMXACT#BMXLEN:BMXDTIME
. I $P(BMXACT,"^")="TCPconnect" D Q
. . ;IHS/OIT/HMW added validity check for namespace
. . N BMXNSJ,X,Y
. . S BMXNSJ=$P(BMXACT,"^",2) ;Namespace
. . S BMXNSJ=$P(BMXNSJ,",")
. . ;if passed in namespace is invalid, new job will start in listener namespace
. . I BMXNSJ]"" S X=BMXNSJ X ^%ZOSF("UCICHECK") S:Y=0 BMXNSJ=BMXNS
. . ;Job another MONITOR using concurrent connection
. . ;J DEBUG^%Serenji("SESSION^BMXMON("_BMXWIN_")"):(:5:BMXDEV:BMXDEV):5
. . ;J SESSION^BMXMON(BMXWIN)[$P(BMXNS,",")]:(:5:BMXDEV:BMXDEV):5 ;IHS/OIT/HMW SAC Exemption Applied For
. . J SESSION^BMXMON(BMXWIN)[BMXNSJ]:(:5:BMXDEV:BMXDEV):5 ;IHS/OIT/HMW SAC Exemption Applied For
. I $P(BMXACT,"^")="TCPshutdown" S BMXQUIT=1 W "ack",!
S %=$$SEMAPHOR(BMXPORT,"UNLOCK") ; destroy 'running flag'
Q
;
XINETD ;PEP Directly from xinetd or inetd for GT.M
N BMXDEV
S U="^",$ETRAP="D ^%ZTER H" ;Set up the error trap
S $ZT="" ;Clear old trap
; GT.M specific error and device code
S @("$ZINTERRUPT=""I $$JOBEXAM^ZU($ZPOSITION)""")
S BMXDEV=$P X "U BMXDEV:(nowrap:nodelimiter:ioerror=""TRAP"")"
S %="",@("%=$ZTRNLNM(""REMOTE_HOST"")") S:$L(%) IO("GTM-IP")=%
I %["::ffff:" S IO("GTM-IP")=$P(%,"::ffff:",2) ; IPv6 support
; Read message type
N BMXACT,BMXDTIME
S BMXDTIME=10 ; change in 2.2 instead of 9999999 - initial conn timout
R BMXACT#5:BMXDTIME
Q:BMXACT'="{BMX}" ; Not a BMX message - quit.
; Fall through to below...
GTMLNX ;EP from XWBTCPM for GT.M
; not implementing NS and integrated authentication
; Vars: Read timeout, msg len, msg, windows auth, Namespace
N BMXDTIME,BMXLEN,BMXACT,BMXWIN,BMXNS
S BMXNSJ="",BMXWIN=0 ; No NS on GT.M, no Windows Authentication
S BMXDTIME(1)=.5,BMXDTIME=180 ; sign on timeout
R BMXACT#5:BMXDTIME ;Read next 5 chars - message length
S BMXLEN=+BMXACT
R BMXACT#BMXLEN:BMXDTIME
I $P(BMXACT,"^")="TCPconnect" G SESSRES
I $P(BMXACT,"^")="TCPshutdown" W "ack",! Q
Q ; Should't hit this quit, but just in case
;
;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)
Q
;
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
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)
Q
;
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")
S BMXNS=$G(NS,$P(Y,","))
;
;Integrated security
S BMXWIN=$G(IS,1)
;
;Open server port;
S BMXDEV="|TCP|"_BMXPORT
C BMXDEV ;IHS/OIT/HMW SAC Exemption Applied For
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
. I BMXACT'="{BMX}" S BMXQUIT=1 Q
. R BMXACT#5:BMXDTIME ;Read next 5 chars - message length
. S BMXLEN=+BMXACT
. R BMXACT#BMXLEN:BMXDTIME
. I $P(BMXACT,"^")="TCPconnect" D Q
. . ;IHS/OIT/HMW added validity check for namespace
. . N BMXNSJ,X,Y
. . S BMXNSJ=$P(BMXACT,"^",2) ;Namespace
. . S BMXNSJ=$P(BMXNSJ,",")
. . ;if passed in namespace is invalid, new job will start in listener namespace
. . I BMXNSJ]"" S X=BMXNSJ X ^%ZOSF("UCICHECK") S:Y=0 BMXNSJ=BMXNS
. . ;Job another MONITOR using concurrent connection
. . ;J DEBUG^%Serenji("SESSION^BMXMON("_BMXWIN_")"):(:5:BMXDEV:BMXDEV):5
. . ;J SESSION^BMXMON(BMXWIN)[$P(BMXNS,",")]:(:5:BMXDEV:BMXDEV):5 ;IHS/OIT/HMW SAC Exemption Applied For
. . J SESSION^BMXMON(BMXWIN)[BMXNSJ]:(:5:BMXDEV:BMXDEV):5 ;IHS/OIT/HMW SAC Exemption Applied For
. I $P(BMXACT,"^")="TCPshutdown" S BMXQUIT=1 W "ack",!
S %=$$SEMAPHOR(BMXPORT,"UNLOCK") ; destroy 'running flag'
Q
;
XINETD ;PEP Directly from xinetd or inetd for GT.M
N BMXDEV
S U="^",$ETRAP="D ^%ZTER H" ;Set up the error trap
S $ZT="" ;Clear old trap
; GT.M specific error and device code
S @("$ZINTERRUPT=""I $$JOBEXAM^ZU($ZPOSITION)""")
S BMXDEV=$P X "U BMXDEV:(nowrap:nodelimiter:ioerror=""TRAP"")"
S %="",@("%=$ZTRNLNM(""REMOTE_HOST"")") S:$L(%) IO("GTM-IP")=%
I %["::ffff:" S IO("GTM-IP")=$P(%,"::ffff:",2) ; IPv6 support
; Read message type
N BMXACT,BMXDTIME
S BMXDTIME=10 ; change in 2.2 instead of 9999999 - initial conn timout
R BMXACT#5:BMXDTIME
Q:BMXACT'="{BMX}" ; Not a BMX message - quit.
; Fall through to below...
GTMLNX ;EP from XWBTCPM for GT.M
; not implementing NS and integrated authentication
; Vars: Read timeout, msg len, msg, windows auth, Namespace
N BMXDTIME,BMXLEN,BMXACT,BMXWIN,BMXNS
S BMXNSJ="",BMXWIN=0 ; No NS on GT.M, no Windows Authentication
S BMXDTIME(1)=.5,BMXDTIME=180 ; sign on timeout like XWBTCPM
R BMXACT#5:BMXDTIME ;Read next 5 chars - message length
S BMXLEN=+BMXACT
R BMXACT#BMXLEN:BMXDTIME
I $P(BMXACT,"^")="TCPconnect" G SESSRES
I $P(BMXACT,"^")="TCPshutdown" W "ack",! Q
Q ; Should't hit this quit, but just in case
;
SESSION(BMXWIN) ;EP
;Start session monitor
;BMXWIN = 1: Enable integrated security
;Start session monitor
;BMXWIN = 1: Enable integrated security
SESSRES ;EP - reentry point from trap
;IHS/OIT/HMW SAC Exemption Applied For
S BMXDTIME(1)=.5,BMXDTIME=$$BAT^XUPARAM ; new in 2.2: Use kernel rpc timeout instead of 9999999
D SETNM^%ZOSV("BMX:ip"_$P(IO("GTM-IP"),".",3,4)) ; new in 2.2: set proces name
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
Q
;
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
. 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
. S BMXPLEN=BMXTBUF
. R BMXTBUF#BMXPLEN:BMXDTIME(1)
. 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 ! ;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 !
S X=$E($G(BMXERROR),1,255)
W $C($L(X))_X W !
S BMXERROR="",BMXSEC="" ;clears parameters
Q
;
WRITE(BMXSTR) ;Write a data string
;
I $L(BMXSTR)<511 W ! W BMXSTR Q
;Handle a long string
W ! ;Flush the buffer
F Q:'$L(BMXSTR) W $E(BMXSTR,1,510),! S BMXSTR=$E(BMXSTR,511,99999)
Q
;IHS/OIT/HMW SAC Exemption Applied For
S BMXDTIME(1)=.5,BMXDTIME=$$BAT^XUPARAM ; new in 2.2: Use kernel rpc timeout instead of 9999999
;
; Change Process Name (new in 2.2 and 2.3)
; (GT.M doesn't store the IP in $P, but Cache does. We get GT.M
; remote process IP from linux env var $REMOTE_HOST)
D:+$G(IO("GTM-IP")) CHPRN("BMX:ip"_$P(IO("GTM-IP"),".",3,4)) ; GT.M
D:+$P CHPRN("BMX:ip_"_$P($P,".",3,4)) ; Cache
;
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
Q
;
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
. 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
. S BMXPLEN=BMXTBUF
. R BMXTBUF#BMXPLEN:BMXDTIME(1)
. 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 ! ;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 !
S X=$E($G(BMXERROR),1,255)
W $C($L(X))_X W !
S BMXERROR="",BMXSEC="" ;clears parameters
Q
;
WRITE(BMXSTR) ;Write a data string
;
I $L(BMXSTR)<511 W ! W BMXSTR Q
;Handle a long string
W ! ;Flush the buffer
F Q:'$L(BMXSTR) W $E(BMXSTR,1,510),! S BMXSTR=$E(BMXSTR,511,99999)
Q
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 ! 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))
Q
;
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 ! 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))
Q
;
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))
Q
;
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))
Q
;
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))
Q
;
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))
Q
;
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"
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 HALT
U $P
D SNDERR,WRITE(BMXERR) W !
S $ETRAP="Q:($ESTACK&'$QUIT) Q:$ESTACK -9 S $ECODE="""" G SESSRES^BMXMON",$ECODE=",U99,"
Q
;
MENU ;EP - ENTRY ACTION FROM BMXMENU OPTION
;
N BMX,BMXVER
;VERSION
D
. 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
Q
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
; Error Trap Vars: Code, Error, Last Global Reference
N BMXERC,BMXERR,BMXLGR
;
; Change trapping during trap.
N $ETRAP S $ETRAP="D ^%ZTER HALT"
;
; If the error is simply that we can't write to the TCP device
; clear and log out
; GT.M Error Code.
I $ECODE=",Z150376602," S $ECODE="" D:$G(DUZ) LOGOUT^XUSRB HALT
; Cache Error Codes:
I ($EC["READ")!($EC["WRITE")!($EC["SYSTEM-F") S $ECODE="" D:$G(DUZ) LOGOUT^XUSRB HALT
;
; Otherwise, log the error and send it to the client
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
;
U $P
;
D SNDERR,WRITE(BMXERR) W !
;
S $ETRAP="Q:($ESTACK&'$QUIT) Q:$ESTACK -9 S $ECODE="""" G SESSRES^BMXMON",$ECODE=",U99,"
QUIT
;
MENU ;EP - ENTRY ACTION FROM BMXMENU OPTION
;
N BMX,BMXVER
;VERSION
D
. 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
Q

Before

Width:  |  Height:  |  Size: 11 KiB

After

Width:  |  Height:  |  Size: 13 KiB

View File

@ -1,5 +1,5 @@
BMXMSEC ; IHS/OIT/HMW - BMXNet MONITOR ; 7/20/2009
;;2.2;BMX;;Sep 07, 2010
;;2.3;BMX;;Jan 25, 2011
; Edit History
; Line SETUP+2 has been changed to support GT.M //SMH 7/5/09
; Per Wally Fort's GT.M code in XWBTCPM, IP for GT.M is stored

Before

Width:  |  Height:  |  Size: 2.7 KiB

After

Width:  |  Height:  |  Size: 2.7 KiB

View File

@ -1,5 +1,5 @@
BMXNTEG ;INTEGRITY CHECKER;FEB 26, 2007
;;2.2;BMX;;Sep 07, 2010
;;2.3;BMX;;Jan 25, 2011
;
START ;
NEW BYTE,COUNT,RTN

Before

Width:  |  Height:  |  Size: 2.1 KiB

After

Width:  |  Height:  |  Size: 2.1 KiB

View File

@ -1,5 +1,5 @@
BMXPO ; IHS/CMI/MAW - Populate appcontext with all namespaced RPC's ;
;;2.2;BMX;;Sep 07, 2010
;;2.3;BMX;;Jan 25, 2011
;
;
MAIN ;EP - this is the main routine driver

Before

Width:  |  Height:  |  Size: 1.6 KiB

After

Width:  |  Height:  |  Size: 1.6 KiB

View File

@ -1,5 +1,5 @@
BMXPRS ; IHS/OIT/HMW - BMX WINDOWS UTILS ;
;;2.2;BMX;;Sep 07, 2010
;;2.3;BMX;;Jan 25, 2011
;
;
PARSE(X) ;EP-Parse SQL Statement into array

Before

Width:  |  Height:  |  Size: 2.2 KiB

After

Width:  |  Height:  |  Size: 2.2 KiB

View File

@ -1,5 +1,5 @@
BMXRPC ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ; 9/7/10 5:04am
;;2.2;BMX;;Sep 07, 2010
;;2.3;BMX;;Jan 25, 2011
;;Stolen from:* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
;; GENERIC LOOKUP UTILITY FOR RETURNING MATCHING RECORDS
;; OR TABLES TO RPC'S.

Before

Width:  |  Height:  |  Size: 6.1 KiB

After

Width:  |  Height:  |  Size: 6.1 KiB

View File

@ -1,5 +1,5 @@
BMXRPC1 ; IHS/OIT/HMW - UTIL: REMOTE PROCEDURE CALLS ;
;;2.2;BMX;;Sep 07, 2010
;;2.3;BMX;;Jan 25, 2011
;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
;; UTILITY: CODE FOR REMOTE PROCEDURE CALLS.
;; RETURNS PATIENT DATA, HEALTH SUMMARY, FACE SHEET.

Before

Width:  |  Height:  |  Size: 7.7 KiB

After

Width:  |  Height:  |  Size: 7.7 KiB

View File

@ -1,5 +1,5 @@
BMXRPC2 ; IHS/OIT/HMW - FIELD LIST ;
;;2.2;BMX;;Sep 07, 2010
;;2.3;BMX;;Jan 25, 2011
;
FLDLIST(BMXGBL,BMXFL,BMXATTR,BMXSCR) ;EP
;TODO: Change all this to be a hard-coded $O thru ^DD

Before

Width:  |  Height:  |  Size: 3.6 KiB

After

Width:  |  Height:  |  Size: 3.6 KiB

View File

@ -1,5 +1,5 @@
BMXRPC3 ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ; ; 8/30/10 2:56pm
;;2.2;BMX;;Sep 07, 2010
;;2.3;BMX;;Jan 25, 2011
;Mods by WV/SMH
;7/26/09 Removed references to ^AUTTSITE, an IHS file in GETFAC*
;8/30/10 Changed GETFCRS to return a better list of user divisions

Before

Width:  |  Height:  |  Size: 6.6 KiB

After

Width:  |  Height:  |  Size: 6.6 KiB

View File

@ -1,5 +1,5 @@
BMXRPC4 ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ;
;;2.2;BMX;;Sep 07, 2010
;;2.3;BMX;;Jan 25, 2011
;
PTINFORS(BMXY,BMXIEN) ;EP Patient Info Recordset
;

Before

Width:  |  Height:  |  Size: 5.0 KiB

After

Width:  |  Height:  |  Size: 5.0 KiB

View File

@ -1,5 +1,5 @@
BMXRPC5 ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ;
;;2.2;BMX;;Sep 07, 2010
;;2.3;BMX;;Jan 25, 2011
;
;Stolen from Mike Remillard. If it doesn't work, it's his fault.
HS(BMXGBL,BMXDFN,BMXTYPE,BMXRDL,BMXFDL) ;EP

Before

Width:  |  Height:  |  Size: 3.9 KiB

After

Width:  |  Height:  |  Size: 3.9 KiB

View File

@ -1,5 +1,5 @@
BMXRPC6 ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ;
;;2.2;BMX;;Sep 07, 2010
;;2.3;BMX;;Jan 25, 2011
;
;
USRKEYRS(BMXY,BMXDUZ) ;EP - Returns recordset of user's keys

Before

Width:  |  Height:  |  Size: 3.8 KiB

After

Width:  |  Height:  |  Size: 3.8 KiB

View File

@ -1,5 +1,5 @@
BMXRPC7 ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ;
;;2.2;BMX;;Sep 07, 2010
;;2.3;BMX;;Jan 25, 2011
;
;
WINVAL(BMXRET,BMXWINID) ;EP

Before

Width:  |  Height:  |  Size: 5.7 KiB

After

Width:  |  Height:  |  Size: 5.7 KiB

View File

@ -1,5 +1,5 @@
BMXRPC8 ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ;
;;2.2;BMX;;Sep 07, 2010
BMXRPC8 ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ; 12/7/10 8:12am
;;2.3;BMX;;Jan 25, 2011
;
;
BMXLOCKD(BMXY,BMXVAR,BMXINC,BMXTIME) ;EP

Before

Width:  |  Height:  |  Size: 2.3 KiB

After

Width:  |  Height:  |  Size: 2.3 KiB

View File

@ -1,5 +1,5 @@
BMXRPC9 ; IHS/OIT/HMW - RPC CALL FOR EXTENDED BROKER FUNCTIONALITY ;
;;2.2;BMX;;Sep 07, 2010
;;2.3;BMX;;Jan 25, 2011
; UPDATE FILEMAN WITH AN ADO RECORD SET FROM A WINDOWS APPLICATION
;
;

Before

Width:  |  Height:  |  Size: 6.4 KiB

After

Width:  |  Height:  |  Size: 6.4 KiB

View File

@ -1,5 +1,5 @@
BMXSQL ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ;
;;2.2;BMX;;Sep 07, 2010
;;2.3;BMX;;Jan 25, 2011
;
;
Q

Before

Width:  |  Height:  |  Size: 11 KiB

After

Width:  |  Height:  |  Size: 11 KiB

View File

@ -1,5 +1,5 @@
BMXSQL1 ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ;
;;2.2;BMX;;Sep 07, 2010
;;2.3;BMX;;Jan 25, 2011
;
;
KW(BMXTK) ;EP

Before

Width:  |  Height:  |  Size: 10 KiB

After

Width:  |  Height:  |  Size: 10 KiB

View File

@ -1,5 +1,5 @@
BMXSQL2 ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ;
;;2.2;BMX;;Sep 07, 2010
;;2.3;BMX;;Jan 25, 2011
;
;
FLDFILE(BMXIN) ;EP - Returns name of file containing field BMXIN

Before

Width:  |  Height:  |  Size: 2.8 KiB

After

Width:  |  Height:  |  Size: 2.8 KiB

View File

@ -1,5 +1,5 @@
BMXSQL3 ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ;
;;2.2;BMX;;Sep 07, 2010
;;2.3;BMX;;Jan 25, 2011
;
;
PLEVEL(BMXFF,BMXLVL,BMXRET) ;EP

Before

Width:  |  Height:  |  Size: 14 KiB

After

Width:  |  Height:  |  Size: 14 KiB

View File

@ -1,5 +1,5 @@
BMXSQL4 ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ;
;;2.2;BMX;;Sep 07, 2010
;;2.3;BMX;;Jan 25, 2011
;
;
JOIN ;EP - Join processing

Before

Width:  |  Height:  |  Size: 1.3 KiB

After

Width:  |  Height:  |  Size: 1.3 KiB

View File

@ -1,5 +1,5 @@
BMXSQL5 ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ;
;;2.2;BMX;;Sep 07, 2010
;;2.3;BMX;;Jan 25, 2011
;
;
SELECT ;EP - Get field names into BMXFLD("NAME")="FILE#^FIELD#"

Before

Width:  |  Height:  |  Size: 6.7 KiB

After

Width:  |  Height:  |  Size: 6.7 KiB

View File

@ -1,5 +1,5 @@
BMXSQL6 ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ; 7/20/2009
;;2.2;BMX;;Sep 07, 2010
;;2.3;BMX;;Jan 25, 2011
; Line EOR+3 used a 2 argument form of $Q which is not
; in the M 95 standard. Replaced this with a call to $$LAST,
; a new Extrinsic in this routine.

Before

Width:  |  Height:  |  Size: 11 KiB

After

Width:  |  Height:  |  Size: 11 KiB

View File

@ -1,5 +1,5 @@
BMXSQL7 ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ;
;;2.2;BMX;;Sep 07, 2010
;;2.3;BMX;;Jan 25, 2011
;
;
CHKCR(BMXFNUM,BMXFLDNU,BMXRET) ;Returns cross reference to iterate on for related file

Before

Width:  |  Height:  |  Size: 8.1 KiB

After

Width:  |  Height:  |  Size: 8.1 KiB

View File

@ -1,5 +1,5 @@
BMXSQL91 ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ;
;;2.2;BMX;;Sep 07, 2010
;;2.3;BMX;;Jan 25, 2011
;
;Below is dead code, but keep for later
SETX2 ;Don't need this unless porting to machine with

Before

Width:  |  Height:  |  Size: 4.4 KiB

After

Width:  |  Height:  |  Size: 4.4 KiB

View File

@ -1,5 +1,5 @@
BMXTABLE ; IHS/OIT/HMW - BMX RETURN ENTIRE TABLE ;
;;2.2;BMX;;Sep 07, 2010
;;2.3;BMX;;Jan 25, 2011
;
TABLE(BMXGBL,BMXFL,BMXMX) ;EP
;

Before

Width:  |  Height:  |  Size: 166 B

After

Width:  |  Height:  |  Size: 166 B

View File

@ -1,5 +1,5 @@
BMXTRS ; IHS/OIT/HMW - UPPERCASE-LOWERCASE ;
;;2.2;BMX;;Sep 07, 2010
;;2.3;BMX;;Jan 25, 2011
;
T(X) ;EP
;---> Translate word to mixed case.

Before

Width:  |  Height:  |  Size: 1.3 KiB

After

Width:  |  Height:  |  Size: 1.3 KiB

View File

@ -1,5 +1,5 @@
BMXUTL1 ; IHS/OIT/HMW - UTIL: PATIENT DEMOGRAPHICS ;
;;2.2;BMX;;Sep 07, 2010
;;2.3;BMX;;Jan 25, 2011
;;Stolen from:* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
;; UTILITY: PATIENT DEMOGRAPHICS.
;

Before

Width:  |  Height:  |  Size: 8.0 KiB

After

Width:  |  Height:  |  Size: 8.0 KiB

View File

@ -1,5 +1,5 @@
BMXUTL2 ; IHS/OIT/HMW - UTIL: PATIENT INFO ;
;;2.2;BMX;;Sep 07, 2010
;;2.3;BMX;;Jan 25, 2011
;;Stolen from:* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
;; UTILITY: PATIENT FUNCTIONS: CONTRAS, INPATIENT, HIDOSE.
;

Before

Width:  |  Height:  |  Size: 932 B

After

Width:  |  Height:  |  Size: 932 B

View File

@ -1,5 +1,5 @@
BMXUTL5 ; IHS/OIT/HMW - DATE FORMAT ;
;;2.2;BMX;;Sep 07, 2010
;;2.3;BMX;;Jan 25, 2011
;;Stolen from:* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
;; UTILITY: SETVARS, CENTERT, COPYLET,
;; UPPERCASE XREFS, DATE FORMATS, PADS/SPACES.

Before

Width:  |  Height:  |  Size: 5.4 KiB

After

Width:  |  Height:  |  Size: 5.4 KiB

View File

@ -1,5 +1,5 @@
BMXUTL6 ; IHS/OIT/HMW - BMXNET INSTALLATION CALLS ;
;;2.2;BMX;;Sep 07, 2010
;;2.3;BMX;;Jan 25, 2011
;
;
POST ;EP - Called from BMX Installation postinit

Before

Width:  |  Height:  |  Size: 978 B

After

Width:  |  Height:  |  Size: 978 B

View File

@ -1,5 +1,5 @@
BMXUTL7 ; IHS/OIT/HMW - BMXNET INSTALLATION CALLS ;
;;2.2;BMX;;Sep 07, 2010
BMXUTL7 ; IHS/OIT/HMW - BMXNET INSTALLATION CALLS ; 9/7/10 9:34am
;;2.3;BMX;;Jan 25, 2011
;
;
ENV ;EP Environment Check

Before

Width:  |  Height:  |  Size: 171 B

After

Width:  |  Height:  |  Size: 185 B