source: WorldVistAEHR/trunk/r/RPC_BROKER-XWB/XWBDRPC.m@ 1005

Last change on this file since 1005 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 4.5 KB
Line 
1XWBDRPC ;ISF/RWF - Deferred RPCs, used by XWB2HL7 ;01/14/2003 09:27
2 ;;1.1;RPC BROKER;**12,20,32**;Mar 28, 1997
3 Q
4 ;This is the entry point used by the Broker
5EN1(RET,RPC,P1,P2,P3,P4,P5,P6,P7,P8,P9,P10) ;Call a deferred RPC with 1-7 parameters.
6 N X,I,INX,N,XWBPAR,XWBPCNT,XWBDVER,XWBHDL
7 N XWBMSG,ZTSAVE,ZTDTH,ZTIO,ZTRTN,ZTSK,ZTDESC
8 S RET="",(XWBPAR,RPCIEN)="",XWBPCNT=0,XWBDVER=1
9 ;Find RPC.
10 S RPCIEN=$$RPCIEN^XWBLIB($P(RPC,"^")) I RPCIEN'>0 S RET(0)="",RET(1)="-1^RPC not found" Q
11 ;Check if RPC is active
12 I '$$RPCAVAIL^XWBLIB(RPCIEN,"L") S RET(0)="-1^RPC Access Blocked" Q
13 ;Build a handle to link request with return.
14 S XWBHDL=$$HANDLE()
15 F I=1:1:10 Q:'$D(@("P"_I)) S XWBPCNT=I
16 ;Build ZTSAVE
17 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_"(")=""
18 S ZTDESC="Deferred RPC - "_RPC
19 S ZTRTN="DQ^XWBDRPC",ZTIO="NULL",ZTDTH=(+$H_",10") ;run first
20 ;Call Taskman
21 D ^%ZTLOAD
22 S RET(0)=XWBHDL
23 I ZTSK>0 D SETNODE(XWBHDL,"TASKID",ZTSK)
24 Q
25 ;
26 ;This is called by TaskMan to process a RPC.
27DQ ;
28 N $ES,$ET S $ET="D ERR^XWBDRPC"
29 N %,%1,%2,IX,X,Y,ERR,PAR
30 S IX=0,XWBAPVER=+$P(RPC,"^",2),RPC=$P(RPC,"^")
31 S XWBRPC=0,XWBRPC=$$RPCGET(RPC,.XWBRPC) I XWBRPC'>0 S XWBY(0)="-1^RPC name not found" G REX
32 S PAR=$$PARAM D SETNODE(XWBHDL,"WRAP",XWBRPC("WRAP"))
33 S X=$$HDLSTA(XWBHDL,"0^Running") ;Tell user we started
34 ;Result returned in XWBY
35 D CAPI(XWBRPC("RTAG"),XWBRPC("RNAM"),PAR)
36REX ;Exit from RPC
37 ;Check to see if our handle is still good.
38 I $$HDLSTA(XWBHDL,"0^LoadRestlts")<0 S XWBY(0)="-1^Abort" Q
39 ;Move data into XTMP for application to pick up.
40 I $D(XWBY)>9 D
41 . S %1="XWBY"
42 . F S %1=$Q(@%1) Q:%1="" D PLACE(XWBHDL,@%1)
43 I $D(XWBY)=1,$E(XWBY)'="^" D PLACE(XWBHDL,XWBY)
44 ;If XWBY is a $NA value just return it.
45 I $D(XWBY)=1,$E(XWBY)="^" D
46 . S %1=XWBY,%2=$E(XWBY,1,$L(XWBY)-1)
47 . F S %1=$Q(@%1) Q:%1'[%2 D PLACE(XWBHDL,@%1)
48 S X=$$HDLSTA(XWBHDL,"1^Done")
49 Q
50 ;
51CAPI(TAG,NAM,PAR) ;make API call
52 N R
53 S R=TAG_"^"_NAM_"(.XWBY"_$S(PAR="":")",1:","_PAR_")")
54 ;Ready to call RPC?
55 D @R
56 ;Return data in XWBY
57 Q
58 ;
59ERR ;Handle an error
60 D ^%ZTER ;Record error
61 I $D(XWBHDL) S X=$$HDLSTA(XWBHDL,"-1^Error: "_$E($$EC^%ZOSV,1,200))
62 D UNWIND^%ZTER
63 ;
64RTNDATA(RET,HDL) ;Return the data under a handle
65 N I,N,RD,WRAP S RET="" K ^TMP($J,"XWB")
66 I $G(HDL)="" S RET(0)="-1^Bad Handle" Q
67 S N=$$CHKHDL^XWBDRPC(HDL) I N<1 S RET(0)=N Q
68 I N'["Done" S RET(0)="-1^Not DONE" Q
69 ;Default is to return an array, switch to global if to big
70 S N=(^XTMP(HDL,"CNT")>100)
71 S I=0,RD=$S(N:$NA(^TMP($J,"XWB")),1:"RET")
72 ;Move into a TMP global, Global is killed in XWBTCPC
73 I N S RET=$NA(^TMP($J,"XWB")),I=$$RTRNFMT^XWBLIB(4) ;Make return a global
74 I N M ^TMP($J,"XWB")=^XTMP(HDL,"D")
75 I 'N F S RET(I)=$G(^XTMP(HDL,"D",I)),I=$O(^XTMP(HDL,"D",I)) Q:I'>0
76 Q
77 ;
78CLEAR(RET,HDL) ;Clear the data under a handle
79 K ^XTMP(HDL),^TMP("XWBHDL",$J,HDL)
80 S RET(0)=1
81 Q
82 ;
83CLEARALL(RET) ;Clear ALL the data for this job.
84 N X
85 S X="" F S X=$O(^TMP("XWBHDL",$J,X)) Q:X="" D CLEAR(.RET,X)
86 Q
87 ;
88RPCGET(N,R) ;Convert RPC name to IEN and parameters.
89 N T,T0
90 S T=$G(N) Q:T="" "-1^No RPC name"
91 S T=$$RPCIEN^XWBLIB(T) Q:T'>0 "-1^Bad RPC name"
92 Q:'$D(R) T
93 S T0=$G(^XWB(8994,T,0)),R("IEN")=T,R("NAME")=$P(T0,"^")
94 S R("RTAG")=$P(T0,"^",2),R("RNAM")=$P(T0,"^",3)
95 S R("RTNTYPE")=$P(T0,"^",4),R("WRAP")=$P(T0,"^",8)
96 Q T
97 ;
98PARAM() ;Build remote parameter list
99 N I,%,X,A S X=""
100 F I=1:1:XWBPCNT S %="P"_I,A="XWBA"_I Q:'$D(@%) K @A D
101 . I $D(@%)=1 S X=X_%_"," Q
102 . S X=X_"."_A_"," M @A=@% Q
103 Q $E(X,1,$L(X)-1)
104 ;
105ADDHDL(HL) ;Add a handle to local set
106 S ^TMP("XWBHDL",$J,HL)=""
107 Q
108 ;
109HANDLE() ;Return a unique handle into ^XTMP
110 N %H,A,J,HL
111 S %H=$H,J="XWBDRPC"_($J#2048)_"-"_(%H#7*86400+$P(%H,",",2))_"_",A=-1
112HAN2 S A=A+1,HL=J_A L +^XTMP(HL):0 I '$T G HAN2
113 I $D(^XTMP(HL)) L -^XTMP(HL) G HAN2
114 S ^XTMP(HL,0)=$$HTFM^XLFDT(%H+2)_"^"_$G(DT) L -^XTMP(HL)
115 S ^XTMP(HL,"STATUS")="0^New",^("CNT")=0
116 Q HL
117 ;
118HDLSTA(HL,STATUS) ;update the status node in XTMP
119 Q:'$D(^XTMP(HL)) -1
120 L +^XTMP(HL):5
121 S ^XTMP(HL,"STATUS")=STATUS
122 L -^XTMP(HL)
123 Q 1
124 ;
125PLACE(HL,DATA) ;Called to place each line of data.
126 N IX
127 Q:'$D(^XTMP(HL,"CNT"))
128 S IX=+$G(^XTMP(HL,"CNT")),^XTMP(HL,"D",IX)=DATA,^XTMP(HL,"CNT")=IX+1
129 Q
130 ;
131RPCCHK(RET,HDL) ;RPC handle status check.
132 S RET(0)=$$CHKHDL(HDL)
133 Q
134 ;
135CHKHDL(HL) ;Return the status of a handle
136 Q:'$D(^XTMP(HL)) "-1^Bad Handle"
137 L +^XTMP(HL):1 I '$T Q "0^Busy"
138 N % S %=$G(^XTMP(HL,"STATUS"),"0^Null")
139 L -^XTMP(HL)
140 Q %
141 ;
142GETNODE(HL,ND) ;Get a status node
143 Q $G(^XTMP(HL,ND))
144 ;
145SETNODE(HL,ND,DATA) ;Set a status node
146 S ^XTMP(HL,ND)=DATA
147 Q
148 ;
Note: See TracBrowser for help on using the repository browser.