| 1 | ZIBGSVED ; 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
|
|---|
| 6 | ASK ;
|
|---|
| 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)
|
|---|
| 11 | NOSELT ;
|
|---|
| 12 | S IO=XBIO
|
|---|
| 13 | D TAPE:"T"[XBMED,CART:"C"[XBMED
|
|---|
| 14 | Q
|
|---|
| 15 | ;
|
|---|
| 16 | HELP ;
|
|---|
| 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 | ;
|
|---|
| 21 | CART ;
|
|---|
| 22 | S XBIO=47,XBMSG="Cartridge"
|
|---|
| 23 | G PROCESS
|
|---|
| 24 | TAPE ;
|
|---|
| 25 | S XBIO=48,XBMSG="9-Track"
|
|---|
| 26 | PROCESS ;
|
|---|
| 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 "
|
|---|
| 37 | RETRY ;
|
|---|
| 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 | ;
|
|---|
| 49 | S9 ;
|
|---|
| 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 | ;
|
|---|
| 59 | WRITPROT ;
|
|---|
| 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 | ;
|
|---|
| 65 | EXIT ;
|
|---|
| 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 | ;
|
|---|
| 77 | GOODREW ;
|
|---|
| 78 | U IO(0)
|
|---|
| 79 | W !!,"Remove the tape... Press RETURN when Ready:"
|
|---|
| 80 | R X:DTIME
|
|---|
| 81 | CLOSE ;
|
|---|
| 82 | D ^%ZISC
|
|---|
| 83 | U IO(0)
|
|---|
| 84 | END ;
|
|---|
| 85 | KILL XBMSG,%MT
|
|---|
| 86 | Q
|
|---|
| 87 | ;
|
|---|
| 88 | SAVEDSM ;
|
|---|
| 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 | ;
|
|---|
