BLRTNA ;IHS/ITSC/TPF - CREATE/EDIT TRANSACTIONS [ 12/19/2002 6:40 AM ]
;;5.2;IHS LABORATORY;**1028**;NOV 01, 1997;Build 46
;;5.2;LR;**1013,1015**;NOV 18, 2002
;
CPTCODE ;EP - CALLED FROM BLRTN,BLRTNB,BLRTNM1
D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("ENTER CPTCODE^BLRTNA")
S BLRFOUND=0,(BLRXII,BLRCPTS,BLRCPTP)="" F S BLRXII=$O(^BLRCPT("C",BLRTEST1,BLRXII)) Q:(BLRXII="") I '$P(^BLRCPT(BLRXII,1),U,2) D GETCPT Q:BLRFOUND
D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("EXIT CPTCODE^BLRTNA")
Q
;
GETCPT ;EP - CALLED FROM BLRTN
D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("ENTER GETCPT^BLRTNA")
Q:BLRODTM<$P($G(^BLRCPT(BLRXII,0)),U,3)
S BLRFOUND=1,BLRCPTP=BLRXII
;---LR*5.2*1028;01/14/11;IHS/OIT/MPW- Corrected error in next line
;S BLRCPTN=0 F BLRNN=1:1 S BLRCPTN=$O(^BLRCPT(BLRXII,11,BLRCPTN)) Q:'BLRCPTN S BLRCPDAT=$g(^BLRCPT(BLRXII,11,BLRCPTN,0)),BLRCPCD=$P(BLRCPDAT,U),BLRCPCST=$P(BLRCPDAT,U,2),BLRCPRC=$P(BLRCPDAT,U,3),BLRCPACT=$P(BLRCPDAT,U,4) D
S BLRCPTN=0 F BLRNN=1:1 S BLRCPTN=$O(^BLRCPT(BLRXII,11,BLRCPTN)) Q:'BLRCPTN S BLRCPDAT=$G(^BLRCPT(BLRXII,11,BLRCPTN,0)),BLRCPCD=$P(BLRCPDAT,U),BLRCPCST=$P(BLRCPDAT,U,2),BLRCPRC=$P(BLRCPDAT,U,3),BLRCPACT=$P(BLRCPDAT,U,4) D
.S (BLRCPTM,BLRCPTQ)=""
.S BLRCPMN=0 F BLRNN1=1:1 S BLRCPMN=$O(^BLRCPT(BLRXII,11,BLRCPTN,1,BLRCPMN)) Q:'BLRCPMN S:BLRNN1>1 BLRCPTM=BLRCPTM_"," S BLRCPTM=BLRCPTM_^BLRCPT(BLRXII,11,BLRCPTN,1,BLRCPMN,0)
.S BLRCPQN=0 F BLRNN1=1:1 S BLRCPQN=$O(^BLRCPT(BLRXII,11,BLRCPTN,2,BLRCPQN)) Q:'BLRCPQN S:BLRNN1>1 BLRCPTQ=BLRCPTQ_"," S BLRCPTQ=BLRCPTQ_$G(^BLRCPT(BLRXII,11,BLRCPTN,2,BLRCPQN,0))
.S:BLRNN>1 BLRCPTS=BLRCPTS_";" S BLRCPTS=BLRCPTS_BLRCPCD_"|"_BLRCPCST_"|"_BLRCPRC_"|"_BLRCPACT_"|"_BLRCPTM_"|"_BLRCPTQ
D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("EXIT GETCPT^BLRTNA")
K BLRCPCD,BLRCPCST,BLRCPRC,BLRCPACT,BLRCPTN,BLRCPDAT,BLRCPTM,BLRCPMN,BLRCPTQ,BLRCPQN,BLRNN,BLRNN1
Q
;
RESVRS ;EP - CALLED FROM BLRTN
D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("ENTER RESVRS^BLRTNA")
S BLRCREF=$P(BLRL60,U,5)
I BLRSS=$P(BLRCREF,";"),$D(BLRRVS($P(BLRCREF,";",2))) S BLRRES=BLRRVS($P(BLRCREF,";",2)),BLRNAF=$P(BLRRES,U,2),BLRDUZ=$P(BLRRES,U,4),BLRRES=$P(BLRRES,U) D RES1
D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("EXIT RESVRS^BLRTNA")
Q
;
RES1 ;EP - CALLED FROM BLRTN
D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("ENTER RES1^BLRTNA")
I BLRCMF'="C" S BLRDEL=$P($G(^BLRTXLOG(BLR("SEQUENCE NUMBER"),1)),U,2)="D" Q:BLRDEL
I BLRSPEC'="" S BLRZ=$G(^LAB(60,BLRTEST1,1,BLRSPEC,0)) I BLRZ'="" D
.S BLRRL=$P(BLRZ,U,2),BLRRH=$P(BLRZ,U,3),BLRUNITS=$P($P(BLRZ,U,7)," ")
.;[LR*5.2*1028;08/20/10;IHS/OIT/MPW]Added next 1 line
.I BLRUNITS=+BLRUNITS,$D(^BLRUCUM(BLRUNITS,0)) S BLRUNITS=$P($G(^BLRUCUM(BLRUNITS,0)),U,1)
.S AGE=$G(^BLRSITE(BLRQSITE,20,BLRQDH,1,BLRLTP,"AGE"))
.S SEX=$G(^BLRSITE(BLRQSITE,20,BLRQDH,1,BLRLTP,"SEX"))
.X:BLRRH'?.N "S BLRRH="_BLRRH X:BLRRL'?.N "S BLRRL="_BLRRL
.S BLR("UNITS")=BLRUNITS,BLR("REFERENCE HIGH")=BLRRH,BLR("REFERENCE LOW")=BLRRL
.K AGE,SEX
S BLR("RESULT")=BLRRES
S BLR("RESULT N/A FLAG")=BLRNAF
S BLR("STATUS FLAG")=$S(BLRRES="pending":"A",BLRRES'="":"R",1:"A") ;IHS/ITSC/TPF 08/15/01 ADDED TO HANDLE NO ANSWER FOR TEST
S BLRDUZN=$S($D(^VA(200,BLRDUZ,0)):$P($G(^VA(200,BLRDUZ,0)),U),1:"UNK"_BLRDUZ)
S BLR("VERIFIER POINTER")=BLRDUZ
D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("EXIT RES1^BLRTNA")
Q
;
CRSFLDS ;EP - CALLED FROM BLRTN
K BLR("REFERENCE HIGH"),BLR("REFERENCE LOW"),BLR("RESULT"),BLR("RESULT N/A FLAG")
Q
SETPRNT ;EP - CALLED BY BLRTN
D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("ENTER SETPRNT^BLRTNA")
K BLR
S BLRCDT=$G(^BLRSITE(BLRQSITE,20,BLRQDH,1,BLRLTP,"LRCDT"))\1
S BLR("STATUS FLAG")="R"
S BLRLTST=0
F S BLRLTST=$O(^BLRTXLOG("AAT",BLRACCN,BLRLTST)) Q:'BLRLTST S BLRSEQ=0 F S BLRSEQ=$O(^BLRTXLOG("AAT",BLRACCN,BLRLTST,BLRSEQ)) Q:'BLRSEQ I $P($G(^BLRTXLOG(BLRSEQ,12)),U)\1=BLRCDT S BLRANSEQ(BLRSEQ)=""
;
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
.;A CHILD WHOSE PARENT IS DISQUALIFIED
.;I 'BLRCMP,BLRPAR,BLRPAR(BLRPAR) Q
.I BLRPAR,BLRPAR(BLRPAR) Q
.;A PARENT
.I $D(BLRPAR(BLRSEQ)) D Q
..;I 'BLRCMP,BLRPAR(BLRSEQ) S:BLRPAR'="" BLRPAR(BLRPAR)=1 Q
..I BLRPAR(BLRSEQ) S:BLRPAR'="" BLRPAR(BLRPAR)=1 Q
..I 'BLRDEL S BLR("SEQUENCE NUMBER")=BLRSEQ,BLRIEN=BLRSEQ_",",BLRENT=BLRSEQ,BLRENTS(1)=BLRENT D ^BLRNFLTL Q
.;NOT A PARENT
.I $P($G(^BLRTXLOG(BLRSEQ,20)),U)="" D Q
..I BLRPAR,$P($G(^LAB(60,$P($G(^BLRTXLOG(BLRSEQ,0)),U,6),0)),U,17) S BLRPAR(BLRPAR)=1 Q
K BLRANSEQ,BLRHSEQ,BLRLSEQ,BLRLTST,BLRPAR
D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("EXIT SETPRNT^BLRTNA")
Q
;
GETIEN() ;EP - CALLED BY BLRTN
D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("ENTER GETIEN^BLRTNA")
S BLRERR=0
D
.I BLRCMF="C" D GETNEW Q
.S BLRCRGL="^BLRTXLOG("_BLRCRSBS_")"
.S BLRENT=$O(@BLRCRGL@(""),BLRDIR)
.S:'BLRENT BLRERR=1
.I BLRENT,BLROKCK'="" D @BLROKCK
.I 'BLRERR,BLRBADCK'="" D @BLRBADCK
.I BLRERR D EMSG^BLRTNA Q
.S BLRIEN=BLRENT_"," Q
D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("EXIT GETIEN^BLRTNA")
Q BLRENT
;
GETNEW ;EP - CALLED FROM BLRTNA
D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("ENTER GETNEW^BLRTNA")
S BLRENT=$G(^BLRTXLOG("SEQ"))
I 'BLRENT S BLRENT=$O(^BLRTXLOG("@"),-1) I BLRENT,'$D(^BLRTXLOG(1)) S BLRENT=0
F BLRENT=BLRENT+1:1 Q:'$D(^BLRTXLOG(BLRENT))
S BLRENTS="BLRENTS"
S BLRENTS(1)=BLRENT
S ^BLRTXLOG("SEQ")=BLRENT
S BLRIEN="+1,"
D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("EXIT GETNEW^BLRTNA")
Q
;
CHKDT ;EP - CALLED BY BLRTN
D:'BLRENT EMSG^BLRTNA Q:BLRERR
S BLRCDT=$P($G(^BLRTXLOG(BLRENT,12)),U)
I $E(BLRCDT,1,3)=$E(DT,1,3) S BLRIEN=BLRENT_"," Q
I ($E(BLRCDT,1,3)+1)'=$E(DT,1,3) S BLRERR=1,BLRDTER=1 Q ;MORE THAN 1 YEAR AHEAD
I $E(BLRCDT,4,5)<11 S BLRERR=1,BLRDTER=1 Q
S BLRIEN=BLRENT_"," Q
Q
;
CKORD ;EP - CALLED FROM BLRTN
D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("ENTER CKORD^BLRTNA")
S BLRERR=1
F D Q:'BLRENT!'BLRERR
.S BLRENT1=BLRENT
.F Q:'$P($G(^BLRTXLOG(BLRENT1,1)),U) S BLRENT1=$P(^BLRTXLOG(BLRENT1,1),U)
.D Q:'BLRERR
..I $D(LRAN) D Q
...I $D(^LRO(68,LRAA,1,LRAD,1,LRAN,4,$P($G(^BLRTXLOG(BLRENT1,0)),U,6))) S BLRERR=0 Q
..I $D(^LRO(69,BLRODTM,1,BLRSEQ,2,"B",$P($G(^BLRTXLOG(BLRENT1,0)),U,6))) S BLRERR=0 Q
.S BLRENT=$O(@BLRCRGL@(BLRENT),BLRDIR)
D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("EXIT CKORD^BLRTNA")
K BLRENT1
Q
EMSG ;EP - CALLED FROM BLRTN
; Log an error because the crossreference isn't set.
I 'BLRENT D
.S BLRERR=1,BLRERROR(1)="Something wrong -- problem with IHS Lab Transaction Log Cross Reference: "_BLRCRGL
Q
;
KILL ;EP - CALLED FROM BLRTN
K BLR,BLRARRAY,BLREMSG,BLRENTS,BLRERR,BLRERROR,BLRFDA,BLRI,BLRICNT,BLRIEN,BLRIENS,BLRIII,BLRLOGDA,BLRQUIET,BLRSFID,BLRSIEN,BLRSTOP,BLRT,BLRTCNT,BLRVL,BLRVR,BLRVRS
K ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,BLRESTR,BLRPT,BLRXQY0,BLRPC,BLRMI,BLRDTER
Q
BLRTNA ;IHS/ITSC/TPF - CREATE/EDIT TRANSACTIONS [ 12/19/2002 6:40 AM ]
+1 ;;5.2;IHS LABORATORY;**1028**;NOV 01, 1997;Build 46
+2 ;;5.2;LR;**1013,1015**;NOV 18, 2002
+3 ;
CPTCODE ;EP - CALLED FROM BLRTN,BLRTNB,BLRTNM1
+1 IF $GET(SNAPSHOT)
DO ENTRYAUD^BLRUTIL("ENTER CPTCODE^BLRTNA")
+2 SET BLRFOUND=0
SET (BLRXII,BLRCPTS,BLRCPTP)=""
FOR
SET BLRXII=$ORDER(^BLRCPT("C",BLRTEST1,BLRXII))
IF (BLRXII="")
QUIT
IF '$PIECE(^BLRCPT(BLRXII,1),U,2)
DO GETCPT
IF BLRFOUND
QUIT
+3 IF $GET(SNAPSHOT)
DO ENTRYAUD^BLRUTIL("EXIT CPTCODE^BLRTNA")
+4 QUIT
+5 ;
GETCPT ;EP - CALLED FROM BLRTN
+1 IF $GET(SNAPSHOT)
DO ENTRYAUD^BLRUTIL("ENTER GETCPT^BLRTNA")
+2 IF BLRODTM<$PIECE($GET(^BLRCPT(BLRXII,0)),U,3)
QUIT
+3 SET BLRFOUND=1
SET BLRCPTP=BLRXII
+4 ;---LR*5.2*1028;01/14/11;IHS/OIT/MPW- Corrected error in next line
+5 ;S BLRCPTN=0 F BLRNN=1:1 S BLRCPTN=$O(^BLRCPT(BLRXII,11,BLRCPTN)) Q:'BLRCPTN S BLRCPDAT=$g(^BLRCPT(BLRXII,11,BLRCPTN,0)),BLRCPCD=$P(BLRCPDAT,U),BLRCPCST=$P(BLRCPDAT,U,2),BLRCPRC=$P(BLRCPDAT,U,3),BLRCPACT=$P(BLRCPDAT,U,4) D
+6 SET BLRCPTN=0
FOR BLRNN=1:1
SET BLRCPTN=$ORDER(^BLRCPT(BLRXII,11,BLRCPTN))
IF 'BLRCPTN
QUIT
SET BLRCPDAT=$GET(^BLRCPT(BLRXII,11,BLRCPTN,0))
SET BLRCPCD=$PIECE(BLRCPDAT,U)
SET BLRCPCST=$PIECE(BLRCPDAT,U,2)
SET BLRCPRC=$PIECE(BLRCPDAT,U,3)
SET BLRCPACT=$PIECE(BLRCPDAT,U,4)
Begin DoDot:1
+7 SET (BLRCPTM,BLRCPTQ)=""
+8 SET BLRCPMN=0
FOR BLRNN1=1:1
SET BLRCPMN=$ORDER(^BLRCPT(BLRXII,11,BLRCPTN,1,BLRCPMN))
IF 'BLRCPMN
QUIT
IF BLRNN1>1
SET BLRCPTM=BLRCPTM_","
SET BLRCPTM=BLRCPTM_^BLRCPT(BLRXII,11,BLRCPTN,1,BLRCPMN,0)
+9 SET BLRCPQN=0
FOR BLRNN1=1:1
SET BLRCPQN=$ORDER(^BLRCPT(BLRXII,11,BLRCPTN,2,BLRCPQN))
IF 'BLRCPQN
QUIT
IF BLRNN1>1
SET BLRCPTQ=BLRCPTQ_","
SET BLRCPTQ=BLRCPTQ_$GET(^BLRCPT(BLRXII,11,BLRCPTN,2,BLRCPQN,0))
+10 IF BLRNN>1
SET BLRCPTS=BLRCPTS_";"
SET BLRCPTS=BLRCPTS_BLRCPCD_"|"_BLRCPCST_"|"_BLRCPRC_"|"_BLRCPACT_"|"_BLRCPTM_"|"_BLRCPTQ
End DoDot:1
+11 IF $GET(SNAPSHOT)
DO ENTRYAUD^BLRUTIL("EXIT GETCPT^BLRTNA")
+12 KILL BLRCPCD,BLRCPCST,BLRCPRC,BLRCPACT,BLRCPTN,BLRCPDAT,BLRCPTM,BLRCPMN,BLRCPTQ,BLRCPQN,BLRNN,BLRNN1
+13 QUIT
+14 ;
RESVRS ;EP - CALLED FROM BLRTN
+1 IF $GET(SNAPSHOT)
DO ENTRYAUD^BLRUTIL("ENTER RESVRS^BLRTNA")
+2 SET BLRCREF=$PIECE(BLRL60,U,5)
+3 IF BLRSS=$PIECE(BLRCREF,";")
IF $DATA(BLRRVS($PIECE(BLRCREF,";",2)))
SET BLRRES=BLRRVS($PIECE(BLRCREF,";",2))
SET BLRNAF=$PIECE(BLRRES,U,2)
SET BLRDUZ=$PIECE(BLRRES,U,4)
SET BLRRES=$PIECE(BLRRES,U)
DO RES1
+4 IF $GET(SNAPSHOT)
DO ENTRYAUD^BLRUTIL("EXIT RESVRS^BLRTNA")
+5 QUIT
+6 ;
RES1 ;EP - CALLED FROM BLRTN
+1 IF $GET(SNAPSHOT)
DO ENTRYAUD^BLRUTIL("ENTER RES1^BLRTNA")
+2 IF BLRCMF'="C"
SET BLRDEL=$PIECE($GET(^BLRTXLOG(BLR("SEQUENCE NUMBER"),1)),U,2)="D"
IF BLRDEL
QUIT
+3 IF BLRSPEC'=""
SET BLRZ=$GET(^LAB(60,BLRTEST1,1,BLRSPEC,0))
IF BLRZ'=""
Begin DoDot:1
+4 SET BLRRL=$PIECE(BLRZ,U,2)
SET BLRRH=$PIECE(BLRZ,U,3)
SET BLRUNITS=$PIECE($PIECE(BLRZ,U,7)," ")
+5 ;[LR*5.2*1028;08/20/10;IHS/OIT/MPW]Added next 1 line
+6 IF BLRUNITS=+BLRUNITS
IF $DATA(^BLRUCUM(BLRUNITS,0))
SET BLRUNITS=$PIECE($GET(^BLRUCUM(BLRUNITS,0)),U,1)
+7 SET AGE=$GET(^BLRSITE(BLRQSITE,20,BLRQDH,1,BLRLTP,"AGE"))
+8 SET SEX=$GET(^BLRSITE(BLRQSITE,20,BLRQDH,1,BLRLTP,"SEX"))
+9 IF BLRRH'?.N
XECUTE "S BLRRH="_BLRRH
IF BLRRL'?.N
XECUTE "S BLRRL="_BLRRL
+10 SET BLR("UNITS")=BLRUNITS
SET BLR("REFERENCE HIGH")=BLRRH
SET BLR("REFERENCE LOW")=BLRRL
+11 KILL AGE,SEX
End DoDot:1
+12 SET BLR("RESULT")=BLRRES
+13 SET BLR("RESULT N/A FLAG")=BLRNAF
+14 ;IHS/ITSC/TPF 08/15/01 ADDED TO HANDLE NO ANSWER FOR TEST
SET BLR("STATUS FLAG")=$SELECT(BLRRES="pending":"A",BLRRES'="":"R",1:"A")
+15 SET BLRDUZN=$SELECT($DATA(^VA(200,BLRDUZ,0)):$PIECE($GET(^VA(200,BLRDUZ,0)),U),1:"UNK"_BLRDUZ)
+16 SET BLR("VERIFIER POINTER")=BLRDUZ
+17 IF $GET(SNAPSHOT)
DO ENTRYAUD^BLRUTIL("EXIT RES1^BLRTNA")
+18 QUIT
+19 ;
CRSFLDS ;EP - CALLED FROM BLRTN
+1 KILL BLR("REFERENCE HIGH"),BLR("REFERENCE LOW"),BLR("RESULT"),BLR("RESULT N/A FLAG")
+2 QUIT
SETPRNT ;EP - CALLED BY BLRTN
+1 IF $GET(SNAPSHOT)
DO ENTRYAUD^BLRUTIL("ENTER SETPRNT^BLRTNA")
+2 KILL BLR
+3 SET BLRCDT=$GET(^BLRSITE(BLRQSITE,20,BLRQDH,1,BLRLTP,"LRCDT"))\1
+4 SET BLR("STATUS FLAG")="R"
+5 SET BLRLTST=0
+6 FOR
SET BLRLTST=$ORDER(^BLRTXLOG("AAT",BLRACCN,BLRLTST))
IF 'BLRLTST
QUIT
SET BLRSEQ=0
FOR
SET BLRSEQ=$ORDER(^BLRTXLOG("AAT",BLRACCN,BLRLTST,BLRSEQ))
IF 'BLRSEQ
QUIT
IF $PIECE($GET(^BLRTXLOG(BLRSEQ,12)),U)\1=BLRCDT
SET BLRANSEQ(BLRSEQ)=""
+7 ;
+8 SET BLRSEQ=""
+9 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
+10 ;A CHILD WHOSE PARENT IS DISQUALIFIED
+11 ;I 'BLRCMP,BLRPAR,BLRPAR(BLRPAR) Q
+12 IF BLRPAR
IF BLRPAR(BLRPAR)
QUIT
+13 ;A PARENT
+14 IF $DATA(BLRPAR(BLRSEQ))
Begin DoDot:2
+15 ;I 'BLRCMP,BLRPAR(BLRSEQ) S:BLRPAR'="" BLRPAR(BLRPAR)=1 Q
+16 IF BLRPAR(BLRSEQ)
IF BLRPAR'=""
SET BLRPAR(BLRPAR)=1
QUIT
+17 IF 'BLRDEL
SET BLR("SEQUENCE NUMBER")=BLRSEQ
SET BLRIEN=BLRSEQ_","
SET BLRENT=BLRSEQ
SET BLRENTS(1)=BLRENT
DO ^BLRNFLTL
QUIT
End DoDot:2
QUIT
+18 ;NOT A PARENT
+19 IF $PIECE($GET(^BLRTXLOG(BLRSEQ,20)),U)=""
Begin DoDot:2
+20 IF BLRPAR
IF $PIECE($GET(^LAB(60,$PIECE($GET(^BLRTXLOG(BLRSEQ,0)),U,6),0)),U,17)
SET BLRPAR(BLRPAR)=1
QUIT
End DoDot:2
QUIT
End DoDot:1
+21 KILL BLRANSEQ,BLRHSEQ,BLRLSEQ,BLRLTST,BLRPAR
+22 IF $GET(SNAPSHOT)
DO ENTRYAUD^BLRUTIL("EXIT SETPRNT^BLRTNA")
+23 QUIT
+24 ;
GETIEN() ;EP - CALLED BY BLRTN
+1 IF $GET(SNAPSHOT)
DO ENTRYAUD^BLRUTIL("ENTER GETIEN^BLRTNA")
+2 SET BLRERR=0
+3 Begin DoDot:1
+4 IF BLRCMF="C"
DO GETNEW
QUIT
+5 SET BLRCRGL="^BLRTXLOG("_BLRCRSBS_")"
+6 SET BLRENT=$ORDER(@BLRCRGL@(""),BLRDIR)
+7 IF 'BLRENT
SET BLRERR=1
+8 IF BLRENT
IF BLROKCK'=""
DO @BLROKCK
+9 IF 'BLRERR
IF BLRBADCK'=""
DO @BLRBADCK
+10 IF BLRERR
DO EMSG^BLRTNA
QUIT
+11 SET BLRIEN=BLRENT_","
QUIT
End DoDot:1
+12 IF $GET(SNAPSHOT)
DO ENTRYAUD^BLRUTIL("EXIT GETIEN^BLRTNA")
+13 QUIT BLRENT
+14 ;
GETNEW ;EP - CALLED FROM BLRTNA
+1 IF $GET(SNAPSHOT)
DO ENTRYAUD^BLRUTIL("ENTER GETNEW^BLRTNA")
+2 SET BLRENT=$GET(^BLRTXLOG("SEQ"))
+3 IF 'BLRENT
SET BLRENT=$ORDER(^BLRTXLOG("@"),-1)
IF BLRENT
IF '$DATA(^BLRTXLOG(1))
SET BLRENT=0
+4 FOR BLRENT=BLRENT+1:1
IF '$DATA(^BLRTXLOG(BLRENT))
QUIT
+5 SET BLRENTS="BLRENTS"
+6 SET BLRENTS(1)=BLRENT
+7 SET ^BLRTXLOG("SEQ")=BLRENT
+8 SET BLRIEN="+1,"
+9 IF $GET(SNAPSHOT)
DO ENTRYAUD^BLRUTIL("EXIT GETNEW^BLRTNA")
+10 QUIT
+11 ;
CHKDT ;EP - CALLED BY BLRTN
+1 IF 'BLRENT
DO EMSG^BLRTNA
IF BLRERR
QUIT
+2 SET BLRCDT=$PIECE($GET(^BLRTXLOG(BLRENT,12)),U)
+3 IF $EXTRACT(BLRCDT,1,3)=$EXTRACT(DT,1,3)
SET BLRIEN=BLRENT_","
QUIT
+4 ;MORE THAN 1 YEAR AHEAD
IF ($EXTRACT(BLRCDT,1,3)+1)'=$EXTRACT(DT,1,3)
SET BLRERR=1
SET BLRDTER=1
QUIT
+5 IF $EXTRACT(BLRCDT,4,5)<11
SET BLRERR=1
SET BLRDTER=1
QUIT
+6 SET BLRIEN=BLRENT_","
QUIT
+7 QUIT
+8 ;
CKORD ;EP - CALLED FROM BLRTN
+1 IF $GET(SNAPSHOT)
DO ENTRYAUD^BLRUTIL("ENTER CKORD^BLRTNA")
+2 SET BLRERR=1
+3 FOR
Begin DoDot:1
+4 SET BLRENT1=BLRENT
+5 FOR
IF '$PIECE($GET(^BLRTXLOG(BLRENT1,1)),U)
QUIT
SET BLRENT1=$PIECE(^BLRTXLOG(BLRENT1,1),U)
+6 Begin DoDot:2
+7 IF $DATA(LRAN)
Begin DoDot:3
+8 IF $DATA(^LRO(68,LRAA,1,LRAD,1,LRAN,4,$PIECE($GET(^BLRTXLOG(BLRENT1,0)),U,6)))
SET BLRERR=0
QUIT
End DoDot:3
QUIT
+9 IF $DATA(^LRO(69,BLRODTM,1,BLRSEQ,2,"B",$PIECE($GET(^BLRTXLOG(BLRENT1,0)),U,6)))
SET BLRERR=0
QUIT
End DoDot:2
IF 'BLRERR
QUIT
+10 SET BLRENT=$ORDER(@BLRCRGL@(BLRENT),BLRDIR)
End DoDot:1
IF 'BLRENT!'BLRERR
QUIT
+11 IF $GET(SNAPSHOT)
DO ENTRYAUD^BLRUTIL("EXIT CKORD^BLRTNA")
+12 KILL BLRENT1
+13 QUIT
EMSG ;EP - CALLED FROM BLRTN
+1 ; Log an error because the crossreference isn't set.
+2 IF 'BLRENT
Begin DoDot:1
+3 SET BLRERR=1
SET BLRERROR(1)="Something wrong -- problem with IHS Lab Transaction Log Cross Reference: "_BLRCRGL
End DoDot:1
+4 QUIT
+5 ;
KILL ;EP - CALLED FROM BLRTN
+1 KILL BLR,BLRARRAY,BLREMSG,BLRENTS,BLRERR,BLRERROR,BLRFDA,BLRI,BLRICNT,BLRIEN,BLRIENS,BLRIII,BLRLOGDA,BLRQUIET,BLRSFID,BLRSIEN,BLRSTOP,BLRT,BLRTCNT,BLRVL,BLRVR,BLRVRS
+2 KILL ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,BLRESTR,BLRPT,BLRXQY0,BLRPC,BLRMI,BLRDTER
+3 QUIT
