BHLCHRI ; cmi/anch/maw - BHL Read CHR data into ^INTHU ;
;;3.01;BHL IHS Interfaces with GIS;**10,14**;JUL 1, 2005
;
;
;this routine will grab a file from HFS and stuff it into the ^INTHU
;global for processing
;
MAIN ;-- this is the main routine driver
N BHLY
D ^%ZISC
K ^TMP("BHLRL",$J)
S BHLY=$$CHK^BHLBCK("OUTPUT CONTROLLER")
D READ(DUZ(2))
D EOJ
Q
;
READ(BHLCHRI) ;-- read the file in
;cmi/maw we need to set up dynamic directory reads here
N BHLFLG,BHLDIR,BHLFST,BHLFLST,BHLLST
S BHLCHR=$O(^BCHSITE("B",BHLCHRI,0))
I $G(BHLCHR)="" S BHLFLG=1
I $G(BHLCHR)]"" D
. S BHLDIR=$P($G(^BCHSITE(BHLCHR,0)),U,13)
. I BHLDIR="" S BHLFLG=1 Q
. S BHLFST=$P($G(^BCHSITE(BHLCHR,0)),U,14)
. I BHLFST="" S BHLFLG=1 Q
I $G(BHLFLG) D Q
. Q:$D(ZTQUEUED)
. W !,"CHR Parameters not Defined in BCH SITE PARAMETER File"
S BHLFST=BHLFST_"*"
I '$D(ZTQUEUED) D
. W !!,"Now reading in CHR file from directory "_BHLDIR
S BHLFLST=$$LIST^%ZISH(BHLDIR,BHLFST,.BHLLST)
;D CR(.BHLLST,"") Q
D LC(.BHLLST,"")
Q
;
LC(BHLLST,RFLG) ;-- parse
S BHLFDA=0 F S BHLFDA=$O(BHLLST(BHLFDA)) Q:'BHLFDA D
. D ^%ZISC
. S BHLFNM=$G(BHLLST(BHLFDA))
. S Y=$$OPEN^%ZISH(BHLDIR,BHLFNM,"R")
. I $G(Y),'$D(ZTQUEUED) W !,"Error Opening Device" Q
. S CNTR=1
. F I=1:1 U IO R BHLT:DTIME D Q:BHLT=""
.. Q:BHLT=""
.. I $E($G(BHLT),1,3)="MSH",CNTR>1 D STUFF K ^TMP("BHLRL",$J) S CNTR=1
.. S ^TMP("BHLRL",$J,CNTR)=$G(BHLT)
.. S CNTR=CNTR+1
. S BHLLMSG=$$LOG(BHLFNM,"R",DUZ)
. D STUFF
. D ^%ZISC
. K ^TMP("BHLRL",$J)
Q
;
CRLF(BHLLST,RFLG) ;-- parse by carriage return line feed
S BHLFDA=0 F S BHLFDA=$O(BHLLST(BHLFDA)) Q:'BHLFDA D
. D ^%ZISC
. S BHLFNM=$G(BHLLST(BHLFDA))
. S Y=$$OPEN^%ZISH(BHLDIR,BHLFNM,"R")
. I $G(Y),'$D(ZTQUEUED) W !,"Error Opening Device" Q
. S CNTR=1
. F I=1:1 U IO R BHLT:DTIME D Q:BHLT=""
.. Q:BHLT=""
.. S ^TMP("BHLRL",$J,CNTR)=$G(BHLT)
.. S CNTR=CNTR+1
. S BHLLMSG=$$LOG(BHLFNM,"R",DUZ)
. D STUFF
. D ^%ZISC
. K ^TMP("BHLRL",$J)
Q
;
CR(BHLLST,RFLG) ;-- parse message by CR only
S BHLFDA=0 F S BHLFDA=$O(BHLLST(BHLFDA)) Q:'BHLFDA D
. D ^%ZISC
. S BHLFNM=$G(BHLLST(BHLFDA))
. S Y=$$OPEN^%ZISH(BHLDIR,BHLFNM,"R")
. I $G(Y),'$D(ZTQUEUED) W !,"Error Opening Device" Q
. F I=1:1 U IO R BHLT:DTIME D Q:BHLT=""
.. S CNTR=1
.. Q:BHLT=""
.. F J=1:1 D Q:$P($G(BHLT),$C(10),J)=""
... Q:$P($G(BHLT),$C(10),J)=""
... I $E($P($G(BHLT),$C(10),J),1,3)="MSH",CNTR>1 D STUFF K ^TMP("BHLRL",$J) S CNTR=1
... S ^TMP("BHLRL",$J,CNTR)=$P($G(BHLT),$C(10),J)
... S CNTR=CNTR+1
.. S BHLLMSG=$$LOG(BHLFNM,"R",DUZ)
.. D STUFF
.. D ^%ZISC
.. K ^TMP("BHLRL",$J)
Q
;
STUFF ;-- stuff the information into ^INTHU
D NOW^%DTC S BHLDTM=$G(%)
S BHLH=$H
S BHLDEST=$O(^INRHD("B","HL IHS CHR R01 IN",0))
S BHLSTAT="N"
S BHLIO="I"
S BHLPRIO=1
K DD,DO
S DIC="^INTHU(",DIC(0)="L",X=BHLDTM
S DIC("DR")=".02////"_BHLDEST_";.03////"_BHLSTAT_";.1////"_BHLIO
S DIC("DR")=DIC("DR")_";.16///"_BHLPRIO
D FILE^DICN
S BHLUIF=+Y
S BHLLSMSG=$$LOGM(BHLFNM,BHLUIF)
S BHLDA=0 F S BHLDA=$O(^TMP("BHLRL",$J,BHLDA)) Q:'BHLDA D
. M ^INTHU(BHLUIF,3,BHLDA,0)=^TMP("BHLRL",$J,BHLDA)
. S ^INTHU(BHLUIF,3,BHLDA,0)=^INTHU(BHLUIF,3,BHLDA,0)_"|CR|"
;TODO call the filer here and pass in UIF
S ^INLHSCH(BHLPRIO,BHLH,BHLUIF)=""
;S ^INLHDEST(BHLDEST,0,$H,BHLUIF)=""
Q
;
REDO(BHLRLI) ;EP - redo the import
;cmi/maw we need to set up dynamic directory reads here
N BHLFLG,BHLDIR,BHLFST,BHLFLST,BHLLST
S BHLCHR=$O(^BCHSITE("B",BHLCHRI,0))
I $G(BHLCHR)="" S BHLFLG=1
I $G(BHLCHR)]"" D
. S BHLDIR=$P($G(^BCHSITE(BHLCHR,0)),U,13)
. I BHLDIR="" S BHLFLG=1 Q
. S BHLFST=$P($G(^BCHSITE(BHLCHR,0)),U,14)
. I BHLFST="" S BHLFLG=1 Q
I $G(BHLFLG) D Q
. Q:$D(ZTQUEUED)
. W !,"CHR Parameters not Defined in BCH SITE PARAMETER File"
S BHLFST=BHLFST_"*"
S BHLFLST=$$LIST(BHLDIR,BHLFST)
I BHLFLST<1 W !,"No Files in the directory, goodbye" Q
S BHLLSDA=0 F S BHLLSDA=$O(BHLLST(BHLLSDA)) Q:'BHLLSDA D
. W !,BHLLSDA_" - "_$G(BHLLST(BHLLSDA))
S DIR(0)="L^1:"_BHLFLST,DIR("A")="Reimport which file(s) "
D ^DIR
Q:$D(DIRUT)
S BHLFNMI=Y
F BHLI=1:1:(BHLFLST+1) S BHLFLI=$P(BHLFNMI,",",BHLI) Q:BHLFLI="" D
. S BHLFNM=$G(BHLLST(BHLFLI))
. S BHLFILES(BHLFLI)=BHLFNM
. I '$D(ZTQUEUED) D
.. W !!,"Now reading in CHR file "_BHLFNM_" from directory "_BHLSDIR
K BHLLST
D CR(.BHLFILES,1),EOJ Q
;D CRLF(.BHLFILES,1),EOJ
Q
;
MOVE(DIR,FN,OPS,SDIR) ;-- move files to storage directory
S BHLMVMSG=$$MV^%ZISH(DIR,FN,SDIR,FN) ;maw new 4/16/03
;cmi/maw original code below
;I '$G(OPS) S OPS=1
;I OPS=1 D Q
;S X=$$TERMINAL^%HOSTCMD("mv "_DIR_FN_" "_SDIR)
;S X=$ZOS(3,DIR_FN,SDIR_FN)
Q
;
LIST(DIR,LST) ;-- get a list of files in the directory
S Y=$$LIST^%ZISH(DIR,LST,.BHLLST)
Q $O(BHLLST(""),-1)
;
EOJ ;-- kill variables and quit
D EN^XBVK("BHL")
K ^BHLRL($J)
Q
;
LOG(FNM,TYP,USER) ;EP - log the entry
I $O(^BCHLOG("B",FNM,0)) D Q BHLLGI
. S BHLLGI=$O(^BCHLOG("B",FNM,0))
. S DIE="^BCHLOG(",DA=BHLLGI,DR=".03////"_$$NOW_";.04////"_USER
. D ^DIE
. K DIE
. Q
K DD,DO,DIC
S DIC="^BCHLOG(",DIC(0)="L"
S DIC("DR")=".02////"_$$NOW_";.04////"_USER
S X=FNM
D FILE^DICN
K DIC
Q +Y
;
LOGM(FNM,ENT) ;-- log the entry in the universal interface file
S BHLLGI=$O(^BCHLOG("B",FNM,0))
I 'BHLLGI Q ""
I $G(ENT),'$O(ENT("")) D Q BHLLLGI
. K DD,DO,DIC
. S DA(1)=BHLLGI
. S DIC="^BCHLOG("_DA(1)_",1,",X=$G(ENT),DIC(0)="L"
. S DIC("P")=$P(^DD(90002.99,1,0),U,2) ;TODO fix with correct fnumber
. D FILE^DICN
. S BHLLLGI=+Y
S BHLLDA=0 F S BHLLDA=$O(ENT(BHLLDA)) Q:'BHLLDA D
. K DD,DO,DIC
. S DA(1)=BHLLGI
. S DIC="^BCHLOG("_DA(1)_",1,",X=BHLLDA,DIC(0)="L"
. S DIC("P")=$P(^DD(90002.99,1,0),U,2) ;TODO fix with correct fnumber
. D FILE^DICN
. S BHLLLGI=+Y
Q $G(BHLLLGI)
;
NOW() ;-- get now
D NOW^%DTC
Q %
;
SITE ;EP - setup the site parameters in BHL HL7 PARAMETER file
N BHLRL
W !,"Now setting up CHR HL7 lab parameters.."
S DIC="^BCHSITE(",DIC(0)="AEMQZ"
S DIC("A")="Setup Parameters for which Site: "
D ^DIC
S BHLRL=+Y
Q:'BHLRL
S DIE=DIC,DA=BHLRL,DR=".13:.14"
D ^DIE
K DIE,DR,DIC,DA
S BHLMSG=$O(^INTHL7M("B","HL IHS CHR R01 IN",0))
Q:'BHLMSG
W !!,"Now activating CHR Interface.."
D COMPILE^BHLU(BHLMSG)
Q
;
BHLCHRI ; cmi/anch/maw - BHL Read CHR data into ^INTHU ;
+1 ;;3.01;BHL IHS Interfaces with GIS;**10,14**;JUL 1, 2005
+2 ;
+3 ;
+4 ;this routine will grab a file from HFS and stuff it into the ^INTHU
+5 ;global for processing
+6 ;
MAIN ;-- this is the main routine driver
+1 NEW BHLY
+2 DO ^%ZISC
+3 KILL ^TMP("BHLRL",$JOB)
+4 SET BHLY=$$CHK^BHLBCK("OUTPUT CONTROLLER")
+5 DO READ(DUZ(2))
+6 DO EOJ
+7 QUIT
+8 ;
READ(BHLCHRI) ;-- read the file in
+1 ;cmi/maw we need to set up dynamic directory reads here
+2 NEW BHLFLG,BHLDIR,BHLFST,BHLFLST,BHLLST
+3 SET BHLCHR=$ORDER(^BCHSITE("B",BHLCHRI,0))
+4 IF $GET(BHLCHR)=""
SET BHLFLG=1
+5 IF $GET(BHLCHR)]""
Begin DoDot:1
+6 SET BHLDIR=$PIECE($GET(^BCHSITE(BHLCHR,0)),U,13)
+7 IF BHLDIR=""
SET BHLFLG=1
QUIT
+8 SET BHLFST=$PIECE($GET(^BCHSITE(BHLCHR,0)),U,14)
+9 IF BHLFST=""
SET BHLFLG=1
QUIT
End DoDot:1
+10 IF $GET(BHLFLG)
Begin DoDot:1
+11 IF $DATA(ZTQUEUED)
QUIT
+12 WRITE !,"CHR Parameters not Defined in BCH SITE PARAMETER File"
End DoDot:1
QUIT
+13 SET BHLFST=BHLFST_"*"
+14 IF '$DATA(ZTQUEUED)
Begin DoDot:1
+15 WRITE !!,"Now reading in CHR file from directory "_BHLDIR
End DoDot:1
+16 SET BHLFLST=$$LIST^%ZISH(BHLDIR,BHLFST,.BHLLST)
+17 ;D CR(.BHLLST,"") Q
+18 DO LC(.BHLLST,"")
+19 QUIT
+20 ;
LC(BHLLST,RFLG) ;-- parse
+1 SET BHLFDA=0
FOR
SET BHLFDA=$ORDER(BHLLST(BHLFDA))
IF 'BHLFDA
QUIT
Begin DoDot:1
+2 DO ^%ZISC
+3 SET BHLFNM=$GET(BHLLST(BHLFDA))
+4 SET Y=$$OPEN^%ZISH(BHLDIR,BHLFNM,"R")
+5 IF $GET(Y)
IF '$DATA(ZTQUEUED)
WRITE !,"Error Opening Device"
QUIT
+6 SET CNTR=1
+7 FOR I=1:1
USE IO
READ BHLT:DTIME
Begin DoDot:2
+8 IF BHLT=""
QUIT
+9 IF $EXTRACT($GET(BHLT),1,3)="MSH"
IF CNTR>1
DO STUFF
KILL ^TMP("BHLRL",$JOB)
SET CNTR=1
+10 SET ^TMP("BHLRL",$JOB,CNTR)=$GET(BHLT)
+11 SET CNTR=CNTR+1
End DoDot:2
IF BHLT=""
QUIT
+12 SET BHLLMSG=$$LOG(BHLFNM,"R",DUZ)
+13 DO STUFF
+14 DO ^%ZISC
+15 KILL ^TMP("BHLRL",$JOB)
End DoDot:1
+16 QUIT
+17 ;
CRLF(BHLLST,RFLG) ;-- parse by carriage return line feed
+1 SET BHLFDA=0
FOR
SET BHLFDA=$ORDER(BHLLST(BHLFDA))
IF 'BHLFDA
QUIT
Begin DoDot:1
+2 DO ^%ZISC
+3 SET BHLFNM=$GET(BHLLST(BHLFDA))
+4 SET Y=$$OPEN^%ZISH(BHLDIR,BHLFNM,"R")
+5 IF $GET(Y)
IF '$DATA(ZTQUEUED)
WRITE !,"Error Opening Device"
QUIT
+6 SET CNTR=1
+7 FOR I=1:1
USE IO
READ BHLT:DTIME
Begin DoDot:2
+8 IF BHLT=""
QUIT
+9 SET ^TMP("BHLRL",$JOB,CNTR)=$GET(BHLT)
+10 SET CNTR=CNTR+1
End DoDot:2
IF BHLT=""
QUIT
+11 SET BHLLMSG=$$LOG(BHLFNM,"R",DUZ)
+12 DO STUFF
+13 DO ^%ZISC
+14 KILL ^TMP("BHLRL",$JOB)
End DoDot:1
+15 QUIT
+16 ;
CR(BHLLST,RFLG) ;-- parse message by CR only
+1 SET BHLFDA=0
FOR
SET BHLFDA=$ORDER(BHLLST(BHLFDA))
IF 'BHLFDA
QUIT
Begin DoDot:1
+2 DO ^%ZISC
+3 SET BHLFNM=$GET(BHLLST(BHLFDA))
+4 SET Y=$$OPEN^%ZISH(BHLDIR,BHLFNM,"R")
+5 IF $GET(Y)
IF '$DATA(ZTQUEUED)
WRITE !,"Error Opening Device"
QUIT
+6 FOR I=1:1
USE IO
READ BHLT:DTIME
Begin DoDot:2
+7 SET CNTR=1
+8 IF BHLT=""
QUIT
+9 FOR J=1:1
Begin DoDot:3
+10 IF $PIECE($GET(BHLT),$CHAR(10),J)=""
QUIT
+11 IF $EXTRACT($PIECE($GET(BHLT),$CHAR(10),J),1,3)="MSH"
IF CNTR>1
DO STUFF
KILL ^TMP("BHLRL",$JOB)
SET CNTR=1
+12 SET ^TMP("BHLRL",$JOB,CNTR)=$PIECE($GET(BHLT),$CHAR(10),J)
+13 SET CNTR=CNTR+1
End DoDot:3
IF $PIECE($GET(BHLT),$CHAR(10),J)=""
QUIT
+14 SET BHLLMSG=$$LOG(BHLFNM,"R",DUZ)
+15 DO STUFF
+16 DO ^%ZISC
+17 KILL ^TMP("BHLRL",$JOB)
End DoDot:2
IF BHLT=""
QUIT
End DoDot:1
+18 QUIT
+19 ;
STUFF ;-- stuff the information into ^INTHU
+1 DO NOW^%DTC
SET BHLDTM=$GET(%)
+2 SET BHLH=$HOROLOG
+3 SET BHLDEST=$ORDER(^INRHD("B","HL IHS CHR R01 IN",0))
+4 SET BHLSTAT="N"
+5 SET BHLIO="I"
+6 SET BHLPRIO=1
+7 KILL DD,DO
+8 SET DIC="^INTHU("
SET DIC(0)="L"
SET X=BHLDTM
+9 SET DIC("DR")=".02////"_BHLDEST_";.03////"_BHLSTAT_";.1////"_BHLIO
+10 SET DIC("DR")=DIC("DR")_";.16///"_BHLPRIO
+11 DO FILE^DICN
+12 SET BHLUIF=+Y
+13 SET BHLLSMSG=$$LOGM(BHLFNM,BHLUIF)
+14 SET BHLDA=0
FOR
SET BHLDA=$ORDER(^TMP("BHLRL",$JOB,BHLDA))
IF 'BHLDA
QUIT
Begin DoDot:1
+15 MERGE ^INTHU(BHLUIF,3,BHLDA,0)=^TMP("BHLRL",$JOB,BHLDA)
+16 SET ^INTHU(BHLUIF,3,BHLDA,0)=^INTHU(BHLUIF,3,BHLDA,0)_"|CR|"
End DoDot:1
+17 ;TODO call the filer here and pass in UIF
+18 SET ^INLHSCH(BHLPRIO,BHLH,BHLUIF)=""
+19 ;S ^INLHDEST(BHLDEST,0,$H,BHLUIF)=""
+20 QUIT
+21 ;
REDO(BHLRLI) ;EP - redo the import
+1 ;cmi/maw we need to set up dynamic directory reads here
+2 NEW BHLFLG,BHLDIR,BHLFST,BHLFLST,BHLLST
+3 SET BHLCHR=$ORDER(^BCHSITE("B",BHLCHRI,0))
+4 IF $GET(BHLCHR)=""
SET BHLFLG=1
+5 IF $GET(BHLCHR)]""
Begin DoDot:1
+6 SET BHLDIR=$PIECE($GET(^BCHSITE(BHLCHR,0)),U,13)
+7 IF BHLDIR=""
SET BHLFLG=1
QUIT
+8 SET BHLFST=$PIECE($GET(^BCHSITE(BHLCHR,0)),U,14)
+9 IF BHLFST=""
SET BHLFLG=1
QUIT
End DoDot:1
+10 IF $GET(BHLFLG)
Begin DoDot:1
+11 IF $DATA(ZTQUEUED)
QUIT
+12 WRITE !,"CHR Parameters not Defined in BCH SITE PARAMETER File"
End DoDot:1
QUIT
+13 SET BHLFST=BHLFST_"*"
+14 SET BHLFLST=$$LIST(BHLDIR,BHLFST)
+15 IF BHLFLST<1
WRITE !,"No Files in the directory, goodbye"
QUIT
+16 SET BHLLSDA=0
FOR
SET BHLLSDA=$ORDER(BHLLST(BHLLSDA))
IF 'BHLLSDA
QUIT
Begin DoDot:1
+17 WRITE !,BHLLSDA_" - "_$GET(BHLLST(BHLLSDA))
End DoDot:1
+18 SET DIR(0)="L^1:"_BHLFLST
SET DIR("A")="Reimport which file(s) "
+19 DO ^DIR
+20 IF $DATA(DIRUT)
QUIT
+21 SET BHLFNMI=Y
+22 FOR BHLI=1:1:(BHLFLST+1)
SET BHLFLI=$PIECE(BHLFNMI,",",BHLI)
IF BHLFLI=""
QUIT
Begin DoDot:1
+23 SET BHLFNM=$GET(BHLLST(BHLFLI))
+24 SET BHLFILES(BHLFLI)=BHLFNM
+25 IF '$DATA(ZTQUEUED)
Begin DoDot:2
+26 WRITE !!,"Now reading in CHR file "_BHLFNM_" from directory "_BHLSDIR
End DoDot:2
End DoDot:1
+27 KILL BHLLST
+28 DO CR(.BHLFILES,1)
DO EOJ
QUIT
+29 ;D CRLF(.BHLFILES,1),EOJ
+30 QUIT
+31 ;
MOVE(DIR,FN,OPS,SDIR) ;-- move files to storage directory
+1 ;maw new 4/16/03
SET BHLMVMSG=$$MV^%ZISH(DIR,FN,SDIR,FN)
+2 ;cmi/maw original code below
+3 ;I '$G(OPS) S OPS=1
+4 ;I OPS=1 D Q
+5 ;S X=$$TERMINAL^%HOSTCMD("mv "_DIR_FN_" "_SDIR)
+6 ;S X=$ZOS(3,DIR_FN,SDIR_FN)
+7 QUIT
+8 ;
LIST(DIR,LST) ;-- get a list of files in the directory
+1 SET Y=$$LIST^%ZISH(DIR,LST,.BHLLST)
+2 QUIT $ORDER(BHLLST(""),-1)
+3 ;
EOJ ;-- kill variables and quit
+1 DO EN^XBVK("BHL")
+2 KILL ^BHLRL($JOB)
+3 QUIT
+4 ;
LOG(FNM,TYP,USER) ;EP - log the entry
+1 IF $ORDER(^BCHLOG("B",FNM,0))
Begin DoDot:1
+2 SET BHLLGI=$ORDER(^BCHLOG("B",FNM,0))
+3 SET DIE="^BCHLOG("
SET DA=BHLLGI
SET DR=".03////"_$$NOW_";.04////"_USER
+4 DO ^DIE
+5 KILL DIE
+6 QUIT
End DoDot:1
QUIT BHLLGI
+7 KILL DD,DO,DIC
+8 SET DIC="^BCHLOG("
SET DIC(0)="L"
+9 SET DIC("DR")=".02////"_$$NOW_";.04////"_USER
+10 SET X=FNM
+11 DO FILE^DICN
+12 KILL DIC
+13 QUIT +Y
+14 ;
LOGM(FNM,ENT) ;-- log the entry in the universal interface file
+1 SET BHLLGI=$ORDER(^BCHLOG("B",FNM,0))
+2 IF 'BHLLGI
QUIT ""
+3 IF $GET(ENT)
IF '$ORDER(ENT(""))
Begin DoDot:1
+4 KILL DD,DO,DIC
+5 SET DA(1)=BHLLGI
+6 SET DIC="^BCHLOG("_DA(1)_",1,"
SET X=$GET(ENT)
SET DIC(0)="L"
+7 ;TODO fix with correct fnumber
SET DIC("P")=$PIECE(^DD(90002.99,1,0),U,2)
+8 DO FILE^DICN
+9 SET BHLLLGI=+Y
End DoDot:1
QUIT BHLLLGI
+10 SET BHLLDA=0
FOR
SET BHLLDA=$ORDER(ENT(BHLLDA))
IF 'BHLLDA
QUIT
Begin DoDot:1
+11 KILL DD,DO,DIC
+12 SET DA(1)=BHLLGI
+13 SET DIC="^BCHLOG("_DA(1)_",1,"
SET X=BHLLDA
SET DIC(0)="L"
+14 ;TODO fix with correct fnumber
SET DIC("P")=$PIECE(^DD(90002.99,1,0),U,2)
+15 DO FILE^DICN
+16 SET BHLLLGI=+Y
End DoDot:1
+17 QUIT $GET(BHLLLGI)
+18 ;
NOW() ;-- get now
+1 DO NOW^%DTC
+2 QUIT %
+3 ;
SITE ;EP - setup the site parameters in BHL HL7 PARAMETER file
+1 NEW BHLRL
+2 WRITE !,"Now setting up CHR HL7 lab parameters.."
+3 SET DIC="^BCHSITE("
SET DIC(0)="AEMQZ"
+4 SET DIC("A")="Setup Parameters for which Site: "
+5 DO ^DIC
+6 SET BHLRL=+Y
+7 IF 'BHLRL
QUIT
+8 SET DIE=DIC
SET DA=BHLRL
SET DR=".13:.14"
+9 DO ^DIE
+10 KILL DIE,DR,DIC,DA
+11 SET BHLMSG=$ORDER(^INTHL7M("B","HL IHS CHR R01 IN",0))
+12 IF 'BHLMSG
QUIT
+13 WRITE !!,"Now activating CHR Interface.."
+14 DO COMPILE^BHLU(BHLMSG)
+15 QUIT
+16 ;