Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BHLCHRI

BHLCHRI.m

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