Changeset 1181

Timestamp:

May 11, 2011, 9:30:11 AM (14 years ago)

Author:

Sam Habiel

Message:

Fixes and enhancements to BMX4

Location:

BMXNET_RPMS_dotNET_UTILITIES-BMX/branch/routines

Files:

• BMXMON.m (modified) (9 diffs)
• BMXRPC10.m (modified) (2 diffs)
• BMXRPC3.m (modified) (1 diff)

BMXNET_RPMS_dotNET_UTILITIES-BMX/branch/routines/BMXMON.m

@@ -1 @@
-BMXMON  ; IHS/OIT/HMW - BMXNet MONITOR ; 4/6/11 12:42pm
+BMXMON  ; IHS/OIT/HMW - BMXNet MONITOR ; 5/9/11 10:16am
         ;;4.1000;BMX;;Apr 17, 2011
-        ;
-        ; IMPORTANT: Logging is on by default. Set XWBDEBUG=0 to turn it off.
         ;
         ; Changes for *1000 by WV/SMH (Feb 2 2011) to support GT.M
         ; - XINETD entry point for GT.M
         ; - Replacement of all W *-3 to W !
-        ; - Addition of logging capabilities for analysis
+        ; - Addition of logging capabilities for analysis using XWBDLOG
         ; - In SESSRES
         ; -- Broker Timeout set from Kernel System Parameter Broker Timeout Field
-        ; -- Process Name now changes to show name in %SS or ZSY
-        ;
+        ; -- Process Name now gets Set to show in %SS or ZSY
+        ; - Error Handling does not log Network Errors to the Error Trap.
+    ; - Major refactoring to Writing to the TCP Network Stream.
+    ; --> All writes are buffered up to 32767 characters (max string on Cache)
+    ; --> Then sent...
+    ; --> See EP's WRITE and WBF
+    ; --> This avoids the side effects of the Nagle Algorithm on the Linux TCP Stack
+    ; - BMXERR renamed to BMXERROR in EP ETRAP so that it can be sent via SNDERR.
+    ; --> This reduces the need for custom error trap handling which is very difficult to do
+    ; --> in Mumps for new programmers. Mumps errors now are thrown on the client.
         ;
         ;IHS/OIT/HMW Patch 1 added validity check for passed-in namespace
@@ -241 +247 @@
         ;
 SESSMAIN        ; MAIN LOOP!!!!!!
-        N BMXTBUF
+        N BMXTBUF ; BMX Read Buffer
+    N BMXWBUF S BMXWBUF="" ; BMX Write Buffer
         D SETUP^BMXMSEC(.RET) ;Setup required system vars
         S U="^"
@@ -254 +261 @@
         . I 'BMXHTYPE S BMXTBUF="#BYE#" D  QUIT  ;;***QUITTING HERE***
         . . D SNDERR 
-        . . W BMXTBUF,$C(4),! 
-        . . D LOG("Write: "_BMXTBUF_$C(4)_"(flush)")
+        . . D WRITE(BMXTBUF_$C(4)),WBF
         . S BMXTLEN=$E(BMXTBUF,6,10),L=$E(BMXTBUF,11,11)
         . R BMXTBUF#4:BMXDTIME(1) 
@@ -269 +275 @@
         . I $P(BMXTBUF,U)="TCPconnect" D  QUIT  ;;***QUIT HERE***
         . . D SNDERR 
-        . . W "accept",$C(4),!  ;Ack
-        . . ;
-        . . D LOG("Write: accept"_$C(4)_"(flush)")
-        . . ;
+        . . D WRITE("accept"_$C(4)),WBF  ;Ack
         . IF BMXHTYPE D
         . . K BMXR,BMXARY
         . . IF BMXTBUF="#BYE#" D  QUIT
         . . . D SNDERR 
-        . . . W "#BYE#",$C(4),!
-        . . . ;
-        . . . D LOG("Write: #BYE#\4")
-        . . . ;
+        . . . D WRITE("#BYE#"_$C(4))
+    . . . D WBF
         . . S BMXTLEN=BMXTLEN-15
         . . D CALLP^BMXMBRK(.BMXR,BMXTBUF)
@@ -288 +289 @@
         . D SNDERR ;Clears SNDERR parameters
         . D SND
-        . D WRITE($C(4)) W ! ;send eot and flush buffer
-        . ;
-        . D LOG("Write: "_$C(4))
-        . ;
+        . D WRITE($C(4)) ;send eot
+    . D WBF ; Flush Buffer
         D UNREGALL^BMXMEVN ;Unregister all events for this session
         Q  ;End Of Main
-        ;
         ;
 SNDERR  ;send error information
@@ -300 +298 @@
         N X
         S X=$E($G(BMXSEC),1,255)
