source: IHS-VA_UTILITIES-XB/trunk/ZIBGSVEM.m@ 1001

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

Modified directory structure; moved routines.
File size: 5.3 KB
RevLine 
[641]1ZIBGSVEM ; IHS/ADC/GTH - SAVE GLOBAL TO MSM UNIX ; [ 09/14/2004 4:57 PM ]
2 ;;4.0;XB;;Jul 20, 2009;Build 2
3 ;
4 ;I ^%ZOSF("OS")["PC"!(^%ZOSF("OS")["Windows NT")!($P($G(^AUTTSITE(1,0)),U,21)=2) G ^ZIBGSVEP ;COMMENTED OUT AND REPLACE BY NEXT LINE - AEF/08/08/03
5 I $$VERSION^%ZOSV(1)["Windows" G ^ZIBGSVEP ;XB*3*10 TASSC/MFD 8/15/03
6 G:$D(XBMED) NOSELT
7ASK ;
8 R !!,"Copy transaction file to ('^' TO EXIT WITHOUT SAVING)",!!?10,"[T]ape, [C]artridge, [D]iskette, or [F]ile F// ",XBMED:DTIME
9 S XBMED=$$UP^XLFSTR($E(XBMED_"F"))
10 I U[XBMED S XBFLG(1)="Job Terminated by Operator at Device Select",XBFLG=-1 G END
11 G HELP:"?"[XBMED,ASK:'("CDFT"[XBMED)
12NOSELT ;
13 S (IO,XBZDEV)=XBIO
14 D TAPE:"T"[XBMED,CART:"C"[XBMED,DISK:"D"[XBMED,UNIX:"F"[XBMED
15 Q
16 ;
17HELP ;
18 W !!,"This option saves the ' ",XBNAR," ",XBGL,"' transaction file to either a tape,",!,"a floppy diskette, or a Unix file. The default is to a unix file",!,"in the ",XBUF," directory."
19 W !,"Enter either a ""C"" for tape cartridge, a ""T"" for 9-track tape, a ""D"" for floppy disk, or an ""F"" for Unix file."
20 G ASK
21 ;
22DISK ; ----- Transfer TX Global to floppy disk.
23 U IO(0)
24 W !!,"Mount a FORMATTED Floppy Diskette, 'WRITE ENABLED' ",*7,!,"Press RETURN When Ready or ""^"" to Exit WITHOUT SAVING "
25 R X:DTIME
26 I X[U!('$T) S XBFLG(1)="Job Aborted by Operator During Floppy Mount",XBFLG=-1 G END
27 I $$OPEN^%ZISH("/dev/","fd0","W") S XBERRMSG="Floppy Disk" G ERRMESS
28 U IO
29 I $$STATUS^%ZISH U IO(0) W !!,"Please",*7 G DISK
30 U IO(0)
31 W !,"Please Standby - Copying Data to Floppy",!
32 U IO
33 D SAVEMSM
34 D ^%ZISC
35 U IO(0)
36 R !!,"Remove the Floppy... Press RETURN when Ready:",X:DTIME
37 G END
38 ;
39UNIX ; ----- Transfer TX Global to unix file.
40 S XBPRE=$E(XBGL,2,5),XBASUFAC=$S('$D(XBSUFAC):$P(^AUTTLOC(DUZ(2),0),U,10),1:XBSUFAC)
41 S XBFN=$S('$D(XBFN):XBPRE_XBASUFAC_"."_XBCARTNO,1:XBFN)
42 S XBTEMPFN=XBUF_"/"_XBFN
43 S XBPAFN=XBTEMPFN
44 S %=$$OPEN^%ZISH(XBUF_"/",XBFN,"W")
45 I % S XBERRMSG=$S(%=1:"All Host File Servers Busy!",1:"UNIX File") G ERRMESS
46 I '$D(ZTQUEUED) U IO(0) W !,"Please Standby - Copying Data to UNIX File ",XBTEMPFN,!
47 S X=$$JOBWAIT^%HOSTCMD("chmod 666 "_XBUF_"/"_XBFN)
48 U IO
49 D SAVEMSM
50 G CLOSE
51 ;
52TAPE ;
53 S XBDEV="rmt0",XBMSG="9-Track"
54 G TAPETST
55CART ;
56 S XBDEV="rct",XBMSG="Cartridge"
57 ;
58TAPETST ; ----- Transfer global to cartridge or 9-track.
59 W !,"Do you want to test the ",XBMSG," DRIVE? (Y/N) Y//"
60 R Y:DTIME
61 S Y=$E(Y_"Y")
62 I "Yy"[Y D TAPETEST G:$D(XBFLG) CLOSE I Y[U S XBFLG(1)="Job Aborted by Operator During Tape Test",XBFLG=-1 G END
63S ;
64 U IO(0)
65 W !!,"Mount ",XBMSG," Tape, 'WRITE ENABLED' ",*7
66 R !,"Press RETURN When Ready - ""^"" to Exit ",X:DTIME
67 I X[U S XBFLG(1)="Job Terminated By Operator at Mount Message",XBFLG=-1 G CLOSE
68MAGOPEN ;
69 I $$OPEN^%ZISH("/dev/",XBDEV,"W") S XBERRMSG="Magtape Device" G ERRMESS
70 U IO
71 I $$STATUS^%ZISH U IO(0) W !!,"Please",*7 G S
72 U IO(0)
73 W !,"Please Standby - Copying Data to Tape",!
74 U IO
75 D SAVEMSM
76 G EXIT
77 ;
78SW ;
79 U IO(0)
80 W *7,!!," The Tape Is WRITE PROTECTED. Please Remove The Tape,"
81 W !," And Re-position The Write Protect/Enable Switch.",!," "
82 G MAGOPEN
83 ;
84ERRMESS ;
85 S XBFLG(1)=XBERRMSG_" Not Available",XBFLG=-1
86 I '$D(ZTQUEUED) U IO(0) W !,XBFLG(1)
87 G END
88 ;
89EXIT ;
90 D ^%ZISC
91 U IO(0)
92 W !!,"Rewinding tape. <WAIT>."
93 H 2
94 W !!,"Remove the tape... Press RETURN when Ready:"
95 R X:DTIME
96 G END
97 ;
98CLOSE ;
99 D ^%ZISC
100END ;
101 I XBMED="F",'$D(XBFLG),XBQ="Y" D UUCPQ
102 D HOME^%ZIS
103 KILL XBPRE,XBASUFAC,XBOUTDAT,XBINDATA,XBDEV,XBMSG,XBERRMSG,XBTEMPFN,XBZDEV
104 Q
105 ;
106TAPETEST ;
107 U IO(0)
108 W !!,"TAPE TEST...Mount ",XBMSG," Tape, 'WRITE ENABLED' ",*7
109 R !,"TAPE TEST...Press RETURN When Ready - ""^"" to Exit ",X:DTIME
110 I X[U S XBFLG(1)="Job Aborted by Operator during Tape Test",XBFLG=-1 Q
111 W !,"TAPE TEST...Opening tape drive."
112 H 1
113 I $$OPEN^%ZISH("/dev/",XBDEV,"W") G TESTERR
114 U IO
115 I $$STATUS^%ZISH U IO(0) W !!,"Please",*7 G TAPETEST
116 U IO(0)
117 W !,"TAPE TEST...Tape drive opened.",!,"TAPE TEST...Writing test data to tape."
118 H 1
119WRITE ;
120 S XBOUTDAT="TEST DATA RECORD WRITTEN TO TAPE ON "_XBDT
121 U IO
122 W XBOUTDAT,!,"**",!,"**",!!
123 U IO(0)
124 W !,"TAPE TEST...Data written."
125 D ^%ZISC
126 H 6
127 U IO(0)
128 W !,"TAPE TEST...Reading test data from tape.",!
129 H 1
130 I $$OPEN^%ZISH("/dev/",XBDEV,"R") G TESTERR
131 U IO
132 R XBINDATA:DTIME
133 D ^%ZISC
134 U IO(0)
135 W !,"WROTE : '",XBOUTDAT,"'",!," READ : '",XBINDATA,"'"
136 I XBINDATA=XBOUTDAT W !,"TAPE TEST...Successful."
137 E W !,"TAPE TEST...FAILED...$#@!" S XBFLG(1)="Tape Test Failed During Testing",XBFLG=-1
138 Q
139 ;
140TESTERR ;
141 S XBFLG(1)="Device Not Available During Tape Testing",XBFLG=-1
142 U IO(0)
143 W !,*7,XBFLG(1),*7
144 Q
145 ;
146UUCPQ ;EP - auto queue to uucp subroutine, must have system id in RPMS SITE file ; IHS/SET/GTH XB*3*9 10/29/2002
147 I $$JOBWAIT^%HOSTCMD("/usr/bin/sendto "_XBQTO_" "_XBUF_"/"_XBFN) S XBFLG=-1,XBFLG(1)="Queue of File to uucp Failed"
148 E W:'$D(ZTQUEUED) !,"Export file ",XBUF,"/",XBFN," queued up to be sent to ",XBQTO,"...",!
149 Q
150 ;
151SAVEMSM ;EP - $QUERY thru global, write to output.
152 K XBQUIT
153 I '$G(XBFLT) W XBDT,!,XBTLE,!
154 S X=XBGL_XBF_")"
155 F D Q:$G(XBQUIT)
156 .S X=$Q(@X)
157 .I X="" S XBQUIT=1 Q
158 .S Y=$P($P($P(X,")",1),"(",2),",",1)
159 .I XBE=+XBE,Y'=+Y S XBQUIT=1 Q
160 .I ($L(XBE)&($$FOLLOW(Y,XBE))) S XBQUIT=1 Q
161 .I $D(XBCON)&('(Y=+Y)) S XBQUIT=1 Q
162 .S Y=X
163 .S:$E(Y,2)="[" Y=U_$P(Y,"]",2,999)
164 .W:'$G(XBFLT) Y,!
165 .W @X,!
166 I '$G(XBFLT) W "**",!,"**",!!
167 K XBQUIT
168 Q
169 ;
170FOLLOW(Y,XBE) ; If Y follows XBE return 1. Else return 0.
171 N Z
172 I '(Y=+Y) D
173 .S Z=(Y]XBE)
174 I Y=+Y D
175 .S Z=(Y>XBE)
176 Q Z
177 ;
Note: See TracBrowser for help on using the repository browser.