source: IHS-VA_UTILITIES-XB/ZIBGSVEP.m@ 641

Last change on this file since 641 was 641, checked in by Sam Habiel, 14 years ago

Initial commit of XB, move away from sf.net.
Includes kids file and documentation.
File size: 3.4 KB
Line 
1ZIBGSVEP ; IHS/ADC/GTH - SAVE GLOBAL TO DOS MEDIA ; [ 07/21/2005 3:22 PM ]
2 ;;4.0;XB;;Jul 20, 2009;Build 2
3 ; XB*3*8 - IHS/ASDST/GTH - 12-07-00 - Protect U IO(0) and WRITE's in background.
4 ; XB*3*9 IHS/SET/GTH XB*3*9 10/29/2002 Cache', NT, and system mods.
5 ;
6 ;S XBUF=$S($P($G(^AUTTSITE(1,1)),U,2)]"":$P(^AUTTSITE(1,1),U,2),1:"C:\EXPORT") ;LINE COMMENTED OUT AND REPLACED BY NEXT LINE - AEF/08/08/03
7 ;S:'$G(XBUF) XBUF=$S($P($G(^AUTTSITE(1,1)),U,2)]"":$P(^AUTTSITE(1,1),U,2),1:"C:\EXPORT") ;XB*3*10
8 G:$D(XBMED) NOSELT
9ASK ;
10 R !!,"Copy transaction file to ('^' TO EXIT WITHOUT SAVING)",!!?10,"[D]iskette, or [F]ile F// ",XBMED:DTIME
11 S XBMED=$$UP^XLFSTR($E(XBMED_"F"))
12 I U[XBMED S XBFLG(1)="Job Terminated by Operator at Device Select",XBFLG=-1 G END
13 G HELP:"?"[XBMED,ASK:"DF"'[XBMED
14NOSELT ;
15 S IO=XBIO
16 D DISK:"D"[XBMED,DOS:"F"[XBMED
17 Q
18 ;
19HELP ;
20 W !!,"This option saves the ' ",XBNAR," ",XBGL,"' transaction file to either a floppy",!,"diskette, or a Dos file on the Hard Disk. The default is to a Dos file",!,"in the ",XBUF," directory."
21 W !,"Enter either a ""D"" for floppy disk, or an ""F"" for Dos file."
22 G ASK
23 ;
24DISK ;TRANSFER TX GLOBAL TO FLOPPY DISK
25 F R !,"Select the drive (A,B,C): B//",Y:DTIME S Y=$$UP^XLFSTR($E(Y_"B")) Q:"ABC"[Y W:'(U[Y) " ??" I U[Y!('$T) S XBFLG(1)="Abort at drive select",XBFLG=-1 G END
26 S XBUF=Y_":"
27 W !!,"Insert a FORMATTED Floppy Diskette into drive '",XBUF,"', 'WRITE ENABLED' ",*7,!,"Press RETURN When Ready or ""^"" to Exit WITHOUT SAVING "
28 R X:DTIME
29 I X[U!('$T) S XBFLG(1)="Job Aborted by Operator During Floppy Mount",XBFLG=-1 G END
30DOS ;TRANSFER TX GLOBAL TO DOS FILE.
31 I '$D(ZTQUEUED) U IO(0) W !!,"DOS File Being Created' ",*7
32 I '$D(XBFN) D
33 .; if you're on NT put the full location code to be compatible with
34 .; area unix boxes
35 .;I ^%ZOSF("OS")["Windows NT" S X2=$E(DT,1,3)_"0101",X1=DT D ^%DTC S X=X+1,XBFN=$E(XBGL,2,5)_$P(^AUTTLOC(DUZ(2),0),U,10)_"."_X Q ; IHS/SET/GTH XB*3*9 10/29/2002
36 .I ^%ZOSF("OS")["NT" S X2=$E(DT,1,3)_"0101",X1=DT D ^%DTC S X=X+1,XBFN=$E(XBGL,2,5)_$P(^AUTTLOC(DUZ(2),0),U,10)_"."_X Q ; IHS/SET/GTH XB*3*9 10/29/2002
37 .S X2=$E(DT,1,3)_"0101",X1=DT D ^%DTC S X=X+1,XBFN=$E(XBGL,2,5)_$E($P(^AUTTLOC(DUZ(2),0),U,10),3,6)_"."_X
38 S XBPAFN=XBUF_"\"_XBFN
39 I $$OPEN^%ZISH(XBUF_"\",XBFN,"W") S XBERRMSG="DOS File" G ERRMESS
40 ; U IO(0) ; XB*3*8
41 I '$D(ZTQUEUED) U IO(0) ; XB*3*8
42 ; W !,"Please Standby - Copying Data to DOS File ",XBUF,"\",XBFN ; XB*3*8
43 I '$D(ZTQUEUED) W !,"Please Standby - Copying Data to DOS File ",XBUF,"\",XBFN ; XB*3*8
44 U IO
45 D SAVEMSM^ZIBGSVEM
46 G END
47 ;
48UUCPQ ;EP - auto queue to sendto and ftp, must have system id in RPMS SITE file ; IHS/SET/GTH XB*3*9 10/29/2002
49 I $$JOBWAIT^%HOSTCMD("sendto "_XBQTO_" "_XBUF_"\"_XBFN) S XBFLG=-1,XBFLG(1)="Queue of File to uucp Failed"
50 ; E W:'$D(ZTQUEUED) !,"Export file ",XBUF,"/",XBFN," queued up to be sent to ",XBQTO,"...",! ; IHS/SET/GTH XB*3*9 10/29/2002
51 ;E W:'$D(ZTQUEUED) !,"Export file ",XBUF,"\",XBFN," queued up to be sent to ",XBQTO,"...",! ; IHS/SET/GTH XB*3*9 10/29/2002 ;LINE COMMENTED OUT AND REPLACED BY NEXT LINE - AEF/08/08/03
52 E I '$D(ZTQUEUED) U IO(0) W !!,"Export file ",XBUF,"\",XBFN," queued up to be sent to ",XBQTO,"...",! ;XB*3*10
53 Q
54 ;
55ERRMESS ;
56 S XBFLG(1)=XBERRMSG_" Not Available",XBFLG=-1
57 ; U IO(0) ; XB*3*8
58 ; W !,XBFLG(1) ; XB*3*8
59 I '$D(ZTQUEUED) U IO(0) W !,XBFLG(1) ; XB*3*8
60END ;
61 ; I '$D(AUFLG),$P(^AUTTSITE(1,0),"^",14)]"" D UUCPQ ;IHS/MFD added line ; XB*3*8
62 I '$D(XBFLG),XBQ="Y" D UUCPQ ; XB*3*8
63 D ^%ZISC,HOME^%ZIS
64 KILL XBERRMSG
65 Q
Note: See TracBrowser for help on using the repository browser.