Ignore:
Timestamp:
Jan 27, 2011, 4:50:57 AM (13 years ago)
Author:
Sam Habiel
Message:

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

Location:
BMXNET_RPMS_dotNET_UTILITIES-BMX/trunk/m
Files:
59 edited

Legend:

Unmodified
Added
Removed

  • BMXNET_RPMS_dotNET_UTILITIES-BMX/trunk/m/BMXADE1.m

    r931 r1087  
    11BMXADE1 ; IHS/OIT/HMW - BMXNet ADO.NET PROVIDER ;
    2         ;;2.2;BMX;;Sep 07, 2010
     2        ;;2.3;BMX;;Jan 25, 2011
    33        ;
    44        ;

  • BMXNET_RPMS_dotNET_UTILITIES-BMX/trunk/m/BMXADE2.m

    r931 r1087  
    11BMXADE2 ; IHS/OIT/HMW - BMXNet ADO.NET PROVIDER ;
    2         ;;2.2;BMX;;Sep 07, 2010
     2        ;;2.3;BMX;;Jan 25, 2011
    33        ;
    44        ;

  • BMXNET_RPMS_dotNET_UTILITIES-BMX/trunk/m/BMXADO.m

    r931 r1087  
    11BMXADO  ; IHS/CIHA/GIS - RPC CALL: GENERATE AN ADO SCHEMA STRING AND DATA SET ;
    2         ;;2.2;BMX;;Sep 07, 2010
     2        ;;2.3;BMX;;Jan 25, 2011
    33        ; SS^BMXADO: RPC EP FROM WINDOWS/WEB APP TO GENERATE A SCHEMEA STRING (& OPTIONALLY, A DATA SET AS WELL)
    44        ; THE SCHEMA DEFINITION AND MAP IS STORED IN THE 'BMX ADO SCHEMA' FILE

  • BMXNET_RPMS_dotNET_UTILITIES-BMX/trunk/m/BMXADO2.m

    r931 r1087  
    11BMXADO2 ; IHS/CIHA/GIS - BMX ADO RECORDSET UTILS ;
    2         ;;2.2;BMX;;Sep 07, 2010
     2        ;;2.3;BMX;;Jan 25, 2011
    33        ;
    44        ;

  • BMXNET_RPMS_dotNET_UTILITIES-BMX/trunk/m/BMXADOF.m

    r931 r1087  
    11BMXADOF ; IHS/CIHA/GIS - RPC CALL FOR EXTENDED FUNCTIONALITY OF BMXNet UTILITIES ;
    2         ;;2.2;BMX;;Sep 07, 2010
     2        ;;2.3;BMX;;Jan 25, 2011
    33        ; THIS IS THE ADO RECORDSET FILER: ADO -> FILEMAN
    44        ; VISIT FILE UPDATES REPRESENT A SPECIAL CASE HTAT IS MANAGED IN BMXADOF1

  • BMXNET_RPMS_dotNET_UTILITIES-BMX/trunk/m/BMXADOF1.m

    r931 r1087  
    11BMXADOF1        ; IHS/CIHA/GIS - RPC CALL FOR EXTENDED FUNCTIONALITY OF BMXNet UTILITIES ;
    2         ;;2.2;BMX;;Sep 07, 2010
     2        ;;2.3;BMX;;Jan 25, 2011
    33        ; UPDATE FILEMAN WITH AN ADO RECORD SET FROM A WINDOWS/WEB APPLICATION
    44        ;

  • BMXNET_RPMS_dotNET_UTILITIES-BMX/trunk/m/BMXADOF2.m

    r931 r1087  
    11BMXADOF2        ; IHS/CIHA/GIS - RPC CALL FOR EXTENDED FUNCTIONALITY OF BMXNet UTILITIES ;
    2         ;;2.2;BMX;;Sep 07, 2010
     2        ;;2.3;BMX;;Jan 25, 2011
    33        ; THIS ROUTINE CONTAINS SPECIAL ENTRY POINTS FOR UPDATING RPMS
    44        ;

  • BMXNET_RPMS_dotNET_UTILITIES-BMX/trunk/m/BMXADOFD.m

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

  • BMXNET_RPMS_dotNET_UTILITIES-BMX/trunk/m/BMXADOFS.m

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

  • BMXNET_RPMS_dotNET_UTILITIES-BMX/trunk/m/BMXADOI.m

    r931 r1087  
    11BMXADOI ; IHS/CIHA/GIS - RPC CALL: GENERATE DATA FOR AN ADO DATASET ;
    2         ;;2.2;BMX;;Sep 07, 2010
     2        ;;2.3;BMX;;Jan 25, 2011
    33        ; CUSTOM IDENTIFIERS
    44        ;

  • BMXNET_RPMS_dotNET_UTILITIES-BMX/trunk/m/BMXADOS.m

    r931 r1087  
    1 BMXADOS ; IHS/CIHA/GIS - UPDATE THE BMX ADO SCHEMA FILE ;
    2         ;;2.2;BMX;;Sep 07, 2010
     1BMXADOS ; IHS/CIHA/GIS - UPDATE THE BMX ADO SCHEMA FILE ; 12/7/10 4:07pm
     2        ;;2.3;BMX;;Jan 25, 2011
    33        ; ENABLES NAVIGATION TO SUBFILES PRIOR TO UPDATING THE SCHEMA FILE ENTRY
     4           ;
     5           ; Change log:
     6           ; Sam Habiel - 3101212 v2.21
     7           ; - Changed the quit from the line in ASTG b/c it couldn't compile in GT.M
     8           ;    F PCE=1:1:LEV S FNO=+$P(STG,",",PCE) D  I '$L(STG) Q "" **OLD**
     9        ;    F PCE=1:1:LEV S FNO=+$P(STG,",",PCE) D  Q:'$L(STG)  ; v 2.21 SMH
    410        ;
    511        ;
    … …  
    232238        N PCE,LEV,FNO,NAME
    233239        S LEV=$L(STG,",")
    234         F PCE=1:1:LEV S FNO=+$P(STG,",",PCE) D  I '$L(STG) Q ""
     240        F PCE=1:1:LEV S FNO=+$P(STG,",",PCE) D  Q:'$L(STG)  ; v 2.21 SMH
    235241        . S NAME=$O(^DD(FNO,0,"NM",""))
    236242        . I $E(NAME)="*" S NAME=$E(NAME,2,99)

  • BMXNET_RPMS_dotNET_UTILITIES-BMX/trunk/m/BMXADOS1.m

    r931 r1087  
    11BMXADOS1        ; IHS/CIHA/GIS - UPDATE THE BMX ADO SCHEMA FILE GUI VERSION ;
    2         ;;2.2;BMX;;Sep 07, 2010
     2        ;;2.3;BMX;;Jan 25, 2011
    33        ; RPC CALLS
    44        ;

  • BMXNET_RPMS_dotNET_UTILITIES-BMX/trunk/m/BMXADOV.m

    r931 r1087  
    11BMXADOV ; CIHA/CIHA/GIS - RPC CALL: GENERATE DATA FOR AN ADO DATASET
    2         ;;2.2;BMX;;Sep 07, 2010
     2        ;;2.3;BMX;;Jan 25, 2011
    33        ;
    44        ;

  • BMXNET_RPMS_dotNET_UTILITIES-BMX/trunk/m/BMXADOV1.m

    r931 r1087  
    1 BMXADOV1        ; IHS/CIHA/GIS - RPC CALL: GENERATE DATA FOR AN ADO DATASET ;
    2         ;;2.2;BMX;;Sep 07, 2010
     1BMXADOV1        ; IHS/CIHA/GIS - RPC CALL: GENERATE DATA FOR AN ADO DATASET ; 12/7/10 4:12pm
     2        ;;2.3;BMX;;Jan 25, 2011
    33        ; CONTINUATION FILE FOR BMXADOV
    44        ; MANAGES ITERATION FOR INDIVIDUAL INDEX TYPES
    55        ; ASSUMES CERTAIN LOCAL VARS: CREF,FIEN,IENS,DAS (<-THESE CAN'T BE NULL),START,STOP,MAX,TOT,NUM,IX
    66        ;
     7           ; Change Log
     8           ; Sam Habiel 3101212 v. 2.21
     9           ; Change line 140 from:
     10           ;  I IX="AA" G AA to
     11           ;  I IX="AA" Q $$AA
     12           ; to fix compilation error
    713        ;
    814        ;
    … …  
    132138        S DA=+IENS I 'DA Q CREF_"||"
    133139        I '$D(@CREF@(DA)) Q CREF_"||" ; NO ENTRY EXISTS
    134         I IX="AA" G AA
     140        I IX="AA" Q $$AA  ; SMH v. 2.21
    135141        S FLD=+$$IXFLD^BMXADOV(FIEN,IX) I 'FLD Q "" ; INVALID DD
    136142        S VAL=$$GET1^DIQ(FIEN,IENS,FLD,"I") I VAL="" Q "" ; VALUE IS NULL - NOTHING TO INDEX

  • BMXNET_RPMS_dotNET_UTILITIES-BMX/trunk/m/BMXADOV2.m

    r931 r1087  
    11BMXADOV2        ; IHS/CIHA/GIS - RPC CALL: GENERATE DATA FOR AN ADO DATASET ;
    2         ;;2.2;BMX;;Sep 07, 2010
     2        ;;2.3;BMX;;Jan 25, 2011
    33        ; CUSTOM ITERATORS FOR RPMS
    44        ;

  • BMXNET_RPMS_dotNET_UTILITIES-BMX/trunk/m/BMXADOVJ.m

    r931 r1087  
    11BMXADOVJ        ; IHS/CIHA/GIS - RPC CALL: GENERATE DATA FOR AN ADO DATASET ;
    2         ;;2.2;BMX;;Sep 07, 2010
     2        ;;2.3;BMX;;Jan 25, 2011
    33        ; THIS ROUTINE MANAGES THE JOINS
    44        ;

  • BMXNET_RPMS_dotNET_UTILITIES-BMX/trunk/m/BMXADOX.m

    r931 r1087  
    11BMXADOX ; IHS/CIHA/GIS - RPC CALL: GENERATE AN ADO SCHEMA STRING AND DATA SET ;
    2         ;;2.2;BMX;;Sep 07, 2010
     2        ;;2.3;BMX;;Jan 25, 2011
    33        ; EXMAPLES OF RPMS SCHEMAE GENERATION
    44        ;

  • BMXNET_RPMS_dotNET_UTILITIES-BMX/trunk/m/BMXADOX1.m

    r931 r1087  
    11BMXADOX1        ; IHS/CIHA/GIS - RPC CALL: GENERATE AN ADO SCHEMA STRING AND DATA SET ;
    2         ;;2.2;BMX;;Sep 07, 2010
     2        ;;2.3;BMX;;Jan 25, 2011
    33        ; EXMAPLES OF FILEMAN SCHEMA GENERATION
    44        ;

  • BMXNET_RPMS_dotNET_UTILITIES-BMX/trunk/m/BMXADOX2.m

    r931 r1087  
    11BMXADOX2        ; IHS/CIHA/GIS - RPC CALL: GENERATE AN ADO SCHEMA STRING AND DATA SET ;
    2         ;;2.2;BMX;;Sep 07, 2010
     2        ;;2.3;BMX;;Jan 25, 2011
    33        ; EXMAPLES OF FILEMAN SCHEMA GENERATION
    44        ;

  • BMXNET_RPMS_dotNET_UTILITIES-BMX/trunk/m/BMXADOXX.m

    r931 r1087  
    11BMXADOXX        ; IHS/CIHA/GIS - RPC CALL: GENERATE AN ADO SCHEMA STRING AND DATA SET ;
    2         ;;2.2;BMX;;Sep 07, 2010
     2        ;;2.3;BMX;;Jan 25, 2011
    33        ; EXMAPLES OF RPMS SCHEMAE GENERATION
    44        ;

  • BMXNET_RPMS_dotNET_UTILITIES-BMX/trunk/m/BMXADOXY.m

    r931 r1087  
    11BMXADOXY        ; IHS/CIHA/GIS - RPC CALL: GENERATE AN ADO SCHEMA STRING AND DATA SET ;
    2         ;;2.2;BMX;;Sep 07, 2010
     2        ;;2.3;BMX;;Jan 25, 2011
    33        ; EXMAPLES OF FILEMAN SCHEMA GENERATION
    44        ;

  • BMXNET_RPMS_dotNET_UTILITIES-BMX/trunk/m/BMXE01.m

    r931 r1087  
    11BMXE01  ; IHS/OIT/FJE - ENVIRONMENT CHECK FOR BMX 2.0 ;
    2         ;;2.2;BMX;;Sep 07, 2010
     2        ;;2.3;BMX;;Jan 25, 2011
    33        ;
    44        S $P(LINE,"*",81)=""

  • BMXNET_RPMS_dotNET_UTILITIES-BMX/trunk/m/BMXFIND.m

    r931 r1087  
    11BMXFIND ; IHS/OIT/HMW - BMX GENERIC FIND ;
    2         ;;2.2;BMX;;Sep 07, 2010
     2        ;;2.3;BMX;;Jan 25, 2011
    33        ;
    44        ;

  • BMXNET_RPMS_dotNET_UTILITIES-BMX/trunk/m/BMXG.m

    r931 r1087  
    11BMXG    ; IHS/OIT/HMW - UTIL: GET DATA ;
    2         ;;2.2;BMX;;Sep 07, 2010
     2        ;;2.3;BMX;;Jan 25, 2011
    33        ;;Stolen from:* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
    44        ;

  • BMXNET_RPMS_dotNET_UTILITIES-BMX/trunk/m/BMXGETS.m

    r931 r1087  
    11BMXGETS ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ;
    2         ;;2.2;BMX;;Sep 07, 2010
     2        ;;2.3;BMX;;Jan 25, 2011
    33        ;
    44        ;;Horace Whitt

  • BMXNET_RPMS_dotNET_UTILITIES-BMX/trunk/m/BMXMBRK.m

    r931 r1087  
    11BMXMBRK ; IHS/OIT/HMW - BMXNet MONITOR ;
    2         ;;2.2;BMX;;Sep 07, 2010
     2        ;;2.3;BMX;;Jan 25, 2011
    33        ;
    44        ;

  • BMXNET_RPMS_dotNET_UTILITIES-BMX/trunk/m/BMXMBRK2.m

    r931 r1087  
    11BMXMBRK2        ; IHS/OIT/HMW - BMXNet MONITOR ;
    2         ;;2.2;BMX;;Sep 07, 2010
     2        ;;2.3;BMX;;Jan 25, 2011
    33        ;
    44        ;

  • BMXNET_RPMS_dotNET_UTILITIES-BMX/trunk/m/BMXMEVN.m

    r931 r1087  
    11BMXMEVN ; IHS/OIT/HMW - BMXNet MONITOR ;
    2         ;;2.2;BMX;;Sep 07, 2010
     2        ;;2.3;BMX;;Jan 25, 2011
    33        ;
    44        Q

  • BMXNET_RPMS_dotNET_UTILITIES-BMX/trunk/m/BMXMON.m

    r931 r1087  
    1 BMXMON  ; IHS/OIT/HMW - BMXNet MONITOR ; 7/20/2009 ; 9/7/10 7:47am
    2         ;;2.2;BMX;;Sep 07, 2010
    3         ;
    4         ;IHS/OIT/HMW Patch 1 added validity check for passed-in namespace
    5         ; 7/20/2009: Release of patch to support GT.M WV/SMH
    6         ; Changes:
    7         ; Addition of XINETD and GTMLNX entry points for support of GT.M
    8         ; Changes of W *-3 (which only works on Cache) to W !
    9            ; 9/7/2009: Minor bug fixes and enhancements
     1BMXMON   ; IHS/OIT/HMW - BMXNet MONITOR ; 7/20/2009 ; 12/7/10 3:20pm
     2           ;;2.3;BMX;;Jan 25, 2011
     3           ;
     4           ;IHS/OIT/HMW Patch 1 added validity check for passed-in namespace
     5           ; 7/20/2009: Release of patch to support GT.M WV/SMH
     6           ; Changes:
     7           ; Addition of XINETD and GTMLNX entry points for support of GT.M
     8           ; Changes of W *-3 (which only works on Cache) to W !
     9           ; 9/7/2010: Minor bug fixes and enhancements
    1010           ; In GTMLNX: Set process name
    1111           ; In GTMLNX: Time out based now on the Kernel Broker Timeout field
    1212           ; in kernel system parameters file
    13         ;
    14 STRT(BMXPORT,NS,IS,VB)  ;EP
    15         ;Interactive monitor start
    16         ;Optional NS = namespace.  If undefined, start in current ns
    17         ;Optional IS = Integrated Security.  Default is 1
    18         ;Optional VB = Verbose. Default is 1
    19         ;
    20         N Y,BMXNS,BMXWIN
    21         ;
    22         ;Verbose
    23         S BMXVB=$G(VB,1)
    24         ;
    25         ;Check if port already running
    26         I '$$SEMAPHOR(BMXPORT,"LOCK") W:BMXVB "BMXNet Monitor on port "_BMXPORT_" appears to be running already.",! Q
    27         S %=$$SEMAPHOR(BMXPORT,"UNLOCK")
    28         ;
    29         D MARKER(BMXPORT,1) ;record problem marker
    30         ; -- start the monitor
    31         ;
    32         ;Namespace
    33         X ^%ZOSF("UCI")
    34         S BMXNS=$G(NS,$P(Y,","))
    35         ;
    36         ;Integrated security
    37         S BMXWIN=$G(IS,1)
    38         ;
    39         ;J DEBUG^%Serenji("MON^BMXMON("_BMXPORT_","_BMXNS_","_BMXWIN_")")
    40         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
    41         F %=1:1:5 D  Q:%=0
    42         . W:BMXVB "Checking if BMXNet Monitor has started...",!
    43         . H 1
    44         . S:'$$MARKER(BMXPORT,0) %=0
    45         I $$MARKER(BMXPORT,0) D
    46         . W:BMXVB !,"BMXNet Monitor could not be started!",!
    47         . W:BMXVB "Check if port "_BMXPORT_" is busy on this CPU.",!
    48         . D MARKER(BMXPORT,-1) ;clear marker
    49         E  W:BMXVB "BMXNet Monitor started successfully."
    50         ;
    51         Q
    52         ;
     13           ; 12/12/2010: Minor bug fixes
     14           ; ETRAP nows screens errors before logging them. If it is a network
     15           ;  write error, it's not logged to the Error Trap
     16           ; Set Process Name crashed on Cache due to undefined IO("GT.M").
     17           ; Now this is surrounded by $Get to prevent this error.
     18           ;
     19STRT(BMXPORT,NS,IS,VB)   ;EP
     20           ;Interactive monitor start
     21           ;Optional NS = namespace.  If undefined, start in current ns
     22           ;Optional IS = Integrated Security.  Default is 1
     23           ;Optional VB = Verbose. Default is 1
     24           ;
     25           N Y,BMXNS,BMXWIN
     26           ;
     27           ;Verbose
     28           S BMXVB=$G(VB,1)
     29           ;
     30           ;Check if port already running
     31           I '$$SEMAPHOR(BMXPORT,"LOCK") W:BMXVB "BMXNet Monitor on port "_BMXPORT_" appears to be running already.",! Q
     32           S %=$$SEMAPHOR(BMXPORT,"UNLOCK")
     33           ;
     34           D MARKER(BMXPORT,1) ;record problem marker
     35           ; -- start the monitor
     36           ;
     37           ;Namespace
     38           X ^%ZOSF("UCI")
     39           S BMXNS=$G(NS,$P(Y,","))
     40           ;
     41           ;Integrated security
     42           S BMXWIN=$G(IS,1)
     43           ;
     44           ;J DEBUG^%Serenji("MON^BMXMON("_BMXPORT_","_BMXNS_","_BMXWIN_")")
     45           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
     46           F %=1:1:5 D  Q:%=0
     47           . W:BMXVB "Checking if BMXNet Monitor has started...",!
     48           . H 1
     49           . S:'$$MARKER(BMXPORT,0) %=0
     50           I $$MARKER(BMXPORT,0) D
     51           . W:BMXVB !,"BMXNet Monitor could not be started!",!
     52           . W:BMXVB "Check if port "_BMXPORT_" is busy on this CPU.",!
     53           . D MARKER(BMXPORT,-1) ;clear marker
     54           E  W:BMXVB "BMXNet Monitor started successfully."
     55           ;
     56           Q
     57           ;
    5358RESTART ;EP
    54         ;Stop and Start all monitors in BMX MONITOR file
    55         ;Called by option BMX MONITOR START
    56         ;
    57         D STOPALL
    58         D STRTALL
    59         Q
    60         ;
     59           ;Stop and Start all monitors in BMX MONITOR file
     60           ;Called by option BMX MONITOR START
     61           ;
     62           D STOPALL
     63           D STRTALL
     64           Q
     65           ;
    6166STRTALL ;EP
    62         ;Start all monitors in BMX MONITOR file
    63         ;
    64         N BMXIEN
    65         S BMXIEN=0 F  S BMXIEN=$O(^BMXMON(BMXIEN)) Q:'+BMXIEN  D
    66         . S BMXNOD=$G(^BMXMON(BMXIEN,0))
    67         . Q:'+BMXNOD
    68         . Q:'+$P(BMXNOD,U,2)
    69         . S BMXWIN=$P(BMXNOD,U,3)
    70         . S BMXNS=$P(BMXNOD,U,4)
    71         . D STRT($P(BMXNOD,U),BMXNS,BMXWIN,0)
    72         . Q
    73         Q
    74         ;
     67           ;Start all monitors in BMX MONITOR file
     68           ;
     69           N BMXIEN
     70           S BMXIEN=0 F  S BMXIEN=$O(^BMXMON(BMXIEN)) Q:'+BMXIEN  D
     71           . S BMXNOD=$G(^BMXMON(BMXIEN,0))
     72           . Q:'+BMXNOD
     73           . Q:'+$P(BMXNOD,U,2)
     74           . S BMXWIN=$P(BMXNOD,U,3)
     75           . S BMXNS=$P(BMXNOD,U,4)
     76           . D STRT($P(BMXNOD,U),BMXNS,BMXWIN,0)
     77           . Q
     78           Q
     79           ;
    7580STOPALL ;EP
    76         ;Stop all monitors in BMXNET MONITOR file
    77         ;
    78         N BMXIEN,BMXPORT
    79         S BMXIEN=0 F  S BMXIEN=$O(^BMXMON(BMXIEN)) Q:'+BMXIEN  D
    80         . S BMXNOD=$G(^BMXMON(BMXIEN,0))
    81         . Q:'+BMXNOD
    82         . S BMXPORT=+BMXNOD
    83         . D STOP(BMXPORT,0)
    84         Q
    85         ;
    86 STOP(BMXPORT,VB)        ;EP Stop monitor on BMXPORT
    87         ;Open a channel to monitor on BMXPORT and send shutdown request
    88         ;Optional VB = Verbose. Default is 1
    89         ;
    90         N IP,REF,X,DEV
    91         S U="^" D HOME^%ZIS
    92         ;
    93         ;Verbose
    94         S BMXVB=$G(VB,1)
    95         ;
    96         D:BMXVB EN^DDIOL("Stop BMXNet Monitor...")
    97         X ^%ZOSF("UCI") S REF=Y
    98         S IP="0.0.0.0" ;get server IP
    99         IF $G(BMXPORT)="" S BMXPORT=9200
    100         ; -- make sure the listener is running
    101         I $$SEMAPHOR(BMXPORT,"LOCK") D  Q
    102         . S %=$$SEMAPHOR(BMXPORT,"UNLOCK")
    103         . D:BMXVB EN^DDIOL("BMXNet Monitor does not appear to be running.")
    104         ; -- send the shutdown message to the TCP Listener process
    105         D CALL^%ZISTCP("127.0.0.1",BMXPORT) I POP D  Q
    106         . S %=$$SEMAPHOR(BMXPORT,"UNLOCK")
    107         . D:BMXVB EN^DDIOL("BMXNet Monitor does not appear to be running.")
    108         U IO
    109         S X=$T(+2),X=$P(X,";;",2),X=$P(X,";")
    110         IF X="" S X=0
    111         S X=$C($L(X))_X
    112         W "{BMX}00011TCPshutdown",!
    113         R X#3:5
    114         D CLOSE^%ZISTCP
    115         I X="ack" D:BMXVB EN^DDIOL("BMXNet Monitor has been shutdown.")
    116         E  D:BMXVB EN^DDIOL("Shutdown Failed!")
    117         ;change process name
    118         D CHPRN($J)
    119         Q
    120         ;
    121 MON(BMXPORT,NS,IS)      ;Monitor port for connection & shutdown requests
    122         ;NS = Namespace to Start monitor
    123         ;IS = 1: Enable integrated security
    124         ;
    125         N BMXDEV,BMXQUIT,BMXDTIME,BMXLEN,BMXACT,BMXWIN,BMXNS
    126         S BMXQUIT=0,BMXDTIME=999999
    127         ;
    128         ;Set lock
    129         Q:'$$SEMAPHOR(BMXPORT,"LOCK")
    130         ;Clear problem marker
    131         D MARKER(BMXPORT,-1)
    132         ;H 1
    133         ;
    134         ;Namespace
    135         X ^%ZOSF("UCI")
    136         S BMXNS=$G(NS,$P(Y,","))
    137         ;
    138         ;Integrated security
    139         S BMXWIN=$G(IS,1)
    140         ;
    141         ;Open server port;
    142         S BMXDEV="|TCP|"_BMXPORT
    143         C BMXDEV ;IHS/OIT/HMW SAC Exemption Applied For
    144         O BMXDEV:(:BMXPORT:"S"):5 I '$T Q  ;IHS/OIT/HMW SAC Exemption Applied For
    145         ;
    146         ;S BMXDTIME(1)=BMXDTIME ; TODO: Set timeouts
    147         S BMXDTIME(1)=.5 ;HMW 20050120
    148         U BMXDEV
    149         F  D  Q:BMXQUIT
    150         . R BMXACT#5:BMXDTIME ;Read first 5 chars from TCP buffer, timeout=BMXDTIME
    151         . I BMXACT'="{BMX}" S BMXQUIT=1 Q
    152         . R BMXACT#5:BMXDTIME ;Read next 5 chars - message length
    153         . S BMXLEN=+BMXACT
    154         . R BMXACT#BMXLEN:BMXDTIME
    155         . I $P(BMXACT,"^")="TCPconnect" D  Q
    156         . . ;IHS/OIT/HMW added validity check for namespace
    157         . . N BMXNSJ,X,Y
    158         . . S BMXNSJ=$P(BMXACT,"^",2) ;Namespace
    159         . . S BMXNSJ=$P(BMXNSJ,",")
    160         . . ;if passed in namespace is invalid, new job will start in listener namespace
    161         . . I BMXNSJ]"" S X=BMXNSJ X ^%ZOSF("UCICHECK") S:Y=0 BMXNSJ=BMXNS
    162         . . ;Job another MONITOR using concurrent connection
    163         . . ;J DEBUG^%Serenji("SESSION^BMXMON("_BMXWIN_")"):(:5:BMXDEV:BMXDEV):5
    164         . . ;J SESSION^BMXMON(BMXWIN)[$P(BMXNS,",")]:(:5:BMXDEV:BMXDEV):5 ;IHS/OIT/HMW SAC Exemption Applied For
    165         . . J SESSION^BMXMON(BMXWIN)[BMXNSJ]:(:5:BMXDEV:BMXDEV):5 ;IHS/OIT/HMW SAC Exemption Applied For
    166         . I $P(BMXACT,"^")="TCPshutdown" S BMXQUIT=1 W "ack",!
    167         S %=$$SEMAPHOR(BMXPORT,"UNLOCK") ; destroy 'running flag'
    168         Q
    169         ;
    170 XINETD  ;PEP Directly from xinetd or inetd for GT.M
    171         N BMXDEV
    172         S U="^",$ETRAP="D ^%ZTER H" ;Set up the error trap
    173         S $ZT="" ;Clear old trap
    174         ; GT.M specific error and device code
    175         S @("$ZINTERRUPT=""I $$JOBEXAM^ZU($ZPOSITION)""")
    176         S BMXDEV=$P X "U BMXDEV:(nowrap:nodelimiter:ioerror=""TRAP"")"
    177         S %="",@("%=$ZTRNLNM(""REMOTE_HOST"")") S:$L(%) IO("GTM-IP")=%
    178         I %["::ffff:" S IO("GTM-IP")=$P(%,"::ffff:",2) ; IPv6 support
    179         ; Read message type
    180         N BMXACT,BMXDTIME
    181         S BMXDTIME=10  ; change in 2.2 instead of 9999999 - initial conn timout
    182         R BMXACT#5:BMXDTIME
    183         Q:BMXACT'="{BMX}"  ; Not a BMX message - quit.
    184         ; Fall through to below...
    185 GTMLNX  ;EP from XWBTCPM for GT.M
    186         ; not implementing NS and integrated authentication
    187         ; Vars: Read timeout, msg len, msg, windows auth, Namespace
    188         N BMXDTIME,BMXLEN,BMXACT,BMXWIN,BMXNS
    189         S BMXNSJ="",BMXWIN=0  ; No NS on GT.M, no Windows Authentication
    190         S BMXDTIME(1)=.5,BMXDTIME=180  ; sign on timeout
    191         R BMXACT#5:BMXDTIME ;Read next 5 chars - message length
    192         S BMXLEN=+BMXACT
    193         R BMXACT#BMXLEN:BMXDTIME
    194         I $P(BMXACT,"^")="TCPconnect" G SESSRES
    195         I $P(BMXACT,"^")="TCPshutdown" W "ack",! Q
    196         Q  ; Should't hit this quit, but just in case
    197         ;
     81           ;Stop all monitors in BMXNET MONITOR file
     82           ;
     83           N BMXIEN,BMXPORT
     84           S BMXIEN=0 F  S BMXIEN=$O(^BMXMON(BMXIEN)) Q:'+BMXIEN  D
     85           . S BMXNOD=$G(^BMXMON(BMXIEN,0))
     86           . Q:'+BMXNOD
     87           . S BMXPORT=+BMXNOD
     88           . D STOP(BMXPORT,0)
     89           Q
     90           ;
     91STOP(BMXPORT,VB)           ;EP Stop monitor on BMXPORT
     92           ;Open a channel to monitor on BMXPORT and send shutdown request
     93           ;Optional VB = Verbose. Default is 1
     94           ;
     95           N IP,REF,X,DEV
     96           S U="^" D HOME^%ZIS
     97           ;
     98           ;Verbose
     99           S BMXVB=$G(VB,1)
     100           ;
     101           D:BMXVB EN^DDIOL("Stop BMXNet Monitor...")
     102           X ^%ZOSF("UCI") S REF=Y
     103           S IP="0.0.0.0" ;get server IP
     104           IF $G(BMXPORT)="" S BMXPORT=9200
     105           ; -- make sure the listener is running
     106           I $$SEMAPHOR(BMXPORT,"LOCK") D  Q
     107           . S %=$$SEMAPHOR(BMXPORT,"UNLOCK")
     108           . D:BMXVB EN^DDIOL("BMXNet Monitor does not appear to be running.")
     109           ; -- send the shutdown message to the TCP Listener process
     110           D CALL^%ZISTCP("127.0.0.1",BMXPORT) I POP D  Q
     111           . S %=$$SEMAPHOR(BMXPORT,"UNLOCK")
     112           . D:BMXVB EN^DDIOL("BMXNet Monitor does not appear to be running.")
     113           U IO
     114           S X=$T(+2),X=$P(X,";;",2),X=$P(X,";")
     115           IF X="" S X=0
     116           S X=$C($L(X))_X
     117           W "{BMX}00011TCPshutdown",!
     118           R X#3:5
     119           D CLOSE^%ZISTCP
     120           I X="ack" D:BMXVB EN^DDIOL("BMXNet Monitor has been shutdown.")
     121           E  D:BMXVB EN^DDIOL("Shutdown Failed!")
     122           ;change process name
     123           D CHPRN($J)
     124           Q
     125           ;
     126MON(BMXPORT,NS,IS)       ;Monitor port for connection & shutdown requests
     127           ;NS = Namespace to Start monitor
     128           ;IS = 1: Enable integrated security
     129           ;
     130           N BMXDEV,BMXQUIT,BMXDTIME,BMXLEN,BMXACT,BMXWIN,BMXNS
     131           S BMXQUIT=0,BMXDTIME=999999
     132           ;
     133           ;Set lock
     134           Q:'$$SEMAPHOR(BMXPORT,"LOCK")
     135           ;Clear problem marker
     136           D MARKER(BMXPORT,-1)
     137           ;H 1
     138           ;
     139           ;Namespace
     140           X ^%ZOSF("UCI")
     141           S BMXNS=$G(NS,$P(Y,","))
     142           ;
     143           ;Integrated security
     144           S BMXWIN=$G(IS,1)
     145           ;
     146           ;Open server port;
     147           S BMXDEV="|TCP|"_BMXPORT
     148           C BMXDEV ;IHS/OIT/HMW SAC Exemption Applied For
     149           O BMXDEV:(:BMXPORT:"S"):5 I '$T Q  ;IHS/OIT/HMW SAC Exemption Applied For
     150           ;
     151           ;S BMXDTIME(1)=BMXDTIME ; TODO: Set timeouts
     152           S BMXDTIME(1)=.5 ;HMW 20050120
     153           U BMXDEV
     154           F  D  Q:BMXQUIT
     155           . R BMXACT#5:BMXDTIME ;Read first 5 chars from TCP buffer, timeout=BMXDTIME
     156           . I BMXACT'="{BMX}" S BMXQUIT=1 Q
     157           . R BMXACT#5:BMXDTIME ;Read next 5 chars - message length
     158           . S BMXLEN=+BMXACT
     159           . R BMXACT#BMXLEN:BMXDTIME
     160           . I $P(BMXACT,"^")="TCPconnect" D  Q
     161           . . ;IHS/OIT/HMW added validity check for namespace
     162           . . N BMXNSJ,X,Y
     163           . . S BMXNSJ=$P(BMXACT,"^",2) ;Namespace
     164           . . S BMXNSJ=$P(BMXNSJ,",")
     165           . . ;if passed in namespace is invalid, new job will start in listener namespace
     166           . . I BMXNSJ]"" S X=BMXNSJ X ^%ZOSF("UCICHECK") S:Y=0 BMXNSJ=BMXNS
     167           . . ;Job another MONITOR using concurrent connection
     168           . . ;J DEBUG^%Serenji("SESSION^BMXMON("_BMXWIN_")"):(:5:BMXDEV:BMXDEV):5
     169           . . ;J SESSION^BMXMON(BMXWIN)[$P(BMXNS,",")]:(:5:BMXDEV:BMXDEV):5 ;IHS/OIT/HMW SAC Exemption Applied For
     170           . . J SESSION^BMXMON(BMXWIN)[BMXNSJ]:(:5:BMXDEV:BMXDEV):5 ;IHS/OIT/HMW SAC Exemption Applied For
     171           . I $P(BMXACT,"^")="TCPshutdown" S BMXQUIT=1 W "ack",!
     172           S %=$$SEMAPHOR(BMXPORT,"UNLOCK") ; destroy 'running flag'
     173           Q
     174           ;
     175XINETD   ;PEP Directly from xinetd or inetd for GT.M
     176           N BMXDEV
     177           S U="^",$ETRAP="D ^%ZTER H" ;Set up the error trap
     178           S $ZT="" ;Clear old trap
     179           ; GT.M specific error and device code
     180           S @("$ZINTERRUPT=""I $$JOBEXAM^ZU($ZPOSITION)""")
     181           S BMXDEV=$P X "U BMXDEV:(nowrap:nodelimiter:ioerror=""TRAP"")"
     182           S %="",@("%=$ZTRNLNM(""REMOTE_HOST"")") S:$L(%) IO("GTM-IP")=%
     183           I %["::ffff:" S IO("GTM-IP")=$P(%,"::ffff:",2) ; IPv6 support
     184           ; Read message type
     185           N BMXACT,BMXDTIME
     186           S BMXDTIME=10  ; change in 2.2 instead of 9999999 - initial conn timout
     187           R BMXACT#5:BMXDTIME
     188           Q:BMXACT'="{BMX}"  ; Not a BMX message - quit.
     189           ; Fall through to below...
     190GTMLNX   ;EP from XWBTCPM for GT.M
     191           ; not implementing NS and integrated authentication
     192           ; Vars: Read timeout, msg len, msg, windows auth, Namespace
     193           N BMXDTIME,BMXLEN,BMXACT,BMXWIN,BMXNS
     194           S BMXNSJ="",BMXWIN=0  ; No NS on GT.M, no Windows Authentication
     195           S BMXDTIME(1)=.5,BMXDTIME=180  ; sign on timeout like XWBTCPM
     196           R BMXACT#5:BMXDTIME ;Read next 5 chars - message length
     197           S BMXLEN=+BMXACT
     198           R BMXACT#BMXLEN:BMXDTIME
     199           I $P(BMXACT,"^")="TCPconnect" G SESSRES
     200           I $P(BMXACT,"^")="TCPshutdown" W "ack",! Q
     201           Q  ; Should't hit this quit, but just in case
     202           ;
    198203SESSION(BMXWIN) ;EP
    199         ;Start session monitor
    200         ;BMXWIN = 1: Enable integrated security
     204           ;Start session monitor
     205           ;BMXWIN = 1: Enable integrated security
    201206SESSRES ;EP - reentry point from trap
    202         ;IHS/OIT/HMW SAC Exemption Applied For
    203         S BMXDTIME(1)=.5,BMXDTIME=$$BAT^XUPARAM  ; new in 2.2: Use kernel rpc timeout instead of 9999999
    204            D SETNM^%ZOSV("BMX:ip"_$P(IO("GTM-IP"),".",3,4)) ; new in 2.2: set proces name
    205         N $ESTACK S $ETRAP="D ETRAP^BMXMON"
    206         S DIQUIET=1,U="^" D DT^DICRW
    207         D UNREGALL^BMXMEVN ;Unregister all events for this session
    208         U $P D SESSMAIN
    209         ;Turn off the error trap for the exit
    210         S $ETRAP=""
    211         I $G(DUZ) D LOGOUT^XUSRB
    212         K BMXR,BMXARY
    213         C $P ;IHS/OIT/HMW SAC Exemption Applied For
    214         Q
    215         ;
    216 SESSMAIN        ;
    217         N BMXTBUF
    218         D SETUP^BMXMSEC(.RET) ;Setup required system vars
    219         S U="^"
    220         U $P
    221         F  D  Q:BMXTBUF="#BYE#"
    222         . R BMXTBUF#11:BMXDTIME IF '$T D TIMEOUT S BMXTBUF="#BYE#" Q
    223         . I BMXTBUF["XQKEY" S HWMP=1
    224         . I BMXTBUF="#BYE#" Q
    225         . S BMXHTYPE=$S($E(BMXTBUF,1,5)="{BMX}":1,1:0)  ;check HDR
    226         . I 'BMXHTYPE S BMXTBUF="#BYE#" D SNDERR W BMXTBUF,$C(4),! Q
    227         . S BMXTLEN=$E(BMXTBUF,6,10),L=$E(BMXTBUF,11,11)
    228         . R BMXTBUF#4:BMXDTIME(1) S BMXTBUF=L_BMXTBUF
    229         . S BMXPLEN=BMXTBUF
    230         . R BMXTBUF#BMXPLEN:BMXDTIME(1)
    231         . I $P(BMXTBUF,U)="TCPconnect" D  Q
    232         . . D SNDERR W "accept",$C(4),!  ;Ack
    233         . IF BMXHTYPE D
    234         . . K BMXR,BMXARY
    235         . . IF BMXTBUF="#BYE#" D SNDERR W "#BYE#",$C(4),! Q
    236         . . S BMXTLEN=BMXTLEN-15
    237         . . D CALLP^BMXMBRK(.BMXR,BMXTBUF)
    238         . . S BMXPTYPE=$S('$D(BMXPTYPE):1,BMXPTYPE<1:1,BMXPTYPE>6:1,1:BMXPTYPE)
    239         . IF BMXTBUF="#BYE#" Q
    240         . U $P
    241         . D SNDERR ;Clears SNDERR parameters
    242         . D SND
    243         . D WRITE($C(4)) W ! ;send eot and flush buffer
    244         D UNREGALL^BMXMEVN ;Unregister all events for this session
    245         Q  ;End Of Main
    246         ;
    247 SNDERR  ;send error information
    248         ;BMXSEC is the security packet, BMXERROR is application packet
    249         N X
    250         S X=$E($G(BMXSEC),1,255)
    251         W $C($L(X))_X W !
    252         S X=$E($G(BMXERROR),1,255)
    253         W $C($L(X))_X W !
    254         S BMXERROR="",BMXSEC="" ;clears parameters
    255         Q
    256         ;
    257 WRITE(BMXSTR)   ;Write a data string
    258         ;
    259         I $L(BMXSTR)<511 W ! W BMXSTR Q
    260         ;Handle a long string
    261         W ! ;Flush the buffer
    262         F  Q:'$L(BMXSTR)  W $E(BMXSTR,1,510),! S BMXSTR=$E(BMXSTR,511,99999)
    263         Q
     207           ;IHS/OIT/HMW SAC Exemption Applied For
     208           S BMXDTIME(1)=.5,BMXDTIME=$$BAT^XUPARAM  ; new in 2.2: Use kernel rpc timeout instead of 9999999
     209           ;
     210           ; Change Process Name (new in 2.2 and 2.3)
     211           ; (GT.M doesn't store the IP in $P, but Cache does. We get GT.M
     212           ;   remote process IP from linux env var $REMOTE_HOST)
     213           D:+$G(IO("GTM-IP")) CHPRN("BMX:ip"_$P(IO("GTM-IP"),".",3,4)) ; GT.M
     214           D:+$P CHPRN("BMX:ip_"_$P($P,".",3,4)) ; Cache
     215           ;
     216           N $ESTACK S $ETRAP="D ETRAP^BMXMON"
     217           S DIQUIET=1,U="^" D DT^DICRW
     218           D UNREGALL^BMXMEVN ;Unregister all events for this session
     219           U $P D SESSMAIN
     220           ;Turn off the error trap for the exit
     221           S $ETRAP=""
     222           I $G(DUZ) D LOGOUT^XUSRB
     223           K BMXR,BMXARY
     224           C $P ;IHS/OIT/HMW SAC Exemption Applied For
     225           Q
     226           ;
     227SESSMAIN           ;
     228           N BMXTBUF
     229           D SETUP^BMXMSEC(.RET) ;Setup required system vars
     230           S U="^"
     231           U $P
     232           F  D  Q:BMXTBUF="#BYE#"
     233           . R BMXTBUF#11:BMXDTIME IF '$T D TIMEOUT S BMXTBUF="#BYE#" Q
     234           . I BMXTBUF["XQKEY" S HWMP=1
     235           . I BMXTBUF="#BYE#" Q
     236           . S BMXHTYPE=$S($E(BMXTBUF,1,5)="{BMX}":1,1:0)  ;check HDR
     237           . I 'BMXHTYPE S BMXTBUF="#BYE#" D SNDERR W BMXTBUF,$C(4),! Q
     238           . S BMXTLEN=$E(BMXTBUF,6,10),L=$E(BMXTBUF,11,11)
     239           . R BMXTBUF#4:BMXDTIME(1) S BMXTBUF=L_BMXTBUF
     240           . S BMXPLEN=BMXTBUF
     241           . R BMXTBUF#BMXPLEN:BMXDTIME(1)
     242           . I $P(BMXTBUF,U)="TCPconnect" D  Q
     243           . . D SNDERR W "accept",$C(4),!  ;Ack
     244           . IF BMXHTYPE D
     245           . . K BMXR,BMXARY
     246           . . IF BMXTBUF="#BYE#" D SNDERR W "#BYE#",$C(4),! Q
     247           . . S BMXTLEN=BMXTLEN-15
     248           . . D CALLP^BMXMBRK(.BMXR,BMXTBUF)
     249           . . S BMXPTYPE=$S('$D(BMXPTYPE):1,BMXPTYPE<1:1,BMXPTYPE>6:1,1:BMXPTYPE)
     250           . IF BMXTBUF="#BYE#" Q
     251           . U $P
     252           . D SNDERR ;Clears SNDERR parameters
     253           . D SND
     254           . D WRITE($C(4)) W ! ;send eot and flush buffer
     255           D UNREGALL^BMXMEVN ;Unregister all events for this session
     256           Q  ;End Of Main
     257           ;
     258SNDERR   ;send error information
     259           ;BMXSEC is the security packet, BMXERROR is application packet
     260           N X
     261           S X=$E($G(BMXSEC),1,255)
     262           W $C($L(X))_X W !
     263           S X=$E($G(BMXERROR),1,255)
     264           W $C($L(X))_X W !
     265           S BMXERROR="",BMXSEC="" ;clears parameters
     266           Q
     267           ;
     268WRITE(BMXSTR)     ;Write a data string
     269           ;
     270           I $L(BMXSTR)<511 W ! W BMXSTR Q
     271           ;Handle a long string
     272           W ! ;Flush the buffer
     273           F  Q:'$L(BMXSTR)  W $E(BMXSTR,1,510),! S BMXSTR=$E(BMXSTR,511,99999)
     274           Q
    264275SND     ; -- send data for all, Let WRITE sort it out
    265         N I,T
    266         ;
    267         ; -- error or abort occurred, send null
    268         IF $L(BMXSEC)>0 D WRITE("") Q
    269         ; -- single value
    270         IF BMXPTYPE=1 S BMXR=$G(BMXR) D WRITE(BMXR) Q
    271         ; -- table delimited by CR+LF
    272         IF BMXPTYPE=2 D  Q
    273         . S I="" F  S I=$O(BMXR(I)) Q:I=""  D WRITE(BMXR(I)),WRITE($C(13,10))
    274         ; -- word processing
    275         IF BMXPTYPE=3 D  Q
    276         . S I="" F  S I=$O(BMXR(I)) Q:I=""  D WRITE(BMXR(I)) D:BMXWRAP WRITE($C(13,10))
    277         ; -- global array
    278         IF BMXPTYPE=4 D  Q
    279         . S I=$G(BMXR) Q:I=""  S T=$E(I,1,$L(I)-1) D:$D(@I)>10 WRITE(@I)
    280         . F  S I=$Q(@I) Q:I=""!(I'[T)  W ! W @I W:BMXWRAP&(@I'=$C(13,10)) $C(13,10)
    281         . IF $D(@BMXR) K @BMXR
    282         ; -- global instance
    283         IF BMXPTYPE=5 S BMXR=$G(@BMXR) D WRITE(BMXR) Q
    284         ; -- variable length records only good upto 255 char)
    285         IF BMXPTYPE=6 S I="" F  S I=$O(BMXR(I)) Q:I=""  D WRITE($C($L(BMXR(I)))),WRITE(BMXR(I))
    286         Q
    287         ;
     276           N I,T
     277           ;
     278           ; -- error or abort occurred, send null
     279           IF $L(BMXSEC)>0 D WRITE("") Q
     280           ; -- single value
     281           IF BMXPTYPE=1 S BMXR=$G(BMXR) D WRITE(BMXR) Q
     282           ; -- table delimited by CR+LF
     283           IF BMXPTYPE=2 D  Q
     284           . S I="" F  S I=$O(BMXR(I)) Q:I=""  D WRITE(BMXR(I)),WRITE($C(13,10))
     285           ; -- word processing
     286           IF BMXPTYPE=3 D  Q
     287           . S I="" F  S I=$O(BMXR(I)) Q:I=""  D WRITE(BMXR(I)) D:BMXWRAP WRITE($C(13,10))
     288           ; -- global array
     289           IF BMXPTYPE=4 D  Q
     290           . S I=$G(BMXR) Q:I=""  S T=$E(I,1,$L(I)-1) D:$D(@I)>10 WRITE(@I)
     291           . F  S I=$Q(@I) Q:I=""!(I'[T)  W ! W @I W:BMXWRAP&(@I'=$C(13,10)) $C(13,10)
     292           . IF $D(@BMXR) K @BMXR
     293           ; -- global instance
     294           IF BMXPTYPE=5 S BMXR=$G(@BMXR) D WRITE(BMXR) Q
     295           ; -- variable length records only good upto 255 char)
     296           IF BMXPTYPE=6 S I="" F  S I=$O(BMXR(I)) Q:I=""  D WRITE($C($L(BMXR(I)))),WRITE(BMXR(I))
     297           Q
     298           ;
    288299TIMEOUT ;Do this on MAIN  loop timeout
    289         I $G(DUZ)>0 D SNDERR,WRITE("#BYE#"_$C(4)) Q
    290         ;Sign-on timeout
    291         S BMXR(0)=0,BMXR(1)=1,BMXR(2)="",BMXR(3)="TIME-OUT",BMXPTYPE=2
    292         D SNDERR,SND,WRITE($C(4))
    293         Q
    294         ;
    295 SEMAPHOR(BMXTSKT,BMXACT)        ;Lock/Unlock BMXMON semaphore
    296         N RESULT
    297         S U="^",RESULT=1
    298         D GETENV^%ZOSV ;get Y=UCI^VOL^NODE^BOXLOOKUP of current system
    299         I BMXACT="LOCK" D
    300         . L +^BMXMON("BMXMON",$P(Y,U,2),$P(Y,U),$P(Y,U,4),BMXTSKT):1
    301         . S RESULT=$T
    302         E  L -^BMXMON("BMXMON",$P(Y,U,2),$P(Y,U),$P(Y,U,4),BMXTSKT)
    303         Q RESULT
    304         ;
    305 CHPRN(N)        ;Change process name to N.
    306         D SETNM^%ZOSV($E(N,1,15))
    307         Q
    308         ;
     300           I $G(DUZ)>0 D SNDERR,WRITE("#BYE#"_$C(4)) Q
     301           ;Sign-on timeout
     302           S BMXR(0)=0,BMXR(1)=1,BMXR(2)="",BMXR(3)="TIME-OUT",BMXPTYPE=2
     303           D SNDERR,SND,WRITE($C(4))
     304           Q
     305           ;
     306SEMAPHOR(BMXTSKT,BMXACT)           ;Lock/Unlock BMXMON semaphore
     307           N RESULT
     308           S U="^",RESULT=1
     309           D GETENV^%ZOSV ;get Y=UCI^VOL^NODE^BOXLOOKUP of current system
     310           I BMXACT="LOCK" D
     311           . L +^BMXMON("BMXMON",$P(Y,U,2),$P(Y,U),$P(Y,U,4),BMXTSKT):1
     312           . S RESULT=$T
     313           E  L -^BMXMON("BMXMON",$P(Y,U,2),$P(Y,U),$P(Y,U,4),BMXTSKT)
     314           Q RESULT
     315           ;
     316CHPRN(N)           ;Change process name to N.
     317           D SETNM^%ZOSV($E(N,1,15))
     318           Q
     319           ;
    309320MARKER(BMXPORT,BMXMODE) ;Set/Test/Clear Problem Marker, BMXMODE=0 is a function
    310         N IP,Y,%,REF X ^%ZOSF("UCI") S REF=Y,IP="0.0.0.0",%=0
    311         L +^BMX(IP,REF,BMXPORT,"PROBLEM MARKER"):1
    312         I BMXMODE=1 S ^BMX(IP,REF,BMXPORT,"PROBLEM MARKER")=1
    313         I BMXMODE=0 S:$D(^BMX(IP,REF,BMXPORT,"PROBLEM MARKER")) %=1
    314         I BMXMODE=-1 K ^BMX(IP,REF,BMXPORT,"PROBLEM MARKER")
    315         L -^BMX(IP,REF,BMXPORT,"PROBLEM MARKER")
    316         Q:BMXMODE=0 % Q
    317         ;
    318 ETRAP   ; -- on trapped error, send error info to client
    319         N BMXERC,BMXERR,BMXLGR
    320         ;Change trapping during trap.
    321         S $ETRAP="D ^%ZTER HALT"
    322         S BMXERC=$$EC^%ZOSV
    323         S BMXERR="M ERROR="_BMXERC_$C(13,10)_"LAST REF="
    324         S BMXLGR=$$LGR^%ZOSV_$C(4)
    325         S BMXERR=BMXERR_BMXLGR
    326         D ^%ZTER ;%ZTER clears $ZE and $ECODE
    327         I (BMXERC["READ")!(BMXERC["WRITE")!(BMXERC["SYSTEM-F") D:$G(DUZ) LOGOUT^XUSRB HALT
    328         U $P
    329         D SNDERR,WRITE(BMXERR) W !
    330         S $ETRAP="Q:($ESTACK&'$QUIT)  Q:$ESTACK -9 S $ECODE="""" G SESSRES^BMXMON",$ECODE=",U99,"
    331         Q
    332         ;
    333 MENU    ;EP - ENTRY ACTION FROM BMXMENU OPTION
    334         ;
    335         N BMX,BMXVER
    336         ;VERSION
    337         D
    338         . S BMXN="BMXNET ADO.NET DATA PROVIDER" I $D(^DIC(9.4,"B",BMXN)) Q
    339         . S BMXN="BMXNET RPMS .NET UTILITIES" I $D(^DIC(9.4,"B",BMXN)) Q
    340         . S BMXN=""
    341         . Q
    342         ;
    343         S BMXVER=""
    344         I BMXN]"",$D(^DIC(9.4,"B",BMXN)) D
    345         . S BMX=$O(^DIC(9.4,"B",BMXN,0))
    346         . I $D(^DIC(9.4,BMX,"VERSION")) S BMXVER=$P(^DIC(9.4,BMX,"VERSION"),"^")
    347         . E  S BMXVER="VERSION NOT FOUND"
    348         S:BMXVER="" BMXVER="VERSION NOT FOUND"
    349         ;
    350         ;LOCATION
    351         N BMXLOC
    352         S BMXLOC=""
    353         I $G(DUZ(2)),$D(^DIC(4,DUZ(2),0)) S BMXLOC=$P(^DIC(4,DUZ(2),0),"^")
    354         S:BMXLOC="" BMXLOC="LOCATION NOT FOUND"
    355         ;
    356         ;WRITE
    357         W !
    358         W !,"BMXNet Version: ",BMXVER
    359         W !,"Location: ",BMXLOC
    360         Q
     321           N IP,Y,%,REF X ^%ZOSF("UCI") S REF=Y,IP="0.0.0.0",%=0
     322           L +^BMX(IP,REF,BMXPORT,"PROBLEM MARKER"):1
     323           I BMXMODE=1 S ^BMX(IP,REF,BMXPORT,"PROBLEM MARKER")=1
     324           I BMXMODE=0 S:$D(^BMX(IP,REF,BMXPORT,"PROBLEM MARKER")) %=1
     325           I BMXMODE=-1 K ^BMX(IP,REF,BMXPORT,"PROBLEM MARKER")
     326           L -^BMX(IP,REF,BMXPORT,"PROBLEM MARKER")
     327           Q:BMXMODE=0 % Q
     328           ;
     329ETRAP     ; -- on trapped error, send error info to client
     330           ; Error Trap Vars: Code, Error, Last Global Reference
     331           N BMXERC,BMXERR,BMXLGR
     332           ;
     333           ; Change trapping during trap.
     334           N $ETRAP S $ETRAP="D ^%ZTER HALT"
     335           ;
     336           ; If the error is simply that we can't write to the TCP device
     337           ; clear and log out
     338           ; GT.M Error Code.
     339           I $ECODE=",Z150376602," S $ECODE="" D:$G(DUZ) LOGOUT^XUSRB HALT
     340           ; Cache Error Codes:
     341           I ($EC["READ")!($EC["WRITE")!($EC["SYSTEM-F") S $ECODE="" D:$G(DUZ) LOGOUT^XUSRB HALT
     342           ;
     343           ; Otherwise, log the error and send it to the client
     344           S BMXERC=$$EC^%ZOSV
     345           S BMXERR="M ERROR="_BMXERC_$C(13,10)_"LAST REF="
     346           S BMXLGR=$$LGR^%ZOSV_$C(4)
     347           S BMXERR=BMXERR_BMXLGR
     348           ;
     349           D ^%ZTER ;%ZTER clears $ZE and $ECODE
     350           ;
     351           U $P
     352           ;
     353           D SNDERR,WRITE(BMXERR) W !
     354           ;
     355           S $ETRAP="Q:($ESTACK&'$QUIT)  Q:$ESTACK -9 S $ECODE="""" G SESSRES^BMXMON",$ECODE=",U99,"
     356           QUIT
     357           ;
     358MENU       ;EP - ENTRY ACTION FROM BMXMENU OPTION
     359           ;
     360           N BMX,BMXVER
     361           ;VERSION
     362           D
     363           . S BMXN="BMXNET ADO.NET DATA PROVIDER" I $D(^DIC(9.4,"B",BMXN)) Q
     364           . S BMXN="BMXNET RPMS .NET UTILITIES" I $D(^DIC(9.4,"B",BMXN)) Q
     365           . S BMXN=""
     366           . Q
     367           ;
     368           S BMXVER=""
     369           I BMXN]"",$D(^DIC(9.4,"B",BMXN)) D
     370           . S BMX=$O(^DIC(9.4,"B",BMXN,0))
     371           . I $D(^DIC(9.4,BMX,"VERSION")) S BMXVER=$P(^DIC(9.4,BMX,"VERSION"),"^")
     372           . E  S BMXVER="VERSION NOT FOUND"
     373           S:BMXVER="" BMXVER="VERSION NOT FOUND"
     374           ;
     375           ;LOCATION
     376           N BMXLOC
     377           S BMXLOC=""
     378           I $G(DUZ(2)),$D(^DIC(4,DUZ(2),0)) S BMXLOC=$P(^DIC(4,DUZ(2),0),"^")
     379           S:BMXLOC="" BMXLOC="LOCATION NOT FOUND"
     380           ;
     381           ;WRITE
     382           W !
     383           W !,"BMXNet Version: ",BMXVER
     384           W !,"Location: ",BMXLOC
     385           Q

  • BMXNET_RPMS_dotNET_UTILITIES-BMX/trunk/m/BMXMSEC.m

    r931 r1087  
    11BMXMSEC ; IHS/OIT/HMW - BMXNet MONITOR ; 7/20/2009
    2         ;;2.2;BMX;;Sep 07, 2010
     2        ;;2.3;BMX;;Jan 25, 2011
    33        ; Edit History
    44        ; Line SETUP+2 has been changed to support GT.M //SMH 7/5/09

  • BMXNET_RPMS_dotNET_UTILITIES-BMX/trunk/m/BMXNTEG.m

    r931 r1087  
    11BMXNTEG ;INTEGRITY CHECKER;FEB 26, 2007
    2         ;;2.2;BMX;;Sep 07, 2010
     2        ;;2.3;BMX;;Jan 25, 2011
    33        ;
    44START   ;

  • BMXNET_RPMS_dotNET_UTILITIES-BMX/trunk/m/BMXPO.m

    r931 r1087  
    11BMXPO   ; IHS/CMI/MAW - Populate appcontext with all namespaced RPC's ;
    2         ;;2.2;BMX;;Sep 07, 2010
     2        ;;2.3;BMX;;Jan 25, 2011
    33        ;
    44        ;

  • BMXNET_RPMS_dotNET_UTILITIES-BMX/trunk/m/BMXPRS.m

    r931 r1087  
    11BMXPRS  ; IHS/OIT/HMW - BMX WINDOWS UTILS ;
    2         ;;2.2;BMX;;Sep 07, 2010
     2        ;;2.3;BMX;;Jan 25, 2011
    33        ;
    44        ;

  • BMXNET_RPMS_dotNET_UTILITIES-BMX/trunk/m/BMXRPC.m

    r931 r1087  
    11BMXRPC  ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ; 9/7/10 5:04am
    2         ;;2.2;BMX;;Sep 07, 2010
     2        ;;2.3;BMX;;Jan 25, 2011
    33        ;;Stolen from:* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
    44        ;;  GENERIC LOOKUP UTILITY FOR RETURNING MATCHING RECORDS

  • BMXNET_RPMS_dotNET_UTILITIES-BMX/trunk/m/BMXRPC1.m

    r931 r1087  
    11BMXRPC1 ; IHS/OIT/HMW - UTIL: REMOTE PROCEDURE CALLS ;
    2         ;;2.2;BMX;;Sep 07, 2010
     2        ;;2.3;BMX;;Jan 25, 2011
    33        ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
    44        ;;  UTILITY: CODE FOR REMOTE PROCEDURE CALLS.

  • BMXNET_RPMS_dotNET_UTILITIES-BMX/trunk/m/BMXRPC2.m

    r931 r1087  
    11BMXRPC2 ; IHS/OIT/HMW - FIELD LIST ;
    2         ;;2.2;BMX;;Sep 07, 2010
     2        ;;2.3;BMX;;Jan 25, 2011
    33        ;
    44FLDLIST(BMXGBL,BMXFL,BMXATTR,BMXSCR)           ;EP

  • BMXNET_RPMS_dotNET_UTILITIES-BMX/trunk/m/BMXRPC3.m

    r931 r1087  
    11BMXRPC3 ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ;  ; 8/30/10 2:56pm
    2         ;;2.2;BMX;;Sep 07, 2010
     2        ;;2.3;BMX;;Jan 25, 2011
    33        ;Mods by WV/SMH
    44        ;7/26/09 Removed references to ^AUTTSITE, an IHS file in GETFAC*

  • BMXNET_RPMS_dotNET_UTILITIES-BMX/trunk/m/BMXRPC4.m

    r931 r1087  
    11BMXRPC4 ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ;
    2         ;;2.2;BMX;;Sep 07, 2010
     2        ;;2.3;BMX;;Jan 25, 2011
    33        ;
    44PTINFORS(BMXY,BMXIEN)          ;EP Patient Info Recordset

  • BMXNET_RPMS_dotNET_UTILITIES-BMX/trunk/m/BMXRPC5.m

    r931 r1087  
    11BMXRPC5 ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ;
    2         ;;2.2;BMX;;Sep 07, 2010
     2        ;;2.3;BMX;;Jan 25, 2011
    33        ;
    44        ;Stolen from Mike Remillard.  If it doesn't work, it's his fault.

  • BMXNET_RPMS_dotNET_UTILITIES-BMX/trunk/m/BMXRPC6.m

    r931 r1087  
    11BMXRPC6 ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ;
    2         ;;2.2;BMX;;Sep 07, 2010
     2        ;;2.3;BMX;;Jan 25, 2011
    33        ;
    44        ;

  • BMXNET_RPMS_dotNET_UTILITIES-BMX/trunk/m/BMXRPC7.m

    r931 r1087  
    11BMXRPC7 ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ;
    2         ;;2.2;BMX;;Sep 07, 2010
     2        ;;2.3;BMX;;Jan 25, 2011
    33        ;
    44        ;

  • BMXNET_RPMS_dotNET_UTILITIES-BMX/trunk/m/BMXRPC8.m

    r931 r1087  
    1 BMXRPC8 ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ;
    2         ;;2.2;BMX;;Sep 07, 2010
     1BMXRPC8 ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ; 12/7/10 8:12am
     2        ;;2.3;BMX;;Jan 25, 2011
    33        ;
    44        ;

  • BMXNET_RPMS_dotNET_UTILITIES-BMX/trunk/m/BMXRPC9.m

    r931 r1087  
    11BMXRPC9 ; IHS/OIT/HMW - RPC CALL FOR EXTENDED BROKER FUNCTIONALITY ;
    2         ;;2.2;BMX;;Sep 07, 2010
     2        ;;2.3;BMX;;Jan 25, 2011
    33        ; UPDATE FILEMAN WITH AN ADO RECORD SET FROM A WINDOWS APPLICATION
    44        ;

  • BMXNET_RPMS_dotNET_UTILITIES-BMX/trunk/m/BMXSQL.m

    r931 r1087  
    11BMXSQL  ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ;
    2         ;;2.2;BMX;;Sep 07, 2010
     2        ;;2.3;BMX;;Jan 25, 2011
    33        ;
    44        ;

  • BMXNET_RPMS_dotNET_UTILITIES-BMX/trunk/m/BMXSQL1.m

    r931 r1087  
    11BMXSQL1 ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ;
    2         ;;2.2;BMX;;Sep 07, 2010
     2        ;;2.3;BMX;;Jan 25, 2011
    33        ;
    44        ;

  • BMXNET_RPMS_dotNET_UTILITIES-BMX/trunk/m/BMXSQL2.m

    r931 r1087  
    11BMXSQL2 ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ;
    2         ;;2.2;BMX;;Sep 07, 2010
     2        ;;2.3;BMX;;Jan 25, 2011
    33        ;
    44        ;

  • BMXNET_RPMS_dotNET_UTILITIES-BMX/trunk/m/BMXSQL3.m

    r931 r1087  
    11BMXSQL3 ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ;
    2         ;;2.2;BMX;;Sep 07, 2010
     2        ;;2.3;BMX;;Jan 25, 2011
    33        ;
    44        ;

  • BMXNET_RPMS_dotNET_UTILITIES-BMX/trunk/m/BMXSQL4.m

    r931 r1087  
    11BMXSQL4 ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ;
    2         ;;2.2;BMX;;Sep 07, 2010
     2        ;;2.3;BMX;;Jan 25, 2011
    33        ;
    44        ;

  • BMXNET_RPMS_dotNET_UTILITIES-BMX/trunk/m/BMXSQL5.m

    r931 r1087  
    11BMXSQL5 ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ;
    2         ;;2.2;BMX;;Sep 07, 2010
     2        ;;2.3;BMX;;Jan 25, 2011
    33        ;
    44        ;

  • BMXNET_RPMS_dotNET_UTILITIES-BMX/trunk/m/BMXSQL6.m

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

  • BMXNET_RPMS_dotNET_UTILITIES-BMX/trunk/m/BMXSQL7.m

    r931 r1087  
    11BMXSQL7 ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ;
    2         ;;2.2;BMX;;Sep 07, 2010
     2        ;;2.3;BMX;;Jan 25, 2011
    33        ;
    44        ;

  • BMXNET_RPMS_dotNET_UTILITIES-BMX/trunk/m/BMXSQL91.m

    r931 r1087  
    11BMXSQL91        ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ;
    2         ;;2.2;BMX;;Sep 07, 2010
     2        ;;2.3;BMX;;Jan 25, 2011
    33        ;
    44        ;Below is dead code, but keep for later

  • BMXNET_RPMS_dotNET_UTILITIES-BMX/trunk/m/BMXTABLE.m

    r931 r1087  
    11BMXTABLE        ; IHS/OIT/HMW - BMX RETURN ENTIRE TABLE ;
    2         ;;2.2;BMX;;Sep 07, 2010
     2        ;;2.3;BMX;;Jan 25, 2011
    33        ;
    44TABLE(BMXGBL,BMXFL,BMXMX)          ;EP

  • BMXNET_RPMS_dotNET_UTILITIES-BMX/trunk/m/BMXTRS.m

    r931 r1087  
    11BMXTRS  ; IHS/OIT/HMW - UPPERCASE-LOWERCASE ;
    2         ;;2.2;BMX;;Sep 07, 2010
     2        ;;2.3;BMX;;Jan 25, 2011
    33        ;
    44T(X)    ;EP

  • BMXNET_RPMS_dotNET_UTILITIES-BMX/trunk/m/BMXUTL1.m

    r931 r1087  
    11BMXUTL1 ; IHS/OIT/HMW - UTIL: PATIENT DEMOGRAPHICS ;
    2         ;;2.2;BMX;;Sep 07, 2010
     2        ;;2.3;BMX;;Jan 25, 2011
    33        ;;Stolen from:* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
    44        ;;  UTILITY: PATIENT DEMOGRAPHICS.

  • BMXNET_RPMS_dotNET_UTILITIES-BMX/trunk/m/BMXUTL2.m

    r931 r1087  
    11BMXUTL2 ; IHS/OIT/HMW - UTIL: PATIENT INFO ;
    2         ;;2.2;BMX;;Sep 07, 2010
     2        ;;2.3;BMX;;Jan 25, 2011
    33        ;;Stolen from:* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
    44        ;;  UTILITY: PATIENT FUNCTIONS: CONTRAS, INPATIENT, HIDOSE.

  • BMXNET_RPMS_dotNET_UTILITIES-BMX/trunk/m/BMXUTL5.m

    r931 r1087  
    11BMXUTL5 ; IHS/OIT/HMW - DATE FORMAT ;
    2         ;;2.2;BMX;;Sep 07, 2010
     2        ;;2.3;BMX;;Jan 25, 2011
    33        ;;Stolen from:* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
    44        ;;  UTILITY: SETVARS, CENTERT, COPYLET,

  • BMXNET_RPMS_dotNET_UTILITIES-BMX/trunk/m/BMXUTL6.m

    r931 r1087  
    11BMXUTL6 ; IHS/OIT/HMW - BMXNET INSTALLATION CALLS ;
    2         ;;2.2;BMX;;Sep 07, 2010
     2        ;;2.3;BMX;;Jan 25, 2011
    33        ;
    44        ;

  • BMXNET_RPMS_dotNET_UTILITIES-BMX/trunk/m/BMXUTL7.m

    r931 r1087  
    1 BMXUTL7 ; IHS/OIT/HMW - BMXNET INSTALLATION CALLS ;
    2         ;;2.2;BMX;;Sep 07, 2010
     1BMXUTL7 ; IHS/OIT/HMW - BMXNET INSTALLATION CALLS ; 9/7/10 9:34am
     2        ;;2.3;BMX;;Jan 25, 2011
    33        ;
    44        ;
Note: See TracChangeset for help on using the changeset viewer.