BLRNFLTL ;IHS/HQT/MJL - SILENT DIE CALLS TO UPDATE TRANSACTION LOG ; 22-Oct-2013 09:22 ; MKK
;;5.2;IHS LABORATORY;**1010,1013,1015,1027,1033**;NOV 01, 1997
;
S U="^"
S BLRFID=9009022
S (BLRERR,BLRICNT)=0
S:BLRCMF="C" BLRICNT=1
D SETVALS
I 'BLRERR S:'BLRXPCC BLRFDA(BLRFID,BLRIEN,BLRF(0,"PCC ERROR FLAG"))="PCC LINK DISABLED" D FILE
I BLRXPCC,'$D(BLRERF),'BLRERR D LOG
I '(+$G(BLRDTER)),BLRERR D BULERR
D KILL
Q
;
SETVALS ; EP
S:$G(BLR("SIGN OR SYMPTOM"))["^" BLR("SIGN OR SYMPTOM")=$P(BLR("SIGN OR SYMPTOM"),"^") ; IHS/OIT/MKK - LR*5.2*1027
S:$G(BLRDIAG)["^" BLRDIAG=$P(BLRDIAG,"^") ; IHS/OIT/MKK - LR*5.2*1027
S BLRI=0 F S BLRI=$O(BLR(BLRI)) Q:BLRI'?.N.1"."1N.N M BLR(BLRF(1,BLRI))=BLR(BLRI)
S BLRI=" " F S BLRI=$O(BLR(BLRI)) Q:BLRI="" S BLRVR=BLRI D
.I $D(BLRF(0,BLRVR,"TYPE")) D Q
..I BLRF(0,BLRVR,"TYPE")="M" D MULTI Q
..I BLRF(0,BLRVR,"TYPE")="W" D WORD Q
.I $D(BLRF(0,BLRVR)),BLR(BLRVR)'="" S BLRFDA(BLRFID,BLRIEN,BLRF(0,BLRVR))=BLR(BLRVR)
Q
;
MULTI ; EP
; Used for multiples
I BLRCMF="M",$G(BLRF(0,BLRVR,"DIK"))'="" X BLRF(0,BLRVR,"DIK")
S BLRSFID=BLRFID,BLRSIEN=BLRIEN,BLRFID=BLRF(0,BLRVR,"FILE"),BLRVL=BLR(BLRVR)
F BLRIII=1:1:$L(BLRVL,$C(20))-1 S BLRICNT=BLRICNT+1,BLRIEN="+"_BLRICNT_","_BLRSIEN,(BLRSSTR,BLRFDA(BLRFID,BLRIEN,BLRF(0,BLRVR)))=$P(BLRVL,$C(20),BLRIII)
S BLRFID=BLRSFID
S BLRIEN=BLRSIEN
Q
;
WORD ; EP
Q
;
FILE ; EP
;
D
.I BLRCMF="C" D UPDATE^DIE("","BLRFDA","BLRENTS","BLREMSG") Q ; IHS/OIT/MKK - LR*5.2*1033
.D UPDATE^DIE("","BLRFDA","","BLREMSG") Q ; IHS/OIT/MKK - LR*5.2*1033
;
S:$D(BLREMSG) BLRERR=1
;
Q
;
EMSG ; EP
; 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
;
LOG ; EP
S BLRDH=+$H
S BLRLTA=$P($G(^BLRSITE(BLRQSITE,21,BLRDH,0)),U,2)+1
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(BLRQSITE,21,BLRDH,BLRLTA)=BLRENT,$P(^BLRSITE(BLRQSITE,21,BLRDH,0),U,2)=BLRLTA
Q
;
BULERR ; EP
NEW ERROR714 ; IHS/OIT/MKK - LR*5.2*1027
S ERROR714="NO" ; IHS/OIT/MKK - LR*5.2*1027
;
;BLRTXLOG ERROR
D:$D(BLREMSG)
.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:+$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
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
K BLRARRAY,BLREMSG,BLRENTS,BLRERR,BLRERROR,BLRFDA,BLRI,BLRICNT,BLRIEN,BLRIENS,BLRIII,BLRLOGDA,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/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
BLRNFLTL ;IHS/HQT/MJL - SILENT DIE CALLS TO UPDATE TRANSACTION LOG ; 22-Oct-2013 09:22 ; MKK
+1 ;;5.2;IHS LABORATORY;**1010,1013,1015,1027,1033**;NOV 01, 1997
+2 ;
+3 SET U="^"
+4 SET BLRFID=9009022
+5 SET (BLRERR,BLRICNT)=0
+6 IF BLRCMF="C"
SET BLRICNT=1
+7 DO SETVALS
+8 IF 'BLRERR
IF 'BLRXPCC
SET BLRFDA(BLRFID,BLRIEN,BLRF(0,"PCC ERROR FLAG"))="PCC LINK DISABLED"
DO FILE
+9 IF BLRXPCC
IF '$DATA(BLRERF)
IF 'BLRERR
DO LOG
+10 IF '(+$GET(BLRDTER))
IF BLRERR
DO BULERR
+11 DO KILL
+12 QUIT
+13 ;
SETVALS ; EP
+1 ; IHS/OIT/MKK - LR*5.2*1027
IF $GET(BLR("SIGN OR SYMPTOM"))["^"
SET BLR("SIGN OR SYMPTOM")=$PIECE(BLR("SIGN OR SYMPTOM"),"^")
+2 ; IHS/OIT/MKK - LR*5.2*1027
IF $GET(BLRDIAG)["^"
SET BLRDIAG=$PIECE(BLRDIAG,"^")
+3 SET BLRI=0
FOR
SET BLRI=$ORDER(BLR(BLRI))
IF BLRI'?.N.1"."1N.N
QUIT
MERGE BLR(BLRF(1,BLRI))=BLR(BLRI)
+4 SET BLRI=" "
FOR
SET BLRI=$ORDER(BLR(BLRI))
IF BLRI=""
QUIT
SET BLRVR=BLRI
Begin DoDot:1
+5 IF $DATA(BLRF(0,BLRVR,"TYPE"))
Begin DoDot:2
+6 IF BLRF(0,BLRVR,"TYPE")="M"
DO MULTI
QUIT
+7 IF BLRF(0,BLRVR,"TYPE")="W"
DO WORD
QUIT
End DoDot:2
QUIT
+8 IF $DATA(BLRF(0,BLRVR))
IF BLR(BLRVR)'=""
SET BLRFDA(BLRFID,BLRIEN,BLRF(0,BLRVR))=BLR(BLRVR)
End DoDot:1
+9 QUIT
+10 ;
MULTI ; EP
+1 ; Used for multiples
+2 IF BLRCMF="M"
IF $GET(BLRF(0,BLRVR,"DIK"))'=""
XECUTE BLRF(0,BLRVR,"DIK")
+3 SET BLRSFID=BLRFID
SET BLRSIEN=BLRIEN
SET BLRFID=BLRF(0,BLRVR,"FILE")
SET BLRVL=BLR(BLRVR)
+4 FOR BLRIII=1:1:$LENGTH(BLRVL,$CHAR(20))-1
SET BLRICNT=BLRICNT+1
SET BLRIEN="+"_BLRICNT_","_BLRSIEN
SET (BLRSSTR,BLRFDA(BLRFID,BLRIEN,BLRF(0,BLRVR)))=$PIECE(BLRVL,$CHAR(20),BLRIII)
+5 SET BLRFID=BLRSFID
+6 SET BLRIEN=BLRSIEN
+7 QUIT
+8 ;
WORD ; EP
+1 QUIT
+2 ;
FILE ; EP
+1 ;
+2 Begin DoDot:1
+3 ; IHS/OIT/MKK - LR*5.2*1033
IF BLRCMF="C"
DO UPDATE^DIE("","BLRFDA","BLRENTS","BLREMSG")
QUIT
+4 ; IHS/OIT/MKK - LR*5.2*1033
DO UPDATE^DIE("","BLRFDA","","BLREMSG")
QUIT
End DoDot:1
+5 ;
+6 IF $DATA(BLREMSG)
SET BLRERR=1
+7 ;
+8 QUIT
+9 ;
EMSG ; EP
+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 ;
LOG ; EP
+1 SET BLRDH=+$HOROLOG
+2 SET BLRLTA=$PIECE($GET(^BLRSITE(BLRQSITE,21,BLRDH,0)),U,2)+1
+3 ;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
+4 SET ^BLRSITE(BLRQSITE,21,BLRDH,BLRLTA)=BLRENT
SET $PIECE(^BLRSITE(BLRQSITE,21,BLRDH,0),U,2)=BLRLTA
+5 QUIT
+6 ;
BULERR ; EP
+1 ; IHS/OIT/MKK - LR*5.2*1027
NEW ERROR714
+2 ; IHS/OIT/MKK - LR*5.2*1027
SET ERROR714="NO"
+3 ;
+4 ;BLRTXLOG ERROR
+5 IF $DATA(BLREMSG)
Begin DoDot:1
+6 SET (BLRECNT,BLRTCNT)=0
FOR
SET BLRECNT=$ORDER(BLREMSG("DIERR",BLRECNT))
IF 'BLRECNT
QUIT
Begin DoDot:2
+7 SET BLRTCNT=BLRTCNT+1
SET BLRERROR(BLRTCNT)="Error code = "_BLREMSG("DIERR",BLRECNT)
+8 ; IHS/OIT/MKK - LR*5.2*1027
IF +$GET(BLREMSG("DIERR",BLRECNT))=714
SET ERROR714="YES"
+9 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
+10 KILL BLRECNT,BLRELCNT
End DoDot:1
+11 ;IHS/DIR TUC/AAB 03/27/98
IF +$GET(BLR("SEQUENCE NUMBER"))
Begin DoDot:1
+12 SET BLRV=""
SET BLRTCNT=$GET(BLRTCNT,1)
SET BLRERROR(BLRTCNT+1)=""
SET BLRERROR(BLRTCNT+2)="VARIABLES:"
SET BLRERROR(BLRTCNT+3)=""
SET BLRTCNT=BLRTCNT+3
+13 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
+14 SET BLRTCNT=$GET(BLRTCNT,1)
+15 FOR BLRPC=1:1
SET BLRESTR=$PIECE($TEXT(PARSE+BLRPC),";",3)
IF BLRESTR=""
QUIT
Begin DoDot:1
+16 SET BLRXQY0=$PIECE(XQY0,U,2)
IF $DATA(BLRTEST1)
SET BLRPT=$PIECE(^LAB(60,BLRTEST1,0),U)
+17 IF $DATA(@($PIECE(BLRESTR,"|",2)))
SET BLRTCNT=BLRTCNT+1
SET BLRERROR(BLRTCNT)=$PIECE(BLRESTR,"|")_@($PIECE(BLRESTR,"|",2))
End DoDot:1
+18 ; S XMB="BLRTXERR",XMTEXT="BLRERROR" S BLRDUZ=DUZ,DUZ=.5 D ^XMB S DUZ=BLRDUZ K ^TMP("XMBTEXT",$J)
+19 ; ----- BEGIN IHS/OIT/MKK - LR*5.2*1027
+20 SET XMB="BLRTXERR"
+21 SET XMTEXT="BLRERROR"
+22 SET XMDUZ=$SELECT(ERROR714="YES":"714 Error",1:"POSTMASTER")
+23 DO ^XMB
+24 KILL ^TMP("XMBTEXT",$JOB)
+25 ; ----- END IHS/OIT/MKK - LR*5.2*1027
+26 QUIT
+27 ;
KILL ; EP
+1 KILL BLRARRAY,BLREMSG,BLRENTS,BLRERR,BLRERROR,BLRFDA,BLRI,BLRICNT,BLRIEN,BLRIENS,BLRIII,BLRLOGDA,BLRSFID,BLRSIEN,BLRT,BLRTCNT,BLRVL,BLRVR,BLRVRS
+2 ;IHS/OIRM TUC/MJL 2/10/98
KILL ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,BLRESTR,BLRPT,BLRXQY0,BLRPC,BLRMI,BLRDTER
+3 QUIT
+4 ;
PARSE ; EP - 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
