BLRFLTL(BLRCMF,BLRVARS,BLRFLDS) ; IHS/DIR/MJL - SILENT DIE CALLS TO UPDATE TRANSACTION LOG ; 22-Oct-2013 09:22 ; MKK
;;5.2;LR;**1001,1003,1006,1007,1008,1009,1021,1027,1033**;NOV 01, 1997
;
; D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("ENTER ^BLRFLTL")
D ENTRYAUD^BLRUTIL("ENTER ^BLRFLTL") ; IHS/OIT/MKK - LR*5.2*1033
S U="^",BLRFID=9009022,BLRERR=0,BLRICNT=0 S:BLRCMF="C" BLRICNT=1 ;IHS/OIRM TUC/MJL 2/10/98
D SETVALS
I 'BLRERR S:'BLRPCC BLRFDA(BLRFID,BLRIEN,BLRF(0,"PCC ERROR FLAG"))="PCC LINK DISABLED" D FILE
I BLRPCC,'$D(BLRERF),'BLRERR D LOG
;D:BLRERR BULERR
I '(+$G(BLRDTER)),BLRERR D BULERR ;IHS/DIR TUC/AAB 05/18/98
D KILL
Q
;
SETVALS ; EP - IHS/OIT/MKK -- Need "EP" for SAC
; D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("ENTER SETVALS^BLRFLTL")
D ENTRYAUD^BLRUTIL("ENTER SETVALS^BLRFLTL") ; IHS/OIT/MKK - LR*5.2*1033
F BLRI=1:1:$L(BLRVARS,"~") S BLRARRAY=0,BLRVRS=$P(BLRVARS,"~",BLRI),BLRVR=$P(BLRVRS,"_",1),BLRVL=$P(BLRVRS,"_",2) D Q:BLRERR I 'BLRARRAY,$D(BLRF(0,BLRVR)),BLR(BLRVR)'="" S BLRFDA(BLRFID,BLRIEN,BLRF(0,BLRVR))=BLR(BLRVR)
.I $E(BLRVR)'="@" D Q
..I BLRVL?.N S BLR(BLRVR)=BLRVL Q
..I BLRVL?1"""".E1"""" S BLR(BLRVR)=$E(BLRVL,2,$L(BLRVL)-1) Q
..I $E(BLRVL)=U S BLR(BLRVR)=@BLRVL Q
..I BLRVL?1U.UN D Q
...I '$D(BLRF(0,BLRVR,"TYPE")) S BLR(BLRVR)=@BLRVL Q
...S BLRARRAY=1
...I BLRF(0,BLRVR,"TYPE")="M" D MULTI Q
...D WORD Q
..X "S BLR(BLRVR)="_BLRVL Q
.S BLRVR=$P(BLRVR,"@",2)
.I BLRVL?.N S @BLRVR=BLRVL Q
.I BLRVL?1"""".E1"""" S @BLRVR=$E(BLRVL,2,$L(BLRVL)-1) Q
.I $E(BLRVL)=U S @BLRVR=@BLRVL Q
.I BLRVL?1U.UN S @BLRVR=@BLRVL Q
.X "S @BLRVR="_BLRVL Q
Q
;
MULTI ; EP - IHS/OIT/MKK -- Need "EP" for SAC
; D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("ENTER MULTI^BLRFLTL")
D ENTRYAUD^BLRUTIL("ENTER MULTI^BLRFLTL") ; IHS/OIT/MKK - LR*5.2*1033
I BLRCMF="M",BLRVR="COMMENTS" S BLRMI="" F S BLRMI=$O(^BLRTXLOG(BLRENT,30,BLRMI)) Q:BLRMI="" S DA=BLRMI,DA(1)=BLRENT,DIK="^BLRTXLOG("_DA(1)_","_30_"," D ^DIK ;IHS/OIRM TUC/AAB 2/10/98
S BLRSFID=BLRFID,BLRSIEN=BLRIEN,BLRFID=BLRF(0,BLRVR,"FILE"),BLRVL=@BLRVL
;F BLRIII=1:1:$L(BLRVL,$C(20)) S BLRIEN=(BLRIII+BLRENT)_","_BLRSIEN,(BLRSSTR,BLRFDA(BLRFID,BLRIEN,BLRF(0,BLRVR)))=$P(BLRVL,$C(20),BLRIII)
F BLRIII=1:1:$L(BLRVL,$C(20)) S BLRICNT=BLRICNT+1,BLRIEN="+"_BLRICNT_","_BLRSIEN,(BLRSSTR,BLRFDA(BLRFID,BLRIEN,BLRF(0,BLRVR)))=$P(BLRVL,$C(20),BLRIII) ;IHS/OIRM TUC/MJL 2/10/98
S BLRFID=BLRSFID,BLRIEN=BLRSIEN
Q
;
WORD ; EP - IHS/OIT/MKK -- Need "EP" for SAC
Q
;
FILE ; EP - IHS/OIT/MKK -- Need "EP" for SAC
;
; D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("ENTER FILE^BLRFLTL")
D ENTRYAUD^BLRUTIL("ENTER FILE^BLRFLTL") ; IHS/OIT/MKK - LR*5.2*1033
L +^BLRTXLOG(BLRENT):300
; If after attempting for 300 seconds the lock fails proceed anyway
S BLRFDA="BLRFDA"
D
.I BLRCMF="C" D UPDATE^DIE("",BLRFDA,BLRENTS,"BLREMSG") Q
.D UPDATE^DIE("",BLRFDA,"","BLREMSG") Q
S:$D(BLREMSG) BLRERR=1
L -^BLRTXLOG(BLRENT) ;IHS/OIRM TUC/MJL 5/21/98
Q
;
GETIEN(BLRSB1,BLRSB2,BLRSB3) ; EP - IHS/OIT/MKK -- Need "EP" for SAC
; D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("ENTER GETIEN^BLRFLTL")
D ENTRYAUD^BLRUTIL("ENTER GETIEN^BLRFLTL") ; IHS/OIT/MKK - LR*5.2*1033
D
.I BLRCMF="C" D GETNEW Q
.I BLRPHASE="O" S BLRCRGL="^BLRTXLOG(""AOT"","_BLRSB1_","_BLRSB2_","_BLRSB3_")",BLRENT=$O(^BLRTXLOG("AOT",BLRSB1,BLRSB2,BLRSB3,""),-1) D:'BLRENT CKORD D:BLRERR EMSG Q:BLRERR S BLRIEN=BLRENT_"," Q
.I $D(BLRSB3) S BLRCRGL="^BLRTXLOG(""AOT"","_BLRSB1_","_BLRSB2_","_BLRSB3_")",BLRENT=$O(^BLRTXLOG("AOT",BLRSB1,BLRSB2,BLRSB3,""),-1) D:'BLRENT CKORD D:BLRERR EMSG Q:BLRERR S BLRIEN=BLRENT_"," Q
.;S BLRCRGL="^BLRTXLOG(""AAT"","_BLRSB1_","_BLRSB2_")" S BLRENT=$O(^BLRTXLOG("AAT",BLRSB1,BLRSB2,""),-1) D:'BLRENT EMSG Q:BLRERR S BLRIEN=BLRENT_"," Q
.;IHS/DIR TUC/AAB 05/07/98
.S BLRCRGL="^BLRTXLOG(""AAT"","_BLRSB1_","_BLRSB2_")" S BLRENT=$O(^BLRTXLOG("AAT",BLRSB1,BLRSB2,""),-1)
.D:'BLRENT EMSG Q:BLRERR
.S BLRCDT=$P(^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 BLRENT
;
GETOGIEN(BLRSB1,BLRSB2,BLRSB3) ; EP - IHS/OIT/MKK -- Need "EP" for SAC
; D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("ENTER GETOGIEN^BLRFLTL")
D ENTRYAUD^BLRUTIL("ENTER GETOGIEN^BLRFLTL") ; IHS/OIT/MKK - LR*5.2*1033
D
.I BLRCMF="C" D GETNEW Q
.I '$D(BLRSB3) S BLRCRGL="^BLRTXLOG(""AOG"","_BLRSB1_","_BLRSB2_")",BLRENT=$O(^BLRTXLOG("AOG",BLRSB1,BLRSB2,""),-1) D:'BLRENT EMSG Q:BLRERR S BLRIEN=BLRENT_"," Q
.S BLRCRGL="^BLRTXLOG(""AOD"","_BLRSB1_","_BLRSB2_","_BLRSB3_")",BLRENT=$O(^BLRTXLOG("AOD",BLRSB1,BLRSB2,BLRSB3,""),-1) D:'BLRENT EMSG Q:BLRERR S BLRIEN=BLRENT_"," Q
Q BLRENT
;
GETBIEN(BLRSB1,BLRSB2,BLRSB3) ; EP - IHS/OIT/MKK -- Need "EP" for SAC
; D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("ENTER GETBIEN^BLRFLTL")
D ENTRYAUD^BLRUTIL("ENTER GETBIEN^BLRFLTL") ; IHS/OIT/MKK - LR*5.2*1033
D
.I BLRCMF="C" D GETNEW Q
.;I '$D(BLRSB3) S BLRCRGL="^BLRTXLOG(""AOB"","_BLRSB1_","_BLRSB2_")",BLRENT=$O(^BLRTXLOG("AOB",BLRSB1,BLRSB2,""),-1) D:'BLRENT EMSG Q:BLRERR S BLRIEN=BLRENT_"," Q
.I '$D(BLRSB3) S BLRCRGL="^BLRTXLOG(""AOB"","_BLRSB1_","_BLRSB2_")",BLRENT=$O(^BLRTXLOG("AOB",BLRSB1,BLRSB2,""),-1) D CHKDT Q ;IHS/DIR TUC/AAB 05/07/98
.;S BLRCRGL="^BLRTXLOG(""AOA"","_BLRSB1_","_BLRSB2_","_BLRSB3_")",BLRENT=$O(^BLRTXLOG("AOA",BLRSB1,BLRSB2,BLRSB3,""),-1) D:'BLRENT EMSG Q:BLRERR S BLRIEN=BLRENT_"," Q
.S BLRCRGL="^BLRTXLOG(""AOA"","_BLRSB1_","_BLRSB2_","_BLRSB3_")",BLRENT=$O(^BLRTXLOG("AOA",BLRSB1,BLRSB2,BLRSB3,""),-1) D CHKDT Q ;IHS/DIR TUC/AAB 05/07/98
Q BLRENT
;
CHKDT ; EP - IHS/OIT/MKK -- Need "EP" for SAC -- IHS/DIR TUC/AAB 05/07/98
; D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("ENTER CHKDT^BLRFLTL")
D ENTRYAUD^BLRUTIL("ENTER CHKDT^BLRFLTL") ; IHS/OIT/MKK - LR*5.2*1033
D:'BLRENT EMSG Q:BLRERR
S BLRCDT=$P(^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
GETOSIEN(BLRSB1,BLRSB2,BLRSB3) ; EP - IHS/OIT/MKK -- Need "EP" for SAC
; D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("ENTER GETOSIEN^BLRFLTL")
D ENTRYAUD^BLRUTIL("ENTER GETOSIEN^BLRFLTL") ; IHS/OIT/MKK - LR*5.2*1033
D
.I BLRCMF="C" D GETNEW Q
.I '$D(BLRSB3) S BLRCRGL="^BLRTXLOG(""AOG"","_BLRSB1_","_BLRSB2_")",BLRENT=$O(^BLRTXLOG("AOG",BLRSB1,BLRSB2,""),-1) D:'BLRENT EMSG Q:BLRERR S BLRIEN=BLRENT_"," Q
.S BLRCRGL="^BLRTXLOG(""AOS"","_BLRSB1_","_BLRSB2_","_BLRSB3_")",BLRENT=$O(^BLRTXLOG("AOS",BLRSB1,BLRSB2,BLRSB3,""),-1) D:'BLRENT EMSG Q:BLRERR S BLRIEN=BLRENT_"," Q
Q BLRENT
;
EMSG ; EP - IHS/OIT/MKK -- Need "EP" for SAC
; 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
;
CKORD ; EP - IHS/OIT/MKK -- Need "EP" for SAC
S BLRERR=1,BLRENT=^BLRTXLOG("SEQ")+1 ;IHS/DIR/MJL BLRERR=1 7/15/99
F BLRTRY=1:1:1000 S BLRENT=$O(^BLRTXLOG(BLRENT),-1) Q:'BLRENT I $P(^BLRTXLOG(BLRENT,11),U,3)=$G(BLR("ORDER NUMBER"),LRORD),$P(^BLRTXLOG(BLRENT,0),U,6)=BLRSB3 S BLRERR=0 Q
S:BLRERR BLRENT=0 K BLRTRY
Q
;
GETNEW ; EP - IHS/OIT/MKK -- Need "EP" for SAC
; L +^BLRTXLOG("SEQ")
L +^BLRTXLOG("SEQ"):5 I '$T H 5 G GETNEW ; IHS/OIT/MKK - LR*5.2*1033
S BLRENT=$G(^BLRTXLOG("SEQ"))
I 'BLRENT S BLRENT=$O(^BLRTXLOG("@"),-1) I BLRENT,'$D(^BLRTXLOG(1)) S BLRENT=0
;IHS/DIR TUC/MJL 12/4/98
;S BLRENT=BLRENT+1 S:$D(^BLRTXLOG(BLRENT)) BLRENT=$O(^BLRTXLOG("@"),-1)+1
;IHS/DIR TUC/MJL 12/4/98
F BLRENT=BLRENT+1:1 Q:'$D(^BLRTXLOG(BLRENT))
S BLRENTS="BLRENTS",BLRENTS(1)=BLRENT,^BLRTXLOG("SEQ")=BLRENT,BLRIEN="+1,"
L -^BLRTXLOG("SEQ")
Q
;
LOG ; EP - IHS/OIT/MKK -- Need "EP" for SAC
;S BLRDH=+$H,BLRLTA=$P($G(^BLRSITE(DUZ(2),21,BLRDH,0)),U,2)+1
S BLRDH=+$H
; L +^BLRSITE(BLRQSITE,21,BLRDH,0)
L +^BLRSITE(BLRQSITE,21,BLRDH,0):5 I '$T H 5 G LOG ; IHS/OIT/MKK - LR*5.2*1033
S BLRLTA=$P($G(^BLRSITE(BLRQSITE,21,BLRDH,0)),U,2)+1
;I BLRLTA=1 S %H=$H D YX^%DTC S $P(^BLRSITE(DUZ(2),21,BLRDH,0),U,1)=X
I BLRLTA=1 S %H=$H D YX^%DTC S $P(^BLRSITE(BLRQSITE,21,BLRDH,0),U,1)=X ;IHS/DIR TUC/AAB 04/07/98
;S ^BLRSITE(DUZ(2),21,BLRDH,BLRLTA)=BLRENT,$P(^BLRSITE(DUZ(2),21,BLRDH,0),U,2)=BLRLTA
S ^BLRSITE(BLRQSITE,21,BLRDH,BLRLTA)=BLRENT,$P(^BLRSITE(BLRQSITE,21,BLRDH,0),U,2)=BLRLTA ;IHS/DIR TUC/AAB 04/07/09
L -^BLRSITE(BLRQSITE,21,BLRDH,0)
Q
;
BULERR ; EP - IHS/OIT/MKK -- Need "EP" for SAC
NEW ERROR714 ; IHS/OIT/MKK - LR*5.2*1027
S ERROR714="NO" ; IHS/OIT/MKK - LR*5.2*1027
;BLRTXLOG ERROR
D:$D(BLREMSG)
.; D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("BULERR^BLRFLTL 1.0","BLREMSG")
. D ENTRYAUD^BLRUTIL("BULERR^BLRFLTL 1.0","BLREMSG") ; IHS/OIT/MKK - LR*5.2*1033
.S (BLRECNT,BLRTCNT)=0 F S BLRECNT=$O(BLREMSG("DIERR",BLRECNT)) Q:'BLRECNT D
..S BLRTCNT=BLRTCNT+1,BLRERROR(BLRTCNT)="Error code = "_BLREMSG("DIERR",BLRECNT)
..S:+$G(BLREMSG("DIERR",BLRECNT))=714 ERROR714="YES" ; IHS/OIT/MKK - LR*5.2*1027
..S BLRELCNT=0 F S BLRELCNT=$O(BLREMSG("DIERR",BLRECNT,"TEXT",BLRELCNT)) Q:'BLRELCNT S BLRTCNT=BLRTCNT+1,BLRERROR(BLRTCNT)=BLREMSG("DIERR",BLRECNT,"TEXT",BLRELCNT)
.K BLRECNT,BLRELCNT
;D:$D(BLR)
D:+$G(BLR("SEQUENCE NUMBER")) ;IHS/DIR TUC/AAB 03/27/98
.S BLRV="",BLRTCNT=$G(BLRTCNT,1),BLRERROR(BLRTCNT+1)="",BLRERROR(BLRTCNT+2)="VARIABLES:",BLRERROR(BLRTCNT+3)="",BLRTCNT=BLRTCNT+3
.S BLRV="" F S BLRV=$O(BLR(BLRV)) Q:BLRV="" S BLRTCNT=BLRTCNT+1,BLRERROR(BLRTCNT)=$J("",10)_BLRV_$J("",35-$L(BLRV))_BLR(BLRV)
S BLRTCNT=$G(BLRTCNT,1)
F BLRPC=1:1 S BLRESTR=$P($T(PARSE+BLRPC),";",3) Q:BLRESTR="" D
.S BLRXQY0=$P(XQY0,U,2) S:$D(BLRTEST1) BLRPT=$P(^LAB(60,BLRTEST1,0),U)
.S:$D(@($P(BLRESTR,"|",2))) BLRTCNT=BLRTCNT+1,BLRERROR(BLRTCNT)=$P(BLRESTR,"|")_@($P(BLRESTR,"|",2))
; S XMB="BLRTXERR",XMTEXT="BLRERROR" S BLRDUZ=DUZ,DUZ=.5 D ^XMB S DUZ=BLRDUZ K ^TMP("XMBTEXT",$J)
; ----- BEGIN IHS/OIT/MKK - LR*5.2*1027
; D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("BULERR^BLRFLTL 2.0","BLRERROR")
D ENTRYAUD^BLRUTIL("BULERR^BLRFLTL 2.0","BLRERROR") ; IHS/OIT/MKK - LR*5.2*1033
S XMB="BLRTXERR"
S XMTEXT="BLRERROR"
S XMDUZ=$S(ERROR714="YES":"714 Error",1:"POSTMASTER")
D ^XMB
K ^TMP("XMBTEXT",$J)
; ----- END IHS/OIT/MKK - LR*5.2*1027
Q
;
KILL ; EP - IHS/OIT/MKK -- Need "EP" for SAC
;K BLR,BLRARRAY,BLREMSG,BLRENTS,BLRERR,BLRERROR,BLRFDA,BLRI,BLRIEN,BLRIENS,BLRIII,BLRLOGDA,BLRQUIET,BLRSFID,BLRSIEN,BLRT,BLRTCNT,BLRVL,BLRVR,BLRVRS,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE
K BLR,BLRARRAY,BLREMSG,BLRENTS,BLRERR,BLRERROR,BLRFDA,BLRI,BLRICNT,BLRIEN,BLRIENS,BLRIII,BLRLOGDA,BLRQUIET,BLRSFID,BLRSIEN,BLRT,BLRTCNT,BLRVL,BLRVR,BLRVRS
K ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,BLRESTR,BLRPT,BLRXQY0,BLRPC,BLRMI,BLRDTER ;IHS/OIRM TUC/MJL 2/10/98
Q
PARSE ; EP - IHS/OIT/MKK -- Need "EP" for SAC - IHS/DIR TUC/AAB 03/27/98
;;Patient Name: |PNM
;;Panel/Test: |BLRPT
;;Order Number: |LRORD
;;Accession Number: |BLRACCN
;;DUZ: |DUZ
;;DUZ(2): |BLRDUZ2
;;BLROPT1: |BLROPT1
;;BLROPT(0): |BLROPT(0)
;;XQY0: |BLRXQY0
Q
BLRFLTL(BLRCMF,BLRVARS,BLRFLDS) ; IHS/DIR/MJL - SILENT DIE CALLS TO UPDATE TRANSACTION LOG ; 22-Oct-2013 09:22 ; MKK
+1 ;;5.2;LR;**1001,1003,1006,1007,1008,1009,1021,1027,1033**;NOV 01, 1997
+2 ;
+3 ; D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("ENTER ^BLRFLTL")
+4 ; IHS/OIT/MKK - LR*5.2*1033
DO ENTRYAUD^BLRUTIL("ENTER ^BLRFLTL")
+5 ;IHS/OIRM TUC/MJL 2/10/98
SET U="^"
SET BLRFID=9009022
SET BLRERR=0
SET BLRICNT=0
IF BLRCMF="C"
SET BLRICNT=1
+6 DO SETVALS
+7 IF 'BLRERR
IF 'BLRPCC
SET BLRFDA(BLRFID,BLRIEN,BLRF(0,"PCC ERROR FLAG"))="PCC LINK DISABLED"
DO FILE
+8 IF BLRPCC
IF '$DATA(BLRERF)
IF 'BLRERR
DO LOG
+9 ;D:BLRERR BULERR
+10 ;IHS/DIR TUC/AAB 05/18/98
IF '(+$GET(BLRDTER))
IF BLRERR
DO BULERR
+11 DO KILL
+12 QUIT
+13 ;
SETVALS ; EP - IHS/OIT/MKK -- Need "EP" for SAC
+1 ; D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("ENTER SETVALS^BLRFLTL")
+2 ; IHS/OIT/MKK - LR*5.2*1033
DO ENTRYAUD^BLRUTIL("ENTER SETVALS^BLRFLTL")
+3 FOR BLRI=1:1:$LENGTH(BLRVARS,"~")
SET BLRARRAY=0
SET BLRVRS=$PIECE(BLRVARS,"~",BLRI)
SET BLRVR=$PIECE(BLRVRS,"_",1)
SET BLRVL=$PIECE(BLRVRS,"_",2)
Begin DoDot:1
+4 IF $EXTRACT(BLRVR)'="@"
Begin DoDot:2
+5 IF BLRVL?.N
SET BLR(BLRVR)=BLRVL
QUIT
+6 IF BLRVL?1"""".E1""""
SET BLR(BLRVR)=$EXTRACT(BLRVL,2,$LENGTH(BLRVL)-1)
QUIT
+7 IF $EXTRACT(BLRVL)=U
SET BLR(BLRVR)=@BLRVL
QUIT
+8 IF BLRVL?1U.UN
Begin DoDot:3
+9 IF '$DATA(BLRF(0,BLRVR,"TYPE"))
SET BLR(BLRVR)=@BLRVL
QUIT
+10 SET BLRARRAY=1
+11 IF BLRF(0,BLRVR,"TYPE")="M"
DO MULTI
QUIT
+12 DO WORD
QUIT
End DoDot:3
QUIT
+13 XECUTE "S BLR(BLRVR)="_BLRVL
QUIT
End DoDot:2
QUIT
+14 SET BLRVR=$PIECE(BLRVR,"@",2)
+15 IF BLRVL?.N
SET @BLRVR=BLRVL
QUIT
+16 IF BLRVL?1"""".E1""""
SET @BLRVR=$EXTRACT(BLRVL,2,$LENGTH(BLRVL)-1)
QUIT
+17 IF $EXTRACT(BLRVL)=U
SET @BLRVR=@BLRVL
QUIT
+18 IF BLRVL?1U.UN
SET @BLRVR=@BLRVL
QUIT
+19 XECUTE "S @BLRVR="_BLRVL
QUIT
End DoDot:1
IF BLRERR
QUIT
IF 'BLRARRAY
IF $DATA(BLRF(0,BLRVR))
IF BLR(BLRVR)'=""
SET BLRFDA(BLRFID,BLRIEN,BLRF(0,BLRVR))=BLR(BLRVR)
+20 QUIT
+21 ;
MULTI ; EP - IHS/OIT/MKK -- Need "EP" for SAC
+1 ; D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("ENTER MULTI^BLRFLTL")
+2 ; IHS/OIT/MKK - LR*5.2*1033
DO ENTRYAUD^BLRUTIL("ENTER MULTI^BLRFLTL")
+3 ;IHS/OIRM TUC/AAB 2/10/98
IF BLRCMF="M"
IF BLRVR="COMMENTS"
SET BLRMI=""
FOR
SET BLRMI=$ORDER(^BLRTXLOG(BLRENT,30,BLRMI))
IF BLRMI=""
QUIT
SET DA=BLRMI
SET DA(1)=BLRENT
SET DIK="^BLRTXLOG("_DA(1)_","_30_","
DO ^DIK
+4 SET BLRSFID=BLRFID
SET BLRSIEN=BLRIEN
SET BLRFID=BLRF(0,BLRVR,"FILE")
SET BLRVL=@BLRVL
+5 ;F BLRIII=1:1:$L(BLRVL,$C(20)) S BLRIEN=(BLRIII+BLRENT)_","_BLRSIEN,(BLRSSTR,BLRFDA(BLRFID,BLRIEN,BLRF(0,BLRVR)))=$P(BLRVL,$C(20),BLRIII)
+6 ;IHS/OIRM TUC/MJL 2/10/98
FOR BLRIII=1:1:$LENGTH(BLRVL,$CHAR(20))
SET BLRICNT=BLRICNT+1
SET BLRIEN="+"_BLRICNT_","_BLRSIEN
SET (BLRSSTR,BLRFDA(BLRFID,BLRIEN,BLRF(0,BLRVR)))=$PIECE(BLRVL,$CHAR(20),BLRIII)
+7 SET BLRFID=BLRSFID
SET BLRIEN=BLRSIEN
+8 QUIT
+9 ;
WORD ; EP - IHS/OIT/MKK -- Need "EP" for SAC
+1 QUIT
+2 ;
FILE ; EP - IHS/OIT/MKK -- Need "EP" for SAC
+1 ;
+2 ; D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("ENTER FILE^BLRFLTL")
+3 ; IHS/OIT/MKK - LR*5.2*1033
DO ENTRYAUD^BLRUTIL("ENTER FILE^BLRFLTL")
+4 LOCK +^BLRTXLOG(BLRENT):300
+5 ; If after attempting for 300 seconds the lock fails proceed anyway
+6 SET BLRFDA="BLRFDA"
+7 Begin DoDot:1
+8 IF BLRCMF="C"
DO UPDATE^DIE("",BLRFDA,BLRENTS,"BLREMSG")
QUIT
+9 DO UPDATE^DIE("",BLRFDA,"","BLREMSG")
QUIT
End DoDot:1
+10 IF $DATA(BLREMSG)
SET BLRERR=1
+11 ;IHS/OIRM TUC/MJL 5/21/98
LOCK -^BLRTXLOG(BLRENT)
+12 QUIT
+13 ;
GETIEN(BLRSB1,BLRSB2,BLRSB3) ; EP - IHS/OIT/MKK -- Need "EP" for SAC
+1 ; D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("ENTER GETIEN^BLRFLTL")
+2 ; IHS/OIT/MKK - LR*5.2*1033
DO ENTRYAUD^BLRUTIL("ENTER GETIEN^BLRFLTL")
+3 Begin DoDot:1
+4 IF BLRCMF="C"
DO GETNEW
QUIT
+5 IF BLRPHASE="O"
SET BLRCRGL="^BLRTXLOG(""AOT"","_BLRSB1_","_BLRSB2_","_BLRSB3_")"
SET BLRENT=$ORDER(^BLRTXLOG("AOT",BLRSB1,BLRSB2,BLRSB3,""),-1)
IF 'BLRENT
DO CKORD
IF BLRERR
DO EMSG
IF BLRERR
QUIT
SET BLRIEN=BLRENT_","
QUIT
+6 IF $DATA(BLRSB3)
SET BLRCRGL="^BLRTXLOG(""AOT"","_BLRSB1_","_BLRSB2_","_BLRSB3_")"
SET BLRENT=$ORDER(^BLRTXLOG("AOT",BLRSB1,BLRSB2,BLRSB3,""),-1)
IF 'BLRENT
DO CKORD
IF BLRERR
DO EMSG
IF BLRERR
QUIT
SET BLRIEN=BLRENT_","
QUIT
+7 ;S BLRCRGL="^BLRTXLOG(""AAT"","_BLRSB1_","_BLRSB2_")" S BLRENT=$O(^BLRTXLOG("AAT",BLRSB1,BLRSB2,""),-1) D:'BLRENT EMSG Q:BLRERR S BLRIEN=BLRENT_"," Q
+8 ;IHS/DIR TUC/AAB 05/07/98
+9 SET BLRCRGL="^BLRTXLOG(""AAT"","_BLRSB1_","_BLRSB2_")"
SET BLRENT=$ORDER(^BLRTXLOG("AAT",BLRSB1,BLRSB2,""),-1)
+10 IF 'BLRENT
DO EMSG
IF BLRERR
QUIT
+11 SET BLRCDT=$PIECE(^BLRTXLOG(BLRENT,12),U)
+12 IF $EXTRACT(BLRCDT,1,3)=$EXTRACT(DT,1,3)
SET BLRIEN=BLRENT_","
QUIT
+13 ;MORE THAN 1 YEAR AHEAD
IF ($EXTRACT(BLRCDT,1,3)+1)'=$EXTRACT(DT,1,3)
SET BLRERR=1
SET BLRDTER=1
QUIT
+14 IF $EXTRACT(BLRCDT,4,5)<11
SET BLRERR=1
SET BLRDTER=1
QUIT
+15 SET BLRIEN=BLRENT_","
QUIT
End DoDot:1
+16 QUIT BLRENT
+17 ;
GETOGIEN(BLRSB1,BLRSB2,BLRSB3) ; EP - IHS/OIT/MKK -- Need "EP" for SAC
+1 ; D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("ENTER GETOGIEN^BLRFLTL")
+2 ; IHS/OIT/MKK - LR*5.2*1033
DO ENTRYAUD^BLRUTIL("ENTER GETOGIEN^BLRFLTL")
+3 Begin DoDot:1
+4 IF BLRCMF="C"
DO GETNEW
QUIT
+5 IF '$DATA(BLRSB3)
SET BLRCRGL="^BLRTXLOG(""AOG"","_BLRSB1_","_BLRSB2_")"
SET BLRENT=$ORDER(^BLRTXLOG("AOG",BLRSB1,BLRSB2,""),-1)
IF 'BLRENT
DO EMSG
IF BLRERR
QUIT
SET BLRIEN=BLRENT_","
QUIT
+6 SET BLRCRGL="^BLRTXLOG(""AOD"","_BLRSB1_","_BLRSB2_","_BLRSB3_")"
SET BLRENT=$ORDER(^BLRTXLOG("AOD",BLRSB1,BLRSB2,BLRSB3,""),-1)
IF 'BLRENT
DO EMSG
IF BLRERR
QUIT
SET BLRIEN=BLRENT_","
QUIT
End DoDot:1
+7 QUIT BLRENT
+8 ;
GETBIEN(BLRSB1,BLRSB2,BLRSB3) ; EP - IHS/OIT/MKK -- Need "EP" for SAC
+1 ; D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("ENTER GETBIEN^BLRFLTL")
+2 ; IHS/OIT/MKK - LR*5.2*1033
DO ENTRYAUD^BLRUTIL("ENTER GETBIEN^BLRFLTL")
+3 Begin DoDot:1
+4 IF BLRCMF="C"
DO GETNEW
QUIT
+5 ;I '$D(BLRSB3) S BLRCRGL="^BLRTXLOG(""AOB"","_BLRSB1_","_BLRSB2_")",BLRENT=$O(^BLRTXLOG("AOB",BLRSB1,BLRSB2,""),-1) D:'BLRENT EMSG Q:BLRERR S BLRIEN=BLRENT_"," Q
+6 ;IHS/DIR TUC/AAB 05/07/98
IF '$DATA(BLRSB3)
SET BLRCRGL="^BLRTXLOG(""AOB"","_BLRSB1_","_BLRSB2_")"
SET BLRENT=$ORDER(^BLRTXLOG("AOB",BLRSB1,BLRSB2,""),-1)
DO CHKDT
QUIT
+7 ;S BLRCRGL="^BLRTXLOG(""AOA"","_BLRSB1_","_BLRSB2_","_BLRSB3_")",BLRENT=$O(^BLRTXLOG("AOA",BLRSB1,BLRSB2,BLRSB3,""),-1) D:'BLRENT EMSG Q:BLRERR S BLRIEN=BLRENT_"," Q
+8 ;IHS/DIR TUC/AAB 05/07/98
SET BLRCRGL="^BLRTXLOG(""AOA"","_BLRSB1_","_BLRSB2_","_BLRSB3_")"
SET BLRENT=$ORDER(^BLRTXLOG("AOA",BLRSB1,BLRSB2,BLRSB3,""),-1)
DO CHKDT
QUIT
End DoDot:1
+9 QUIT BLRENT
+10 ;
CHKDT ; EP - IHS/OIT/MKK -- Need "EP" for SAC -- IHS/DIR TUC/AAB 05/07/98
+1 ; D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("ENTER CHKDT^BLRFLTL")
+2 ; IHS/OIT/MKK - LR*5.2*1033
DO ENTRYAUD^BLRUTIL("ENTER CHKDT^BLRFLTL")
+3 IF 'BLRENT
DO EMSG
IF BLRERR
QUIT
+4 SET BLRCDT=$PIECE(^BLRTXLOG(BLRENT,12),U)
+5 IF $EXTRACT(BLRCDT,1,3)=$EXTRACT(DT,1,3)
SET BLRIEN=BLRENT_","
QUIT
+6 ;MORE THAN 1 YEAR AHEAD
IF ($EXTRACT(BLRCDT,1,3)+1)'=$EXTRACT(DT,1,3)
SET BLRERR=1
SET BLRDTER=1
QUIT
+7 IF $EXTRACT(BLRCDT,4,5)<11
SET BLRERR=1
SET BLRDTER=1
QUIT
+8 SET BLRIEN=BLRENT_","
QUIT
+9 QUIT
GETOSIEN(BLRSB1,BLRSB2,BLRSB3) ; EP - IHS/OIT/MKK -- Need "EP" for SAC
+1 ; D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("ENTER GETOSIEN^BLRFLTL")
+2 ; IHS/OIT/MKK - LR*5.2*1033
DO ENTRYAUD^BLRUTIL("ENTER GETOSIEN^BLRFLTL")
+3 Begin DoDot:1
+4 IF BLRCMF="C"
DO GETNEW
QUIT
+5 IF '$DATA(BLRSB3)
SET BLRCRGL="^BLRTXLOG(""AOG"","_BLRSB1_","_BLRSB2_")"
SET BLRENT=$ORDER(^BLRTXLOG("AOG",BLRSB1,BLRSB2,""),-1)
IF 'BLRENT
DO EMSG
IF BLRERR
QUIT
SET BLRIEN=BLRENT_","
QUIT
+6 SET BLRCRGL="^BLRTXLOG(""AOS"","_BLRSB1_","_BLRSB2_","_BLRSB3_")"
SET BLRENT=$ORDER(^BLRTXLOG("AOS",BLRSB1,BLRSB2,BLRSB3,""),-1)
IF 'BLRENT
DO EMSG
IF BLRERR
QUIT
SET BLRIEN=BLRENT_","
QUIT
End DoDot:1
+7 QUIT BLRENT
+8 ;
EMSG ; EP - IHS/OIT/MKK -- Need "EP" for SAC
+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 ;
CKORD ; EP - IHS/OIT/MKK -- Need "EP" for SAC
+1 ;IHS/DIR/MJL BLRERR=1 7/15/99
SET BLRERR=1
SET BLRENT=^BLRTXLOG("SEQ")+1
+2 FOR BLRTRY=1:1:1000
SET BLRENT=$ORDER(^BLRTXLOG(BLRENT),-1)
IF 'BLRENT
QUIT
IF $PIECE(^BLRTXLOG(BLRENT,11),U,3)=$GET(BLR("ORDER NUMBER"),LRORD)
IF $PIECE(^BLRTXLOG(BLRENT,0),U,6)=BLRSB3
SET BLRERR=0
QUIT
+3 IF BLRERR
SET BLRENT=0
KILL BLRTRY
+4 QUIT
+5 ;
GETNEW ; EP - IHS/OIT/MKK -- Need "EP" for SAC
+1 ; L +^BLRTXLOG("SEQ")
+2 ; IHS/OIT/MKK - LR*5.2*1033
LOCK +^BLRTXLOG("SEQ"):5
IF '$TEST
HANG 5
GOTO GETNEW
+3 SET BLRENT=$GET(^BLRTXLOG("SEQ"))
+4 IF 'BLRENT
SET BLRENT=$ORDER(^BLRTXLOG("@"),-1)
IF BLRENT
IF '$DATA(^BLRTXLOG(1))
SET BLRENT=0
+5 ;IHS/DIR TUC/MJL 12/4/98
+6 ;S BLRENT=BLRENT+1 S:$D(^BLRTXLOG(BLRENT)) BLRENT=$O(^BLRTXLOG("@"),-1)+1
+7 ;IHS/DIR TUC/MJL 12/4/98
+8 FOR BLRENT=BLRENT+1:1
IF '$DATA(^BLRTXLOG(BLRENT))
QUIT
+9 SET BLRENTS="BLRENTS"
SET BLRENTS(1)=BLRENT
SET ^BLRTXLOG("SEQ")=BLRENT
SET BLRIEN="+1,"
+10 LOCK -^BLRTXLOG("SEQ")
+11 QUIT
+12 ;
LOG ; EP - IHS/OIT/MKK -- Need "EP" for SAC
+1 ;S BLRDH=+$H,BLRLTA=$P($G(^BLRSITE(DUZ(2),21,BLRDH,0)),U,2)+1
+2 SET BLRDH=+$HOROLOG
+3 ; L +^BLRSITE(BLRQSITE,21,BLRDH,0)
+4 ; IHS/OIT/MKK - LR*5.2*1033
LOCK +^BLRSITE(BLRQSITE,21,BLRDH,0):5
IF '$TEST
HANG 5
GOTO LOG
+5 SET BLRLTA=$PIECE($GET(^BLRSITE(BLRQSITE,21,BLRDH,0)),U,2)+1
+6 ;I BLRLTA=1 S %H=$H D YX^%DTC S $P(^BLRSITE(DUZ(2),21,BLRDH,0),U,1)=X
+7 ;IHS/DIR TUC/AAB 04/07/98
IF BLRLTA=1
SET %H=$HOROLOG
DO YX^%DTC
SET $PIECE(^BLRSITE(BLRQSITE,21,BLRDH,0),U,1)=X
+8 ;S ^BLRSITE(DUZ(2),21,BLRDH,BLRLTA)=BLRENT,$P(^BLRSITE(DUZ(2),21,BLRDH,0),U,2)=BLRLTA
+9 ;IHS/DIR TUC/AAB 04/07/09
SET ^BLRSITE(BLRQSITE,21,BLRDH,BLRLTA)=BLRENT
SET $PIECE(^BLRSITE(BLRQSITE,21,BLRDH,0),U,2)=BLRLTA
+10 LOCK -^BLRSITE(BLRQSITE,21,BLRDH,0)
+11 QUIT
+12 ;
BULERR ; EP - IHS/OIT/MKK -- Need "EP" for SAC
+1 ; IHS/OIT/MKK - LR*5.2*1027
NEW ERROR714
+2 ; IHS/OIT/MKK - LR*5.2*1027
SET ERROR714="NO"
+3 ;BLRTXLOG ERROR
+4 IF $DATA(BLREMSG)
Begin DoDot:1
+5 ; D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("BULERR^BLRFLTL 1.0","BLREMSG")
+6 ; IHS/OIT/MKK - LR*5.2*1033
DO ENTRYAUD^BLRUTIL("BULERR^BLRFLTL 1.0","BLREMSG")
+7 SET (BLRECNT,BLRTCNT)=0
FOR
SET BLRECNT=$ORDER(BLREMSG("DIERR",BLRECNT))
IF 'BLRECNT
QUIT
Begin DoDot:2
+8 SET BLRTCNT=BLRTCNT+1
SET BLRERROR(BLRTCNT)="Error code = "_BLREMSG("DIERR",BLRECNT)
+9 ; IHS/OIT/MKK - LR*5.2*1027
IF +$GET(BLREMSG("DIERR",BLRECNT))=714
SET ERROR714="YES"
+10 SET BLRELCNT=0
FOR
SET BLRELCNT=$ORDER(BLREMSG("DIERR",BLRECNT,"TEXT",BLRELCNT))
IF 'BLRELCNT
QUIT
SET BLRTCNT=BLRTCNT+1
SET BLRERROR(BLRTCNT)=BLREMSG("DIERR",BLRECNT,"TEXT",BLRELCNT)
End DoDot:2
+11 KILL BLRECNT,BLRELCNT
End DoDot:1
+12 ;D:$D(BLR)
+13 ;IHS/DIR TUC/AAB 03/27/98
IF +$GET(BLR("SEQUENCE NUMBER"))
Begin DoDot:1
+14 SET BLRV=""
SET BLRTCNT=$GET(BLRTCNT,1)
SET BLRERROR(BLRTCNT+1)=""
SET BLRERROR(BLRTCNT+2)="VARIABLES:"
SET BLRERROR(BLRTCNT+3)=""
SET BLRTCNT=BLRTCNT+3
+15 SET BLRV=""
FOR
SET BLRV=$ORDER(BLR(BLRV))
IF BLRV=""
QUIT
SET BLRTCNT=BLRTCNT+1
SET BLRERROR(BLRTCNT)=$JUSTIFY("",10)_BLRV_$JUSTIFY("",35-$LENGTH(BLRV))_BLR(BLRV)
End DoDot:1
+16 SET BLRTCNT=$GET(BLRTCNT,1)
+17 FOR BLRPC=1:1
SET BLRESTR=$PIECE($TEXT(PARSE+BLRPC),";",3)
IF BLRESTR=""
QUIT
Begin DoDot:1
+18 SET BLRXQY0=$PIECE(XQY0,U,2)
IF $DATA(BLRTEST1)
SET BLRPT=$PIECE(^LAB(60,BLRTEST1,0),U)
+19 IF $DATA(@($PIECE(BLRESTR,"|",2)))
SET BLRTCNT=BLRTCNT+1
SET BLRERROR(BLRTCNT)=$PIECE(BLRESTR,"|")_@($PIECE(BLRESTR,"|",2))
End DoDot:1
+20 ; S XMB="BLRTXERR",XMTEXT="BLRERROR" S BLRDUZ=DUZ,DUZ=.5 D ^XMB S DUZ=BLRDUZ K ^TMP("XMBTEXT",$J)
+21 ; ----- BEGIN IHS/OIT/MKK - LR*5.2*1027
+22 ; D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("BULERR^BLRFLTL 2.0","BLRERROR")
+23 ; IHS/OIT/MKK - LR*5.2*1033
DO ENTRYAUD^BLRUTIL("BULERR^BLRFLTL 2.0","BLRERROR")
+24 SET XMB="BLRTXERR"
+25 SET XMTEXT="BLRERROR"
+26 SET XMDUZ=$SELECT(ERROR714="YES":"714 Error",1:"POSTMASTER")
+27 DO ^XMB
+28 KILL ^TMP("XMBTEXT",$JOB)
+29 ; ----- END IHS/OIT/MKK - LR*5.2*1027
+30 QUIT
+31 ;
KILL ; EP - IHS/OIT/MKK -- Need "EP" for SAC
+1 ;K BLR,BLRARRAY,BLREMSG,BLRENTS,BLRERR,BLRERROR,BLRFDA,BLRI,BLRIEN,BLRIENS,BLRIII,BLRLOGDA,BLRQUIET,BLRSFID,BLRSIEN,BLRT,BLRTCNT,BLRVL,BLRVR,BLRVRS,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE
+2 KILL BLR,BLRARRAY,BLREMSG,BLRENTS,BLRERR,BLRERROR,BLRFDA,BLRI,BLRICNT,BLRIEN,BLRIENS,BLRIII,BLRLOGDA,BLRQUIET,BLRSFID,BLRSIEN,BLRT,BLRTCNT,BLRVL,BLRVR,BLRVRS
+3 ;IHS/OIRM TUC/MJL 2/10/98
KILL ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,BLRESTR,BLRPT,BLRXQY0,BLRPC,BLRMI,BLRDTER
+4 QUIT
PARSE ; EP - IHS/OIT/MKK -- Need "EP" for SAC - IHS/DIR TUC/AAB 03/27/98
+1 ;;Patient Name: |PNM
+2 ;;Panel/Test: |BLRPT
+3 ;;Order Number: |LRORD
+4 ;;Accession Number: |BLRACCN
+5 ;;DUZ: |DUZ
+6 ;;DUZ(2): |BLRDUZ2
+7 ;;BLROPT1: |BLROPT1
+8 ;;BLROPT(0): |BLROPT(0)
+9 ;;XQY0: |BLRXQY0
+10 QUIT
