- BLRSLTLD ; IHS/DIR/FJE - SET IHS LAB TRANSACTION LOG ; [ 10/05/1999 8:47 AM ]
- ;;5.2;BLR;**1009**;OCT 01, 1999
- S BLRFLG="D"
- I BLROPT1="DELORD" D Q
- .S BLRPHASE="O",BLRODTM=$P(LROD0,U,5)
- .I BLRPARAM["TESTS" S BLRLRSN=+T(J),BLRTEST=$P(T(J),U,3) D DELTST Q
- .S BLRII="" F S BLRII=$O(T(BLRII)) Q:BLRII="" S BLRLRSN=+T(BLRII),BLRTEST=$P(T(BLRII),U,3) D DELTST
- I BLROPT1="DELACC" S BLRPHASE="A",BLRACCN=^LRO(68,LRAA,1,LRAD,1,LRAN,.2),BLRTEST=LRTSTS D DELTST Q
- I BLROPT1="REMACC" S BLRTST="" F S BLRTST=$O(^BLRTXLOG("AAT",BLRACCN,BLRTST)) Q:BLRTST="" S BLRSTR="SEQUENCE NUMBER_$$GETIEN(BLRACCN,BLRTST)~STATUS FLAG_BLRFLG" D ^BLRFLTL("M",BLRSTR)
- Q
- ;
- DELTST ;
- S BLRLEV=1,BLRTEST1=BLRTEST,BLRLEV(1)=BLRTEST D DELTST2 F D DELTST1 Q:'BLRLEV
- Q
- ;
- DELTST1 ;
- S BLRATOM=$O(^LAB(60,BLRLEV(BLRLEV),2,0))="" I BLRATOM,BLRLEV=1 S BLRLEV=0 Q
- S:'BLRATOM BLRLEV=BLRLEV+1 S BLRLEV(BLRLEV,0)=$O(^LAB(60,BLRLEV(BLRLEV-1),2,+$G(BLRLEV(BLRLEV,0))))
- I BLRLEV(BLRLEV,0) S BLRTEST1=$P(^LAB(60,BLRLEV(BLRLEV-1),2,$G(BLRLEV(BLRLEV,0),0),0),U),BLRLEV(BLRLEV)=BLRTEST1 D DELTST2 Q ;IHS/DIR/MJL 09/22/99
- S BLRLEV(BLRLEV,0)=0,BLRLEV=BLRLEV-2
- Q
- ;
- DELTST2 ;
- I BLRPHASE="O",'$D(^BLRTXLOG("AOT",BLRODTM,BLRLRSN,BLRTEST1)) D CHGDATE Q
- S BLRSTR="SEQUENCE NUMBER_$$GETIEN("_$S(BLRPHASE="O":"BLRODTM,BLRLRSN,BLRTEST1",1:"BLRACCN,BLRTEST1")_")~STATUS FLAG_BLRFLG" D ^BLRFLTL("M",BLRSTR)
- Q
- ;
- CHGDATE ;
- S BLRDT=BLRODTM,BLRQ=0 F S BLRDT=$O(^BLRTXLOG("AOT",BLRDT),-1) Q:(BLRDT=""!(BLRQ)) I $D(^BLRTXLOG("AOT",BLRDT,BLRLRSN,BLRTEST1)) D GETDATE
- K BLRQ
- Q
- GETDATE ;
- S BLRXSEQ=$O(^BLRTXLOG("AOT",BLRDT,BLRLRSN,BLRTEST1,""),-1)
- Q:$P(^BLRTXLOG(BLRXSEQ,0),U,3)'=$G(LRDFN)
- Q:$P(^BLRTXLOG(BLRXSEQ,11),U,3)'=$G(LRORD)
- S BLRSTR="SEQUENCE NUMBER_$$GETIEN(BLRDT,BLRLRSN,BLRTEST1)~STATUS FLAG_BLRFLG" D ^BLRFLTL("M",BLRSTR) S BLRQ=1
- Q
- BLRSLTLD ; IHS/DIR/FJE - SET IHS LAB TRANSACTION LOG ; [ 10/05/1999 8:47 AM ]
- +1 ;;5.2;BLR;**1009**;OCT 01, 1999
- +2 SET BLRFLG="D"
- +3 IF BLROPT1="DELORD"
- Begin DoDot:1
- +4 SET BLRPHASE="O"
- SET BLRODTM=$PIECE(LROD0,U,5)
- +5 IF BLRPARAM["TESTS"
- SET BLRLRSN=+T(J)
- SET BLRTEST=$PIECE(T(J),U,3)
- DO DELTST
- QUIT
- +6 SET BLRII=""
- FOR
- SET BLRII=$ORDER(T(BLRII))
- IF BLRII=""
- QUIT
- SET BLRLRSN=+T(BLRII)
- SET BLRTEST=$PIECE(T(BLRII),U,3)
- DO DELTST
- End DoDot:1
- QUIT
- +7 IF BLROPT1="DELACC"
- SET BLRPHASE="A"
- SET BLRACCN=^LRO(68,LRAA,1,LRAD,1,LRAN,.2)
- SET BLRTEST=LRTSTS
- DO DELTST
- QUIT
- +8 IF BLROPT1="REMACC"
- SET BLRTST=""
- FOR
- SET BLRTST=$ORDER(^BLRTXLOG("AAT",BLRACCN,BLRTST))
- IF BLRTST=""
- QUIT
- SET BLRSTR="SEQUENCE NUMBER_$$GETIEN(BLRACCN,BLRTST)~STATUS FLAG_BLRFLG"
- DO ^BLRFLTL("M",BLRSTR)
- +9 QUIT
- +10 ;
- DELTST ;
- +1 SET BLRLEV=1
- SET BLRTEST1=BLRTEST
- SET BLRLEV(1)=BLRTEST
- DO DELTST2
- FOR
- DO DELTST1
- IF 'BLRLEV
- QUIT
- +2 QUIT
- +3 ;
- DELTST1 ;
- +1 SET BLRATOM=$ORDER(^LAB(60,BLRLEV(BLRLEV),2,0))=""
- IF BLRATOM
- IF BLRLEV=1
- SET BLRLEV=0
- QUIT
- +2 IF 'BLRATOM
- SET BLRLEV=BLRLEV+1
- SET BLRLEV(BLRLEV,0)=$ORDER(^LAB(60,BLRLEV(BLRLEV-1),2,+$GET(BLRLEV(BLRLEV,0))))
- +3 ;IHS/DIR/MJL 09/22/99
- IF BLRLEV(BLRLEV,0)
- SET BLRTEST1=$PIECE(^LAB(60,BLRLEV(BLRLEV-1),2,$GET(BLRLEV(BLRLEV,0),0),0),U)
- SET BLRLEV(BLRLEV)=BLRTEST1
- DO DELTST2
- QUIT
- +4 SET BLRLEV(BLRLEV,0)=0
- SET BLRLEV=BLRLEV-2
- +5 QUIT
- +6 ;
- DELTST2 ;
- +1 IF BLRPHASE="O"
- IF '$DATA(^BLRTXLOG("AOT",BLRODTM,BLRLRSN,BLRTEST1))
- DO CHGDATE
- QUIT
- +2 SET BLRSTR="SEQUENCE NUMBER_$$GETIEN("_$SELECT(BLRPHASE="O":"BLRODTM,BLRLRSN,BLRTEST1",1:"BLRACCN,BLRTEST1")_")~STATUS FLAG_BLRFLG"
- DO ^BLRFLTL("M",BLRSTR)
- +3 QUIT
- +4 ;
- CHGDATE ;
- +1 SET BLRDT=BLRODTM
- SET BLRQ=0
- FOR
- SET BLRDT=$ORDER(^BLRTXLOG("AOT",BLRDT),-1)
- IF (BLRDT=""!(BLRQ))
- QUIT
- IF $DATA(^BLRTXLOG("AOT",BLRDT,BLRLRSN,BLRTEST1))
- DO GETDATE
- +2 KILL BLRQ
- +3 QUIT
- GETDATE ;
- +1 SET BLRXSEQ=$ORDER(^BLRTXLOG("AOT",BLRDT,BLRLRSN,BLRTEST1,""),-1)
- +2 IF $PIECE(^BLRTXLOG(BLRXSEQ,0),U,3)'=$GET(LRDFN)
- QUIT
- +3 IF $PIECE(^BLRTXLOG(BLRXSEQ,11),U,3)'=$GET(LRORD)
- QUIT
- +4 SET BLRSTR="SEQUENCE NUMBER_$$GETIEN(BLRDT,BLRLRSN,BLRTEST1)~STATUS FLAG_BLRFLG"
- DO ^BLRFLTL("M",BLRSTR)
- SET BLRQ=1
- +5 QUIT
