BWMDEU1 ;IHS/ANMC/MWR - MDE FUNCTIONS.;29-Oct-2003 21:38;PLS
;;2.0;WOMEN'S HEALTH;**8,9**;MAY 16, 1996
; CDC Utility functions to extract building.
;
HFS ; EP - Save data from ^BWTMP( to host file server.
;
I '$D(^BWTMP($J)) D Q
. D ^%ZISC
. Q:$D(BWSILENT)
. W !!?5,"NO RECORDS TO BE EXPORTED." D DIRZ^BWUTL3
;
; If this is an extract then offer to write file out to screen.
S BWCAPT="h"
I 'BWXPORT D Q:BWPOP
. N DIR U IO(0)
. W !!?3,"Do you wish to save this to the Host File ",BWPATH,BWFLNM,","
. W !?3,"or write it to your screen for capture by a PC?",!
. S DIR("A")=" Select HOST or SCREEN: ",DIR("B")="HOST"
. S DIR(0)="SAM^h:HOST;s:SCREEN" D HELP1^BWMDE4
. D ^DIR
. I $D(DIRUT) S BWPOP=1 Q
. S BWCAPT=Y
. I Y="s" D Q
. . U IO(0)
. . W !!?5,"Screen print of the file will follow immediately."
. . D DIRZ^BWUTL3
. . U IO
I BWXPORT D Q:BWPOP
. S BWPATH=$P(^BWSITE(DUZ(2),0),U,14) ;K IO(1)
. S BWFLNM=$P(^BWSITE(DUZ(2),0),U,13)_$E(DT,4,5)_$E(DT,2,3)_$S($G(BWXPORT):"",1:"LC")_BWCDCV
. S BWPOP=$$OPEN^%ZISH(BWPATH,BWFLNM,"W")
. I BWPOP D ^%ZISC,ERROR S BWPOP=1
U IO W ""
N N,M S N=0,BWCOUNT=0
F S N=$O(^BWTMP($J,N)) Q:'N D
. S M=0
. F S M=$O(^BWTMP($J,N,M)) Q:'M D
. . U IO W ^BWTMP($J,N,M),! S BWCOUNT=BWCOUNT+1
. . I '$D(BWSILENT) U 0 W "/" ;IHS/CMI/THL PATCH 7 ;PATCH 8
D ^%ZISC
I '$D(BWSILENT),BWCAPT="s" D DIRZ^BWUTL3 Q
I '$D(BWSILENT) D ;IHS/CIM/THL PATCH 8
. W !!?5,"File ",BWPATH_BWFLNM
. W " successfully saved to Host File Server."
. W !!?5,"Records exported...........................................: "
. W $J(BWCOUNT,6)
. D NOFAC,DIRZ^BWUTL3
; Quit if this was only an exrtact (BWXPORT=0).
I 'BWXPORT Q
E D SAVELOG^BWMDE4
Q
;
;
ERROR ;EP
I $D(BWSILENT)!($D(ZTQUEUED)) Q
W !!?5,"* Save to Host File Server FAILED. Contact your sitemanager."
D DIRZ^BWUTL3
Q
;
;
NOFAC ;EP
W !?5,"Total Procedures rejected: "
W ?33,"Not done at a selected facility: ",$J(BWOFAC,6)
W !?33,"No facility entered............: ",$J(BWNOFAC,6)
Q
BWMDEU1 ;IHS/ANMC/MWR - MDE FUNCTIONS.;29-Oct-2003 21:38;PLS
+1 ;;2.0;WOMEN'S HEALTH;**8,9**;MAY 16, 1996
+2 ; CDC Utility functions to extract building.
+3 ;
HFS ; EP - Save data from ^BWTMP( to host file server.
+1 ;
+2 IF '$DATA(^BWTMP($JOB))
Begin DoDot:1
+3 DO ^%ZISC
+4 IF $DATA(BWSILENT)
QUIT
+5 WRITE !!?5,"NO RECORDS TO BE EXPORTED."
DO DIRZ^BWUTL3
End DoDot:1
QUIT
+6 ;
+7 ; If this is an extract then offer to write file out to screen.
+8 SET BWCAPT="h"
+9 IF 'BWXPORT
Begin DoDot:1
+10 NEW DIR
USE IO(0)
+11 WRITE !!?3,"Do you wish to save this to the Host File ",BWPATH,BWFLNM,","
+12 WRITE !?3,"or write it to your screen for capture by a PC?",!
+13 SET DIR("A")=" Select HOST or SCREEN: "
SET DIR("B")="HOST"
+14 SET DIR(0)="SAM^h:HOST;s:SCREEN"
DO HELP1^BWMDE4
+15 DO ^DIR
+16 IF $DATA(DIRUT)
SET BWPOP=1
QUIT
+17 SET BWCAPT=Y
+18 IF Y="s"
Begin DoDot:2
+19 USE IO(0)
+20 WRITE !!?5,"Screen print of the file will follow immediately."
+21 DO DIRZ^BWUTL3
+22 USE IO
End DoDot:2
QUIT
End DoDot:1
IF BWPOP
QUIT
+23 IF BWXPORT
Begin DoDot:1
+24 ;K IO(1)
SET BWPATH=$PIECE(^BWSITE(DUZ(2),0),U,14)
+25 SET BWFLNM=$PIECE(^BWSITE(DUZ(2),0),U,13)_$EXTRACT(DT,4,5)_$EXTRACT(DT,2,3)_$SELECT($GET(BWXPORT):"",1:"LC")_BWCDCV
+26 SET BWPOP=$$OPEN^%ZISH(BWPATH,BWFLNM,"W")
+27 IF BWPOP
DO ^%ZISC
DO ERROR
SET BWPOP=1
End DoDot:1
IF BWPOP
QUIT
+28 USE IO
WRITE ""
+29 NEW N,M
SET N=0
SET BWCOUNT=0
+30 FOR
SET N=$ORDER(^BWTMP($JOB,N))
IF 'N
QUIT
Begin DoDot:1
+31 SET M=0
+32 FOR
SET M=$ORDER(^BWTMP($JOB,N,M))
IF 'M
QUIT
Begin DoDot:2
+33 USE IO
WRITE ^BWTMP($JOB,N,M),!
SET BWCOUNT=BWCOUNT+1
+34 ;IHS/CMI/THL PATCH 7 ;PATCH 8
IF '$DATA(BWSILENT)
USE 0
WRITE "/"
End DoDot:2
End DoDot:1
+35 DO ^%ZISC
+36 IF '$DATA(BWSILENT)
IF BWCAPT="s"
DO DIRZ^BWUTL3
QUIT
+37 ;IHS/CIM/THL PATCH 8
IF '$DATA(BWSILENT)
Begin DoDot:1
+38 WRITE !!?5,"File ",BWPATH_BWFLNM
+39 WRITE " successfully saved to Host File Server."
+40 WRITE !!?5,"Records exported...........................................: "
+41 WRITE $JUSTIFY(BWCOUNT,6)
+42 DO NOFAC
DO DIRZ^BWUTL3
End DoDot:1
+43 ; Quit if this was only an exrtact (BWXPORT=0).
+44 IF 'BWXPORT
QUIT
+45 IF '$TEST
DO SAVELOG^BWMDE4
+46 QUIT
+47 ;
+48 ;
ERROR ;EP
+1 IF $DATA(BWSILENT)!($DATA(ZTQUEUED))
QUIT
+2 WRITE !!?5,"* Save to Host File Server FAILED. Contact your sitemanager."
+3 DO DIRZ^BWUTL3
+4 QUIT
+5 ;
+6 ;
NOFAC ;EP
+1 WRITE !?5,"Total Procedures rejected: "
+2 WRITE ?33,"Not done at a selected facility: ",$JUSTIFY(BWOFAC,6)
+3 WRITE !?33,"No facility entered............: ",$JUSTIFY(BWNOFAC,6)
+4 QUIT
