| 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 | 
|---|