LROC1.m

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 ---LROC1   422     printed  Apr 09, 2024@21:25:31                                                                                                                                                                                                        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