LROC1 ;SLC/CJS - TO CLEAN UP LAB ANCILLARY FILE ;2/6/91 10:53 ;
;;5.2;LAB SERVICE;;Sep 27, 1994
S X="T-14",%DT="" D ^%DT S LRKDT=Y,%H=$H-14
S LAB="ET" D LAH
S LAB="LOST" D LAD
S LAB="SMAC" D LAD
S LAB="TIME" D LAD
K LAB,LRKDT,LRIX
Q
LAH S LRIX="" F I=1:1 S LRIX=$O(^LA(LAB,LRIX)) Q:(LRIX<1)!(LRIX>%H) K ^(LRIX)
Q
LAD S LRIX="" F I=1:1 S LRIX=$O(^LA(LAB,LRIX)) Q:(LRIX<1)!(LRIX>LRKDT) K ^(LRIX)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLROC1 422 printed Nov 22, 2024@17:28:32 Page 2
LROC1 ;SLC/CJS - TO CLEAN UP LAB ANCILLARY FILE ;2/6/91 10:53 ;
+1 ;;5.2;LAB SERVICE;;Sep 27, 1994
+2 SET X="T-14"
SET %DT=""
DO ^%DT
SET LRKDT=Y
SET %H=$HOROLOG-14
+3 SET LAB="ET"
DO LAH
+4 SET LAB="LOST"
DO LAD
+5 SET LAB="SMAC"
DO LAD
+6 SET LAB="TIME"
DO LAD
+7 KILL LAB,LRKDT,LRIX
+8 QUIT
LAH SET LRIX=""
FOR I=1:1
SET LRIX=$ORDER(^LA(LAB,LRIX))
if (LRIX<1)!(LRIX>%H)
QUIT
KILL ^(LRIX)
+1 QUIT
LAD SET LRIX=""
FOR I=1:1
SET LRIX=$ORDER(^LA(LAB,LRIX))
if (LRIX<1)!(LRIX>LRKDT)
QUIT
KILL ^(LRIX)
+1 QUIT
