ZIBGSVEM.m

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       ;