BMXRPC8.m

BMXRPC8 ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ;

 ;;4.0;BMX;;JUN 28, 2010

 ;

 ;

BMXLOCKD(BMXY,BMXVAR,BMXINC,BMXTIME) ;EP

 ;Entry point for debugging

 ;

 ;D DEBUG^%Serenji("BMXLOCKD^BMXRPC8(.BMXY,BMXVAR,BMXINC,BMXTIME)")

 Q

 ;

BMXLOCK(BMXY,BMXVAR,BMXINC,BMXTIME) ;EP

 ;Called by BMX LOCK rpc to lock variable BMXVAR

 ;If BMXVAR = "", argumentless lock is performed to release all locks

 ;BMXINC = increment lock if "+", decrement if "-"

 ;BMXTIME = lock timeout

 ;Returns 1 if lock successful, otherwise 0;

 ;

 S X="ERR^BMXRPC8",@^%ZOSF("TRAP")

 ;

 N BMXC

 S:$E(BMXVAR,1,1)="~" BMXVAR="^"_$E(BMXVAR,2,$L(BMXVAR))

 S:BMXTIME="" BMXTIME=0

 I BMXVAR="" X "L"  S BMXY=1 Q

 S BMXC="L "

 S BMXC=BMXC_$S(BMXINC="+":"+",BMXINC="-":"-",1:"")

 S BMXC=BMXC_BMXVAR_":"_+BMXTIME

 X BMXC

 S BMXY=$T

 Q

 ;

ERR ;Error processing

 S BMXY=0

 Q

 ;

BMXVERD(BMXY,BMXNS,BMXLOC) ;EP

 ;Entry point for debugging

 ;

 ;D DEBUG^%Serenji("BMXVERD^BMXRPC8(.BMXY,BMXNS,BMXLOC)")

 Q

 ;

BMXVER(BMXY,BMXNS,BMXLOC) ;EP

 ;

 ;Called by BMX VERSION INFO rpc

 ;Returns recordset of version info for server components in namespace BMXNS.

 ;If BMXLOC is "", then the version info is assumed to be stored in piece 1-3 of

 ;^<BMXNS>APPL(1,0)

 ;

 ;TODO:

 ;BMXLOC, if not null, is either a global reference such that $P(@BMXLOC,U,1,3) returns

 ;MAJOR^MINOR^BUILD

 ;Or BMXLOC can be an extrinsic function call that returns MAJOR^MINOR^BUILD.

 ;

 ;The returned error field is either "" or contains a text error message.

 ;

 N X,BMXI,BMXNOD,BMXDAT

 ;

 S X="VETRAP^BMXRPC8",@^%ZOSF("TRAP")

 S BMXI=0

 K ^BMXTMP($J)

 S BMXY="^BMXTMP("_$J_")"

 S ^BMXTMP($J,BMXI)="T00030ERROR^T00030MAJOR_VERSION^T00030MINOR_VERSION^T00030BUILD"_$C(30)

 S BMXI=BMXI+1

 I BMXNS="" D VERR(BMXI,"BMXRPC8: Invalid Null Application Namespace") Q

 S BMXNOD="^"_BMXNS_"APPL(1,0)"

 S BMXDAT=$G(@BMXNOD)

 I BMXNS="" D VERR(BMXI,"BMXRPC8: No version info for Application Namespace") Q

 S ^BMXTMP($J,BMXI)="^"_$P(BMXDAT,U,1,3)_$C(30)

 Q

 ;

 ;

VERR(BMXI,BMXERR) ;Error processing

 S BMXI=BMXI+1

 S ^BMXTMP($J,BMXI)=BMXERR_"^^^"_$C(30)

 S BMXI=BMXI+1

 S ^BMXTMP($J,BMXI)=$C(31)

 Q

 ;

VETRAP ;EP Error trap entry

 D ^%ZTER

 I '$D(BMXI) N BMXI S BMXI=999999

 S BMXI=BMXI+1

 D VERR(BMXI,"BMXRPC8 Error: "_$G(%ZTERROR))

 Q

 ;

IMHERE(BMXRES) ;EP

 ;Entry point for BMX IM HERE remote procedure

 S BMXRES=1

 Q

 ;

BMXRPC8   ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ;

 +1       ;;4.0;BMX;;JUN 28, 2010

 +2       ;

 +3       ;

BMXLOCKD(BMXY,BMXVAR,BMXINC,BMXTIME) ;EP

 +1       ;Entry point for debugging

 +2       ;

 +3       ;D DEBUG^%Serenji("BMXLOCKD^BMXRPC8(.BMXY,BMXVAR,BMXINC,BMXTIME)")

 +4        QUIT 

 +5       ;

