CIANBASY ;MSC/IND/DKM - Asynchronous RPC calls ;29-Jun-2012 15:50;PLS
;;1.1;CIA NETWORK COMPONENTS;**001007,001009**;Sep 18, 2007
;;Copyright 2000-2012, Medsphere Systems Corporation
;=================================================================
; Background task for executing an asynchronous RPC
TASK N CIAD,TGT,$ET,$ES
S $ET="D ERROR^CIANBASY",ZTREQ="@"
K ^XTMP("CIA",CIA("UID"),"T",ZTSK)
Q:$$S^%ZTLOAD
S ^XTMP("CIA",CIA("UID"),"T",ZTSK)=0,TGT=$NA(^(ZTSK,0))
S:XWBPTYPE=4 CIAD=TGT
D DORPC^CIANBACT
I XWBPTYPE=1 S @TGT@(0)=CIAD
E I XWBPTYPE>1,XWBPTYPE<4 M @TGT=CIAD S:XWBPTYPE=2 XWBWRAP=1
E I XWBPTYPE=4,$L(CIAD),CIAD'=TGT M @TGT=@CIAD K @CIAD
E I XWBPTYPE=5 S @TGT@(0)=$G(@CIAD)
E I XWBPTYPE="H" D
.N X,Y,FIL,DIR
.S X=$E($$DIRDLM^CIAUOS,3),Y=$L(CIAD,X),DIR=$P(CIAD,X,1,Y-1),FIL=$P(CIAD,X,Y)
.I '$$FTG^%ZISH(DIR,FIL,$NA(@TGT@(0)),$QL(TGT)+1)
.D DELETE^CIAUOS(CIAD)
I $$S^%ZTLOAD K ^XTMP("CIA",CIA("UID"),"T",ZTSK)
E S ^XTMP("CIA",CIA("UID"),"T",ZTSK)=ZTSK_"^0^"_XWBWRAP
Q
ERROR D SETERR(-1,$$EC^%ZOSV)
D ^%ZTER,UNWIND^%ZTER
Q
; Retrieve specified routine line
RTNTEXT(RTN) ;
N TAG
S TAG=$P(RTN,U),RTN=$P(RTN,U,2)
Q $S('$L(RTN):$T(^@TAG),$L(TAG):$T(@TAG^@RTN),1:$T(^@RTN))
; Set error info to return to client
SETERR(CODE,TEXT) ;
K ^XTMP("CIA",CIA("UID"),"T",ZTSK) M ^(ZTSK,0,0)=TEXT
S ^XTMP("CIA",CIA("UID"),"T",ZTSK)=ZTSK_U_CODE_"^1"
Q
; RPC to check for completed tasks
; Results[0] at the client end will contain the TaskMan ID of the
; completed RPC. The remainder of the Result will be the data
; returned by the RPC.
ASYCHK() N ZTSK,CIAD,X
S ZTSK=0
F S ZTSK=+$O(^XTMP("CIA",CIA("UID"),"T",ZTSK)) Q:'ZTSK S X=$G(^(ZTSK)),CIAD=$NA(^(ZTSK,0)) I X D Q
.D TCPUSE^CIANBLIS
.W $C(2),X,$C(13),!
.D OUT^CIANBACT(CIAD,$P(X,U,3))
.K ^XTMP("CIA",CIA("UID"),"T",ZTSK)
Q ZTSK
; RPC: Stop a task
; Signals to a backround task that it should stop running. Cleans up
; any output generated by completed tasks.
STOP(CIAD,ZTSK) ;
S CIAD=''$D(^XTMP("CIA",CIA("UID"),"T",ZTSK)) K:CIAD ^(ZTSK)
Q:'$D(^%ZTSK(ZTSK))
S $P(^%ZTSK(ZTSK,.1),U,10)=$P($G(^VA(200,DUZ,0)),U)
D DQ^%ZTLOAD
I $G(ZTSK(0)) D KILL^%ZTLOAD
Q
; Stop all tasks in task list
STOPALL N ZTSK
S ZTSK=0
F S ZTSK=$O(^XTMP("CIA",CIA("UID"),"T",ZTSK)) Q:'ZTSK D STOP(,ZTSK)
K ^XTMP("CIA",CIA("UID"),"T")
Q
CIANBASY ;MSC/IND/DKM - Asynchronous RPC calls ;29-Jun-2012 15:50;PLS
+1 ;;1.1;CIA NETWORK COMPONENTS;**001007,001009**;Sep 18, 2007
+2 ;;Copyright 2000-2012, Medsphere Systems Corporation
+3 ;=================================================================
+4 ; Background task for executing an asynchronous RPC
TASK NEW CIAD,TGT,$ETRAP,$ESTACK
+1 SET $ETRAP="D ERROR^CIANBASY"
SET ZTREQ="@"
+2 KILL ^XTMP("CIA",CIA("UID"),"T",ZTSK)
+3 IF $$S^%ZTLOAD
QUIT
+4 SET ^XTMP("CIA",CIA("UID"),"T",ZTSK)=0
SET TGT=$NAME(^(ZTSK,0))
+5 IF XWBPTYPE=4
SET CIAD=TGT
+6 DO DORPC^CIANBACT
+7 IF XWBPTYPE=1
SET @TGT@(0)=CIAD
+8 IF '$TEST
IF XWBPTYPE>1
IF XWBPTYPE<4
MERGE @TGT=CIAD
IF XWBPTYPE=2
SET XWBWRAP=1
+9 IF '$TEST
IF XWBPTYPE=4
IF $LENGTH(CIAD)
IF CIAD'=TGT
MERGE @TGT=@CIAD
KILL @CIAD
+10 IF '$TEST
IF XWBPTYPE=5
SET @TGT@(0)=$GET(@CIAD)
+11 IF '$TEST
IF XWBPTYPE="H"
Begin DoDot:1
+12 NEW X,Y,FIL,DIR
+13 SET X=$EXTRACT($$DIRDLM^CIAUOS,3)
SET Y=$LENGTH(CIAD,X)
SET DIR=$PIECE(CIAD,X,1,Y-1)
SET FIL=$PIECE(CIAD,X,Y)
+14 IF '$$FTG^%ZISH(DIR,FIL,$NAME(@TGT@(0)),$QLENGTH(TGT)+1)
+15 DO DELETE^CIAUOS(CIAD)
End DoDot:1
+16 IF $$S^%ZTLOAD
KILL ^XTMP("CIA",CIA("UID"),"T",ZTSK)
+17 IF '$TEST
SET ^XTMP("CIA",CIA("UID"),"T",ZTSK)=ZTSK_"^0^"_XWBWRAP
+18 QUIT
ERROR DO SETERR(-1,$$EC^%ZOSV)
+1 DO ^%ZTER
DO UNWIND^%ZTER
+2 QUIT
+3 ; Retrieve specified routine line
RTNTEXT(RTN) ;
+1 NEW TAG
+2 SET TAG=$PIECE(RTN,U)
SET RTN=$PIECE(RTN,U,2)
+3 QUIT $SELECT('$LENGTH(RTN):$TEXT(^@TAG),$LENGTH(TAG):$TEXT(@TAG^@RTN),1:$TEXT(^@RTN))
+4 ; Set error info to return to client
SETERR(CODE,TEXT) ;
+1 KILL ^XTMP("CIA",CIA("UID"),"T",ZTSK)
MERGE ^(ZTSK,0,0)=TEXT
+2 SET ^XTMP("CIA",CIA("UID"),"T",ZTSK)=ZTSK_U_CODE_"^1"
+3 QUIT
+4 ; RPC to check for completed tasks
+5 ; Results[0] at the client end will contain the TaskMan ID of the
+6 ; completed RPC. The remainder of the Result will be the data
+7 ; returned by the RPC.
ASYCHK() NEW ZTSK,CIAD,X
+1 SET ZTSK=0
+2 FOR
SET ZTSK=+$ORDER(^XTMP("CIA",CIA("UID"),"T",ZTSK))
IF 'ZTSK
QUIT
SET X=$GET(^(ZTSK))
SET CIAD=$NAME(^(ZTSK,0))
IF X
Begin DoDot:1
+3 DO TCPUSE^CIANBLIS
+4 WRITE $CHAR(2),X,$CHAR(13),!
+5 DO OUT^CIANBACT(CIAD,$PIECE(X,U,3))
+6 KILL ^XTMP("CIA",CIA("UID"),"T",ZTSK)
End DoDot:1
QUIT
+7 QUIT ZTSK
+8 ; RPC: Stop a task
+9 ; Signals to a backround task that it should stop running. Cleans up
+10 ; any output generated by completed tasks.
STOP(CIAD,ZTSK) ;
+1 SET CIAD=''$DATA(^XTMP("CIA",CIA("UID"),"T",ZTSK))
IF CIAD
KILL ^(ZTSK)
+2 IF '$DATA(^%ZTSK(ZTSK))
QUIT
+3 SET $PIECE(^%ZTSK(ZTSK,.1),U,10)=$PIECE($GET(^VA(200,DUZ,0)),U)
+4 DO DQ^%ZTLOAD
+5 IF $GET(ZTSK(0))
DO KILL^%ZTLOAD
+6 QUIT
+7 ; Stop all tasks in task list
STOPALL NEW ZTSK
+1 SET ZTSK=0
+2 FOR
SET ZTSK=$ORDER(^XTMP("CIA",CIA("UID"),"T",ZTSK))
IF 'ZTSK
QUIT
DO STOP(,ZTSK)
+3 KILL ^XTMP("CIA",CIA("UID"),"T")
+4 QUIT
