Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: XWBDRPC

XWBDRPC.m

Go to the documentation of this file.
  1. XWBDRPC ;ISF/RWF - Deferred RPCs, used by XWB2HL7 ;01/14/2003 09:27
  1. ;;1.1;RPC BROKER;**12,20,32**;Mar 28, 1997
  1. Q
  1. ;This is the entry point used by the Broker
  1. EN1(RET,RPC,P1,P2,P3,P4,P5,P6,P7,P8,P9,P10) ;Call a deferred RPC with 1-7 parameters.
  1. N X,I,INX,N,XWBPAR,XWBPCNT,XWBDVER,XWBHDL
  1. N XWBMSG,ZTSAVE,ZTDTH,ZTIO,ZTRTN,ZTSK,ZTDESC
  1. S RET="",(XWBPAR,RPCIEN)="",XWBPCNT=0,XWBDVER=1
  1. ;Find RPC.
  1. S RPCIEN=$$RPCIEN^XWBLIB($P(RPC,"^")) I RPCIEN'>0 S RET(0)="",RET(1)="-1^RPC not found" Q
  1. ;Check if RPC is active
  1. I '$$RPCAVAIL^XWBLIB(RPCIEN,"L") S RET(0)="-1^RPC Access Blocked" Q
  1. ;Build a handle to link request with return.
  1. S XWBHDL=$$HANDLE()
  1. F I=1:1:10 Q:'$D(@("P"_I)) S XWBPCNT=I
  1. ;Build ZTSAVE
  1. F N="RPC","XWBHDL","XWBPCNT","P1","P2","P3","P4","P5","P6","P7","P8","P9","P10" Q:'$D(@N) S ZTSAVE(N)="" S:$D(@N)>9 ZTSAVE(N_"(")=""
  1. S ZTDESC="Deferred RPC - "_RPC
  1. S ZTRTN="DQ^XWBDRPC",ZTIO="NULL",ZTDTH=(+$H_",10") ;run first
  1. ;Call Taskman
  1. D ^%ZTLOAD
  1. S RET(0)=XWBHDL
  1. I ZTSK>0 D SETNODE(XWBHDL,"TASKID",ZTSK)
  1. Q
  1. ;
  1. ;This is called by TaskMan to process a RPC.
  1. DQ ;
  1. N $ES,$ET S $ET="D ERR^XWBDRPC"
  1. N %,%1,%2,IX,X,Y,ERR,PAR
  1. S IX=0,XWBAPVER=+$P(RPC,"^",2),RPC=$P(RPC,"^")
  1. S XWBRPC=0,XWBRPC=$$RPCGET(RPC,.XWBRPC) I XWBRPC'>0 S XWBY(0)="-1^RPC name not found" G REX
  1. S PAR=$$PARAM D SETNODE(XWBHDL,"WRAP",XWBRPC("WRAP"))
  1. S X=$$HDLSTA(XWBHDL,"0^Running") ;Tell user we started
  1. ;Result returned in XWBY
  1. D CAPI(XWBRPC("RTAG"),XWBRPC("RNAM"),PAR)
  1. REX ;Exit from RPC
  1. ;Check to see if our handle is still good.
  1. I $$HDLSTA(XWBHDL,"0^LoadRestlts")<0 S XWBY(0)="-1^Abort" Q
  1. ;Move data into XTMP for application to pick up.
  1. I $D(XWBY)>9 D
  1. . S %1="XWBY"
  1. . F S %1=$Q(@%1) Q:%1="" D PLACE(XWBHDL,@%1)
  1. I $D(XWBY)=1,$E(XWBY)'="^" D PLACE(XWBHDL,XWBY)
  1. ;If XWBY is a $NA value just return it.
  1. I $D(XWBY)=1,$E(XWBY)="^" D
  1. . S %1=XWBY,%2=$E(XWBY,1,$L(XWBY)-1)
  1. . F S %1=$Q(@%1) Q:%1'[%2 D PLACE(XWBHDL,@%1)
  1. S X=$$HDLSTA(XWBHDL,"1^Done")
  1. Q
  1. ;
  1. CAPI(TAG,NAM,PAR) ;make API call
  1. N R
  1. S R=TAG_"^"_NAM_"(.XWBY"_$S(PAR="":")",1:","_PAR_")")
  1. ;Ready to call RPC?
  1. D @R
  1. ;Return data in XWBY
  1. Q
  1. ;
  1. ERR ;Handle an error
  1. D ^%ZTER ;Record error
  1. I $D(XWBHDL) S X=$$HDLSTA(XWBHDL,"-1^Error: "_$E($$EC^%ZOSV,1,200))
  1. D UNWIND^%ZTER
  1. ;
  1. RTNDATA(RET,HDL) ;Return the data under a handle
  1. N I,N,RD,WRAP S RET="" K ^TMP($J,"XWB")
  1. I $G(HDL)="" S RET(0)="-1^Bad Handle" Q
  1. S N=$$CHKHDL^XWBDRPC(HDL) I N<1 S RET(0)=N Q
  1. I N'["Done" S RET(0)="-1^Not DONE" Q
  1. ;Default is to return an array, switch to global if to big
  1. S N=(^XTMP(HDL,"CNT")>100)
  1. S I=0,RD=$S(N:$NA(^TMP($J,"XWB")),1:"RET")
  1. ;Move into a TMP global, Global is killed in XWBTCPC
  1. I N S RET=$NA(^TMP($J,"XWB")),I=$$RTRNFMT^XWBLIB(4) ;Make return a global
  1. I N M ^TMP($J,"XWB")=^XTMP(HDL,"D")
  1. I 'N F S RET(I)=$G(^XTMP(HDL,"D",I)),I=$O(^XTMP(HDL,"D",I)) Q:I'>0
  1. Q
  1. ;
  1. CLEAR(RET,HDL) ;Clear the data under a handle
  1. K ^XTMP(HDL),^TMP("XWBHDL",$J,HDL)
  1. S RET(0)=1
  1. Q
  1. ;
  1. CLEARALL(RET) ;Clear ALL the data for this job.
  1. N X
  1. S X="" F S X=$O(^TMP("XWBHDL",$J,X)) Q:X="" D CLEAR(.RET,X)
  1. Q
  1. ;
  1. RPCGET(N,R) ;Convert RPC name to IEN and parameters.
  1. N T,T0
  1. S T=$G(N) Q:T="" "-1^No RPC name"
  1. S T=$$RPCIEN^XWBLIB(T) Q:T'>0 "-1^Bad RPC name"
  1. Q:'$D(R) T
  1. S T0=$G(^XWB(8994,T,0)),R("IEN")=T,R("NAME")=$P(T0,"^")
  1. S R("RTAG")=$P(T0,"^",2),R("RNAM")=$P(T0,"^",3)
  1. S R("RTNTYPE")=$P(T0,"^",4),R("WRAP")=$P(T0,"^",8)
  1. Q T
  1. ;
  1. PARAM() ;Build remote parameter list
  1. N I,%,X,A S X=""
  1. F I=1:1:XWBPCNT S %="P"_I,A="XWBA"_I Q:'$D(@%) K @A D
  1. . I $D(@%)=1 S X=X_%_"," Q
  1. . S X=X_"."_A_"," M @A=@% Q
  1. Q $E(X,1,$L(X)-1)
  1. ;
  1. ADDHDL(HL) ;Add a handle to local set
  1. S ^TMP("XWBHDL",$J,HL)=""
  1. Q
  1. ;
  1. HANDLE() ;Return a unique handle into ^XTMP
  1. N %H,A,J,HL
  1. S %H=$H,J="XWBDRPC"_($J#2048)_"-"_(%H#7*86400+$P(%H,",",2))_"_",A=-1
  1. HAN2 S A=A+1,HL=J_A L +^XTMP(HL):0 I '$T G HAN2
  1. I $D(^XTMP(HL)) L -^XTMP(HL) G HAN2
  1. S ^XTMP(HL,0)=$$HTFM^XLFDT(%H+2)_"^"_$G(DT) L -^XTMP(HL)
  1. S ^XTMP(HL,"STATUS")="0^New",^("CNT")=0
  1. Q HL
  1. ;
  1. HDLSTA(HL,STATUS) ;update the status node in XTMP
  1. Q:'$D(^XTMP(HL)) -1
  1. L +^XTMP(HL):5
  1. S ^XTMP(HL,"STATUS")=STATUS
  1. L -^XTMP(HL)
  1. Q 1
  1. ;
  1. PLACE(HL,DATA) ;Called to place each line of data.
  1. N IX
  1. Q:'$D(^XTMP(HL,"CNT"))
  1. S IX=+$G(^XTMP(HL,"CNT")),^XTMP(HL,"D",IX)=DATA,^XTMP(HL,"CNT")=IX+1
  1. Q
  1. ;
  1. RPCCHK(RET,HDL) ;RPC handle status check.
  1. S RET(0)=$$CHKHDL(HDL)
  1. Q
  1. ;
  1. CHKHDL(HL) ;Return the status of a handle
  1. Q:'$D(^XTMP(HL)) "-1^Bad Handle"
  1. L +^XTMP(HL):1 I '$T Q "0^Busy"
  1. N % S %=$G(^XTMP(HL,"STATUS"),"0^Null")
  1. L -^XTMP(HL)
  1. Q %
  1. ;
  1. GETNODE(HL,ND) ;Get a status node
  1. Q $G(^XTMP(HL,ND))
  1. ;
  1. SETNODE(HL,ND,DATA) ;Set a status node
  1. S ^XTMP(HL,ND)=DATA
  1. Q
  1. ;