BMXLOCK(BMXY,BMXVAR,BMXINC,BMXTIME) ;EP

 +1       ;Called by BMX LOCK rpc to lock variable BMXVAR

 +2       ;If BMXVAR = "", argumentless lock is performed to release all locks

 +3       ;BMXINC = increment lock if "+", decrement if "-"

 +4       ;BMXTIME = lock timeout

 +5       ;Returns 1 if lock successful, otherwise 0;

 +6       ;

 +7        SET X="ERR^BMXRPC8"

           SET @^%ZOSF("TRAP")

 +8       ;

 +9        NEW BMXC

 +10       IF $EXTRACT(BMXVAR,1,1)="~"

               SET BMXVAR="^"_$EXTRACT(BMXVAR,2,$LENGTH(BMXVAR))

 +11       IF BMXTIME=""

               SET BMXTIME=0

 +12       IF BMXVAR=""

               XECUTE "L"

               SET BMXY=1

               QUIT 

 +13       SET BMXC="L "

 +14       SET BMXC=BMXC_$SELECT(BMXINC="+":"+",BMXINC="-":"-",1:"")

 +15       SET BMXC=BMXC_BMXVAR_":"_+BMXTIME

 +16       XECUTE BMXC

 +17       SET BMXY=$TEST

 +18       QUIT 

 +19      ;

ERR       ;Error processing

 +1        SET BMXY=0

 +2        QUIT 

 +3       ;

BMXVERD(BMXY,BMXNS,BMXLOC) ;EP

 +1       ;Entry point for debugging

 +2       ;

 +3       ;D DEBUG^%Serenji("BMXVERD^BMXRPC8(.BMXY,BMXNS,BMXLOC)")

 +4        QUIT 

 +5       ;

BMXVER(BMXY,BMXNS,BMXLOC) ;EP

 +1       ;

 +2       ;Called by BMX VERSION INFO rpc

 +3       ;Returns recordset of version info for server components in namespace BMXNS.

 +4       ;If BMXLOC is "", then the version info is assumed to be stored in piece 1-3 of

 +5       ;^<BMXNS>APPL(1,0)

 +6       ;

 +7       ;TODO:

 +8       ;BMXLOC, if not null, is either a global reference such that $P(@BMXLOC,U,1,3) returns

 +9       ;MAJOR^MINOR^BUILD

 +10      ;Or BMXLOC can be an extrinsic function call that returns MAJOR^MINOR^BUILD.

 +11      ;

 +12      ;The returned error field is either "" or contains a text error message.

 +13      ;

 +14       NEW X,BMXI,BMXNOD,BMXDAT

 +15      ;

 +16       SET X="VETRAP^BMXRPC8"

           SET @^%ZOSF("TRAP")

 +17       SET BMXI=0

 +18       KILL ^BMXTMP($JOB)

 +19       SET BMXY="^BMXTMP("_$JOB_")"

 +20       SET ^BMXTMP($JOB,BMXI)="T00030ERROR^T00030MAJOR_VERSION^T00030MINOR_VERSION^T00030BUILD"_$CHAR(30)

 +21       SET BMXI=BMXI+1

 +22       IF BMXNS=""

               DO VERR(BMXI,"BMXRPC8: Invalid Null Application Namespace")

               QUIT 

 +23       SET BMXNOD="^"_BMXNS_"APPL(1,0)"

 +24       SET BMXDAT=$GET(@BMXNOD)

 +25       IF BMXNS=""

               DO VERR(BMXI,"BMXRPC8: No version info for Application Namespace")

               QUIT 

 +26       SET ^BMXTMP($JOB,BMXI)="^"_$PIECE(BMXDAT,U,1,3)_$CHAR(30)

 +27       QUIT 

 +28      ;

 +29      ;

VERR(BMXI,BMXERR) ;Error processing

 +1        SET BMXI=BMXI+1

 +2        SET ^BMXTMP($JOB,BMXI)=BMXERR_"^^^"_$CHAR(30)

 +3        SET BMXI=BMXI+1

 +4        SET ^BMXTMP($JOB,BMXI)=$CHAR(31)

 +5        QUIT 

 +6       ;

VETRAP    ;EP Error trap entry

 +1        DO ^%ZTER

 +2        IF '$DATA(BMXI)

               NEW BMXI

               SET BMXI=999999

 +3        SET BMXI=BMXI+1

 +4        DO VERR(BMXI,"BMXRPC8 Error: "_$GET(%ZTERROR))

 +5        QUIT 

 +6       ;

IMHERE(BMXRES) ;EP

 +1       ;Entry point for BMX IM HERE remote procedure

 +2        SET BMXRES=1

 +3        QUIT 

 +4       ;