ZIBGSVEM ; IHS/ADC/GTH - SAVE GLOBAL TO MSM UNIX ; [ 09/14/2004 4:57 PM ]
;;3.0;IHS/VA UTILITIES;**9,10**;FEB 07, 1997
;
;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
I $$VERSION^%ZOSV(1)["Windows" G ^ZIBGSVEP ;XB*3*10 TASSC/MFD 8/15/03
G:$D(XBMED) NOSELT
ASK ;
R !!,"Copy transaction file to ('^' TO EXIT WITHOUT SAVING)",!!?10,"[T]ape, [C]artridge, [D]iskette, or [F]ile F// ",XBMED:DTIME
S XBMED=$$UP^XLFSTR($E(XBMED_"F"))
I U[XBMED S XBFLG(1)="Job Terminated by Operator at Device Select",XBFLG=-1 G END
G HELP:"?"[XBMED,ASK:'("CDFT"[XBMED)
NOSELT ;
S (IO,XBZDEV)=XBIO
D TAPE:"T"[XBMED,CART:"C"[XBMED,DISK:"D"[XBMED,UNIX:"F"[XBMED
Q
;
HELP ;
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."
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."
G ASK
;
DISK ; ----- Transfer TX Global to floppy disk.
U IO(0)
W !!,"Mount a FORMATTED Floppy Diskette, 'WRITE ENABLED' ",*7,!,"Press RETURN When Ready or ""^"" to Exit WITHOUT SAVING "
R X:DTIME
I X[U!('$T) S XBFLG(1)="Job Aborted by Operator During Floppy Mount",XBFLG=-1 G END
I $$OPEN^%ZISH("/dev/","fd0","W") S XBERRMSG="Floppy Disk" G ERRMESS
U IO
I $$STATUS^%ZISH U IO(0) W !!,"Please",*7 G DISK
U IO(0)
W !,"Please Standby - Copying Data to Floppy",!
U IO
D SAVEMSM
D ^%ZISC
U IO(0)
R !!,"Remove the Floppy... Press RETURN when Ready:",X:DTIME
G END
;
UNIX ; ----- Transfer TX Global to unix file.
S XBPRE=$E(XBGL,2,5),XBASUFAC=$S('$D(XBSUFAC):$P(^AUTTLOC(DUZ(2),0),U,10),1:XBSUFAC)
S XBFN=$S('$D(XBFN):XBPRE_XBASUFAC_"."_XBCARTNO,1:XBFN)
S XBTEMPFN=XBUF_"/"_XBFN
S XBPAFN=XBTEMPFN
S %=$$OPEN^%ZISH(XBUF_"/",XBFN,"W")
I % S XBERRMSG=$S(%=1:"All Host File Servers Busy!",1:"UNIX File") G ERRMESS
I '$D(ZTQUEUED) U IO(0) W !,"Please Standby - Copying Data to UNIX File ",XBTEMPFN,!
S X=$$JOBWAIT^%HOSTCMD("chmod 666 "_XBUF_"/"_XBFN)
U IO
D SAVEMSM
G CLOSE
;
TAPE ;
S XBDEV="rmt0",XBMSG="9-Track"
G TAPETST
CART ;
S XBDEV="rct",XBMSG="Cartridge"
;
TAPETST ; ----- Transfer global to cartridge or 9-track.
W !,"Do you want to test the ",XBMSG," DRIVE? (Y/N) Y//"
R Y:DTIME
S Y=$E(Y_"Y")
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
S ;
U IO(0)
W !!,"Mount ",XBMSG," Tape, 'WRITE ENABLED' ",*7
R !,"Press RETURN When Ready - ""^"" to Exit ",X:DTIME
I X[U S XBFLG(1)="Job Terminated By Operator at Mount Message",XBFLG=-1 G CLOSE
MAGOPEN ;
I $$OPEN^%ZISH("/dev/",XBDEV,"W") S XBERRMSG="Magtape Device" G ERRMESS
U IO
I $$STATUS^%ZISH U IO(0) W !!,"Please",*7 G S
U IO(0)
W !,"Please Standby - Copying Data to Tape",!
U IO
D SAVEMSM
G EXIT
;
SW ;
U IO(0)
W *7,!!," The Tape Is WRITE PROTECTED. Please Remove The Tape,"
W !," And Re-position The Write Protect/Enable Switch.",!," "
G MAGOPEN
;
ERRMESS ;
S XBFLG(1)=XBERRMSG_" Not Available",XBFLG=-1
I '$D(ZTQUEUED) U IO(0) W !,XBFLG(1)
G END
;
EXIT ;
D ^%ZISC
U IO(0)
W !!,"Rewinding tape. <WAIT>."
H 2
W !!,"Remove the tape... Press RETURN when Ready:"
R X:DTIME
G END
;
CLOSE ;
D ^%ZISC
END ;
I XBMED="F",'$D(XBFLG),XBQ="Y" D UUCPQ
D HOME^%ZIS
KILL XBPRE,XBASUFAC,XBOUTDAT,XBINDATA,XBDEV,XBMSG,XBERRMSG,XBTEMPFN,XBZDEV
Q
;
TAPETEST ;
U IO(0)
W !!,"TAPE TEST...Mount ",XBMSG," Tape, 'WRITE ENABLED' ",*7
R !,"TAPE TEST...Press RETURN When Ready - ""^"" to Exit ",X:DTIME
I X[U S XBFLG(1)="Job Aborted by Operator during Tape Test",XBFLG=-1 Q
W !,"TAPE TEST...Opening tape drive."
H 1
I $$OPEN^%ZISH("/dev/",XBDEV,"W") G TESTERR
U IO
I $$STATUS^%ZISH U IO(0) W !!,"Please",*7 G TAPETEST
U IO(0)
W !,"TAPE TEST...Tape drive opened.",!,"TAPE TEST...Writing test data to tape."
H 1
WRITE ;
S XBOUTDAT="TEST DATA RECORD WRITTEN TO TAPE ON "_XBDT
U IO
W XBOUTDAT,!,"**",!,"**",!!
U IO(0)
W !,"TAPE TEST...Data written."
D ^%ZISC
H 6
U IO(0)
W !,"TAPE TEST...Reading test data from tape.",!
H 1
I $$OPEN^%ZISH("/dev/",XBDEV,"R") G TESTERR
U IO
R XBINDATA:DTIME
D ^%ZISC
U IO(0)
W !,"WROTE : '",XBOUTDAT,"'",!," READ : '",XBINDATA,"'"
I XBINDATA=XBOUTDAT W !,"TAPE TEST...Successful."
E W !,"TAPE TEST...FAILED...$#@!" S XBFLG(1)="Tape Test Failed During Testing",XBFLG=-1
Q
;
TESTERR ;
S XBFLG(1)="Device Not Available During Tape Testing",XBFLG=-1
U IO(0)
W !,*7,XBFLG(1),*7
Q
;
UUCPQ ;EP - auto queue to uucp subroutine, must have system id in RPMS SITE file ; IHS/SET/GTH XB*3*9 10/29/2002
I $$JOBWAIT^%HOSTCMD("/usr/bin/sendto "_XBQTO_" "_XBUF_"/"_XBFN) S XBFLG=-1,XBFLG(1)="Queue of File to uucp Failed"
E W:'$D(ZTQUEUED) !,"Export file ",XBUF,"/",XBFN," queued up to be sent to ",XBQTO,"...",!
Q
;
SAVEMSM ;EP - $QUERY thru global, write to output.
K XBQUIT
I '$G(XBFLT) W XBDT,!,XBTLE,!
S X=XBGL_XBF_")"
F D Q:$G(XBQUIT)
.S X=$Q(@X)
.I X="" S XBQUIT=1 Q
.S Y=$P($P($P(X,")",1),"(",2),",",1)
.I XBE=+XBE,Y'=+Y S XBQUIT=1 Q
.I ($L(XBE)&($$FOLLOW(Y,XBE))) S XBQUIT=1 Q
.I $D(XBCON)&('(Y=+Y)) S XBQUIT=1 Q
.S Y=X
.S:$E(Y,2)="[" Y=U_$P(Y,"]",2,999)
.W:'$G(XBFLT) Y,!
.W @X,!
I '$G(XBFLT) W "**",!,"**",!!
K XBQUIT
Q
;
FOLLOW(Y,XBE) ; If Y follows XBE return 1. Else return 0.
N Z
I '(Y=+Y) D
.S Z=(Y]XBE)
I Y=+Y D
.S Z=(Y>XBE)
Q Z
;
ZIBGSVEM ; IHS/ADC/GTH - SAVE GLOBAL TO MSM UNIX ; [ 09/14/2004 4:57 PM ]
+1 ;;3.0;IHS/VA UTILITIES;**9,10**;FEB 07, 1997
+2 ;
+3 ;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
+4 ;XB*3*10 TASSC/MFD 8/15/03
IF $$VERSION^%ZOSV(1)["Windows"
GOTO ^ZIBGSVEP
+5 IF $DATA(XBMED)
GOTO NOSELT
ASK ;
+1 READ !!,"Copy transaction file to ('^' TO EXIT WITHOUT SAVING)",!!?10,"[T]ape, [C]artridge, [D]iskette, or [F]ile F// ",XBMED:DTIME
+2 SET XBMED=$$UP^XLFSTR($EXTRACT(XBMED_"F"))
+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 '("CDFT"[XBMED)
GOTO ASK
NOSELT ;
+1 SET (IO,XBZDEV)=XBIO
+2 IF "T"[XBMED
DO TAPE
IF "C"[XBMED
DO CART
IF "D"[XBMED
DO DISK
IF "F"[XBMED
DO UNIX
+3 QUIT
+4 ;
HELP ;
+1 WRITE !!,"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."
+2 WRITE !,"Enter either a ""C"" for tape cartridge, a ""T"" for 9-track tape, a ""D"" for floppy disk, or an ""F"" for Unix file."
+3 GOTO ASK
+4 ;
DISK ; ----- Transfer TX Global to floppy disk.
+1 USE IO(0)
+2 WRITE !!,"Mount a FORMATTED Floppy Diskette, 'WRITE ENABLED' ",*7,!,"Press RETURN When Ready or ""^"" to Exit WITHOUT SAVING "
+3 READ X:DTIME
+4 IF X[U!('$TEST)
SET XBFLG(1)="Job Aborted by Operator During Floppy Mount"
SET XBFLG=-1
GOTO END
+5 IF $$OPEN^%ZISH("/dev/","fd0","W")
SET XBERRMSG="Floppy Disk"
GOTO ERRMESS
+6 USE IO
+7 IF $$STATUS^%ZISH
USE IO(0)
WRITE !!,"Please",*7
GOTO DISK
+8 USE IO(0)
+9 WRITE !,"Please Standby - Copying Data to Floppy",!
+10 USE IO
+11 DO SAVEMSM
+12 DO ^%ZISC
+13 USE IO(0)
+14 READ !!,"Remove the Floppy... Press RETURN when Ready:",X:DTIME
+15 GOTO END
+16 ;
UNIX ; ----- Transfer TX Global to unix file.
+1 SET XBPRE=$EXTRACT(XBGL,2,5)
SET XBASUFAC=$SELECT('$DATA(XBSUFAC):$PIECE(^AUTTLOC(DUZ(2),0),U,10),1:XBSUFAC)
+2 SET XBFN=$SELECT('$DATA(XBFN):XBPRE_XBASUFAC_"."_XBCARTNO,1:XBFN)
+3 SET XBTEMPFN=XBUF_"/"_XBFN
+4 SET XBPAFN=XBTEMPFN
+5 SET %=$$OPEN^%ZISH(XBUF_"/",XBFN,"W")
+6 IF %
SET XBERRMSG=$SELECT(%=1:"All Host File Servers Busy!",1:"UNIX File")
GOTO ERRMESS
+7 IF '$DATA(ZTQUEUED)
USE IO(0)
WRITE !,"Please Standby - Copying Data to UNIX File ",XBTEMPFN,!
+8 SET X=$$JOBWAIT^%HOSTCMD("chmod 666 "_XBUF_"/"_XBFN)
+9 USE IO
+10 DO SAVEMSM
+11 GOTO CLOSE
+12 ;
TAPE ;
+1 SET XBDEV="rmt0"
SET XBMSG="9-Track"
+2 GOTO TAPETST
CART ;
+1 SET XBDEV="rct"
SET XBMSG="Cartridge"
+2 ;
TAPETST ; ----- Transfer global to cartridge or 9-track.
+1 WRITE !,"Do you want to test the ",XBMSG," DRIVE? (Y/N) Y//"
+2 READ Y:DTIME
+3 SET Y=$EXTRACT(Y_"Y")
+4 IF "Yy"[Y
DO TAPETEST
IF $DATA(XBFLG)
GOTO CLOSE
IF Y[U
SET XBFLG(1)="Job Aborted by Operator During Tape Test"
SET XBFLG=-1
GOTO END
S ;
+1 USE IO(0)
+2 WRITE !!,"Mount ",XBMSG," Tape, 'WRITE ENABLED' ",*7
+3 READ !,"Press RETURN When Ready - ""^"" to Exit ",X:DTIME
+4 IF X[U
SET XBFLG(1)="Job Terminated By Operator at Mount Message"
SET XBFLG=-1
GOTO CLOSE
MAGOPEN ;
+1 IF $$OPEN^%ZISH("/dev/",XBDEV,"W")
SET XBERRMSG="Magtape Device"
GOTO ERRMESS
+2 USE IO
+3 IF $$STATUS^%ZISH
USE IO(0)
WRITE !!,"Please",*7
GOTO S
+4 USE IO(0)
+5 WRITE !,"Please Standby - Copying Data to Tape",!
+6 USE IO
+7 DO SAVEMSM
+8 GOTO EXIT
+9 ;
SW ;
+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 MAGOPEN
+5 ;
ERRMESS ;
+1 SET XBFLG(1)=XBERRMSG_" Not Available"
SET XBFLG=-1
+2 IF '$DATA(ZTQUEUED)
USE IO(0)
WRITE !,XBFLG(1)
+3 GOTO END
+4 ;
EXIT ;
+1 DO ^%ZISC
+2 USE IO(0)
+3 WRITE !!,"Rewinding tape. <WAIT>."
+4 HANG 2
+5 WRITE !!,"Remove the tape... Press RETURN when Ready:"
+6 READ X:DTIME
+7 GOTO END
+8 ;
CLOSE ;
+1 DO ^%ZISC
END ;
+1 IF XBMED="F"
IF '$DATA(XBFLG)
IF XBQ="Y"
DO UUCPQ
+2 DO HOME^%ZIS
+3 KILL XBPRE,XBASUFAC,XBOUTDAT,XBINDATA,XBDEV,XBMSG,XBERRMSG,XBTEMPFN,XBZDEV
+4 QUIT
+5 ;
TAPETEST ;
+1 USE IO(0)
+2 WRITE !!,"TAPE TEST...Mount ",XBMSG," Tape, 'WRITE ENABLED' ",*7
+3 READ !,"TAPE TEST...Press RETURN When Ready - ""^"" to Exit ",X:DTIME
+4 IF X[U
SET XBFLG(1)="Job Aborted by Operator during Tape Test"
SET XBFLG=-1
QUIT
+5 WRITE !,"TAPE TEST...Opening tape drive."
+6 HANG 1
+7 IF $$OPEN^%ZISH("/dev/",XBDEV,"W")
GOTO TESTERR
+8 USE IO
+9 IF $$STATUS^%ZISH
USE IO(0)
WRITE !!,"Please",*7
GOTO TAPETEST
+10 USE IO(0)
+11 WRITE !,"TAPE TEST...Tape drive opened.",!,"TAPE TEST...Writing test data to tape."
+12 HANG 1
WRITE ;
+1 SET XBOUTDAT="TEST DATA RECORD WRITTEN TO TAPE ON "_XBDT
+2 USE IO
+3 WRITE XBOUTDAT,!,"**",!,"**",!!
+4 USE IO(0)
+5 WRITE !,"TAPE TEST...Data written."
+6 DO ^%ZISC
+7 HANG 6
+8 USE IO(0)
+9 WRITE !,"TAPE TEST...Reading test data from tape.",!
+10 HANG 1
+11 IF $$OPEN^%ZISH("/dev/",XBDEV,"R")
GOTO TESTERR
+12 USE IO
+13 READ XBINDATA:DTIME
+14 DO ^%ZISC
+15 USE IO(0)
+16 WRITE !,"WROTE : '",XBOUTDAT,"'",!," READ : '",XBINDATA,"'"
+17 IF XBINDATA=XBOUTDAT
WRITE !,"TAPE TEST...Successful."
+18 IF '$TEST
WRITE !,"TAPE TEST...FAILED...$#@!"
SET XBFLG(1)="Tape Test Failed During Testing"
SET XBFLG=-1
+19 QUIT
+20 ;
TESTERR ;
+1 SET XBFLG(1)="Device Not Available During Tape Testing"
SET XBFLG=-1
+2 USE IO(0)
+3 WRITE !,*7,XBFLG(1),*7
+4 QUIT
+5 ;
UUCPQ ;EP - auto queue to uucp subroutine, must have system id in RPMS SITE file ; IHS/SET/GTH XB*3*9 10/29/2002
+1 IF $$JOBWAIT^%HOSTCMD("/usr/bin/sendto "_XBQTO_" "_XBUF_"/"_XBFN)
SET XBFLG=-1
SET XBFLG(1)="Queue of File to uucp Failed"
+2 IF '$TEST
IF '$DATA(ZTQUEUED)
WRITE !,"Export file ",XBUF,"/",XBFN," queued up to be sent to ",XBQTO,"...",!
+3 QUIT
+4 ;
SAVEMSM ;EP - $QUERY thru global, write to output.
+1 KILL XBQUIT
+2 IF '$GET(XBFLT)
WRITE XBDT,!,XBTLE,!
+3 SET X=XBGL_XBF_")"
+4 FOR
Begin DoDot:1
+5 SET X=$QUERY(@X)
+6 IF X=""
SET XBQUIT=1
QUIT
+7 SET Y=$PIECE($PIECE($PIECE(X,")",1),"(",2),",",1)
+8 IF XBE=+XBE
IF Y'=+Y
SET XBQUIT=1
QUIT
+9 IF ($LENGTH(XBE)&($$FOLLOW(Y,XBE)))
SET XBQUIT=1
QUIT
+10 IF $DATA(XBCON)&('(Y=+Y))
SET XBQUIT=1
QUIT
+11 SET Y=X
+12 IF $EXTRACT(Y,2)="["
SET Y=U_$PIECE(Y,"]",2,999)
+13 IF '$GET(XBFLT)
WRITE Y,!
+14 WRITE @X,!
End DoDot:1
IF $GET(XBQUIT)
QUIT
+15 IF '$GET(XBFLT)
WRITE "**",!,"**",!!
+16 KILL XBQUIT
+17 QUIT
+18 ;
FOLLOW(Y,XBE) ; If Y follows XBE return 1. Else return 0.
+1 NEW Z
+2 IF '(Y=+Y)
Begin DoDot:1
+3 SET Z=(Y]XBE)
End DoDot:1
+4 IF Y=+Y
Begin DoDot:1
+5 SET Z=(Y>XBE)
End DoDot:1
+6 QUIT Z
+7 ;
