SRHLXTMP ;B'HAM ISC/DLR - Surgery Interface Purge ^XTMP("SRHL7"_CASE# ; 9/3/10 10:04am
;;3.0; Surgery ;**41,173**;24 Jun 93;Build 8
; Per VHA Directive 10-93-142, this routine SHOULD NOT be modified.
;this routine is used to purge entries from the XTMP global
N SRX,SRX1
S SRX="" F S SRX=$O(^XTMP(SRX)) Q:SRX="" I SRX["SRHL7" S SRX1=0 F S SRX1=$O(^XTMP(SRX,SRX1)) Q:'SRX1 D
.I '$D(^XTMP(SRX,SRX1,0)) K ^XTMP(SRX,SRX1) Q
.S X1=DT,X2=-1 D C^%DTC I +$G(^XTMP(SRX,SRX1,0))'>X K ^XTMP(SRX,SRX1)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSRHLXTMP 513 printed Dec 13, 2024@02:39:42 Page 2
SRHLXTMP ;B'HAM ISC/DLR - Surgery Interface Purge ^XTMP("SRHL7"_CASE# ; 9/3/10 10:04am
+1 ;;3.0; Surgery ;**41,173**;24 Jun 93;Build 8
+2 ; Per VHA Directive 10-93-142, this routine SHOULD NOT be modified.
+3 ;this routine is used to purge entries from the XTMP global
+4 NEW SRX,SRX1
+5 SET SRX=""
FOR
SET SRX=$ORDER(^XTMP(SRX))
if SRX=""
QUIT
IF SRX["SRHL7"
SET SRX1=0
FOR
SET SRX1=$ORDER(^XTMP(SRX,SRX1))
if 'SRX1
QUIT
Begin DoDot:1
+6 IF '$DATA(^XTMP(SRX,SRX1,0))
KILL ^XTMP(SRX,SRX1)
QUIT
+7 SET X1=DT
SET X2=-1
DO C^%DTC
IF +$GET(^XTMP(SRX,SRX1,0))'>X
KILL ^XTMP(SRX,SRX1)
End DoDot:1
+8 QUIT
