RORTMP ;HCIOFO/SG - TEMPORARY GLOBAL STORAGE ; 10/14/05 1:41pm
;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
;
; DO NOT use this API to pass the data between tasks!
;
Q
;
;***** ALLOCATES A TEMPORARY GLOBAL BUFFER
;
; [.SUBS] Subscript of the buffer is returned here
;
; Return Values:
; Closed root of the buffer
;
ALLOC(SUBS) ;
N NDX,NODE
S NDX=$O(^TMP($J,"RORTMP-0",""),-1)+1
S SUBS="RORTMP-"_NDX,NODE=$NA(^TMP($J,SUBS)) K @NODE
S ^TMP($J,"RORTMP-0",NDX)=""
Q NODE
;
;***** FREES THE TEMPORARY GLOBAL BUFFER
;
; NODE Closed root of the temporary global buffer
;
FREE(NODE) ;
N NDX S NDX=$$NDX(NODE)
K:NDX>0 ^TMP($J,"RORTMP-0",NDX),@NODE
Q
;
;***** EXTRACTS THE INDEX FROM THE CLOSED ROOT OF THE BUFFER
;
; NODE Closed root of the temporary global buffer
;
; Return Values:
; 0 Invalid closed root
; >0 Index of the buffer
;
NDX(NODE) ;
N SUBS
Q:$E(NODE,1)'="^" 0
Q:$NA(@NODE,1)'=$NA(^TMP($J)) 0
S SUBS=$QS(NODE,2)
Q:$P(SUBS,"-")'="RORTMP" 0
S NDX=+$P(SUBS,"-",2)
Q $S(NDX>0:NDX,1:0)
;
;***** FREES THE LAST ALLOCATED BUFFER(S)
;
; [NODE] Closed root of the temporary global buffer.
;
; If this parameter is defined and references a
; valid temporary buffer, then this buffer and
; all others allocated after it are freed.
;
; Otherwise, only the last buffer is freed.
;
POP(NODE) ;
N NDX S NDX=$$NDX($G(NODE))
S:NDX'>0 NDX=+$O(^TMP($J,"RORTMP-0",""),-1)
F Q:NDX'>0 D S NDX=$O(^TMP($J,"RORTMP-0",NDX))
. D FREE($NA(^TMP($J,"RORTMP-"_NDX)))
Q
;
;***** DELETES ALL TEMPORARY BUFFERS
PURGE ;
N I S I="RORTMP-"
F S I=$O(^TMP($J,I)) Q:$E(I,1,7)'="RORTMP-" K ^TMP($J,I)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORTMP 1821 printed Apr 09, 2024@20:48:34 Page 2
RORTMP ;HCIOFO/SG - TEMPORARY GLOBAL STORAGE ; 10/14/05 1:41pm
+1 ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
+2 ;
+3 ; DO NOT use this API to pass the data between tasks!
+4 ;
+5 QUIT
+6 ;
+7 ;***** ALLOCATES A TEMPORARY GLOBAL BUFFER
+8 ;
+9 ; [.SUBS] Subscript of the buffer is returned here
+10 ;
+11 ; Return Values:
+12 ; Closed root of the buffer
+13 ;
ALLOC(SUBS) ;
+1 NEW NDX,NODE
+2 SET NDX=$ORDER(^TMP($JOB,"RORTMP-0",""),-1)+1
+3 SET SUBS="RORTMP-"_NDX
SET NODE=$NAME(^TMP($JOB,SUBS))
KILL @NODE
+4 SET ^TMP($JOB,"RORTMP-0",NDX)=""
+5 QUIT NODE
+6 ;
+7 ;***** FREES THE TEMPORARY GLOBAL BUFFER
+8 ;
+9 ; NODE Closed root of the temporary global buffer
+10 ;
FREE(NODE) ;
+1 NEW NDX
SET NDX=$$NDX(NODE)
+2 if NDX>0
KILL ^TMP($JOB,"RORTMP-0",NDX),@NODE
+3 QUIT
+4 ;
+5 ;***** EXTRACTS THE INDEX FROM THE CLOSED ROOT OF THE BUFFER
+6 ;
+7 ; NODE Closed root of the temporary global buffer
+8 ;
+9 ; Return Values:
+10 ; 0 Invalid closed root
+11 ; >0 Index of the buffer
+12 ;
NDX(NODE) ;
+1 NEW SUBS
+2 if $EXTRACT(NODE,1)'="^"
QUIT 0
+3 if $NAME(@NODE,1)'=$NAME(^TMP($JOB))
QUIT 0
+4 SET SUBS=$QSUBSCRIPT(NODE,2)
+5 if $PIECE(SUBS,"-")'="RORTMP"
QUIT 0
+6 SET NDX=+$PIECE(SUBS,"-",2)
+7 QUIT $SELECT(NDX>0:NDX,1:0)
+8 ;
+9 ;***** FREES THE LAST ALLOCATED BUFFER(S)
+10 ;
+11 ; [NODE] Closed root of the temporary global buffer.
+12 ;
+13 ; If this parameter is defined and references a
+14 ; valid temporary buffer, then this buffer and
+15 ; all others allocated after it are freed.
+16 ;
+17 ; Otherwise, only the last buffer is freed.
+18 ;
POP(NODE) ;
+1 NEW NDX
SET NDX=$$NDX($GET(NODE))
+2 if NDX'>0
SET NDX=+$ORDER(^TMP($JOB,"RORTMP-0",""),-1)
+3 FOR
if NDX'>0
QUIT
Begin DoDot:1
+4 DO FREE($NAME(^TMP($JOB,"RORTMP-"_NDX)))
End DoDot:1
SET NDX=$ORDER(^TMP($JOB,"RORTMP-0",NDX))
+5 QUIT
+6 ;
+7 ;***** DELETES ALL TEMPORARY BUFFERS
PURGE ;
+1 NEW I
SET I="RORTMP-"
+2 FOR
SET I=$ORDER(^TMP($JOB,I))
if $EXTRACT(I,1,7)'="RORTMP-"
QUIT
KILL ^TMP($JOB,I)
+3 QUIT
