Routine: BHLRLABI

BHLRLABI ; cmi/anchorage/maw - BHL ORU/R01 Ref Lab inbound Lab Message ;

 ;;3.01;BHL IHS Interfaces with GIS;**13,14,16**;AUG 01, 2004

 ;this is the master routine all ref lab inbound are built off of this

 ;this routine will file the inbound dynacare lab message.

MAIN ;EP -- this is the main routine driver

 S BHLRL=+$G(^BLRSITE(DUZ(2),"RL"))

 Q:'$G(BHLRL)

 S BHLNOST=1 D ^BHLSETI

 ;I '$P($G(^BLRRL(BHLRL,0)),U,10) D ORU^BLRHL7(BHLUIF),EOJ Q  2/25/2008 cmi/maw orig

 I '$P($G(^BLRSITE(DUZ(2),"RL")),U,18) D ORU^BLRHL7(BHLUIF),EOJ Q  ;NEW cmi/maw 2/25/2008

 D ^BHLFO

 D CHKPAT

 Q:$D(BHLERR("FATAL"))

 D PRS

 D RFL

 D EOJ

 D JOB^BLRPARAM  ;jump start the link

CHKPAT ;-- lookup the patient by chart

 N BHLR

 S BHLR="PID"

 S BHLDA=0,BHLDA=$O(@BHLTMP@(BHLDA)) ;should be one PID

 S PAT=+$G(@BHLTMP@(BHLDA,3))

 S BHLDOB=$$HDATE^INHUT($E($G(@BHLTMP@(BHLDA,7)),1,8))

 S BHLSEX=$G(@BHLTMP@(BHLDA,8))

 S BHLPAT=$$CHKPAT^BHLU(PAT,$G(DUZ(2)))

 I '$G(BHLPAT) S BHLERCD="NOPAT" X BHLERR

 Q:$D(BHLERR("FATAL"))

 S BHLPAT=$$CHKDOB^BHLU(BHLPAT)

 I '$G(BHLPAT) S BHLERCD="NOPAT" X BHLERR

 Q:$D(BHLERR("FATAL"))

 S BHLLOE=$G(DUZ(2))

PRS ;-- parse the HL7 message array

 D OBR

OBR ;-- parse the OBR segment

 N BHLR

 S BHLR="OBR"

 S BHLODA=0 F  S BHLODA=$O(@BHLTMP@(BHLODA)) Q:BHLODA=""  D

 . K BHLPAR,BHLTST,BHLPSEQ,BHLCLTE

 . S BHLACC=$G(@BHLTMP@(BHLODA,2))

 . S BHLTST=$P($G(@BHLTMP@(BHLODA,4)),CS,4)

 . S BHLCLTE=$P($G(@BHLTMP@(BHLODA,4)),CS,5)

 . S BHLOBSDT=$$HDATE^INHUT($G(@BHLTMP@(BHLODA,7)),"T")

 . S BHLSPDT=$$HDATE^INHUT($G(@BHLTMP@(BHLODA,14)),"T")

 . S BHLORDP=$G(@BHLTMP@(BHLODA,16))

 . S BHLRESDT=$$HDATE^INHUT($G(@BHLTMP@(BHLODA,22)),"T")

 . S BHLPAR=BHLODA

 . D MAP

 . I $D(BHL("OBX",BHLODA,2)) D CPT,FILE K BHLCPTS S BHLPSEQ=BHLSEQ

 . I $D(BHLERR("WARNING")) D BUL

 . K BHLERR("WARNING")

 . D OBX

OBX ;-- parse the OBX segment

 N BHLR

 S BHLR="OBX"

 S BHLXDA=0 F  S BHLXDA=$O(@BHLSTMP@(BHLXDA)) Q:BHLXDA=""!($D(BHLERR("WARNING")))  D

 . K BHLSPAR,BHLTST,BHLCLTE

 . S BHLTST=$P($G(@BHLSTMP@(BHLXDA,3)),CS,4)

 . S BHLCLTE=$P($G(@BHLSTMP@(BHLXDA,3)),CS,5)

 . S BHLRSLT=$G(@BHLSTMP@(BHLXDA,5))

 . S BHLUNIT=$G(@BHLSTMP@(BHLXDA,6))

 . S BHLREFR=$G(@BHLSTMP@(BHLXDA,7))

 . S BHLREFL=$P($G(BHLREFR),"-")

 . S BHLREFH=$P($G(BHLREFR),"-",2)

 . S BHLABN=$G(@BHLSTMP@(BHLXDA,8))

 . S BHLRESDT=$$HDATE^INHUT($G(@BHLSTMP@(BHLXDA,14)),"T")

 . S BHLSPAR=BHLXDA

 . D TESTMAP

 . I '$G(BHLPSEQ) D CPT

 . D FILE

 . K BHLCPTS

 . D NTE

 . K BHLCMT

 . I $D(BHLERR("WARNING")) D BUL

 . K BHLERR("WARNING")

