LROC1.m

LROC1 ; IHS/DIR/FJE - TO CLEAN UP LAB ANCILLARY FILE 2/6/91 10:53 ;

 ;;5.2;LR;**1013**;JUL 15, 2002

 ;

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

LROC1     ; IHS/DIR/FJE - TO CLEAN UP LAB ANCILLARY FILE 2/6/91 10:53 ;

 +1       ;;5.2;LR;**1013**;JUL 15, 2002

 +2       ;

 +3       ;;5.2;LAB SERVICE;;Sep 27, 1994

 +4        SET X="T-14"

           SET %DT=""

           DO ^%DT

           SET LRKDT=Y

           SET %H=$HOROLOG-14

 +5        SET LAB="ET"

           DO LAH

 +6        SET LAB="LOST"

           DO LAD

 +7        SET LAB="SMAC"

           DO LAD

 +8        SET LAB="TIME"

           DO LAD

 +9        KILL LAB,LRKDT,LRIX

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