ZIBGSVED.m

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      ;