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

BLSLX.m

Go to the documentation of this file. 
  1. BLSLX ; IHS/CMI/LAB - BLS export data ;  [ 02/20/2003  6:40 AM ]
  1.  ;;5.2;LR;**1015**;NOV 18, 2002
  1.  ;
  1.  ;
  1. EN(BLSX) ;EP - called from APCDALVR
  1.  I '$G(BLSX) Q
  1.  Q:'$$ADDON^BLRUTIL("LR*5.2*1015","BLSLX",DUZ(2))  ;REAL 
  1.  I '$D(^AUPNVLAB(BLSX)) Q
  1.  I $P($G(^AUPNVLAB(BLSX,11)),U,9)'="R" Q
  1.  NEW BLSLOINC
  1.  S BLSLOINC=$P($G(^AUPNVLAB(BLSX,11)),U,13)
  1.  Q:BLSLOINC=""
  1.  I '$D(^BLSELL(BLSLOINC)) Q  ;not a test cereplex wants
  1.  I '$G(BLSRX) I $D(^BLSLX(BLSX,0)),$P(^BLSLX(BLSX,0),U,3)="" Q
  1.  S ^BLSLX(BLSX,0)=BLSX_"^"_DT
  1.  S ^BLSLX("AEXP",DT,BLSX)="",^BLSLX("B",BLSX,BLSX)=""
  1.  L +^BLSLX(0):10
  1.  S $P(^BLSLX(0),U,3)=BLSX,$P(^BLSLX(0),U,4)=$P(^BLSLX(0),U,4)+1
  1.  L -^BLSLX(0)
  1.  K BLSX
  1.  Q
  1.  ;
  1. EXPORT ;EP - loop through BLSLX and export message
  1.  I '$D(ZTQUEUED) W !,"Generating HL7 messages for export"
  1.  S BLSDA=0 F  S BLSDA=$O(^BLSLX("AEXP",BLSDA)) Q:'BLSDA  D
  1.  . S BLSIEN=0 F  S BLSIEN=$O(^BLSLX("AEXP",BLSDA,BLSIEN)) Q:'BLSIEN  D
  1.  .. S BLSERR=$$R01SS^BHLEVENT(BLSIEN)
  1.  .. Q:'INHF
  1.  .. I '$D(ZTQUEUED) W "."
  1.  .. S DIE="^BLSLX(",DA=BLSIEN,DR=".03////"_DT D ^DIE
  1.  .. K DIE,DR
  1.  S BLSDEST=$O(^INRHD("B","HL IHS LOINC",0))
  1.  Q:'BLSDEST
  1.  S BLSDIR=$P($G(^BLRSITE(DUZ(2),5)),U,3)
  1.  ;S BLSXPD=$P($G(^BLRSITE(DUZ(2),5)),U,2)
  1.  S BLSLLI=$P($G(^BLRSITE(DUZ(2),5)),U,5)
  1.  S BLSLPI=$P($G(^BLRSITE(DUZ(2),5)),U,6)
  1.  I BLSLLI]"" S BLSLL=$$DQ(BLSLLI)
  1.  I BLSLPI]"" S BLSLP=$$DQ(BLSLPI)
  1.  S BLSPASS=$G(BLSLL)_":"_$G(BLSLP)
  1.  I BLSPASS=":" S BLSPASS=""
  1.  S BLSFTP=$P($G(^BLRSITE(DUZ(2),5)),U)
  1.  S BLSFNM="BLS"_$$FAC(DUZ(2))_$E($$DATE^INHUT($$NOW,1),1,14)_".HL7"
  1.  I '$D(ZTQUEUED) D
  1.  . W !!,"Now writing export file, this could take up to 5 minutes"
  1.  H 300  ;for message generation to occur
  1.  D HFSA^BHLU(BLSDEST,BLSDIR,BLSFNM)
  1.  I '$D(ZTQUEUED) D
  1.  . W !,"Export file "_BLSFNM_" in directory "_BLSDIR_" created"
  1.  . W !,"Sending to IP Address "_BLSFTP
  1.  D SENDFILE(BLSFNM,BLSDIR,BLSFTP,BLSPASS)
  1.  I '$D(ZTQUEUED) D
  1.  . W !,"File "_BLSFNM_" sent to "_BLSFTP
  1.  D BUL(BLSFTP,BLSDIR,BLSFNM)
  1.  Q
  1.  ;
  1. BUL(FTP,DIR,FNM)   ;-- send a bulletin indicating file send
  1.  S XMB="BLS EXPORT FILE SENT"
  1.  S XMB(1)=FNM
  1.  S XMB(2)=DIR
  1.  S XMB(3)=FTP
  1.  D ^XMB
  1.  K XMB
  1.  Q
  1.  ;
  1. RESEND ;EP -- resend a file
  1.  S BLSDIR=$P($G(^BLRSITE(DUZ(2),5)),U,3)
  1.  S BLSFLST=$$LIST(BLSDIR)
  1.  I BLSFLST<1 W !,"No Files in the directory, goodbye" Q
  1.  S BLSLSDA=0 F  S BLSLSDA=$O(BLSFILES(BLSLSDA)) Q:'BLSLSDA  D
  1.  . W !,BLSLSDA_" - "_$G(BLSFILES(BLSLSDA))
  1.  S DIR(0)="L^1:"_BLSFLST,DIR("A")="Resend which file(s) "
  1.  D ^DIR
  1.  Q:$D(DIRUT)
  1.  S BLSFNMI=Y
  1.  F BLSI=1:1:BLSFLST  S BLSFLI=$P(BLSFNMI,",",BLSI) Q:BLSFLI=""  D
  1.  . S BLSFNM=$G(BLSFILES(BLSFLI))
  1.  . ;S BLSXPD=$P($G(^BLRSITE(DUZ(2),5)),U,2)
  1.  . S BLSFTP=$P($G(^BLRSITE(DUZ(2),5)),U)
  1.  . S BLSLLI=$P($G(^BLRSITE(DUZ(2),5)),U,5)
  1.  . S BLSLPI=$P($G(^BLRSITE(DUZ(2),5)),U,6)
  1.  . I BLSLLI]"" S BLSLL=$$DQ(BLSLLI)
  1.  . I BLSLPI]"" S BLSLP=$$DQ(BLSLPI)
  1.  . S BLSPASS=$G(BLSLL)_":"_$G(BLSLP)
  1.  . I BLSPASS=":" S BLSPASS=""
  1.  . W !,"Sending export file "_BLSFNM_" in directory "_BLSDIR
  1.  . W !,"Sending to IP Address "_BLSFTP
  1.  . D SENDFILE(BLSFNM,BLSDIR,BLSFTP,BLSPASS)
  1.  . W !,"File "_BLSFNM_" sent to "_BLSFTP
  1.  . D BUL(BLSFTP,BLSDIR,BLSFNM)
  1.  Q
  1.  ;
  1. CLEANUP ;EP -- cleanup files older than parameter days
  1.  S BLSDIR=$P($G(^BLRSITE(DUZ(2),5)),U,3)
  1.  S BLSDAYS=$P($G(^BLRSITE(DUZ(2),5)),U,4)
  1.  I 'BLSDAYS S BLSDAYS=30
  1.  S BLST=$$BLST(DT,BLSDAYS)
  1.  S BLSTE=$$FMTE^XLFDT(BLST)
  1.  S BLSCDA=0
  1.  W !,"Now cleaning up export log file entries older than "_BLSTE
  1.  F  S BLSCDA=$O(^BLSLX("ADXP",BLSCDA)) Q:'BLSCDA!(BLSCDA>BLST)  D
  1.  . S BLSCIEN=0
  1.  . F  S BLSCIEN=$O(^BLSLX("ADXP",BLSCDA,BLSCIEN)) Q:'BLSCIEN  D
  1.  .. W "."
  1.  .. S DIK="^BLSLX(",DA=BLSCIEN D ^DIK
  1.  W !!,"Now cleaning up host files older than "_BLSTE
  1.  S BLSFLST=$$LIST(BLSDIR)
  1.  Q:'$O(BLSFILES(""))
  1.  S BLSFDA=0 F  S BLSFDA=$O(BLSFILES(BLSFDA)) Q:'BLSFDA  D
  1.  . S BLSFNM=$G(BLSFILES(BLSFDA))
  1.  . S BLSFDT=$$HDATE^INHUT($E(BLSFNM,10,17))
  1.  . Q:'+$G(BLSFDT)
  1.  . Q:BLSFDT>BLST
  1.  . W !,"Removing export file "_BLSFNM_" in directory "_BLSDIR
  1.  . ;S BLSOS=$P($G(^AUTTSITE(1,0)),U,21)
  1.  . ;I BLSOS=1 S X=$$TERMINAL^%HOSTCMD("rm "_BLSDIR_BLSFNM)
  1.  . ;I BLSOS=2 S X=$ZOS(2,BLSDIR_BLSFNM)
  1.  . ;W !,"File "_BLSFNM_" removed"
  1.  .;BEGIN MOD
  1.  .S X=$$DEL^%ZISH(BLSDIR,BLSFNM)  ;IHS/ITSC/TPF 1/27/2003 REMOVE VENDOR SPECIFIC CODE ABOVE ; X=0 IF SUCCESSFUL
  1.  .I 'X W !,"File "_BLSFNM_" removed"
  1.  .;END MOD
  1.  Q
  1.  ;
  1. RFILE ;EP - remove files from hfs
  1.  S BLSDIR=$P($G(^BLRSITE(DUZ(2),5)),U,3)
  1.  S BLSFLST=$$LIST(BLSDIR)
  1.  I BLSFLST<1 W !,"No Files in the directory, goodbye" Q
  1.  S BLSLSDA=0 F  S BLSLSDA=$O(BLSFILES(BLSLSDA)) Q:'BLSLSDA  D
  1.  . W !,BLSLSDA_" - "_$G(BLSFILES(BLSLSDA))
  1.  S DIR(0)="L^1:"_BLSFLST,DIR("A")="Remove which file(s) "
  1.  D ^DIR
  1.  Q:$D(DIRUT)
  1.  S BLSFNMI=Y
  1.  F BLSI=1:1:BLSFLST  S BLSFLI=$P(BLSFNMI,",",BLSI) Q:BLSFLI=""  D
  1.  . S BLSFNM=$G(BLSFILES(BLSFLI))
  1.  . ;S BLSXPD=$P($G(^BLRSITE(DUZ(2),5)),U,2)
  1.  . S BLSFTP=$P($G(^BLRSITE(DUZ(2),5)),U)
  1.  . W !,"Removing export file "_BLSFNM_" in directory "_BLSDIR
  1.  . ;S BLSOS=$P($G(^AUTTSITE(1,0)),U,21)
  1.  . ;I BLSOS=1 S X=$$TERMINAL^%HOSTCMD(BLSDIR_BLSFNM)
  1.  . ;I BLSOS=2 S X=$ZOS(2,BLSDIR_BLSFNM)
  1.  . ;W !,"File "_BLSFNM_" removed"
  1.  .;BEGIN MOD
  1.  .S X=$$DEL^%ZISH(BLSDIR,BLSFNM)  ;IHS/ITSC/TPF 1/27/2003 REMOVE VENDOR SPECIFIC CODE ABOVE; X=0 IF SUCCESSFUL
  1.  .I 'X W !,"File "_BLSFNM_" removed"
  1.  .;END MOD
  1.  Q
  1.  ;
  1. SENDFILE(FNM,SDIR,IP,PASS) ;-- this will trigger a send via the sendto command, sendto.pl must exist
  1.  S BLSOPS=$P($G(^AUTTSITE(1,0)),U,21)
  1.  ;I PASS["anonymous" D  Q
  1.  ;. S BLSSEND="sendto -i"_$S(BHLOPS=1:" ",1:" -a ")_IP_" "_SDIR_FNM
  1.  ;. S X=$$JOBWAIT^%HOSTCMD(BLSSEND)
  1.  ;S BLSSEND="sendto1 -u  -l "_PASS_$S(BLSOPS=1:" ",1:" -a ")_IP_" "_SDIR_FNM
  1.  ;S X=$$JOBWAIT^%HOSTCMD(BLSSEND)
  1.  S RESULT=$$SEND^%ZISH(SDIR,FNM,IP)  ;CHANGE REQUIRED BY SAC REQUIREMENTS IHS/ITSC/TPF 02/10/03 RESULT=0 IF SUCCESSFUL
  1.  ;
  1.  Q
  1.  ;
  1. BLST(DATE,DAYS)    ;-- find cleanup date
  1.  S X1=DATE,X2=-(DAYS)
  1.  D C^%DTC
  1.  Q X
  1.  ;
  1. NOW() ;-- return now in fm dt
  1.  D NOW^%DTC
  1.  Q %
  1.  ;
  1. LIST(DIR) ;-- get a list of files in the directory
  1.  S Y=$$LIST^%ZISH(DIR,"BLS*",.BLSFILES)
  1.  Q $O(BLSFILES(""),-1)
  1.  ;
  1. FAC(LOC) ;-- return the asufac code
  1.  Q $P($G(^AUTTLOC(LOC,0)),U,10)
  1.  ;
  1. DQ(DEQ) ;-- decrypt the password
  1.  N X,X1,X2
  1.  S (X1,X2)=5,X=DEQ
  1.  D DE^XUSHSHP
  1.  Q X
  1.  ;