ZIBGSVED ; IHS/ADC/GTH - SAVE GLOBAL TO TAPE, DSM SPECIFIC ; [ 02/07/97 3:02 PM ]
;;3.0;IHS/VA UTILITIES;;FEB 07, 1997
;
I $G(XBFLT) S XBFLG=-1,XBFLG(0)="DSM flat filer has not been tested." Q
G:$D(XBMED) NOSELT
ASK ;
R !!,"Copy transaction file to ('^' To Exit Without Saving)",!!?10,"[T]ape, [C]artridge C// ",XBMED:DTIME
S XBMED=$$UP^XLFSTR($E(XBMED_"C"))
I U[XBMED S XBFLG(1)="Job Terminated by Operator at Device Select",XBFLG=-1 G END
G HELP:"?"[XBMED,ASK:'("CT"[XBMED)
NOSELT ;
S IO=XBIO
D TAPE:"T"[XBMED,CART:"C"[XBMED
Q
;
HELP ;
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."
W !,"Enter either a ""C"" for Cartridge Tape or a ""T"" for 9-Track Tape."
G ASK
;
CART ;
S XBIO=47,XBMSG="Cartridge"
G PROCESS
TAPE ;
S XBIO=48,XBMSG="9-Track"
PROCESS ;
S IOP=XBIO
D ^%ZIS
KILL IOP
S:'$D(XBPAR) XBPAR=IOPAR
I POP S XBFLG(1)=XBMSG_" Drive Not Available",XBFLG=-1 U IO(0) W !,XBFLG(1) G END
U IO
X ^%ZOSF("MAGTAPE")
W @%MT("REW")
U IO(0)
W !!,"Mount The ",XBMSG," Tape 'WRITE ENABLED' And "
RETRY ;
R !?10,"Press RETURN When Ready - ""^"" to Exit ",X:DTIME
I X=U!('$T) S XBFLG(1)="Job Aborted by Operator During Tape Mount",XBFLG=-1 G CLOSE
U IO
X ^%ZOSF("MTONLINE")
I 'Y U IO(0) W !!,"WAITING FOR TAPE"
F I=1:1:75 U IO X ^%ZOSF("MTONLINE") G S9:Y U IO(0) W "." H 5
U IO(0)
W !!,XBFLG(1)," After 6 Minutes"
S XBFLG(1)="Job Aborted, Tape not Ready",XBFLG=-1
G END
;
S9 ;
U IO
X ^%ZOSF("MTWPROT")
G WRITPROT:Y
U IO(0)
W !,"Please Standby - Copying Data to ",XBMSG
U IO
D SAVEDSM
G CLOSE:$D(XBFLG),EXIT
;
WRITPROT ;
U IO(0)
W *7,!!," The Tape Is WRITE PROTECTED. Please Remove The Tape,"
W !," And Re-position The Write Protect/Enable Switch.",!," "
G RETRY
;
EXIT ;
X ^%ZOSF("MAGTAPE")
U IO
W @%MT("WTM"),@%MT("REW")
U IO(0)
W !!,"Rewinding tape. <WAIT>"
F L=1:1:150 U IO X ^%ZOSF("MTBOT") G:Y GOODREW U IO(0) W "." H 2
S XBFLG=-1,XBFLG(1)="Tape not rewound"
U IO(0)
W !!,XBFLG(1),*7
G CLOSE
;
GOODREW ;
U IO(0)
W !!,"Remove the tape... Press RETURN when Ready:"
R X:DTIME
CLOSE ;
D ^%ZISC
U IO(0)
END ;
KILL XBMSG,%MT
Q
;
SAVEDSM ;
W XBDT
W:XBPAR'["V" !
W XBTLE
W:XBPAR'["V" !
S X=XBGL_XBF_")"
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" !
W "**END**" W:XBPAR'["V" !
W "**END**" W:XBPAR'["V" !
Q
;
ZIBGSVED ; IHS/ADC/GTH - SAVE GLOBAL TO TAPE, DSM SPECIFIC ; [ 02/07/97 3:02 PM ]
+1 ;;3.0;IHS/VA UTILITIES;;FEB 07, 1997
+2 ;
+3 IF $GET(XBFLT)
SET XBFLG=-1
SET XBFLG(0)="DSM flat filer has not been tested."
QUIT
+4 IF $DATA(XBMED)
GOTO NOSELT
ASK ;
+1 READ !!,"Copy transaction file to ('^' To Exit Without Saving)",!!?10,"[T]ape, [C]artridge C// ",XBMED:DTIME
+2 SET XBMED=$$UP^XLFSTR($EXTRACT(XBMED_"C"))
+3 IF U[XBMED
SET XBFLG(1)="Job Terminated by Operator at Device Select"
SET XBFLG=-1
GOTO END
+4 IF "?"[XBMED
GOTO HELP
IF '("CT"[XBMED)
GOTO ASK
NOSELT ;
+1 SET IO=XBIO
+2 IF "T"[XBMED
DO TAPE
IF "C"[XBMED
DO CART
+3 QUIT
+4 ;
HELP ;
+1 WRITE !!,"This option saves the ' ",XBNAR," ",XBGL,"' transaction file to either a Cartridge",!,"or 9-Track Tape. The default is to a 9-Track Tape."
+2 WRITE !,"Enter either a ""C"" for Cartridge Tape or a ""T"" for 9-Track Tape."
+3 GOTO ASK
+4 ;
CART ;
+1 SET XBIO=47
SET XBMSG="Cartridge"
+2 GOTO PROCESS
TAPE ;
+1 SET XBIO=48
SET XBMSG="9-Track"
PROCESS ;
+1 SET IOP=XBIO
+2 DO ^%ZIS
+3 KILL IOP
+4 IF '$DATA(XBPAR)
SET XBPAR=IOPAR
+5 IF POP
SET XBFLG(1)=XBMSG_" Drive Not Available"
SET XBFLG=-1
USE IO(0)
WRITE !,XBFLG(1)
GOTO END
+6 USE IO
+7 XECUTE ^%ZOSF("MAGTAPE")
+8 WRITE @%MT("REW")
+9 USE IO(0)
+10 WRITE !!,"Mount The ",XBMSG," Tape 'WRITE ENABLED' And "
RETRY ;
+1 READ !?10,"Press RETURN When Ready - ""^"" to Exit ",X:DTIME
+2 IF X=U!('$TEST)
SET XBFLG(1)="Job Aborted by Operator During Tape Mount"
SET XBFLG=-1
GOTO CLOSE
+3 USE IO
+4 XECUTE ^%ZOSF("MTONLINE")
+5 IF 'Y
USE IO(0)
WRITE !!,"WAITING FOR TAPE"
+6 FOR I=1:1:75
USE IO
XECUTE ^%ZOSF("MTONLINE")
IF Y
GOTO S9
USE IO(0)
WRITE "."
HANG 5
+7 USE IO(0)
+8 WRITE !!,XBFLG(1)," After 6 Minutes"
+9 SET XBFLG(1)="Job Aborted, Tape not Ready"
SET XBFLG=-1
+10 GOTO END
+11 ;
S9 ;
+1 USE IO
+2 XECUTE ^%ZOSF("MTWPROT")
+3 IF Y
GOTO WRITPROT
+4 USE IO(0)
+5 WRITE !,"Please Standby - Copying Data to ",XBMSG
+6 USE IO
+7 DO SAVEDSM
+8 IF $DATA(XBFLG)
GOTO CLOSE
GOTO EXIT
+9 ;
WRITPROT ;
+1 USE IO(0)
+2 WRITE *7,!!," The Tape Is WRITE PROTECTED. Please Remove The Tape,"
+3 WRITE !," And Re-position The Write Protect/Enable Switch.",!," "
+4 GOTO RETRY
+5 ;
EXIT ;
+1 XECUTE ^%ZOSF("MAGTAPE")
+2 USE IO
+3 WRITE @%MT("WTM"),@%MT("REW")
+4 USE IO(0)
+5 WRITE !!,"Rewinding tape. <WAIT>"
+6 FOR L=1:1:150
USE IO
XECUTE ^%ZOSF("MTBOT")
IF Y
GOTO GOODREW
USE IO(0)
WRITE "."
HANG 2
+7 SET XBFLG=-1
SET XBFLG(1)="Tape not rewound"
+8 USE IO(0)
+9 WRITE !!,XBFLG(1),*7
+10 GOTO CLOSE
+11 ;
GOODREW ;
+1 USE IO(0)
+2 WRITE !!,"Remove the tape... Press RETURN when Ready:"
+3 READ X:DTIME
CLOSE ;
+1 DO ^%ZISC
+2 USE IO(0)
END ;
+1 KILL XBMSG,%MT
+2 QUIT
+3 ;
SAVEDSM ;
+1 WRITE XBDT
+2 IF XBPAR'["V"
WRITE !
+3 WRITE XBTLE
+4 IF XBPAR'["V"
WRITE !
+5 SET X=XBGL_XBF_")"
+6 FOR
SET X=$QUERY(@X)
IF X=""
QUIT
IF (XBE]"")&($PIECE($PIECE(X,"(",2),",")>XBE)
QUIT
SET Y=X
IF $EXTRACT(Y,2)="["
SET Y=U_$PIECE(Y,"]",2,999)
WRITE Y
IF XBPAR'["V"
WRITE !
WRITE @X
IF XBPAR'["V"
WRITE !
+7 WRITE "**END**"
IF XBPAR'["V"
WRITE !
+8 WRITE "**END**"
IF XBPAR'["V"
WRITE !
+9 QUIT
+10 ;
