Routine: BLRNFLTL

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

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)

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

WORD ; EP

FILE ; EP

 .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

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

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

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

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

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

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

BLRNFLTL.m