- 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
