LRNIGHT1.m

LRNIGHT1 ;SLC/DCM - NIGHTLY LAB CLEANUP (^LAM,^LRO(67.9) ;2/6/91  08:47 ;

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

 Q:'$L($P(^LAB(69.9,1,1),"^",9))  S X="T-"_($P(^(1),"^",9)+1),%DT="" D ^%DT S LDT=Y

 S I=0 F  S I=$O(^LAM(I)) Q:I<1  S J=0 F  S J=$O(^LAM(I,1,J)) Q:J<1  S LRCT=$S($D(^(J,1,0)):$P(^(0),"^",4),1:0) D LAM S $P(^LAM(I,1,J,1,0),"^",4)=$S(LRCT>0:LRCT,1:0)

 S LRCT=$P(^LRO(67.9,0),"^",4),I=0 F  S I=$O(^LRO(67.9,I)) Q:I<1  I $D(^LRO(67.9,I,0)) S X=^(0),J=+X D:+J<LDT LRO

 S $P(^LRO(67.9,0),"^",4)=$S(LRCT>0:LRCT,1:0) K LRCT,LRN1,LRN2,LRN3,LRN9,LRN10,DIC,DIE,LDT Q

LRO S LRCT=LRCT-1,LRN1=+X,LRN2=$P(X,"^",2),LRN3=$P(X,"^",3),LRN9=$P(X,"^",9),LRN10=$P(X,"^",10)

 K ^LRO(67.9,"B",J,I),^LRO(67.9,I) K:LRN2 ^LRO(67.9,"AC",$E(LRN2,1,30),I) K:$L(LRN3)&(LRN9) ^LRO(67.9,"AD",LRN1_";"_LRN3_";"_LRN9,I) K:$L(LRN10) ^LRO(67.9,"AE",$E(LRN10,1,30),I) I $D(^LRO(67.9,"AR",LRN1\1)) K ^(LRN1\1)

 K:+LRN9 ^LRO(67.9,"B",LRN9,I),^LRO(67.9,"C",LRN9,I)

 Q

LAM S K=0 F  S K=$O(^LAM(I,1,J,1,K)) Q:K<1!(K>LDT)  S DA=K,LRCT=LRCT-1 K ^LAM(I,1,J,1,K)

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---LRNIGHT1   1039     printed  Apr 09, 2024@21:13:19                                                                                                                                                                                                    Page 2

LRNIGHT1  ;SLC/DCM - NIGHTLY LAB CLEANUP (^LAM,^LRO(67.9) ;2/6/91  08:47 ;

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

 +2        if '$LENGTH($PIECE(^LAB(69.9,1,1),"^",9))

               QUIT 

           SET X="T-"_($PIECE(^(1),"^",9)+1)

           SET %DT=""

           DO ^%DT

           SET LDT=Y

 +3        SET I=0

           FOR 

               SET I=$ORDER(^LAM(I))

               if I<1

                   QUIT 

               SET J=0

               FOR 

                   SET J=$ORDER(^LAM(I,1,J))

                   if J<1

                       QUIT 

                   SET LRCT=$SELECT($DATA(^(J,1,0)):$PIECE(^(0),"^",4),1:0)

                   DO LAM

                   SET $PIECE(^LAM(I,1,J,1,0),"^",4)=$SELECT(LRCT>0:LRCT,1:0)

 +4        SET LRCT=$PIECE(^LRO(67.9,0),"^",4)

           SET I=0

           FOR 

               SET I=$ORDER(^LRO(67.9,I))

               if I<1

                   QUIT 

               IF $DATA(^LRO(67.9,I,0))

                   SET X=^(0)

                   SET J=+X

                   if +J<LDT

                       DO LRO

 +5        SET $PIECE(^LRO(67.9,0),"^",4)=$SELECT(LRCT>0:LRCT,1:0)

           KILL LRCT,LRN1,LRN2,LRN3,LRN9,LRN10,DIC,DIE,LDT

           QUIT 

LRO        SET LRCT=LRCT-1

           SET LRN1=+X

           SET LRN2=$PIECE(X,"^",2)

           SET LRN3=$PIECE(X,"^",3)

           SET LRN9=$PIECE(X,"^",9)

           SET LRN10=$PIECE(X,"^",10)

 +1        KILL ^LRO(67.9,"B",J,I),^LRO(67.9,I)

           if LRN2

               KILL ^LRO(67.9,"AC",$EXTRACT(LRN2,1,30),I)

           if $LENGTH(LRN3)&(LRN9)

               KILL ^LRO(67.9,"AD",LRN1_";"_LRN3_";"_LRN9,I)

           if $LENGTH(LRN10)

               KILL ^LRO(67.9,"AE",$EXTRACT(LRN10,1,30),I)

           IF $DATA(^LRO(67.9,"AR",LRN1\1))

               KILL ^(LRN1\1)

 +2        if +LRN9

               KILL ^LRO(67.9,"B",LRN9,I),^LRO(67.9,"C",LRN9,I)

 +3        QUIT 

LAM        SET K=0

           FOR 

               SET K=$ORDER(^LAM(I,1,J,1,K))

               if K<1!(K>LDT)

                   QUIT 

               SET DA=K

               SET LRCT=LRCT-1

               KILL ^LAM(I,1,J,1,K)

 +1        QUIT