1 | RORTMP ;HCIOFO/SG - TEMPORARY GLOBAL STORAGE ; 10/14/05 1:41pm
|
---|
2 | ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
|
---|
3 | ;
|
---|
4 | ; DO NOT use this API to pass the data between tasks!
|
---|
5 | ;
|
---|
6 | Q
|
---|
7 | ;
|
---|
8 | ;***** ALLOCATES A TEMPORARY GLOBAL BUFFER
|
---|
9 | ;
|
---|
10 | ; [.SUBS] Subscript of the buffer is returned here
|
---|
11 | ;
|
---|
12 | ; Return Values:
|
---|
13 | ; Closed root of the buffer
|
---|
14 | ;
|
---|
15 | ALLOC(SUBS) ;
|
---|
16 | N NDX,NODE
|
---|
17 | S NDX=$O(^TMP($J,"RORTMP-0",""),-1)+1
|
---|
18 | S SUBS="RORTMP-"_NDX,NODE=$NA(^TMP($J,SUBS)) K @NODE
|
---|
19 | S ^TMP($J,"RORTMP-0",NDX)=""
|
---|
20 | Q NODE
|
---|
21 | ;
|
---|
22 | ;***** FREES THE TEMPORARY GLOBAL BUFFER
|
---|
23 | ;
|
---|
24 | ; NODE Closed root of the temporary global buffer
|
---|
25 | ;
|
---|
26 | FREE(NODE) ;
|
---|
27 | N NDX S NDX=$$NDX(NODE)
|
---|
28 | K:NDX>0 ^TMP($J,"RORTMP-0",NDX),@NODE
|
---|
29 | Q
|
---|
30 | ;
|
---|
31 | ;***** EXTRACTS THE INDEX FROM THE CLOSED ROOT OF THE BUFFER
|
---|
32 | ;
|
---|
33 | ; NODE Closed root of the temporary global buffer
|
---|
34 | ;
|
---|
35 | ; Return Values:
|
---|
36 | ; 0 Invalid closed root
|
---|
37 | ; >0 Index of the buffer
|
---|
38 | ;
|
---|
39 | NDX(NODE) ;
|
---|
40 | N SUBS
|
---|
41 | Q:$E(NODE,1)'="^" 0
|
---|
42 | Q:$NA(@NODE,1)'=$NA(^TMP($J)) 0
|
---|
43 | S SUBS=$QS(NODE,2)
|
---|
44 | Q:$P(SUBS,"-")'="RORTMP" 0
|
---|
45 | S NDX=+$P(SUBS,"-",2)
|
---|
46 | Q $S(NDX>0:NDX,1:0)
|
---|
47 | ;
|
---|
48 | ;***** FREES THE LAST ALLOCATED BUFFER(S)
|
---|
49 | ;
|
---|
50 | ; [NODE] Closed root of the temporary global buffer.
|
---|
51 | ;
|
---|
52 | ; If this parameter is defined and references a
|
---|
53 | ; valid temporary buffer, then this buffer and
|
---|
54 | ; all others allocated after it are freed.
|
---|
55 | ;
|
---|
56 | ; Otherwise, only the last buffer is freed.
|
---|
57 | ;
|
---|
58 | POP(NODE) ;
|
---|
59 | N NDX S NDX=$$NDX($G(NODE))
|
---|
60 | S:NDX'>0 NDX=+$O(^TMP($J,"RORTMP-0",""),-1)
|
---|
61 | F Q:NDX'>0 D S NDX=$O(^TMP($J,"RORTMP-0",NDX))
|
---|
62 | . D FREE($NA(^TMP($J,"RORTMP-"_NDX)))
|
---|
63 | Q
|
---|
64 | ;
|
---|
65 | ;***** DELETES ALL TEMPORARY BUFFERS
|
---|
66 | PURGE ;
|
---|
67 | N I S I="RORTMP-"
|
---|
68 | F S I=$O(^TMP($J,I)) Q:$E(I,1,7)'="RORTMP-" K ^TMP($J,I)
|
---|
69 | Q
|
---|