BLRRLXP ; cmi/anch/maw - BLR Reference Lab Batch Export ;
;;5.2;LR;**1021**;Jul 27, 2006
;;1.0;BLR REFERENCE LAB;;MAR 14, 2005
;
;
;this routine will call the lookup the lab destination and write
;out the file nightly
;
MAIN ;PEP - Main routine driver
I '$D(ZTQUEUED) D PCHK(DUZ(2))
Q:$G(BLRQFLG)
D HFS(DUZ(2))
Q
;
HFS(BLRSDA) ;-- get the destination and call HFS filer
W:'$D(ZTQUEUED) !,"Now exporting reference lab orders.."
;S BLRSDA=0 F S BLRSDA=$O(^BLRSITE("B",BLRSDA)) Q:'BLRSDA D
S BLRRL=+$P($G(^BLRSITE(BLRSDA,"RL")),U)
Q:BLRRL=""
S BLRRLNM=$P($G(^BLRRL(BLRRL,0)),U)
S BLRRLDS=$O(^INRHD("B","HL IHS LAB "_BLRRLNM,0))
Q:BLRRLDS=""
S BLRTID=$P($G(^BLRRL(BLRRL,0)),U,6)
Q:BLRTID=""
S BLRTFNM=BLRTID_"_"_$E($$DATE^INHUT($$NOW,1),1,14)_".ord"
S BLRDIR=$P($G(^BLRRL(BLRRL,0)),U,2)
Q:BLRDIR=""
I '$D(ZTQUEUED) D
. W !,"Writing file "_BLRTFNM_" to directory "_BLRDIR
D HFSRL^BHLU(BLRRLDS,BLRDIR,BLRTFNM)
S BLRLMSG=$$LOG^BLRRLU(BLRTFNM,"O",DUZ)
I $G(BLRLMSG),$O(BHLUI(0)) S BLRLLMSG=$$LOGM^BLRRLU(BLRTFNM,.BHLUI)
I $P($G(^BLRRL(BLRRL,0)),U,3)'="" D
. D FTP(BLRRL,BLRTID,BLRDIR)
Q
;
FTP(RL,BLRFNM,BLRSDIR) ;-- send the file across to the sending machine
S BLRIP=$P($G(^BLRRL(RL,0)),U,3)
S BLRUSER=$P($G(^BLRRL(RL,0)),U,4)
S BLRPASS=$P($G(^BLRRL(RL,0)),U,5)
I BLRUSER="" S BLRUPAS=""
I '$G(BLRUPAS) S BLRUPAS=BLRUSER_":"_BLRPASS
I '$D(ZTQUEUED) D
. W !,"Sending reference lab orders to IP "_BLRIP
D SENDFILE^BHLU(BLRFNM,BLRSDIR,BLRIP,BLRPASS)
Q
;
NOW() ;-- get now
D NOW^%DTC
Q %
;
PCHK(BLRSDA) ;EP - check to make sure parameters are set
I '$P($G(^BLRSITE(BLRSDA,"RL")),U) D Q
. S BLRQFLG=1
. W !,"Reference Lab not defined in BLR MASTER CONTROL file"
S BLRRL=$P($G(^BLRSITE(BLRSDA,"RL")),U)
I $P($G(^BLRRL(BLRRL,0)),U,6)="" D
. S BLRQFLG=1
. W !,"Reference Lab file name prefix not defined"
I $P($G(^BLRRL(BLRRL,0)),U,2)="" D
. S BLRQFLG=1
. W !,"Reference Lab directory not defined"
I $P($G(^BLRRL(BLRRL,0)),U,3)="" D
. W !,"IP address not defined, file will be written to local host"
Q
;
BLRRLXP ; cmi/anch/maw - BLR Reference Lab Batch Export ;
+1 ;;5.2;LR;**1021**;Jul 27, 2006
+2 ;;1.0;BLR REFERENCE LAB;;MAR 14, 2005
+3 ;
+4 ;
+5 ;this routine will call the lookup the lab destination and write
+6 ;out the file nightly
+7 ;
MAIN ;PEP - Main routine driver
+1 IF '$DATA(ZTQUEUED)
DO PCHK(DUZ(2))
+2 IF $GET(BLRQFLG)
QUIT
+3 DO HFS(DUZ(2))
+4 QUIT
+5 ;
HFS(BLRSDA) ;-- get the destination and call HFS filer
+1 IF '$DATA(ZTQUEUED)
WRITE !,"Now exporting reference lab orders.."
+2 ;S BLRSDA=0 F S BLRSDA=$O(^BLRSITE("B",BLRSDA)) Q:'BLRSDA D
+3 SET BLRRL=+$PIECE($GET(^BLRSITE(BLRSDA,"RL")),U)
+4 IF BLRRL=""
QUIT
+5 SET BLRRLNM=$PIECE($GET(^BLRRL(BLRRL,0)),U)
+6 SET BLRRLDS=$ORDER(^INRHD("B","HL IHS LAB "_BLRRLNM,0))
+7 IF BLRRLDS=""
QUIT
+8 SET BLRTID=$PIECE($GET(^BLRRL(BLRRL,0)),U,6)
+9 IF BLRTID=""
QUIT
+10 SET BLRTFNM=BLRTID_"_"_$EXTRACT($$DATE^INHUT($$NOW,1),1,14)_".ord"
+11 SET BLRDIR=$PIECE($GET(^BLRRL(BLRRL,0)),U,2)
+12 IF BLRDIR=""
QUIT
+13 IF '$DATA(ZTQUEUED)
Begin DoDot:1
+14 WRITE !,"Writing file "_BLRTFNM_" to directory "_BLRDIR
End DoDot:1
+15 DO HFSRL^BHLU(BLRRLDS,BLRDIR,BLRTFNM)
+16 SET BLRLMSG=$$LOG^BLRRLU(BLRTFNM,"O",DUZ)
+17 IF $GET(BLRLMSG)
IF $ORDER(BHLUI(0))
SET BLRLLMSG=$$LOGM^BLRRLU(BLRTFNM,.BHLUI)
+18 IF $PIECE($GET(^BLRRL(BLRRL,0)),U,3)'=""
Begin DoDot:1
+19 DO FTP(BLRRL,BLRTID,BLRDIR)
End DoDot:1
+20 QUIT
+21 ;
FTP(RL,BLRFNM,BLRSDIR) ;-- send the file across to the sending machine
+1 SET BLRIP=$PIECE($GET(^BLRRL(RL,0)),U,3)
+2 SET BLRUSER=$PIECE($GET(^BLRRL(RL,0)),U,4)
+3 SET BLRPASS=$PIECE($GET(^BLRRL(RL,0)),U,5)
+4 IF BLRUSER=""
SET BLRUPAS=""
+5 IF '$GET(BLRUPAS)
SET BLRUPAS=BLRUSER_":"_BLRPASS
+6 IF '$DATA(ZTQUEUED)
Begin DoDot:1
+7 WRITE !,"Sending reference lab orders to IP "_BLRIP
End DoDot:1
+8 DO SENDFILE^BHLU(BLRFNM,BLRSDIR,BLRIP,BLRPASS)
+9 QUIT
+10 ;
NOW() ;-- get now
+1 DO NOW^%DTC
+2 QUIT %
+3 ;
PCHK(BLRSDA) ;EP - check to make sure parameters are set
+1 IF '$PIECE($GET(^BLRSITE(BLRSDA,"RL")),U)
Begin DoDot:1
+2 SET BLRQFLG=1
+3 WRITE !,"Reference Lab not defined in BLR MASTER CONTROL file"
End DoDot:1
QUIT
+4 SET BLRRL=$PIECE($GET(^BLRSITE(BLRSDA,"RL")),U)
+5 IF $PIECE($GET(^BLRRL(BLRRL,0)),U,6)=""
Begin DoDot:1
+6 SET BLRQFLG=1
+7 WRITE !,"Reference Lab file name prefix not defined"
End DoDot:1
+8 IF $PIECE($GET(^BLRRL(BLRRL,0)),U,2)=""
Begin DoDot:1
+9 SET BLRQFLG=1
+10 WRITE !,"Reference Lab directory not defined"
End DoDot:1
+11 IF $PIECE($GET(^BLRRL(BLRRL,0)),U,3)=""
Begin DoDot:1
+12 WRITE !,"IP address not defined, file will be written to local host"
End DoDot:1
+13 QUIT
+14 ;
