BLRSLTLR ; IHS/DIR/FJE - SET IHS LAB TRANSACTION LOG ; [ 11/04/1999 9:21 AM ]
;;5.2;BLR;**1008,1009**;AUG 1, 1999
I BLROPT1="MICRO" S BLROPT1="" D ^BLRMLTL Q
I BLROPT1="BBANK" S BLROPT1="" D ^BLRBLTL Q
I BLROPT1="BYPASS" S BLRCMF="C",BLRTEST=$G(LRTY,LRTNUM),BLRODT=LRODT,BLRSEQ=LRSN D ^BLRSLTL1 S BLRCMF="M",BLRPHASE="R" D RES Q
I BLROPT1="ACCORD" D Q
.I $D(LRTNUM) S BLRTEST=LRTNUM,BLRCMF="M",BLRODT=LRODT,BLRSEQ=LRSN D ^BLRSLTL1 S BLRPHASE="R" D RES Q
.D RES Q
D RES Q
Q
;
RES ;
S:$D(LRACC)'=0 BLRACCN=LRACC S:$D(LRACC)=0 BLRACCN=^LRO(68,LRAA,1,LRAD,1,LRAN,.2) S BLRCMP=$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,3)),U,4)'=""
S BLRDN="" F S BLRDN=$O(LRSB(BLRDN)) Q:BLRDN="" S BLRCREF=LRSS_";"_BLRDN_";1",BLRTEST1=$O(^LAB(60,"C",BLRCREF,"")) I BLRTEST1'="",$D(^BLRTXLOG("AAT",BLRACCN,BLRTEST1)) D
.S BLRRES=$P(LRSB(BLRDN),U,1),BLRNAF=$P(LRSB(BLRDN),U,2) D RES1
D SETPRNT
Q
;
RES1 ;
S BLRSEQ=$O(^BLRTXLOG("AAT",BLRACCN,BLRTEST1,""),-1) I BLRSEQ'="" S BLRDEL=$G(^BLRTXLOG(BLRSEQ,1)),BLRDEL=$P(BLRDEL,U,2)="D" Q:BLRDEL ;;**NEW
S BLRSPEC=$G(LRSPEC)
S:BLRSPEC'="" BLRZ=$G(^LAB(60,BLRTEST1,1,BLRSPEC,0))
S BLRRL=$P(BLRZ,U,2),BLRRH=$P(BLRZ,U,3)
X:BLRRH'?.N "S BLRRH="_BLRRH
X:BLRRL'?.N "S BLRRL="_BLRRL
S BLRSTR="SEQUENCE NUMBER_$$GETIEN(BLRACCN,BLRTEST1)~STATUS FLAG_BLRPHASE~"
S BLRSTR=BLRSTR_"REFERENCE HIGH_BLRRH~REFERENCE LOW_BLRRL~RESULT_BLRRES~RESULT N/A FLAG_BLRNAF"
D ^BLRFLTL("M",BLRSTR)
Q
;
SETPRNT ;
;S BLRLSEQ=9999999,BLRHSEQ=0
;S BLRLTST=0 F S BLRLTST=$O(^BLRTXLOG("AAT",BLRACCN,BLRLTST)) Q:BLRLTST="" S BLRSEQ=$O(^BLRTXLOG("AAT",BLRACCN,BLRLTST,""),-1) I BLRSEQ'="" S:BLRSEQ<BLRLSEQ BLRLSEQ=BLRSEQ S:BLRSEQ>BLRHSEQ BLRHSEQ=BLRSEQ
;F BLRSEQ=BLRHSEQ:-1:BLRLSEQ S BLRDEL=$G(^BLRTXLOG(BLRSEQ,1)),BLRPAR=$P(BLRDEL,U),BLRDEL=$P(BLRDEL,U,2)="D" S:BLRPAR'="" BLRPAR(BLRPAR)=$G(BLRPAR(BLRPAR)) D
;S BLRLTST=0 F S BLRLTST=$O(^BLRTXLOG("AAT",BLRACCN,BLRLTST)) Q:BLRLTST="" S BLRSEQ=$O(^BLRTXLOG("AAT",BLRACCN,BLRLTST,""),-1) S:BLRSEQ'="" BLRANSEQ(BLRSEQ)="" ;IHS/DIR/MJL 02/12/98
S:'$D(BLRCDT) BLRCDT=LRCDT
;S BLRLTST=0 F S BLRLTST=$O(^BLRTXLOG("AAT",BLRACCN,BLRLTST)) Q:BLRLTST="" S BLRSEQ=$O(^BLRTXLOG("AAT",BLRACCN,BLRLTST,""),-1) I BLRSEQ'="",$P(^BLRTXLOG(BLRSEQ,12),U)=$P(BLRCDT,".") S BLRANSEQ(BLRSEQ)="" ;IHS/DIR/AAB 05/07/98
S BLRLTST=0 F S BLRLTST=$O(^BLRTXLOG("AAT",BLRACCN,BLRLTST)) Q:BLRLTST="" S BLRSEQ=$O(^BLRTXLOG("AAT",BLRACCN,BLRLTST,""),-1) I BLRSEQ'="",$P(^BLRTXLOG(BLRSEQ,12),U)=$G(BLRCDT) S BLRANSEQ(BLRSEQ)="" ;IHS/DIR/FJE 07/28/99
S BLRSEQ="" F S BLRSEQ=$O(BLRANSEQ(BLRSEQ),-1) Q:BLRSEQ="" S BLRDEL=$G(^BLRTXLOG(BLRSEQ,1)),BLRPAR=$P(BLRDEL,U),BLRDEL=$P(BLRDEL,U,2)="D" S:BLRPAR'="" BLRPAR(BLRPAR)=$G(BLRPAR(BLRPAR)) D ;IHS/DIR/MJL 02/12/98
.I 'BLRCMP,BLRPAR,BLRPAR(BLRPAR) Q
.I $D(BLRPAR(BLRSEQ)) D Q
..I 'BLRCMP,BLRPAR(BLRSEQ) S:BLRPAR'="" BLRPAR(BLRPAR)=1 Q
..I 'BLRDEL S BLRSTR="SEQUENCE NUMBER_"_BLRSEQ_"~STATUS FLAG_""R""",BLRIEN=BLRSEQ_",",BLRENT=BLRSEQ D ^BLRFLTL("M",BLRSTR) Q
.I $P($G(^BLRTXLOG(BLRSEQ,20)),U)="" D
..I 'BLRCMP,BLRPAR,$P(^LAB(60,$P(^BLRTXLOG(BLRSEQ,0),U,6),0),U,17) S BLRPAR(BLRPAR)=1 Q
.I BLRCMP,'BLRDEL S BLRSTR="SEQUENCE NUMBER_"_BLRSEQ_"~STATUS FLAG_""R""",BLRIEN=BLRSEQ_",",BLRENT=BLRSEQ D ^BLRFLTL("M",BLRSTR) Q
K BLRANSEQ,BLRHSEQ,BLRLSEQ,BLRLTST,BLRPAR ;IHS/DIR/MJL 02/12/98
Q
BLRSLTLR ; IHS/DIR/FJE - SET IHS LAB TRANSACTION LOG ; [ 11/04/1999 9:21 AM ]
+1 ;;5.2;BLR;**1008,1009**;AUG 1, 1999
+2 IF BLROPT1="MICRO"
SET BLROPT1=""
DO ^BLRMLTL
QUIT
+3 IF BLROPT1="BBANK"
SET BLROPT1=""
DO ^BLRBLTL
QUIT
+4 IF BLROPT1="BYPASS"
SET BLRCMF="C"
SET BLRTEST=$GET(LRTY,LRTNUM)
SET BLRODT=LRODT
SET BLRSEQ=LRSN
DO ^BLRSLTL1
SET BLRCMF="M"
SET BLRPHASE="R"
DO RES
QUIT
+5 IF BLROPT1="ACCORD"
Begin DoDot:1
+6 IF $DATA(LRTNUM)
SET BLRTEST=LRTNUM
SET BLRCMF="M"
SET BLRODT=LRODT
SET BLRSEQ=LRSN
DO ^BLRSLTL1
SET BLRPHASE="R"
DO RES
QUIT
+7 DO RES
QUIT
End DoDot:1
QUIT
+8 DO RES
QUIT
+9 QUIT
+10 ;
RES ;
+1 IF $DATA(LRACC)'=0
SET BLRACCN=LRACC
IF $DATA(LRACC)=0
SET BLRACCN=^LRO(68,LRAA,1,LRAD,1,LRAN,.2)
SET BLRCMP=$PIECE($GET(^LRO(68,LRAA,1,LRAD,1,LRAN,3)),U,4)'=""
+2 SET BLRDN=""
FOR
SET BLRDN=$ORDER(LRSB(BLRDN))
IF BLRDN=""
QUIT
SET BLRCREF=LRSS_";"_BLRDN_";1"
SET BLRTEST1=$ORDER(^LAB(60,"C",BLRCREF,""))
IF BLRTEST1'=""
IF $DATA(^BLRTXLOG("AAT",BLRACCN,BLRTEST1))
Begin DoDot:1
+3 SET BLRRES=$PIECE(LRSB(BLRDN),U,1)
SET BLRNAF=$PIECE(LRSB(BLRDN),U,2)
DO RES1
End DoDot:1
+4 DO SETPRNT
+5 QUIT
+6 ;
RES1 ;
+1 ;;**NEW
SET BLRSEQ=$ORDER(^BLRTXLOG("AAT",BLRACCN,BLRTEST1,""),-1)
IF BLRSEQ'=""
SET BLRDEL=$GET(^BLRTXLOG(BLRSEQ,1))
SET BLRDEL=$PIECE(BLRDEL,U,2)="D"
IF BLRDEL
QUIT
+2 SET BLRSPEC=$GET(LRSPEC)
+3 IF BLRSPEC'=""
SET BLRZ=$GET(^LAB(60,BLRTEST1,1,BLRSPEC,0))
+4 SET BLRRL=$PIECE(BLRZ,U,2)
SET BLRRH=$PIECE(BLRZ,U,3)
+5 IF BLRRH'?.N
XECUTE "S BLRRH="_BLRRH
+6 IF BLRRL'?.N
XECUTE "S BLRRL="_BLRRL
+7 SET BLRSTR="SEQUENCE NUMBER_$$GETIEN(BLRACCN,BLRTEST1)~STATUS FLAG_BLRPHASE~"
+8 SET BLRSTR=BLRSTR_"REFERENCE HIGH_BLRRH~REFERENCE LOW_BLRRL~RESULT_BLRRES~RESULT N/A FLAG_BLRNAF"
+9 DO ^BLRFLTL("M",BLRSTR)
+10 QUIT
+11 ;
SETPRNT ;
+1 ;S BLRLSEQ=9999999,BLRHSEQ=0
+2 ;S BLRLTST=0 F S BLRLTST=$O(^BLRTXLOG("AAT",BLRACCN,BLRLTST)) Q:BLRLTST="" S BLRSEQ=$O(^BLRTXLOG("AAT",BLRACCN,BLRLTST,""),-1) I BLRSEQ'="" S:BLRSEQ<BLRLSEQ BLRLSEQ=BLRSEQ S:BLRSEQ>BLRHSEQ BLRHSEQ=BLRSEQ
+3 ;F BLRSEQ=BLRHSEQ:-1:BLRLSEQ S BLRDEL=$G(^BLRTXLOG(BLRSEQ,1)),BLRPAR=$P(BLRDEL,U),BLRDEL=$P(BLRDEL,U,2)="D" S:BLRPAR'="" BLRPAR(BLRPAR)=$G(BLRPAR(BLRPAR)) D
+4 ;S BLRLTST=0 F S BLRLTST=$O(^BLRTXLOG("AAT",BLRACCN,BLRLTST)) Q:BLRLTST="" S BLRSEQ=$O(^BLRTXLOG("AAT",BLRACCN,BLRLTST,""),-1) S:BLRSEQ'="" BLRANSEQ(BLRSEQ)="" ;IHS/DIR/MJL 02/12/98
+5 IF '$DATA(BLRCDT)
SET BLRCDT=LRCDT
+6 ;S BLRLTST=0 F S BLRLTST=$O(^BLRTXLOG("AAT",BLRACCN,BLRLTST)) Q:BLRLTST="" S BLRSEQ=$O(^BLRTXLOG("AAT",BLRACCN,BLRLTST,""),-1) I BLRSEQ'="",$P(^BLRTXLOG(BLRSEQ,12),U)=$P(BLRCDT,".") S BLRANSEQ(BLRSEQ)="" ;IHS/DIR/AAB 05/07/98
+7 ;IHS/DIR/FJE 07/28/99
SET BLRLTST=0
FOR
SET BLRLTST=$ORDER(^BLRTXLOG("AAT",BLRACCN,BLRLTST))
IF BLRLTST=""
QUIT
SET BLRSEQ=$ORDER(^BLRTXLOG("AAT",BLRACCN,BLRLTST,""),-1)
IF BLRSEQ'=""
IF $PIECE(^BLRTXLOG(BLRSEQ,12),U)=$GET(BLRCDT)
SET BLRANSEQ(BLRSEQ)=""
+8 ;IHS/DIR/MJL 02/12/98
SET BLRSEQ=""
FOR
SET BLRSEQ=$ORDER(BLRANSEQ(BLRSEQ),-1)
IF BLRSEQ=""
QUIT
SET BLRDEL=$GET(^BLRTXLOG(BLRSEQ,1))
SET BLRPAR=$PIECE(BLRDEL,U)
SET BLRDEL=$PIECE(BLRDEL,U,2)="D"
IF BLRPAR'=""
SET BLRPAR(BLRPAR)=$GET(BLRPAR(BLRPAR))
Begin DoDot:1
+9 IF 'BLRCMP
IF BLRPAR
IF BLRPAR(BLRPAR)
QUIT
+10 IF $DATA(BLRPAR(BLRSEQ))
Begin DoDot:2
+11 IF 'BLRCMP
IF BLRPAR(BLRSEQ)
IF BLRPAR'=""
SET BLRPAR(BLRPAR)=1
QUIT
+12 IF 'BLRDEL
SET BLRSTR="SEQUENCE NUMBER_"_BLRSEQ_"~STATUS FLAG_""R"""
SET BLRIEN=BLRSEQ_","
SET BLRENT=BLRSEQ
DO ^BLRFLTL("M",BLRSTR)
QUIT
End DoDot:2
QUIT
+13 IF $PIECE($GET(^BLRTXLOG(BLRSEQ,20)),U)=""
Begin DoDot:2
+14 IF 'BLRCMP
IF BLRPAR
IF $PIECE(^LAB(60,$PIECE(^BLRTXLOG(BLRSEQ,0),U,6),0),U,17)
SET BLRPAR(BLRPAR)=1
QUIT
End DoDot:2
+15 IF BLRCMP
IF 'BLRDEL
SET BLRSTR="SEQUENCE NUMBER_"_BLRSEQ_"~STATUS FLAG_""R"""
SET BLRIEN=BLRSEQ_","
SET BLRENT=BLRSEQ
DO ^BLRFLTL("M",BLRSTR)
QUIT
End DoDot:1
+16 ;IHS/DIR/MJL 02/12/98
KILL BLRANSEQ,BLRHSEQ,BLRLSEQ,BLRLTST,BLRPAR
+17 QUIT
