- 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 ;
