BLRSLTLD.m

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