Ignore:
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:
3 edited

Legend:

Unmodified
Added
Removed

  • BMXNET_RPMS_dotNET_UTILITIES-BMX/branch/routines/BMXMON.m

    r1147 r1181  
    1 BMXMON  ; IHS/OIT/HMW - BMXNet MONITOR ; 4/6/11 12:42pm
     1BMXMON  ; IHS/OIT/HMW - BMXNet MONITOR ; 5/9/11 10:16am
    22        ;;4.1000;BMX;;Apr 17, 2011
    3         ;
    4         ; IMPORTANT: Logging is on by default. Set XWBDEBUG=0 to turn it off.
    53        ;
    64        ; Changes for *1000 by WV/SMH (Feb 2 2011) to support GT.M
    75        ; - XINETD entry point for GT.M
    86        ; - Replacement of all W *-3 to W !
    9         ; - Addition of logging capabilities for analysis
     7        ; - Addition of logging capabilities for analysis using XWBDLOG
    108        ; - In SESSRES
    119        ; -- Broker Timeout set from Kernel System Parameter Broker Timeout Field
    12         ; -- Process Name now changes to show name in %SS or ZSY
    13         ;
     10        ; -- Process Name now gets Set to show in %SS or ZSY
     11        ; - Error Handling does not log Network Errors to the Error Trap.
     12    ; - Major refactoring to Writing to the TCP Network Stream.
     13    ; --> All writes are buffered up to 32767 characters (max string on Cache)
     14    ; --> Then sent...
     15    ; --> See EP's WRITE and WBF
     16    ; --> This avoids the side effects of the Nagle Algorithm on the Linux TCP Stack
     17    ; - BMXERR renamed to BMXERROR in EP ETRAP so that it can be sent via SNDERR.
     18    ; --> This reduces the need for custom error trap handling which is very difficult to do
     19    ; --> in Mumps for new programmers. Mumps errors now are thrown on the client.
    1420        ;
    1521        ;IHS/OIT/HMW Patch 1 added validity check for passed-in namespace
    … …  
    241247        ;
    242248SESSMAIN        ; MAIN LOOP!!!!!!
    243         N BMXTBUF
     249        N BMXTBUF ; BMX Read Buffer
     250    N BMXWBUF S BMXWBUF="" ; BMX Write Buffer
    244251        D SETUP^BMXMSEC(.RET) ;Setup required system vars
    245252        S U="^"
    … …  
    254261        . I 'BMXHTYPE S BMXTBUF="#BYE#" D  QUIT  ;;***QUITTING HERE***
    255262        . . D SNDERR
    256         . . W BMXTBUF,$C(4),!
    257         . . D LOG("Write: "_BMXTBUF_$C(4)_"(flush)")
     263        . . D WRITE(BMXTBUF_$C(4)),WBF
    258264        . S BMXTLEN=$E(BMXTBUF,6,10),L=$E(BMXTBUF,11,11)
    259265        . R BMXTBUF#4:BMXDTIME(1)
    … …  
    269275        . I $P(BMXTBUF,U)="TCPconnect" D  QUIT  ;;***QUIT HERE***
    270276        . . D SNDERR
    271         . . W "accept",$C(4),!  ;Ack
    272         . . ;
    273         . . D LOG("Write: accept"_$C(4)_"(flush)")
    274         . . ;
     277        . . D WRITE("accept"_$C(4)),WBF  ;Ack
    275278        . IF BMXHTYPE D
    276279        . . K BMXR,BMXARY
    277280        . . IF BMXTBUF="#BYE#" D  QUIT
    278281        . . . D SNDERR
    279         . . . W "#BYE#",$C(4),!
    280         . . . ;
    281         . . . D LOG("Write: #BYE#\4")
    282         . . . ;
     282        . . . D WRITE("#BYE#"_$C(4))
     283    . . . D WBF
    283284        . . S BMXTLEN=BMXTLEN-15
    284285        . . D CALLP^BMXMBRK(.BMXR,BMXTBUF)
    … …  
    288289        . D SNDERR ;Clears SNDERR parameters
    289290        . D SND
    290         . D WRITE($C(4)) W ! ;send eot and flush buffer
    291         . ;
    292         . D LOG("Write: "_$C(4))
    293         . ;
     291        . D WRITE($C(4)) ;send eot
     292    . D WBF ; Flush Buffer
    294293        D UNREGALL^BMXMEVN ;Unregister all events for this session
    295294        Q  ;End Of Main
    296         ;
    297295        ;
    298296SNDERR  ;send error information
    … …  
    300298        N X
    301299        S X=$E($G(BMXSEC),1,255)
    302         W $C($L(X))_X W !
    303         D LOG("Write: "_$C($L(X))_X_"(flush)")
     300        D WRITE($C($L(X))_X)
    304301        S X=$E($G(BMXERROR),1,255)
    305         W $C($L(X))_X W !
    306         D LOG("Write: "_$C($L(X))_X_"(flush)")
     302        D WRITE($C($L(X))_X)
    307303        S BMXERROR="",BMXSEC="" ;clears parameters
    308304        Q
    309305        ;
    310 WRITE(BMXSTR)   ;Write a data string
    311         ;
    312         I $L(BMXSTR)<511 W ! W BMXSTR Q
    313         ;Handle a long string
    314         W ! ;Flush the buffer
    315         F  Q:'$L(BMXSTR)  W $E(BMXSTR,1,510),! S BMXSTR=$E(BMXSTR,511,99999)
    316         Q
     306WRITE(BMXSTR)   ;Write a data string to the output buffer
     307    F  Q:'$L(BMXSTR)  D
     308    . I $L(BMXWBUF)+$L(BMXSTR)>32767 D WBF  ; Maximum String Length on Cache
     309    . S BMXWBUF=BMXWBUF_$E(BMXSTR,1,255),BMXSTR=$E(BMXSTR,256,999999)
     310    QUIT
     311    ;
     312WBF ;Write Buffer to Network Stream then flush
     313    Q:'$L(BMXWBUF)
     314    I $G(XWBDEBUG)>2,$L(BMXWBUF) D LOG^XWBDLOG("wrt ("_$L(BMXWBUF)_"): "_BMXWBUF)
     315    W BMXWBUF,!
     316    S BMXWBUF=""
     317    QUIT
     318
    317319SND     ; -- send data for all, Let WRITE sort it out
    318320        N I,T
    319321        ;
    320322        ; -- error or abort occurred, send null
    321         IF $L(BMXSEC)>0 D WRITE(""),LOG("Write Sting.Empty") Q
     323        IF $L(BMXSEC)>0 D WRITE("") QUIT
     324    ;
    322325        ; -- single value
    323         IF BMXPTYPE=1 S BMXR=$G(BMXR) D WRITE(BMXR),LOG("Write: "_BMXR) Q
    324         ; -- table delimited by CR+LF
    325         IF BMXPTYPE=2 D  Q
    326         . S I="" F  S I=$O(BMXR(I)) Q:I=""  D WRITE(BMXR(I)),WRITE($C(13,10)),LOG("Write: "_BMXR(I))
     326        IF BMXPTYPE=1 S BMXR=$G(BMXR) D WRITE(BMXR) QUIT
     327        ;
     328    ; -- table delimited by CR+LF
     329        IF BMXPTYPE=2 D  QUIT
     330        . S I="" F  S I=$O(BMXR(I)) Q:I=""  D WRITE(BMXR(I)),WRITE($C(13,10))
     331    ;
    327332        ; -- word processing
    328         IF BMXPTYPE=3 D  Q
    329         . 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))
     333        IF BMXPTYPE=3 D  QUIT
     334        . S I="" F  S I=$O(BMXR(I)) Q:I=""  D WRITE(BMXR(I)),WRITE($C(13,10)):BMXWRAP
     335    ;
    330336        ; -- global array
    331         IF BMXPTYPE=4 D  Q
    332         . S I=$G(BMXR) Q:I=""  S T=$E(I,1,$L(I)-1) D:$D(@I)>10 WRITE(@I),LOG("Write: "_@I)
    333         . 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)
     337        IF BMXPTYPE=4 D  QUIT
     338        . S I=$G(BMXR) Q:I=""  S T=$E(I,1,$L(I)-1) D:$D(@I)>10 WRITE(@I)
     339        . F  S I=$Q(@I) Q:I=""!(I'[T)  D WRITE(@I),WRITE($C(13,10)):(BMXWRAP&(@I'=$C(13,10)))
    334340        . IF $D(@BMXR) K @BMXR
     341    ;
    335342        ; -- global instance
    336         IF BMXPTYPE=5 S BMXR=$G(@BMXR) D WRITE(BMXR),LOG("Write: "_BMXR) Q
     343        IF BMXPTYPE=5 S BMXR=$G(@BMXR) D WRITE(BMXR) QUIT
     344    ;
    337345        ; -- variable length records only good upto 255 char)
    338         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))
    339         Q
     346        IF BMXPTYPE=6 S I="" F  S I=$O(BMXR(I)) Q:I=""  D WRITE($C($L(BMXR(I)))),WRITE(BMXR(I))
     347        QUIT
    340348        ;
    341349TIMEOUT ;Do this on MAIN  loop timeout
    342         I $G(DUZ)>0 D SNDERR,WRITE("#BYE#"_$C(4)) Q
     350        I $G(DUZ)>0 D SNDERR,WRITE("#BYE#"_$C(4)),WBF QUIT
    343351        ;Sign-on timeout
    344352        S BMXR(0)=0,BMXR(1)=1,BMXR(2)="",BMXR(3)="TIME-OUT",BMXPTYPE=2
    345         D SNDERR,SND,WRITE($C(4))
    346         Q
     353        D SNDERR,SND,WRITE($C(4)),WBF QUIT
    347354        ;
    348355SEMAPHOR(BMXTSKT,BMXACT)        ;Lock/Unlock BMXMON semaphore
    … …  
    384391ETRAP   ; -- on trapped error, send error info to client
    385392        ; Error Trap Vars: Code, Error, Last Global Reference
    386         N BMXERC,BMXERR,BMXLGR
     393        N BMXERC,BMXERROR,BMXLGR
    387394        ;
    388395        ;Change trapping during trap.
    … …  
    398405        ; Otherwise, log error and send to client
    399406        S BMXERC=$$EC^%ZOSV
    400         S BMXERR="M ERROR="_BMXERC_$C(13,10)_"LAST REF="
     407        S BMXERROR="M ERROR="_BMXERC_$C(13,10)_"LAST REF="
    401408        S BMXLGR=$$LGR^%ZOSV_$C(4)
    402         S BMXERR=BMXERR_BMXLGR
     409        S BMXERROR=BMXERROR_BMXLGR
    403410        ;
    404411        D ^%ZTER ;%ZTER clears $ZE and $ECODE
    … …  
    406413        U $P
    407414        ;
    408         D SNDERR,WRITE(BMXERR) W !
     415        D SNDERR,WRITE(BMXERROR),WBF
    409416        ;
    410417        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

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

  • BMXNET_RPMS_dotNET_UTILITIES-BMX/branch/routines/BMXRPC3.m

    r1147 r1181  
    1 BMXRPC3 ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ; 4/6/11 4:56pm
     1BMXRPC3 ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ; 5/11/11 4:33pm
    22        ;;4.1000;BMX;;Apr 17, 2011
    3            ;
    4            ; Changed for .1000 by WV/SMH on April 6 2011
    5            ; - References to ^AUTTSITE in GETFC & GETFCRS removed, as VISTA doesn't use this file
    6            ; -
    7            ;
    8         ;
     3   ;
     4   ; Changed for .1000 by WV/SMH on April 6 2011
     5   ; - References to ^AUTTSITE in GETFC & GETFCRS removed, as VISTA doesn't use this file
     6   ; -
     7   ;
     8    ;
    99        ;
    1010VARVAL(RESULT,VARIABLE) ;returns value of passed in variable
Note: See TracChangeset for help on using the changeset viewer.