BLRRLMP ; cmi/anch/maw - BLR Read Reference Lab into ^INTHU ;
;;5.2;LR;**1021**;Jul 27, 2006
;;1.0;BLR REFERENCE LAB;;MAR 14, 2005
;
;
;
;this routine will grab a file from UNIX and stuff it into the ^INTHU
;global for processing
;
MAIN ;-- this is the main routine driver
D ^%ZISC
K ^TMP("BLRRL",$J)
S BLRY=$$CHK^BHLBCK("OUTPUT CONTROLLER")
D READ(DUZ(2))
D EOJ
Q
;
READ(BLRRLI) ;-- read the file in
;cmi/maw we need to set up dynamic directory reads here
S BLRRL=$P($G(^BLRSITE(BLRRLI,"RL")),U)
I $G(BLRRL)="" D Q
. Q:$D(ZTQUEUED)
. W !,"Reference Lab not defined in BLR MASTER CONTROL File"
S BLRRLNM=$P($G(^BLRRL(BLRRL,0)),U)
S BLRDIR=$P($G(^BLRRL(BLRRL,0)),U,16)
S BLRSDIR=$P($G(^BLRRL(BLRRL,0)),U,9)
S BLROPS=$P($G(^AUTTSITE(1,0)),U,21)
S BLRFST=$P($G(^BLRRL(BLRRL,0)),U,7)_"*"
I '$D(ZTQUEUED) D
. W !!,"Now reading in reference lab file from directory "_BLRDIR
S BLRFLST=$$LIST^%ZISH(BLRDIR,BLRFST,.BLRLST)
I $G(BLRRLNM)="LABCORP" D LC(.BLRLST,"") Q
I $G(BLRRLNM)="UNILAB" D LC(.BLRLST,"") Q
I $P($G(^BLRRL(BLRRL,0)),U,8) D CR(.BLRLST,"") Q
D CRLF(.BLRLST,"")
Q
;
LC(BLRLST,RFLG) ;-- parse specifically for labcorp
S BLRFDA=0 F S BLRFDA=$O(BLRLST(BLRFDA)) Q:'BLRFDA D
. D ^%ZISC
. S BLRFNM=$G(BLRLST(BLRFDA))
. Q:BLRFNM["ord" ;testing
. S Y=$$OPEN^%ZISH(BLRDIR,BLRFNM,"R")
. I $G(Y),'$D(ZTQUEUED) W !,"Error Opening Device" Q
. S CNTR=1
. F I=1:1 U IO R BLRT:DTIME D Q:BLRT=""
.. Q:BLRT=""
.. I $E($G(BLRT),1,3)="MSH",CNTR>1 D STUFF K ^TMP("BLRRL",$J) S CNTR=1
.. S ^TMP("BLRRL",$J,CNTR)=$G(BLRT)
.. S CNTR=CNTR+1
. S BLRLMSG=$$LOG^BLRRLU(BLRFNM,"R",DUZ)
. D STUFF
. D ^%ZISC
. I '$G(RFLG) D
.. W:'$D(ZTQUEUED) !,"Now backing up read in file",!
.. D MOVE(BLRDIR,BLRFNM,BLROPS,BLRSDIR)
. K ^TMP("BLRRL",$J)
Q
;
CRLF(BLRLST,RFLG) ;-- parse by carriage return line feed
S BLRFDA=0 F S BLRFDA=$O(BLRLST(BLRFDA)) Q:'BLRFDA D
. D ^%ZISC
. S BLRFNM=$G(BLRLST(BLRFDA))
. Q:BLRFNM["ord" ;testing
. S Y=$$OPEN^%ZISH(BLRDIR,BLRFNM,"R")
. I $G(Y),'$D(ZTQUEUED) W !,"Error Opening Device" Q
. S CNTR=1
. F I=1:1 U IO R BLRT:DTIME D Q:BLRT=""
.. Q:BLRT=""
.. S ^TMP("BLRRL",$J,CNTR)=$G(BLRT)
.. S CNTR=CNTR+1
. S BLRLMSG=$$LOG^BLRRLU(BLRFNM,"R",DUZ)
. D STUFF
. D ^%ZISC
. I '$G(RFLG) D
.. W:'$D(ZTQUEUED) !,"Now backing up read in file",!
.. D MOVE(BLRDIR,BLRFNM,BLROPS,BLRSDIR)
. K ^TMP("BLRRL",$J)
Q
;
CR(BLRLST,RFLG) ;-- parse message by CR only
S BLRFDA=0 F S BLRFDA=$O(BLRLST(BLRFDA)) Q:'BLRFDA D
. D ^%ZISC
. S BLRFNM=$G(BLRLST(BLRFDA))
. Q:BLRFNM["ord" ;testing
. S Y=$$OPEN^%ZISH(BLRDIR,BLRFNM,"R")
. I $G(Y),'$D(ZTQUEUED) W !,"Error Opening Device" Q
. F I=1:1 U IO R BLRT:DTIME D Q:BLRT=""
.. S CNTR=1
.. Q:BLRT=""
.. F J=1:1 D Q:$P($G(BLRT),$C(10),J)=""
... Q:$P($G(BLRT),$C(10),J)=""
... I $E($P($G(BLRT),$C(10),J),1,3)="MSH",CNTR>1 D STUFF K ^TMP("BLRRL",$J) S CNTR=1
... S ^TMP("BLRRL",$J,CNTR)=$P($G(BLRT),$C(10),J)
... S CNTR=CNTR+1
.. S BLRLMSG=$$LOG^BLRRLU(BLRFNM,"R",DUZ)
.. D STUFF
.. D ^%ZISC
.. I '$G(RFLG) D
... W:'$D(ZTQUEUED) !,"Now backing up read in file",!
... D MOVE(BLRDIR,BLRFNM,BLROPS,BLRSDIR)
.. K ^TMP("BLRRL",$J)
Q
;
STUFF ;-- stuff the information into ^INTHU
D NOW^%DTC S BLRDTM=$G(%)
S BLRH=$H
S BLRDEST=$O(^INRHD("B","HL IHS LAB R01 "_BLRRLNM_" IN",0))
S BLRSTAT="N"
S BLRIO="I"
S BLRPRIO=1
K DD,DO
S DIC="^INTHU(",DIC(0)="L",X=BLRDTM
S DIC("DR")=".02////"_BLRDEST_";.03////"_BLRSTAT_";.1////"_BLRIO
S DIC("DR")=DIC("DR")_";.16///"_BLRPRIO
D FILE^DICN
S BLRUIF=+Y
S BLRLSMSG=$$LOGM^BLRRLU(BLRFNM,BLRUIF)
S BLRDA=0 F S BLRDA=$O(^TMP("BLRRL",$J,BLRDA)) Q:'BLRDA D
. M ^INTHU(BLRUIF,3,BLRDA,0)=^TMP("BLRRL",$J,BLRDA)
. S ^INTHU(BLRUIF,3,BLRDA,0)=^INTHU(BLRUIF,3,BLRDA,0)_"|CR|"
S ^INLHSCH(BLRPRIO,BLRH,BLRUIF)=""
;S ^INLHDEST(BLRDEST,0,$H,BLRUIF)=""
Q
;
REDO(BLRRLI) ; EP -- redo the import
;cmi/maw we need to set up dynamic directory reads here
S BLRRL=$P($G(^BLRSITE(BLRRLI,"RL")),U)
I $G(BLRRL)="" D Q
. Q:$D(ZTQUEUED)
. W !,"Reference Lab not defined in BLR MASTER CONTROL File"
S BLRRLNM=$P($G(^BLRRL(BLRRL,0)),U)
S BLRDIR=$P($G(^BLRRL(BLRRL,0)),U,2)
S BLRSDIR=$P($G(^BLRRL(BLRRL,0)),U,9)
S BLROPS=$P($G(^AUTTSITE(1,0)),U,21)
S BLRFST=$P($G(^BLRRL(BLRRL,0)),U,7)_"*"
S BLRFLST=$$LIST(BLRSDIR,BLRFST)
I BLRFLST<1 W !,"No Files in the directory, goodbye" Q
S BLRLSDA=0 F S BLRLSDA=$O(BLRLST(BLRLSDA)) Q:'BLRLSDA D
. W !,BLRLSDA_" - "_$G(BLRLST(BLRLSDA))
S DIR(0)="L^1:"_BLRFLST,DIR("A")="Reimport which file(s) "
D ^DIR
Q:$D(DIRUT)
S BLRFNMI=Y
F BLRI=1:1:(BLRFLST+1) S BLRFLI=$P(BLRFNMI,",",BLRI) Q:BLRFLI="" D
. S BLRFNM=$G(BLRLST(BLRFLI))
. S BLRFILES(BLRFLI)=BLRFNM
. I '$D(ZTQUEUED) D
.. W !!,"Now reading in reference lab file "_BLRFNM_" from directory "_BLRSDIR
K BLRLST
I $P($G(^BLRRL(BLRRL,0)),U,8) D CR(.BLRFILES,1),EOJ Q
D CRLF(.BLRFILES,1),EOJ
Q
;
MOVE(DIR,FN,OPS,SDIR) ;-- move files to storage directory
S BLRMVMSG=$$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,.BLRLST)
Q $O(BLRLST(""),-1)
;
EOJ ;-- kill variables and quit
D EN^XBVK("BLR")
K ^BLRRL($J)
Q
;
BLRRLMP ; cmi/anch/maw - BLR Read Reference Lab into ^INTHU ;
+1 ;;5.2;LR;**1021**;Jul 27, 2006
+2 ;;1.0;BLR REFERENCE LAB;;MAR 14, 2005
+3 ;
+4 ;
+5 ;
+6 ;this routine will grab a file from UNIX and stuff it into the ^INTHU
+7 ;global for processing
+8 ;
MAIN ;-- this is the main routine driver
+1 DO ^%ZISC
+2 KILL ^TMP("BLRRL",$JOB)
+3 SET BLRY=$$CHK^BHLBCK("OUTPUT CONTROLLER")
+4 DO READ(DUZ(2))
+5 DO EOJ
+6 QUIT
+7 ;
READ(BLRRLI) ;-- read the file in
+1 ;cmi/maw we need to set up dynamic directory reads here
+2 SET BLRRL=$PIECE($GET(^BLRSITE(BLRRLI,"RL")),U)
+3 IF $GET(BLRRL)=""
Begin DoDot:1
+4 IF $DATA(ZTQUEUED)
QUIT
+5 WRITE !,"Reference Lab not defined in BLR MASTER CONTROL File"
End DoDot:1
QUIT
+6 SET BLRRLNM=$PIECE($GET(^BLRRL(BLRRL,0)),U)
+7 SET BLRDIR=$PIECE($GET(^BLRRL(BLRRL,0)),U,16)
+8 SET BLRSDIR=$PIECE($GET(^BLRRL(BLRRL,0)),U,9)
+9 SET BLROPS=$PIECE($GET(^AUTTSITE(1,0)),U,21)
+10 SET BLRFST=$PIECE($GET(^BLRRL(BLRRL,0)),U,7)_"*"
+11 IF '$DATA(ZTQUEUED)
Begin DoDot:1
+12 WRITE !!,"Now reading in reference lab file from directory "_BLRDIR
End DoDot:1
+13 SET BLRFLST=$$LIST^%ZISH(BLRDIR,BLRFST,.BLRLST)
+14 IF $GET(BLRRLNM)="LABCORP"
DO LC(.BLRLST,"")
QUIT
+15 IF $GET(BLRRLNM)="UNILAB"
DO LC(.BLRLST,"")
QUIT
+16 IF $PIECE($GET(^BLRRL(BLRRL,0)),U,8)
DO CR(.BLRLST,"")
QUIT
+17 DO CRLF(.BLRLST,"")
+18 QUIT
+19 ;
LC(BLRLST,RFLG) ;-- parse specifically for labcorp
+1 SET BLRFDA=0
FOR
SET BLRFDA=$ORDER(BLRLST(BLRFDA))
IF 'BLRFDA
QUIT
Begin DoDot:1
+2 DO ^%ZISC
+3 SET BLRFNM=$GET(BLRLST(BLRFDA))
+4 ;testing
IF BLRFNM["ord"
QUIT
+5 SET Y=$$OPEN^%ZISH(BLRDIR,BLRFNM,"R")
+6 IF $GET(Y)
IF '$DATA(ZTQUEUED)
WRITE !,"Error Opening Device"
QUIT
+7 SET CNTR=1
+8 FOR I=1:1
USE IO
READ BLRT:DTIME
Begin DoDot:2
+9 IF BLRT=""
QUIT
+10 IF $EXTRACT($GET(BLRT),1,3)="MSH"
IF CNTR>1
DO STUFF
KILL ^TMP("BLRRL",$JOB)
SET CNTR=1
+11 SET ^TMP("BLRRL",$JOB,CNTR)=$GET(BLRT)
+12 SET CNTR=CNTR+1
End DoDot:2
IF BLRT=""
QUIT
+13 SET BLRLMSG=$$LOG^BLRRLU(BLRFNM,"R",DUZ)
+14 DO STUFF
+15 DO ^%ZISC
+16 IF '$GET(RFLG)
Begin DoDot:2
+17 IF '$DATA(ZTQUEUED)
WRITE !,"Now backing up read in file",!
+18 DO MOVE(BLRDIR,BLRFNM,BLROPS,BLRSDIR)
End DoDot:2
+19 KILL ^TMP("BLRRL",$JOB)
End DoDot:1
+20 QUIT
+21 ;
CRLF(BLRLST,RFLG) ;-- parse by carriage return line feed
+1 SET BLRFDA=0
FOR
SET BLRFDA=$ORDER(BLRLST(BLRFDA))
IF 'BLRFDA
QUIT
Begin DoDot:1
+2 DO ^%ZISC
+3 SET BLRFNM=$GET(BLRLST(BLRFDA))
+4 ;testing
IF BLRFNM["ord"
QUIT
+5 SET Y=$$OPEN^%ZISH(BLRDIR,BLRFNM,"R")
+6 IF $GET(Y)
IF '$DATA(ZTQUEUED)
WRITE !,"Error Opening Device"
QUIT
+7 SET CNTR=1
+8 FOR I=1:1
USE IO
READ BLRT:DTIME
Begin DoDot:2
+9 IF BLRT=""
QUIT
+10 SET ^TMP("BLRRL",$JOB,CNTR)=$GET(BLRT)
+11 SET CNTR=CNTR+1
End DoDot:2
IF BLRT=""
QUIT
+12 SET BLRLMSG=$$LOG^BLRRLU(BLRFNM,"R",DUZ)
+13 DO STUFF
+14 DO ^%ZISC
+15 IF '$GET(RFLG)
Begin DoDot:2
+16 IF '$DATA(ZTQUEUED)
WRITE !,"Now backing up read in file",!
+17 DO MOVE(BLRDIR,BLRFNM,BLROPS,BLRSDIR)
End DoDot:2
+18 KILL ^TMP("BLRRL",$JOB)
End DoDot:1
+19 QUIT
+20 ;
CR(BLRLST,RFLG) ;-- parse message by CR only
+1 SET BLRFDA=0
FOR
SET BLRFDA=$ORDER(BLRLST(BLRFDA))
IF 'BLRFDA
QUIT
Begin DoDot:1
+2 DO ^%ZISC
+3 SET BLRFNM=$GET(BLRLST(BLRFDA))
+4 ;testing
IF BLRFNM["ord"
QUIT
+5 SET Y=$$OPEN^%ZISH(BLRDIR,BLRFNM,"R")
+6 IF $GET(Y)
IF '$DATA(ZTQUEUED)
WRITE !,"Error Opening Device"
QUIT
+7 FOR I=1:1
USE IO
READ BLRT:DTIME
Begin DoDot:2
+8 SET CNTR=1
+9 IF BLRT=""
QUIT
+10 FOR J=1:1
Begin DoDot:3
+11 IF $PIECE($GET(BLRT),$CHAR(10),J)=""
QUIT
+12 IF $EXTRACT($PIECE($GET(BLRT),$CHAR(10),J),1,3)="MSH"
IF CNTR>1
DO STUFF
KILL ^TMP("BLRRL",$JOB)
SET CNTR=1
+13 SET ^TMP("BLRRL",$JOB,CNTR)=$PIECE($GET(BLRT),$CHAR(10),J)
+14 SET CNTR=CNTR+1
End DoDot:3
IF $PIECE($GET(BLRT),$CHAR(10),J)=""
QUIT
+15 SET BLRLMSG=$$LOG^BLRRLU(BLRFNM,"R",DUZ)
+16 DO STUFF
+17 DO ^%ZISC
+18 IF '$GET(RFLG)
Begin DoDot:3
+19 IF '$DATA(ZTQUEUED)
WRITE !,"Now backing up read in file",!
+20 DO MOVE(BLRDIR,BLRFNM,BLROPS,BLRSDIR)
End DoDot:3
+21 KILL ^TMP("BLRRL",$JOB)
End DoDot:2
IF BLRT=""
QUIT
End DoDot:1
+22 QUIT
+23 ;
STUFF ;-- stuff the information into ^INTHU
+1 DO NOW^%DTC
SET BLRDTM=$GET(%)
+2 SET BLRH=$HOROLOG
+3 SET BLRDEST=$ORDER(^INRHD("B","HL IHS LAB R01 "_BLRRLNM_" IN",0))
+4 SET BLRSTAT="N"
+5 SET BLRIO="I"
+6 SET BLRPRIO=1
+7 KILL DD,DO
+8 SET DIC="^INTHU("
SET DIC(0)="L"
SET X=BLRDTM
+9 SET DIC("DR")=".02////"_BLRDEST_";.03////"_BLRSTAT_";.1////"_BLRIO
+10 SET DIC("DR")=DIC("DR")_";.16///"_BLRPRIO
+11 DO FILE^DICN
+12 SET BLRUIF=+Y
+13 SET BLRLSMSG=$$LOGM^BLRRLU(BLRFNM,BLRUIF)
+14 SET BLRDA=0
FOR
SET BLRDA=$ORDER(^TMP("BLRRL",$JOB,BLRDA))
IF 'BLRDA
QUIT
Begin DoDot:1
+15 MERGE ^INTHU(BLRUIF,3,BLRDA,0)=^TMP("BLRRL",$JOB,BLRDA)
+16 SET ^INTHU(BLRUIF,3,BLRDA,0)=^INTHU(BLRUIF,3,BLRDA,0)_"|CR|"
End DoDot:1
+17 SET ^INLHSCH(BLRPRIO,BLRH,BLRUIF)=""
+18 ;S ^INLHDEST(BLRDEST,0,$H,BLRUIF)=""
+19 QUIT
+20 ;
REDO(BLRRLI) ; EP -- redo the import
+1 ;cmi/maw we need to set up dynamic directory reads here
+2 SET BLRRL=$PIECE($GET(^BLRSITE(BLRRLI,"RL")),U)
+3 IF $GET(BLRRL)=""
Begin DoDot:1
+4 IF $DATA(ZTQUEUED)
QUIT
+5 WRITE !,"Reference Lab not defined in BLR MASTER CONTROL File"
End DoDot:1
QUIT
+6 SET BLRRLNM=$PIECE($GET(^BLRRL(BLRRL,0)),U)
+7 SET BLRDIR=$PIECE($GET(^BLRRL(BLRRL,0)),U,2)
+8 SET BLRSDIR=$PIECE($GET(^BLRRL(BLRRL,0)),U,9)
+9 SET BLROPS=$PIECE($GET(^AUTTSITE(1,0)),U,21)
+10 SET BLRFST=$PIECE($GET(^BLRRL(BLRRL,0)),U,7)_"*"
+11 SET BLRFLST=$$LIST(BLRSDIR,BLRFST)
+12 IF BLRFLST<1
WRITE !,"No Files in the directory, goodbye"
QUIT
+13 SET BLRLSDA=0
FOR
SET BLRLSDA=$ORDER(BLRLST(BLRLSDA))
IF 'BLRLSDA
QUIT
Begin DoDot:1
+14 WRITE !,BLRLSDA_" - "_$GET(BLRLST(BLRLSDA))
End DoDot:1
+15 SET DIR(0)="L^1:"_BLRFLST
SET DIR("A")="Reimport which file(s) "
+16 DO ^DIR
+17 IF $DATA(DIRUT)
QUIT
+18 SET BLRFNMI=Y
+19 FOR BLRI=1:1:(BLRFLST+1)
SET BLRFLI=$PIECE(BLRFNMI,",",BLRI)
IF BLRFLI=""
QUIT
Begin DoDot:1
+20 SET BLRFNM=$GET(BLRLST(BLRFLI))
+21 SET BLRFILES(BLRFLI)=BLRFNM
+22 IF '$DATA(ZTQUEUED)
Begin DoDot:2
+23 WRITE !!,"Now reading in reference lab file "_BLRFNM_" from directory "_BLRSDIR
End DoDot:2
End DoDot:1
+24 KILL BLRLST
+25 IF $PIECE($GET(^BLRRL(BLRRL,0)),U,8)
DO CR(.BLRFILES,1)
DO EOJ
QUIT
+26 DO CRLF(.BLRFILES,1)
DO EOJ
+27 QUIT
+28 ;
MOVE(DIR,FN,OPS,SDIR) ;-- move files to storage directory
+1 ;maw new 4/16/03
SET BLRMVMSG=$$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,.BLRLST)
+2 QUIT $ORDER(BLRLST(""),-1)
+3 ;
EOJ ;-- kill variables and quit
+1 DO EN^XBVK("BLR")
+2 KILL ^BLRRL($JOB)
+3 QUIT
+4 ;
