diff --git a/m/BMXADE1.m b/m/BMXADE1.m index 0485d8c..30efd52 100644 --- a/m/BMXADE1.m +++ b/m/BMXADE1.m @@ -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 diff --git a/m/BMXADE2.m b/m/BMXADE2.m index d84bc00..32a59ff 100644 --- a/m/BMXADE2.m +++ b/m/BMXADE2.m @@ -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 diff --git a/m/BMXADO.m b/m/BMXADO.m index 868d26e..2b4c12e 100644 --- a/m/BMXADO.m +++ b/m/BMXADO.m @@ -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. diff --git a/m/BMXADO2.m b/m/BMXADO2.m index 4627326..009a30e 100644 --- a/m/BMXADO2.m +++ b/m/BMXADO2.m @@ -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 diff --git a/m/BMXADOF.m b/m/BMXADOF.m index 4bb83d4..415b862 100644 --- a/m/BMXADOF.m +++ b/m/BMXADOF.m @@ -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 diff --git a/m/BMXADOF1.m b/m/BMXADOF1.m index 24d849b..3af1bb5 100644 --- a/m/BMXADOF1.m +++ b/m/BMXADOF1.m @@ -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 ; ; diff --git a/m/BMXADOF2.m b/m/BMXADOF2.m index dd805f7..824939f 100644 --- a/m/BMXADOF2.m +++ b/m/BMXADOF2.m @@ -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 ; ; diff --git a/m/BMXADOFD.m b/m/BMXADOFD.m index 98d070d..166c3f8 100644 --- a/m/BMXADOFD.m +++ b/m/BMXADOFD.m @@ -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 ; diff --git a/m/BMXADOFS.m b/m/BMXADOFS.m index 763160e..0b1b969 100644 --- a/m/BMXADOFS.m +++ b/m/BMXADOFS.m @@ -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. ; diff --git a/m/BMXADOI.m b/m/BMXADOI.m index 4afb999..35f741b 100644 --- a/m/BMXADOI.m +++ b/m/BMXADOI.m @@ -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 ; ; diff --git a/m/BMXADOS.m b/m/BMXADOS.m index 5edcbbe..5212954 100644 --- a/m/BMXADOS.m +++ b/m/BMXADOS.m @@ -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 diff --git a/m/BMXADOS1.m b/m/BMXADOS1.m index 73693f6..40b2de5 100644 --- a/m/BMXADOS1.m +++ b/m/BMXADOS1.m @@ -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 ; ; diff --git a/m/BMXADOV.m b/m/BMXADOV.m index fbc1651..39ed881 100644 --- a/m/BMXADOV.m +++ b/m/BMXADOV.m @@ -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 ; ; ; diff --git a/m/BMXADOV1.m b/m/BMXADOV1.m index 3a0f19f..b1b35c5 100644 --- a/m/BMXADOV1.m +++ b/m/BMXADOV1.m @@ -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 diff --git a/m/BMXADOV2.m b/m/BMXADOV2.m index bb59c80..f7c20ae 100644 --- a/m/BMXADOV2.m +++ b/m/BMXADOV2.m @@ -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 ; ; diff --git a/m/BMXADOVJ.m b/m/BMXADOVJ.m index 2655ce9..7f6dbd9 100644 --- a/m/BMXADOVJ.m +++ b/m/BMXADOVJ.m @@ -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 ; ; diff --git a/m/BMXADOX.m b/m/BMXADOX.m index c4e7130..0c3c592 100644 --- a/m/BMXADOX.m +++ b/m/BMXADOX.m @@ -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 ; ; diff --git a/m/BMXADOX1.m b/m/BMXADOX1.m index a3cc5f8..d18cbe9 100644 --- a/m/BMXADOX1.m +++ b/m/BMXADOX1.m @@ -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 ; ; diff --git a/m/BMXADOX2.m b/m/BMXADOX2.m index ba5d2bb..5deacd6 100644 --- a/m/BMXADOX2.m +++ b/m/BMXADOX2.m @@ -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) ; diff --git a/m/BMXADOXX.m b/m/BMXADOXX.m index d1466a3..393703e 100644 --- a/m/BMXADOXX.m +++ b/m/BMXADOXX.m @@ -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 ; ; diff --git a/m/BMXADOXY.m b/m/BMXADOXY.m index d05196f..a47cb65 100644 --- a/m/BMXADOXY.m +++ b/m/BMXADOXY.m @@ -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 ; ; diff --git a/m/BMXE01.m b/m/BMXE01.m index dec3681..b242f71 100644 --- a/m/BMXE01.m +++ b/m/BMXE01.m @@ -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 diff --git a/m/BMXFIND.m b/m/BMXFIND.m index 659513b..736eb2a 100644 --- a/m/BMXFIND.m +++ b/m/BMXFIND.m @@ -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 diff --git a/m/BMXG.m b/m/BMXG.m index 4e954c5..9c80d8c 100644 --- a/m/BMXG.m +++ b/m/BMXG.m @@ -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 * ; ; diff --git a/m/BMXGETS.m b/m/BMXGETS.m index 5a6d724..ad9970f 100644 --- a/m/BMXGETS.m +++ b/m/BMXGETS.m @@ -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 diff --git a/m/BMXMBRK.m b/m/BMXMBRK.m index 6b63f75..55d59dd 100644 --- a/m/BMXMBRK.m +++ b/m/BMXMBRK.m @@ -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 diff --git a/m/BMXMBRK2.m b/m/BMXMBRK2.m index 243e8cb..e2cc5e9 100644 --- a/m/BMXMBRK2.m +++ b/m/BMXMBRK2.m @@ -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 diff --git a/m/BMXMEVN.m b/m/BMXMEVN.m index c9e49b2..4befb6e 100644 --- a/m/BMXMEVN.m +++ b/m/BMXMEVN.m @@ -1,5 +1,5 @@ BMXMEVN ; IHS/OIT/HMW - BMXNet MONITOR ; - ;;2.2;BMX;;Sep 07, 2010 + ;;2.3;BMX;;Jan 25, 2011 ; Q ; diff --git a/m/BMXMON.m b/m/BMXMON.m index 0d1f6cc..5261d43 100644 --- a/m/BMXMON.m +++ b/m/BMXMON.m @@ -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 diff --git a/m/BMXMSEC.m b/m/BMXMSEC.m index 793fff7..87cf26a 100644 --- a/m/BMXMSEC.m +++ b/m/BMXMSEC.m @@ -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 diff --git a/m/BMXNTEG.m b/m/BMXNTEG.m index ec8029b..d6d0fa3 100644 --- a/m/BMXNTEG.m +++ b/m/BMXNTEG.m @@ -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 diff --git a/m/BMXPO.m b/m/BMXPO.m index 0105cd2..ce7032a 100644 --- a/m/BMXPO.m +++ b/m/BMXPO.m @@ -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 diff --git a/m/BMXPRS.m b/m/BMXPRS.m index bf7cd84..1565b77 100644 --- a/m/BMXPRS.m +++ b/m/BMXPRS.m @@ -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 diff --git a/m/BMXRPC.m b/m/BMXRPC.m index caa1638..b7f9a83 100644 --- a/m/BMXRPC.m +++ b/m/BMXRPC.m @@ -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. diff --git a/m/BMXRPC1.m b/m/BMXRPC1.m index c92bed5..f7c899b 100644 --- a/m/BMXRPC1.m +++ b/m/BMXRPC1.m @@ -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. diff --git a/m/BMXRPC2.m b/m/BMXRPC2.m index 22f610e..e9fb6ea 100644 --- a/m/BMXRPC2.m +++ b/m/BMXRPC2.m @@ -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 diff --git a/m/BMXRPC3.m b/m/BMXRPC3.m index 82713de..e3c68eb 100644 --- a/m/BMXRPC3.m +++ b/m/BMXRPC3.m @@ -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 diff --git a/m/BMXRPC4.m b/m/BMXRPC4.m index 5d7bc7d..dc4049e 100644 --- a/m/BMXRPC4.m +++ b/m/BMXRPC4.m @@ -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 ; diff --git a/m/BMXRPC5.m b/m/BMXRPC5.m index b16032e..78d4169 100644 --- a/m/BMXRPC5.m +++ b/m/BMXRPC5.m @@ -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 diff --git a/m/BMXRPC6.m b/m/BMXRPC6.m index 922873b..0e8b37a 100644 --- a/m/BMXRPC6.m +++ b/m/BMXRPC6.m @@ -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 diff --git a/m/BMXRPC7.m b/m/BMXRPC7.m index 8c39ee6..79ac385 100644 --- a/m/BMXRPC7.m +++ b/m/BMXRPC7.m @@ -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 diff --git a/m/BMXRPC8.m b/m/BMXRPC8.m index 014f622..1e8ebfe 100644 --- a/m/BMXRPC8.m +++ b/m/BMXRPC8.m @@ -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 diff --git a/m/BMXRPC9.m b/m/BMXRPC9.m index 2e2395e..c0679a9 100644 --- a/m/BMXRPC9.m +++ b/m/BMXRPC9.m @@ -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 ; ; diff --git a/m/BMXSQL.m b/m/BMXSQL.m index 0500900..a4b02f8 100644 --- a/m/BMXSQL.m +++ b/m/BMXSQL.m @@ -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 diff --git a/m/BMXSQL1.m b/m/BMXSQL1.m index 2f713de..8b19ddc 100644 --- a/m/BMXSQL1.m +++ b/m/BMXSQL1.m @@ -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 diff --git a/m/BMXSQL2.m b/m/BMXSQL2.m index c40d249..0f8fb0c 100644 --- a/m/BMXSQL2.m +++ b/m/BMXSQL2.m @@ -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 diff --git a/m/BMXSQL3.m b/m/BMXSQL3.m index c53dabd..d4a095b 100644 --- a/m/BMXSQL3.m +++ b/m/BMXSQL3.m @@ -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 diff --git a/m/BMXSQL4.m b/m/BMXSQL4.m index 9129cf7..604107f 100644 --- a/m/BMXSQL4.m +++ b/m/BMXSQL4.m @@ -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 diff --git a/m/BMXSQL5.m b/m/BMXSQL5.m index a3378b5..c449fdc 100644 --- a/m/BMXSQL5.m +++ b/m/BMXSQL5.m @@ -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#" diff --git a/m/BMXSQL6.m b/m/BMXSQL6.m index 1cba183..1271c94 100644 --- a/m/BMXSQL6.m +++ b/m/BMXSQL6.m @@ -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. diff --git a/m/BMXSQL7.m b/m/BMXSQL7.m index b7ec636..5e50a7c 100644 --- a/m/BMXSQL7.m +++ b/m/BMXSQL7.m @@ -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 diff --git a/m/BMXSQL91.m b/m/BMXSQL91.m index 4f1ba8d..e1fc1ab 100644 --- a/m/BMXSQL91.m +++ b/m/BMXSQL91.m @@ -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 diff --git a/m/BMXTABLE.m b/m/BMXTABLE.m index 2ea1e70..b36d563 100644 --- a/m/BMXTABLE.m +++ b/m/BMXTABLE.m @@ -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 ; diff --git a/m/BMXTRS.m b/m/BMXTRS.m index 8ba70d7..ec2a5eb 100644 --- a/m/BMXTRS.m +++ b/m/BMXTRS.m @@ -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. diff --git a/m/BMXUTL1.m b/m/BMXUTL1.m index 6f91283..b303519 100644 --- a/m/BMXUTL1.m +++ b/m/BMXUTL1.m @@ -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. ; diff --git a/m/BMXUTL2.m b/m/BMXUTL2.m index 385eed4..39f84ca 100644 --- a/m/BMXUTL2.m +++ b/m/BMXUTL2.m @@ -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. ; diff --git a/m/BMXUTL5.m b/m/BMXUTL5.m index 9c2caf9..e745568 100644 --- a/m/BMXUTL5.m +++ b/m/BMXUTL5.m @@ -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. diff --git a/m/BMXUTL6.m b/m/BMXUTL6.m index 3e2e278..fdb4b5b 100644 --- a/m/BMXUTL6.m +++ b/m/BMXUTL6.m @@ -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 diff --git a/m/BMXUTL7.m b/m/BMXUTL7.m index 26650b3..275f6f0 100644 --- a/m/BMXUTL7.m +++ b/m/BMXUTL7.m @@ -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