NTE ;-- parse the NTE segment

 N BHLR

 S BHLR="NTE"

 S BHLNDA=0 F  S BHLNDA=$O(@BHLSSTMP@(BHLNDA)) Q:BHLNDA=""  D

 . S:'$D(BHLCMT(BHLNDA)) BHLCMT(BHLNDA)=0

 . S (BHLCMT(BHLNDA),X)=$G(@BHLSSTMP@(BHLNDA,3))

 . K DIC

 . S DIC="^BLRTXLOG("_BHLSEQ_",30,"

 . S DA(1)=BHLSEQ,DIC(0)="L",DIC("P")=$P(^DD(9009022,3001,0),"^",2)

 . D ^DIC

MAP ;-- map the necessary incoming items to rpms

 I '$G(BHLORDPI) D

 . S BHLORDPI=$O(^VA(200,"ANPI",BHLORDP,0))

 S BHLORDPE=$S(BHLORDP'="":$P($G(^DIC(6,BHLORDP,0)),U),1:"")

 S BHLPNM=$$VAL^XBDIQ1(2,BHLPAT,.01)

 S BHLLOE=$G(DUZ(2))

TESTMAP ;

 S BHLCLTI=$O(^BLRRL("BTST",BHLTST,BHLRL,0))

 I BHLCLTI="" S BHLERCD="NOLCODE" X BHLERR Q

 S BHLCLT=$P($G(^BLRRL(BHLRL,1,BHLCLTI,0)),U,2)

 I BHLCLT="" S BHLERCD="NOLAB" X BHLERR

CPT ;-- let's build the cpt string

 Q:$G(BHLPSEQ)

 Q:'$G(BHLCLT)

 S BHLCTST=$O(^BLRCPT("C",BHLCLT,0))

 Q:BHLCTST=""

 S BHLCCNT=0

 S BHLCPTS="|||||"

 S BHLCDA=0 F  S BHLCDA=$O(^BLRCPT(BHLCTST,11,BHLCDA)) Q:'BHLCDA  D

 . S BHLCPT=$P($G(^BLRCPT(BHLCTST,11,BHLDA,0)),U)

 . S BHLCCNT=BHLCCNT+1

 . S $P(BHLCPTS,"|",BHLCCNT)=$G(BHLCPT)

FILE ;-- file the data in BLRTXLOG

 ;FORMAT IS BLRVARS="FIELD NAME_VARIABLE~FIELD NAME_VARIABLE""

 K BLR,BLRF,BLRFDA  ;maw test

 S BHLQSIT=$P($G(^AUTTSITE(1,0)),U)

 Q:BHLQSIT=""

 S BLRPCC=$P($G(^BLRSITE(BHLQSIT,0)),U,3)

 S (BLRODTM,BLRSEQ,BLRTEST1)="",BLRLINK=1,BLRERR=0,BHLPHASE="R",BLRCMF="C"

 S BLRXPCC=1 ;after patch 10

 S BHLSEQ=$$GETIEN^BLRFLTL(BLRODTM,BLRSEQ,BLRTEST1)

 S BLRVARS="SEQUENCE NUMBER_BHLSEQ~STATUS FLAG_BHLPHASE~DUZ(2)_BHLLOE~"

 S BLRVARS=BLRVARS_"PATIENT NAME_$G(BHLPNM)~PATIENT POINTER VALUE_$G(BHLPAT)~ACCESSION NUMBER_BHLACC~"

 S BLRVARS=BLRVARS_"ORDERING PROVIDER NAME_$G(BLRH2(6))~ORDERING PROVIDER POINTER_$G(BLRH2(16))~"

 S BLRVARS=BLRVARS_"PANEL/TEST POINTER_BHLCLT~PANEL/TEST NAME_$G(BHLCLTE)~RESULT_$G(BHLRSLT)~UNITS_$G(BHLUNIT)~REFERENCE LOW_$G(BHLREFL)~REFERENCE HIGH_$G(BHLREFH)~"

 S BLRVARS=BLRVARS_"PARENT POINTER_$G(BHLPSEQ)~COLLECTION DATE/TIME_BHLOBSDT~ORDER DATE_$G(BHLODT)~ENTRY DATE/TIME_$G(BHLSPDT)~ORDERING LOCATION POINTER_$G(BHLLOC)~ORDERING LOCATION NAME_$G(BHLLOCE)~"

 S BHLLM="CH",BLRVARS=BLRVARS_"LAB MODULE_BHLLM~"

 S BHLIO="A",BLRVARS=BLRVARS_"I/O CATEGORY_BHLIO~"

 S BHLSTAT="R",BLRVARS=BLRVARS_"STATUS FLAG_BHLSTAT~"

 S BHLBILL=1,BLRVARS=BLRVARS_"BILLABLE ITEM_BHLBILL~"

 S BHLSRC=0,BLRVARS=BLRVARS_"SOURCE OF DATA INPUT_BHLSRC~"

 S BHLSPC=999,BLRVARS=BLRVARS_"SITE/SPECIMEN POINTER_BHLSPC~"

 S BHLSPCE="UNKNOWN",BLRVARS=BLRVARS_"SITE/SPECIMEN NAME_BHLSPCE~"

 S BHLLFLE=2,BLRVARS=BLRVARS_"LRFILE_BHLLFLE~"

 S BLRVARS=BLRVARS_"RESULT N/A FLAG_$G(BHLABN)~"

 S BLRVARS=BLRVARS_"BILLING CPT STRING_$G(BHLCPTS)"

 I '$D(BLRF(0)) D INIT^BLRPARAM ;after patch 10

 ;I '$D(BLRF(0)) D ^BLRPARAM

 D SETVALS^BLRFLTL ;after patch 10

 ;D ^BLRFLTL("C",BLRVARS) ;before patch 10

 D ^BLRNFLTL ;after patch 10

BUL ;-- file a bulletin if no test match

 S XMB="BHL NO TEST MATCH"

 S XMB(1)=$G(BHLTST),XMB(2)=$G(BHLCLTE),XMB(3)=$G(BHLSEQ)

 D ^XMB

EOJ ;-- kill variables and quit

 D EN^XBVK("BLR")

 D EOJ^BHLSETI

RFL ;-- set the refile node in BLRSITE

 S BHLDA=0 F  S BHLDA=$O(BHLSEQ(BHLDA)) Q:'BHLDA  D

 . S BHLIEN=$G(BHLSEQ(BHLDA))

 . D ^BLREVTQ("M","REFILE","REFILE",,BHLIEN)

BHLRLABI  ; cmi/anchorage/maw - BHL ORU/R01 Ref Lab inbound Lab Message ;

 +1       ;;3.01;BHL IHS Interfaces with GIS;**13,14,16**;AUG 01, 2004

 +2       ;

 +3       ;this is the master routine all ref lab inbound are built off of this

 +4       ;

 +5       ;this routine will file the inbound dynacare lab message.

 +6       ;

MAIN      ;EP -- this is the main routine driver

 +1        SET BHLRL=+$GET(^BLRSITE(DUZ(2),"RL"))

 +2        IF '$GET(BHLRL)

               QUIT

 +3        SET BHLNOST=1

           DO ^BHLSETI

 +4       ;I '$P($G(^BLRRL(BHLRL,0)),U,10) D ORU^BLRHL7(BHLUIF),EOJ Q  2/25/2008 cmi/maw orig

 +5       ;NEW cmi/maw 2/25/2008

           IF '$PIECE($GET(^BLRSITE(DUZ(2),"RL")),U,18)

               DO ORU^BLRHL7(BHLUIF)

               DO EOJ

               QUIT

 +6        DO ^BHLFO

 +7        DO CHKPAT

 +8        IF $DATA(BHLERR("FATAL"))

               QUIT

 +9        DO PRS

 +10       DO RFL

 +11       DO EOJ

 +12      ;jump start the link

           DO JOB^BLRPARAM

 +13       QUIT

 +14      ;

CHKPAT    ;-- lookup the patient by chart

 +1        NEW BHLR

 +2        SET BHLR="PID"

 +3       ;should be one PID

           SET BHLDA=0

           SET BHLDA=$ORDER(@BHLTMP@(BHLDA))

 +4        SET PAT=+$GET(@BHLTMP@(BHLDA,3))

 +5        SET BHLDOB=$$HDATE^INHUT($EXTRACT($GET(@BHLTMP@(BHLDA,7)),1,8))

 +6        SET BHLSEX=$GET(@BHLTMP@(BHLDA,8))

 +7        SET BHLPAT=$$CHKPAT^BHLU(PAT,$GET(DUZ(2)))

 +8        IF '$GET(BHLPAT)

               SET BHLERCD="NOPAT"

               XECUTE BHLERR

 +9        IF $DATA(BHLERR("FATAL"))

               QUIT

 +10       SET BHLPAT=$$CHKDOB^BHLU(BHLPAT)

 +11       IF '$GET(BHLPAT)

               SET BHLERCD="NOPAT"

               XECUTE BHLERR

 +12       IF $DATA(BHLERR("FATAL"))

               QUIT

 +13       SET BHLLOE=$GET(DUZ(2))

 +14       QUIT

 +15      ;

PRS       ;-- parse the HL7 message array

 +1        DO OBR

 +2        QUIT

 +3       ;

OBR       ;-- parse the OBR segment

 +1        NEW BHLR

 +2        SET BHLR="OBR"

 +3        SET BHLODA=0

FOR

               SET BHLODA=$ORDER(@BHLTMP@(BHLODA))

               IF BHLODA=""

                   QUIT

               Begin DoDot:1

 +4                KILL BHLPAR,BHLTST,BHLPSEQ,BHLCLTE

 +5                SET BHLACC=$GET(@BHLTMP@(BHLODA,2))

 +6                SET BHLTST=$PIECE($GET(@BHLTMP@(BHLODA,4)),CS,4)

 +7                SET BHLCLTE=$PIECE($GET(@BHLTMP@(BHLODA,4)),CS,5)

 +8                SET BHLOBSDT=$$HDATE^INHUT($GET(@BHLTMP@(BHLODA,7)),"T")

 +9                SET BHLSPDT=$$HDATE^INHUT($GET(@BHLTMP@(BHLODA,14)),"T")

 +10               SET BHLORDP=$GET(@BHLTMP@(BHLODA,16))

 +11               SET BHLRESDT=$$HDATE^INHUT($GET(@BHLTMP@(BHLODA,22)),"T")

 +12               SET BHLPAR=BHLODA

 +13               DO MAP

 +14               IF $DATA(BHL("OBX",BHLODA,2))

                       DO CPT

                       DO FILE

                       KILL BHLCPTS

                       SET BHLPSEQ=BHLSEQ

 +15               IF $DATA(BHLERR("WARNING"))

                       DO BUL

 +16               KILL BHLERR("WARNING")

 +17               DO OBX

               End DoDot:1

 +18       QUIT

 +19      ;

OBX       ;-- parse the OBX segment

 +1        NEW BHLR

 +2        SET BHLR="OBX"

 +3        SET BHLXDA=0

FOR

               SET BHLXDA=$ORDER(@BHLSTMP@(BHLXDA))

               IF BHLXDA=""!($DATA(BHLERR("WARNING")))

                   QUIT

               Begin DoDot:1

 +4                KILL BHLSPAR,BHLTST,BHLCLTE

 +5                SET BHLTST=$PIECE($GET(@BHLSTMP@(BHLXDA,3)),CS,4)

 +6                SET BHLCLTE=$PIECE($GET(@BHLSTMP@(BHLXDA,3)),CS,5)

 +7                SET BHLRSLT=$GET(@BHLSTMP@(BHLXDA,5))

 +8                SET BHLUNIT=$GET(@BHLSTMP@(BHLXDA,6))

 +9                SET BHLREFR=$GET(@BHLSTMP@(BHLXDA,7))

 +10               SET BHLREFL=$PIECE($GET(BHLREFR),"-")

 +11               SET BHLREFH=$PIECE($GET(BHLREFR),"-",2)

 +12               SET BHLABN=$GET(@BHLSTMP@(BHLXDA,8))

 +13               SET BHLRESDT=$$HDATE^INHUT($GET(@BHLSTMP@(BHLXDA,14)),"T")

 +14               SET BHLSPAR=BHLXDA

 +15               DO TESTMAP

 +16               IF '$GET(BHLPSEQ)

                       DO CPT

 +17               DO FILE

 +18               KILL BHLCPTS

 +19               DO NTE

 +20               KILL BHLCMT

 +21               IF $DATA(BHLERR("WARNING"))

                       DO BUL

 +22               KILL BHLERR("WARNING")

               End DoDot:1

 +23       QUIT

 +24      ;

NTE       ;-- parse the NTE segment

 +1        NEW BHLR

 +2        SET BHLR="NTE"

 +3        SET BHLNDA=0

FOR

               SET BHLNDA=$ORDER(@BHLSSTMP@(BHLNDA))

               IF BHLNDA=""

                   QUIT

               Begin DoDot:1

 +4                IF '$DATA(BHLCMT(BHLNDA))

                       SET BHLCMT(BHLNDA)=0

 +5                SET (BHLCMT(BHLNDA),X)=$GET(@BHLSSTMP@(BHLNDA,3))

 +6                KILL DIC

 +7                SET DIC="^BLRTXLOG("_BHLSEQ_",30,"

 +8                SET DA(1)=BHLSEQ

                   SET DIC(0)="L"

                   SET DIC("P")=$PIECE(^DD(9009022,3001,0),"^",2)

 +9                DO ^DIC

               End DoDot:1

 +10       QUIT

 +11      ;

MAP       ;-- map the necessary incoming items to rpms

 +1        IF '$GET(BHLORDPI)

               Begin DoDot:1

 +2                SET BHLORDPI=$ORDER(^VA(200,"ANPI",BHLORDP,0))

               End DoDot:1

 +3        SET BHLORDPE=$SELECT(BHLORDP'="":$PIECE($GET(^DIC(6,BHLORDP,0)),U),1:"")

 +4        SET BHLPNM=$$VAL^XBDIQ1(2,BHLPAT,.01)

 +5        SET BHLLOE=$GET(DUZ(2))

TESTMAP   ;

 +1        SET BHLCLTI=$ORDER(^BLRRL("BTST",BHLTST,BHLRL,0))

 +2        IF BHLCLTI=""

               SET BHLERCD="NOLCODE"

               XECUTE BHLERR

               QUIT

 +3        SET BHLCLT=$PIECE($GET(^BLRRL(BHLRL,1,BHLCLTI,0)),U,2)

 +4        IF BHLCLT=""

               SET BHLERCD="NOLAB"

               XECUTE BHLERR

 +5        QUIT

 +6       ;

CPT       ;-- let's build the cpt string

 +1        IF $GET(BHLPSEQ)

               QUIT

 +2        IF '$GET(BHLCLT)

               QUIT

 +3        SET BHLCTST=$ORDER(^BLRCPT("C",BHLCLT,0))

 +4        IF BHLCTST=""

               QUIT

 +5        SET BHLCCNT=0

 +6        SET BHLCPTS="|||||"

 +7        SET BHLCDA=0

FOR

               SET BHLCDA=$ORDER(^BLRCPT(BHLCTST,11,BHLCDA))

               IF 'BHLCDA

                   QUIT

               Begin DoDot:1

 +8                SET BHLCPT=$PIECE($GET(^BLRCPT(BHLCTST,11,BHLDA,0)),U)

 +9                SET BHLCCNT=BHLCCNT+1

 +10               SET $PIECE(BHLCPTS,"|",BHLCCNT)=$GET(BHLCPT)

               End DoDot:1

 +11       QUIT

 +12      ;

FILE      ;-- file the data in BLRTXLOG

 +1       ;FORMAT IS BLRVARS="FIELD NAME_VARIABLE~FIELD NAME_VARIABLE""

 +2       ;maw test

           KILL BLR,BLRF,BLRFDA

 +3        SET BHLQSIT=$PIECE($GET(^AUTTSITE(1,0)),U)

 +4        IF BHLQSIT=""

               QUIT

 +5        SET BLRPCC=$PIECE($GET(^BLRSITE(BHLQSIT,0)),U,3)

 +6        SET (BLRODTM,BLRSEQ,BLRTEST1)=""

           SET BLRLINK=1

           SET BLRERR=0

           SET BHLPHASE="R"

           SET BLRCMF="C"

 +7       ;after patch 10

           SET BLRXPCC=1

 +8        SET BHLSEQ=$$GETIEN^BLRFLTL(BLRODTM,BLRSEQ,BLRTEST1)

 +9        SET BLRVARS="SEQUENCE NUMBER_BHLSEQ~STATUS FLAG_BHLPHASE~DUZ(2)_BHLLOE~"

 +10       SET BLRVARS=BLRVARS_"PATIENT NAME_$G(BHLPNM)~PATIENT POINTER VALUE_$G(BHLPAT)~ACCESSION NUMBER_BHLACC~"

 +11       SET BLRVARS=BLRVARS_"ORDERING PROVIDER NAME_$G(BLRH2(6))~ORDERING PROVIDER POINTER_$G(BLRH2(16))~"

 +12       SET BLRVARS=BLRVARS_"PANEL/TEST POINTER_BHLCLT~PANEL/TEST NAME_$G(BHLCLTE)~RESULT_$G(BHLRSLT)~UNITS_$G(BHLUNIT)~REFERENCE LOW_$G(BHLREFL)~REFERENCE HIGH_$G(BHLREFH)~"

 +13       SET BLRVARS=BLRVARS_"PARENT POINTER_$G(BHLPSEQ)~COLLECTION DATE/TIME_BHLOBSDT~ORDER DATE_$G(BHLODT)~ENTRY DATE/TIME_$G(BHLSPDT)~ORDERING LOCATION POINTER_$G(BHLLOC)~ORDERING LOCATION NAME_$G(BHLLOCE)~"

 +14       SET BHLLM="CH"

           SET BLRVARS=BLRVARS_"LAB MODULE_BHLLM~"

 +15       SET BHLIO="A"

           SET BLRVARS=BLRVARS_"I/O CATEGORY_BHLIO~"

 +16       SET BHLSTAT="R"

           SET BLRVARS=BLRVARS_"STATUS FLAG_BHLSTAT~"

 +17       SET BHLBILL=1

           SET BLRVARS=BLRVARS_"BILLABLE ITEM_BHLBILL~"

 +18       SET BHLSRC=0

           SET BLRVARS=BLRVARS_"SOURCE OF DATA INPUT_BHLSRC~"

 +19       SET BHLSPC=999

           SET BLRVARS=BLRVARS_"SITE/SPECIMEN POINTER_BHLSPC~"

 +20       SET BHLSPCE="UNKNOWN"

           SET BLRVARS=BLRVARS_"SITE/SPECIMEN NAME_BHLSPCE~"

 +21       SET BHLLFLE=2

           SET BLRVARS=BLRVARS_"LRFILE_BHLLFLE~"

 +22       SET BLRVARS=BLRVARS_"RESULT N/A FLAG_$G(BHLABN)~"

 +23       SET BLRVARS=BLRVARS_"BILLING CPT STRING_$G(BHLCPTS)"

 +24      ;after patch 10

           IF '$DATA(BLRF(0))

               DO INIT^BLRPARAM

 +25      ;I '$D(BLRF(0)) D ^BLRPARAM

 +26      ;after patch 10

           DO SETVALS^BLRFLTL

 +27      ;D ^BLRFLTL("C",BLRVARS) ;before patch 10

 +28      ;after patch 10

           DO ^BLRNFLTL

 +29       QUIT

 +30      ;

BUL       ;-- file a bulletin if no test match

 +1        SET XMB="BHL NO TEST MATCH"

 +2        SET XMB(1)=$GET(BHLTST)

           SET XMB(2)=$GET(BHLCLTE)

           SET XMB(3)=$GET(BHLSEQ)

 +3        DO ^XMB

 +4        QUIT

 +5       ;

EOJ       ;-- kill variables and quit

 +1        DO EN^XBVK("BLR")

 +2        DO EOJ^BHLSETI

 +3        QUIT

 +4       ;

RFL       ;-- set the refile node in BLRSITE

 +1        SET BHLDA=0

FOR

               SET BHLDA=$ORDER(BHLSEQ(BHLDA))

               IF 'BHLDA

                   QUIT

               Begin DoDot:1

 +2                SET BHLIEN=$GET(BHLSEQ(BHLDA))

 +3                DO ^BLREVTQ("M","REFILE","REFILE",,BHLIEN)

               End DoDot:1

 +4        QUIT

 +5       ;

BHLRLABI.m