- 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
