- 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 Mar 13, 2025@21:22:57 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