-        W $C($L(X))_X W !
-        D LOG("Write: "_$C($L(X))_X_"(flush)")
+        D WRITE($C($L(X))_X)
         S X=$E($G(BMXERROR),1,255)
-        W $C($L(X))_X W !
-        D LOG("Write: "_$C($L(X))_X_"(flush)")
+        D WRITE($C($L(X))_X)
         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
+WRITE(BMXSTR)   ;Write a data string to the output buffer
+    F  Q:'$L(BMXSTR)  D
+    . I $L(BMXWBUF)+$L(BMXSTR)>32767 D WBF  ; Maximum String Length on Cache
+    . S BMXWBUF=BMXWBUF_$E(BMXSTR,1,255),BMXSTR=$E(BMXSTR,256,999999)
+    QUIT
+    ;
+WBF ;Write Buffer to Network Stream then flush
+    Q:'$L(BMXWBUF)
+    I $G(XWBDEBUG)>2,$L(BMXWBUF) D LOG^XWBDLOG("wrt ("_$L(BMXWBUF)_"): "_BMXWBUF)
+    W BMXWBUF,!
+    S BMXWBUF=""
+    QUIT
+
 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(""),LOG("Write Sting.Empty") Q
+        IF $L(BMXSEC)>0 D WRITE("") QUIT
+    ;
         ; -- single value
-        IF BMXPTYPE=1 S BMXR=$G(BMXR) D WRITE(BMXR),LOG("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)),LOG("Write: "_BMXR(I))
+        IF BMXPTYPE=1 S BMXR=$G(BMXR) D WRITE(BMXR) QUIT
+        ;
+    ; -- table delimited by CR+LF
+        IF BMXPTYPE=2 D  QUIT
+        . 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)),LOG("Write: "_BMXR(I)) D:BMXWRAP WRITE($C(13,10)),LOG("Write: "_$C(13,10))
+        IF BMXPTYPE=3 D  QUIT
+        . S I="" F  S I=$O(BMXR(I)) Q:I=""  D WRITE(BMXR(I)),WRITE($C(13,10)):BMXWRAP
+    ;
         ; -- 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),LOG("Write: "_@I)
-        . F  S I=$Q(@I) Q:I=""!(I'[T)  W ! W @I W:BMXWRAP&(@I'=$C(13,10)) $C(13,10) D LOG("Write: "_@I)
+        IF BMXPTYPE=4 D  QUIT
+        . 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)  D WRITE(@I),WRITE($C(13,10)):(BMXWRAP&(@I'=$C(13,10)))
         . IF $D(@BMXR) K @BMXR
+    ;
         ; -- global instance
-        IF BMXPTYPE=5 S BMXR=$G(@BMXR) D WRITE(BMXR),LOG("Write: "_BMXR) Q
+        IF BMXPTYPE=5 S BMXR=$G(@BMXR) D WRITE(BMXR) QUIT
+    ;
         ; -- 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)),LOG("Write: "_$C($L(BMXR(I)))_BMXR(I))
-        Q
+        IF BMXPTYPE=6 S I="" F  S I=$O(BMXR(I)) Q:I=""  D WRITE($C($L(BMXR(I)))),WRITE(BMXR(I))
+        QUIT
         ;
 TIMEOUT ;Do this on MAIN  loop timeout
-        I $G(DUZ)>0 D SNDERR,WRITE("#BYE#"_$C(4)) Q
+        I $G(DUZ)>0 D SNDERR,WRITE("#BYE#"_$C(4)),WBF QUIT
         ;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
+        D SNDERR,SND,WRITE($C(4)),WBF QUIT
         ;
 SEMAPHOR(BMXTSKT,BMXACT)        ;Lock/Unlock BMXMON semaphore
@@ -384 +391 @@
 ETRAP   ; -- on trapped error, send error info to client
         ; Error Trap Vars: Code, Error, Last Global Reference
-        N BMXERC,BMXERR,BMXLGR
+        N BMXERC,BMXERROR,BMXLGR
         ;
         ;Change trapping during trap.
@@ -398 +405 @@
         ; Otherwise, log error and send to client
         S BMXERC=$$EC^%ZOSV
-        S BMXERR="M ERROR="_BMXERC_$C(13,10)_"LAST REF="
+        S BMXERROR="M ERROR="_BMXERC_$C(13,10)_"LAST REF="
         S BMXLGR=$$LGR^%ZOSV_$C(4)
-        S BMXERR=BMXERR_BMXLGR
+        S BMXERROR=BMXERROR_BMXLGR
         ;
         D ^%ZTER ;%ZTER clears $ZE and $ECODE
@@ -406 +413 @@
         U $P
         ;
