- 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 Jan 18, 2025@02:44:40 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