- 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 ---[H[J[2J[HLRNIGHT1 1039 printed Feb 18, 2025@23:43:59 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