-        D SNDERR,WRITE(BMXERR) W !
+        D SNDERR,WRITE(BMXERROR),WBF
         ;
         S $ETRAP="Q:($ESTACK&'$QUIT)  Q:$ESTACK -9 S $ECODE="""" G SESSRES^BMXMON",$ECODE=",U99," ;IHS/OIT/HMW SAC Exemption Applied For

BMXNET_RPMS_dotNET_UTILITIES-BMX/branch/routines/BMXRPC10.m

@@ -1 @@
-BMXRPC10        ; IHS/OIT/GIS - RPC CALL FOR EXTENDED BROKER FUNCTIONALITY ; 08 Jun 2010  8:47 AM
+BMXRPC10        ; IHS/OIT/GIS - RPC CALL FOR EXTENDED BROKER FUNCTIONALITY ; 5/11/11 4:35pm
         ;;4.1000;BMX;;Apr 17, 2011
         ;; LOGIN RPCS TO RETURN PATIENTS, VISITS AND FACILITIES.  SUPPORTS MULTI-INDEX PATIENT LOOKUP (DOB, NAME, CHART#, ETC)
+    ; 
+    ; Changes in v 4.1000 to support GT.M
+    ; - In BMXCCXT, there are several lines that rely on the
+    ;   settings in BMX MONITOR file. We don't use that on GT.M
+    ;   as xinetd handles all connection issues.
+    ;   Also, at this point, we don't have integrated windows authentication
+    ;   See below for the specific details.
         ;
 GETFCRS(BMXFACS,BMXDUZ) ; EP - Gets all facilities for a user - returns RECORDSET
@@ -239 +246 @@
         I $E(OPTION,1,3)="BMX" S RESULT=1 Q  ; NO RESTRICTIONS FOR BMX CONTEXT FOR THIS PORT
         K XQY0,XQY
-        I OPTION="" S XQY=0,XQY0="" Q  ;delete context if "" passed in N PORT
-        S PORT=+$P($P,"|",3) I 'PORT Q
-        S IEN=$O(^BMXMON("B",PORT,0)) I 'IEN Q
-        I '$O(^BMXMON(IEN,1,0)) G BC1  ; NO RESTRICTIONS ON CONTEXT FOR THIS PORT
-        S OK=0,CIEN=0
-        F  S CIEN=$O(^BMXMON(IEN,1,CIEN)) Q:'CIEN  D  I OK Q
-        . S %=$P($G(^BMXMON(IEN,1,CIEN,0)),U) I '% Q
-        . S %=$P($G(^DIC(19,%,0)),U) I %="" Q
-        . I %=OPTION S OK=1
-        . Q
-        I 'OK S (XWBSEC,RESULT)="The context '"_OPTION_"' is not registered with port "_PORT_"." Q
+    I OPTION="" S XQY=0,XQY0="" Q  ;delete context if "" passed in N PORT
+    ; 
+    ; Following lines are addition for 4.1000; GT.M does not use BMXMON
+    D:^%ZOSF("OS")["OpenM"  ; Doesn't apply to GT.M; Only Cache
+    . S PORT=+$P($P,"|",3) I 'PORT Q
+        . S IEN=$O(^BMXMON("B",PORT,0)) I 'IEN Q
+        . I '$O(^BMXMON(IEN,1,0)) G BC1  ; NO RESTRICTIONS ON CONTEXT FOR THIS PORT
+        . S OK=0,CIEN=0
+        . F  S CIEN=$O(^BMXMON(IEN,1,CIEN)) Q:'CIEN  D  I OK Q
+        . . S %=$P($G(^BMXMON(IEN,1,CIEN,0)),U) I '% Q
+        . . S %=$P($G(^DIC(19,%,0)),U) I %="" Q
+        . . I %=OPTION S OK=1
+        . . Q
+        . I 'OK S (XWBSEC,RESULT)="The context '"_OPTION_"' is not registered with port "_PORT_"." Q
 BC1     S XWB1=$$OPTLK^XQCS(OPTION)
         I XWB1="" S (XWBSEC,RESULT)="The context '"_OPTION_"' does not exist on server." Q  ;P10

BMXNET_RPMS_dotNET_UTILITIES-BMX/branch/routines/BMXRPC3.m

@@ -1 @@
-BMXRPC3 ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ; 4/6/11 4:56pm
+BMXRPC3 ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ; 5/11/11 4:33pm
         ;;4.1000;BMX;;Apr 17, 2011
-           ;
-           ; Changed for .1000 by WV/SMH on April 6 2011
-           ; - References to ^AUTTSITE in GETFC & GETFCRS removed, as VISTA doesn't use this file
-           ; - 
-           ; 
-        ;
+   ;
+   ; Changed for .1000 by WV/SMH on April 6 2011
+   ; - References to ^AUTTSITE in GETFC & GETFCRS removed, as VISTA doesn't use this file
+   ; - 
+   ; 
+    ;
         ;
 VARVAL(RESULT,VARIABLE) ;returns value of passed in variable