source: IHS-VA_UTILITIES-XB/trunk/ZIBGSVED.m@ 1193

Last change on this file since 1193 was 642, checked in by Sam Habiel, 15 years ago

Modified directory structure; moved routines.

File size: 2.4 KB
RevLine 
[641]1ZIBGSVED ; IHS/ADC/GTH - SAVE GLOBAL TO TAPE, DSM SPECIFIC ; [ 02/07/97 3:02 PM ]
2 ;;4.0;XB;;Jul 20, 2009;Build 2
3 ;
4 I $G(XBFLT) S XBFLG=-1,XBFLG(0)="DSM flat filer has not been tested." Q
5 G:$D(XBMED) NOSELT
6ASK ;
7 R !!,"Copy transaction file to ('^' To Exit Without Saving)",!!?10,"[T]ape, [C]artridge C// ",XBMED:DTIME
8 S XBMED=$$UP^XLFSTR($E(XBMED_"C"))
9 I U[XBMED S XBFLG(1)="Job Terminated by Operator at Device Select",XBFLG=-1 G END
10 G HELP:"?"[XBMED,ASK:'("CT"[XBMED)
11NOSELT ;
12 S IO=XBIO
13 D TAPE:"T"[XBMED,CART:"C"[XBMED
14 Q
15 ;
16HELP ;
17 W !!,"This option saves the ' ",XBNAR," ",XBGL,"' transaction file to either a Cartridge",!,"or 9-Track Tape. The default is to a 9-Track Tape."
18 W !,"Enter either a ""C"" for Cartridge Tape or a ""T"" for 9-Track Tape."
19 G ASK
20 ;
21CART ;
22 S XBIO=47,XBMSG="Cartridge"
23 G PROCESS
24TAPE ;
25 S XBIO=48,XBMSG="9-Track"
26PROCESS ;
27 S IOP=XBIO
28 D ^%ZIS
29 KILL IOP
30 S:'$D(XBPAR) XBPAR=IOPAR
31 I POP S XBFLG(1)=XBMSG_" Drive Not Available",XBFLG=-1 U IO(0) W !,XBFLG(1) G END
32 U IO
33 X ^%ZOSF("MAGTAPE")
34 W @%MT("REW")
35 U IO(0)
36 W !!,"Mount The ",XBMSG," Tape 'WRITE ENABLED' And "
37RETRY ;
38 R !?10,"Press RETURN When Ready - ""^"" to Exit ",X:DTIME
39 I X=U!('$T) S XBFLG(1)="Job Aborted by Operator During Tape Mount",XBFLG=-1 G CLOSE
40 U IO
41 X ^%ZOSF("MTONLINE")
42 I 'Y U IO(0) W !!,"WAITING FOR TAPE"
43 F I=1:1:75 U IO X ^%ZOSF("MTONLINE") G S9:Y U IO(0) W "." H 5
44 U IO(0)
45 W !!,XBFLG(1)," After 6 Minutes"
46 S XBFLG(1)="Job Aborted, Tape not Ready",XBFLG=-1
47 G END
48 ;
49S9 ;
50 U IO
51 X ^%ZOSF("MTWPROT")
52 G WRITPROT:Y
53 U IO(0)
54 W !,"Please Standby - Copying Data to ",XBMSG
55 U IO
56 D SAVEDSM
57 G CLOSE:$D(XBFLG),EXIT
58 ;
59WRITPROT ;
60 U IO(0)
61 W *7,!!," The Tape Is WRITE PROTECTED. Please Remove The Tape,"
62 W !," And Re-position The Write Protect/Enable Switch.",!," "
63 G RETRY
64 ;
65EXIT ;
66 X ^%ZOSF("MAGTAPE")
67 U IO
68 W @%MT("WTM"),@%MT("REW")
69 U IO(0)
70 W !!,"Rewinding tape. <WAIT>"
71 F L=1:1:150 U IO X ^%ZOSF("MTBOT") G:Y GOODREW U IO(0) W "." H 2
72 S XBFLG=-1,XBFLG(1)="Tape not rewound"
73 U IO(0)
74 W !!,XBFLG(1),*7
75 G CLOSE
76 ;
77GOODREW ;
78 U IO(0)
79 W !!,"Remove the tape... Press RETURN when Ready:"
80 R X:DTIME
81CLOSE ;
82 D ^%ZISC
83 U IO(0)
84END ;
85 KILL XBMSG,%MT
86 Q
87 ;
88SAVEDSM ;
89 W XBDT
90 W:XBPAR'["V" !
91 W XBTLE
92 W:XBPAR'["V" !
93 S X=XBGL_XBF_")"
94 F S X=$Q(@X) Q:X="" Q:(XBE]"")&($P($P(X,"(",2),",")>XBE) S Y=X S:$E(Y,2)="[" Y=U_$P(Y,"]",2,999) W Y W:XBPAR'["V" ! W @X W:XBPAR'["V" !
95 W "**END**" W:XBPAR'["V" !
96 W "**END**" W:XBPAR'["V" !
97 Q
98 ;
Note: See TracBrowser for help on using the repository browser.