AMQQEM1.m

AMQQEM1 ; IHS/CMI/THL - GETS DOS/UNIX PATH AND FILE NAME ;

 ;;2.0;IHS PCC SUITE;;MAY 14, 2009

 ;-----

 I $G(^DD("OS"))'=8&($G(^DD("OS"))'=18) S AMQQEM("FORMAT")="MUMPS" Q

 I ^%ZOSF("OS")["UNIX" S AMQQEM("FORMAT")="UNIX" G RUN

 I ^%ZOSF("OS")["PC"!(^%ZOSF("OS")["386")!(^%ZOSF("OS")["NT") S AMQQEM("FORMAT")="PC" G RUN

 S AMQQEM("FORMAT")="MUMPS"

 Q

RUN S U="^"

 F AMQQERUN=12:1:14 D @$P("UNIX^FILE^OVER",U,AMQQERUN-11) Q:AMQQERUN<11  I $D(AMQQQUIT) Q

EXIT Q

 ;

MARK W !!,"---------",!!

 Q

 ;

FWD S AMQQEMS=AMQQERUN_U_AMQQEMS

 Q

 ;

BACKUP S AMQQERUN=$P(AMQQEMS,U)-1

 S AMQQEMS=$P(AMQQEMS,U,2,99)

 Q

 ;

CK I $D(DIRUT)!($D(DUOUT))!($D(DTOUT))!($D(DIROUT))!(X="") K DIRUT,DUOUT,DTOUT,DIROUT S AMQQQUIT=""

 Q

 ;

VAR ;EP; OS VARIABLES

 N X,I

 ; The following line contain commands that perform OPEN, USE

 ; commands without use of the kernel utilities. - An exemption to

 ; SAC 6.3.1 has been approved by Jim McArthur per memo dated 

 ; May 17, 1993. This exemption is only for version 2. ** BRJ/IHS ** 6/7/93

 I ^DD("OS")=18 D  Q

 .S AMQQEX("CHECK")="D OPEN^%ZISH("""",AMQQEX(""PATH""),AMQQEX(""FILE"")) Q:'$T  U IO S Y=$ZA"

 .S AMQQEX("IOP")="HFS"

 .S AMQQEX("READ")="D OPEN^%ZISH("""",AMQQEX(""PATH""),AMQQEX(""FILE""),""R"")"

 .S AMQQEX("WRITE")="D OPEN^%ZISH("""",AMQQEX(""PATH""),AMQQEX(""FILE""),""W"")"

 .S AMQQEX("USE")="U IO"

 .S AMQQEX("CLOSE")="D CLOSE^%ZISH()"

 .S AMQQEX("EOF")="S X=$$EOF^%ZISH()"

 .S AMQQEX("WRAPOFF")="U 0:(0)"

 S X="O 51:(AMQQEFN):5 Q:'$T  U 51 S Y=$ZA^51^O 51:(AMQQEFN:""R""::::$C(10)):5^O 51:(AMQQEFN:""W""):5^U 51^C 51^^U 0:(0)"

 F I=1:1:8 S AMQQEX($P("CHECK^IOP^READ^WRITE^USE^CLOSE^EOF^WRAPOFF",U,I))=$P(X,U,I)

 Q

 ;

UNIX ; UNIX CHOICES ; 11

 D MARK

 W "OUTPUT FILE LOCATION",!

 I AMQQEM("FORMAT")="PC" D PC Q

 S DIR(0)="S^1:UNIX FILE;2:MUMPS FILE"

 S DIR("A")="     Your choice"

 S DIR("?")="See User's Guide or type '??' for a full explanation of output format alternatives"

 D ^DIR

 K DIR

 S:$D(DUOUT) DIRUT=1

 I X=U D BACKUP Q

 D CK

 I $D(AMQQQUIT) Q

 D FWD

 S AMQQEM("FORMAT")=$S(Y=1:"UNIX",1:"MUMPS")

 I $G(AMQQEX("PATH"))["\" K AMQQEX("PATH")

 I Y=2 S AMQQERUN=99,AMQQEM("FORMAT")="MUMPS"

 Q

 ;

PC ; PC CHOICES ; 11

 S DIR(0)="S^1:DOS FILE;2:MUMPS FILE"

 S DIR("A")="     Your choice"

 S DIR("?")="See User's Guide or type '??' for a full explanation of output format alternatives."

 S DIR("??")="AMQQEMANHOST"

 D ^DIR

 K DIR

 S:$D(DUOUT) DIRUT=1

 I X=U D BACKUP Q

 D CK

 I $D(AMQQQUIT) Q

 D FWD

 S AMQQEM("FORMAT")=$S(Y=1:"DOS",1:"MUMPS")

 I $G(AMQQEX("PATH"))["/" K AMQQEX("PATH")

 I Y=2 S AMQQERUN=99

 Q

 ;

FILE ; FILE NAME AND PATH ; 12

 D VAR

 D MARK

 W "FILE NAME AND PATH",!

 I AMQQEM("FORMAT")="DOS" S DIR(0)="F^:",DIR("A")="Enter the DOS file (path, name, extension)",DIR("?")="Enter path, file name and extension; e.g., 'C:\DBASE\DATA\MYFILE.DAT'" I 1

 E  S DIR(0)="F^:",DIR("A")="Enter the UNIX file (path, name, extension)",DIR("?")="Enter path, file name and extension; e.g., 'user/mumps/myfile.data'"

 D ^DIR

 K DIR

 S:$D(DUOUT) DIRUT=1

 I X=U D BACKUP S AMQQERUN=11 Q

 D CK

 I $D(AMQQQUIT) Q

 D FWD

 S AMQQEX("FILE")=Y

 N AMQQEFN

 S AMQQEFN=AMQQEX("FILE")

CHKIT X AMQQEX("CHECK")

 E  W !,"The Host File Server is being used by someone else.  I will keep trying for 30 seconds.",!,"If it is still not free, I must terminate this session.",!! D  I $D(AMQQQUIT) Q

 .N H,T,D S H=$H,D=+H,T=$P(H,",",2)+30

 .F  X AMQQEX("CHECK") Q:$T  I +$H'=D!($P($H,",",2)>T) S AMQQQUIT="" Q

 .Q

 X AMQQEX("CLOSE")

 I Y'<0 Q

 I Y<0 X AMQQEX("WRITE"),AMQQEX("CHECK"),AMQQEX("CLOSE") I Y<0 W !!,"Sorry, I can't accept this path/filename...Check your User's Guide!" G FILE

F1 S X=AMQQEX("FILE")

 S Y=$S(AMQQEM("FORMAT")="DOS":"\",1:"/"),Z=$L(X,Y)

 I Z>1 S AMQQEX("PATH")=$P(X,Y,1,Z-1),X=$P(X,AMQQEX("PATH"),2,99)

 S %=$L(X,".")

 S AMQQEX("EXT")=$P(X,".",%)

 S AMQQEX("NAME")=$P($P(AMQQEX("FILE"),Y,Z),".")

 S AMQQERUN=99

 S AMQQEX("DOC")=$P(AMQQEX("FILE"),".")_".DOC"

 Q

 ;

OVER ; OVERWRITE OLD FILE ; 13

 D MARK

 W "OVERWRITE OLD FILE",!

 W !!,"This ASCII file already exists..."

 S DIR(0)="Y"

 S DIR("A")="Want to overwrite the old version"

 S DIR("B")="NO",DIR("?")="If you answer 'Y', you will destroy the old version and create a new file with the same name"

 D ^DIR

 K DIR

 S:$D(DUOUT) DIRUT=1

 I X=U D BACKUP Q

 D CK

 I $D(AMQQQUIT) Q

 I Y="" S Y=0

 I 'Y D BACKUP Q

 D F1

 Q

 ;

AMQQEM1   ; IHS/CMI/THL - GETS DOS/UNIX PATH AND FILE NAME ;

 +1       ;;2.0;IHS PCC SUITE;;MAY 14, 2009

 +2       ;-----

 +3        IF $GET(^DD("OS"))'=8&($GET(^DD("OS"))'=18)

               SET AMQQEM("FORMAT")="MUMPS"

               QUIT 

 +4        IF ^%ZOSF("OS")["UNIX"

               SET AMQQEM("FORMAT")="UNIX"

               GOTO RUN

 +5        IF ^%ZOSF("OS")["PC"!(^%ZOSF("OS")["386")!(^%ZOSF("OS")["NT")

               SET AMQQEM("FORMAT")="PC"

               GOTO RUN

 +6        SET AMQQEM("FORMAT")="MUMPS"

 +7        QUIT 

RUN        SET U="^"

 +1        FOR AMQQERUN=12:1:14

               DO @$PIECE("UNIX^FILE^OVER",U,AMQQERUN-11)

               IF AMQQERUN<11

                   QUIT 

               IF $DATA(AMQQQUIT)

                   QUIT 

EXIT       QUIT 

 +1       ;

MARK       WRITE !!,"---------",!!

 +1        QUIT 

 +2       ;

FWD        SET AMQQEMS=AMQQERUN_U_AMQQEMS

 +1        QUIT 

 +2       ;

BACKUP     SET AMQQERUN=$PIECE(AMQQEMS,U)-1

 +1        SET AMQQEMS=$PIECE(AMQQEMS,U,2,99)

 +2        QUIT 

 +3       ;

CK         IF $DATA(DIRUT)!($DATA(DUOUT))!($DATA(DTOUT))!($DATA(DIROUT))!(X="")

               KILL DIRUT,DUOUT,DTOUT,DIROUT

               SET AMQQQUIT=""

 +1        QUIT 

 +2       ;

VAR       ;EP; OS VARIABLES

 +1        NEW X,I

 +2       ; The following line contain commands that perform OPEN, USE

 +3       ; commands without use of the kernel utilities. - An exemption to

 +4       ; SAC 6.3.1 has been approved by Jim McArthur per memo dated 

 +5       ; May 17, 1993. This exemption is only for version 2. ** BRJ/IHS ** 6/7/93

 +6        IF ^DD("OS")=18

               Begin DoDot:1

 +7                SET AMQQEX("CHECK")="D OPEN^%ZISH("""",AMQQEX(""PATH""),AMQQEX(""FILE"")) Q:'$T  U IO S Y=$ZA"

 +8                SET AMQQEX("IOP")="HFS"

 +9                SET AMQQEX("READ")="D OPEN^%ZISH("""",AMQQEX(""PATH""),AMQQEX(""FILE""),""R"")"

 +10               SET AMQQEX("WRITE")="D OPEN^%ZISH("""",AMQQEX(""PATH""),AMQQEX(""FILE""),""W"")"

 +11               SET AMQQEX("USE")="U IO"

 +12               SET AMQQEX("CLOSE")="D CLOSE^%ZISH()"

 +13               SET AMQQEX("EOF")="S X=$$EOF^%ZISH()"

 +14               SET AMQQEX("WRAPOFF")="U 0:(0)"

               End DoDot:1

               QUIT 

 +15       SET X="O 51:(AMQQEFN):5 Q:'$T  U 51 S Y=$ZA^51^O 51:(AMQQEFN:""R""::::$C(10)):5^O 51:(AMQQEFN:""W""):5^U 51^C 51^^U 0:(0)"

 +16       FOR I=1:1:8

               SET AMQQEX($PIECE("CHECK^IOP^READ^WRITE^USE^CLOSE^EOF^WRAPOFF",U,I))=$PIECE(X,U,I)

 +17       QUIT 

 +18      ;

UNIX      ; UNIX CHOICES ; 11

 +1        DO MARK

 +2        WRITE "OUTPUT FILE LOCATION",!

 +3        IF AMQQEM("FORMAT")="PC"

               DO PC

               QUIT 

 +4        SET DIR(0)="S^1:UNIX FILE;2:MUMPS FILE"

 +5        SET DIR("A")="     Your choice"

 +6        SET DIR("?")="See User's Guide or type '??' for a full explanation of output format alternatives"

 +7        DO ^DIR

 +8        KILL DIR

 +9        IF $DATA(DUOUT)

               SET DIRUT=1

 +10       IF X=U

               DO BACKUP

               QUIT 

 +11       DO CK

 +12       IF $DATA(AMQQQUIT)

               QUIT 

 +13       DO FWD

 +14       SET AMQQEM("FORMAT")=$SELECT(Y=1:"UNIX",1:"MUMPS")

 +15       IF $GET(AMQQEX("PATH"))["\"

               KILL AMQQEX("PATH")

 +16       IF Y=2

               SET AMQQERUN=99

               SET AMQQEM("FORMAT")="MUMPS"

 +17       QUIT 

 +18      ;

PC        ; PC CHOICES ; 11

 +1        SET DIR(0)="S^1:DOS FILE;2:MUMPS FILE"

 +2        SET DIR("A")="     Your choice"

 +3        SET DIR("?")="See User's Guide or type '??' for a full explanation of output format alternatives."

 +4        SET DIR("??")="AMQQEMANHOST"

 +5        DO ^DIR

 +6        KILL DIR

 +7        IF $DATA(DUOUT)

               SET DIRUT=1

 +8        IF X=U

               DO BACKUP

               QUIT 

 +9        DO CK

 +10       IF $DATA(AMQQQUIT)

               QUIT 

 +11       DO FWD

 +12       SET AMQQEM("FORMAT")=$SELECT(Y=1:"DOS",1:"MUMPS")

 +13       IF $GET(AMQQEX("PATH"))["/"

               KILL AMQQEX("PATH")

 +14       IF Y=2

               SET AMQQERUN=99

 +15       QUIT 

 +16      ;

FILE      ; FILE NAME AND PATH ; 12

 +1        DO VAR

 +2        DO MARK

 +3        WRITE "FILE NAME AND PATH",!

 +4        IF AMQQEM("FORMAT")="DOS"

               SET DIR(0)="F^:"

               SET DIR("A")="Enter the DOS file (path, name, extension)"

               SET DIR("?")="Enter path, file name and extension; e.g., 'C:\DBASE\DATA\MYFILE.DAT'"

               IF 1

 +5       IF '$TEST

               SET DIR(0)="F^:"

               SET DIR("A")="Enter the UNIX file (path, name, extension)"

               SET DIR("?")="Enter path, file name and extension; e.g., 'user/mumps/myfile.data'"

 +6        DO ^DIR

 +7        KILL DIR

 +8        IF $DATA(DUOUT)

               SET DIRUT=1

 +9        IF X=U

               DO BACKUP

               SET AMQQERUN=11

               QUIT 

 +10       DO CK

 +11       IF $DATA(AMQQQUIT)

               QUIT 

 +12       DO FWD

 +13       SET AMQQEX("FILE")=Y

 +14       NEW AMQQEFN

 +15       SET AMQQEFN=AMQQEX("FILE")

CHKIT      XECUTE AMQQEX("CHECK")

 +1       IF '$TEST

               WRITE !,"The Host File Server is being used by someone else.  I will keep trying for 30 seconds.",!,"If it is still not free, I must terminate this session.",!!

               Begin DoDot:1

 +2                NEW H,T,D

                   SET H=$HOROLOG

                   SET D=+H

                   SET T=$PIECE(H,",",2)+30

 +3                FOR 

                       XECUTE AMQQEX("CHECK")

                       IF $TEST

                           QUIT 

                       IF +$HOROLOG'=D!($PIECE($HOROLOG,",",2)>T)

                           SET AMQQQUIT=""

                           QUIT 

 +4                QUIT 

               End DoDot:1

               IF $DATA(AMQQQUIT)

                   QUIT 

 +5        XECUTE AMQQEX("CLOSE")

 +6        IF Y'<0

               QUIT 

 +7        IF Y<0

               XECUTE AMQQEX("WRITE")

               XECUTE AMQQEX("CHECK")

               XECUTE AMQQEX("CLOSE")

               IF Y<0

                   WRITE !!,"Sorry, I can't accept this path/filename...Check your User's Guide!"

                   GOTO FILE

F1         SET X=AMQQEX("FILE")

 +1        SET Y=$SELECT(AMQQEM("FORMAT")="DOS":"\",1:"/")

           SET Z=$LENGTH(X,Y)

 +2        IF Z>1

               SET AMQQEX("PATH")=$PIECE(X,Y,1,Z-1)

               SET X=$PIECE(X,AMQQEX("PATH"),2,99)

 +3        SET %=$LENGTH(X,".")

 +4        SET AMQQEX("EXT")=$PIECE(X,".",%)

 +5        SET AMQQEX("NAME")=$PIECE($PIECE(AMQQEX("FILE"),Y,Z),".")

 +6        SET AMQQERUN=99

 +7        SET AMQQEX("DOC")=$PIECE(AMQQEX("FILE"),".")_".DOC"

 +8        QUIT 

 +9       ;

OVER      ; OVERWRITE OLD FILE ; 13

 +1        DO MARK

 +2        WRITE "OVERWRITE OLD FILE",!

 +3        WRITE !!,"This ASCII file already exists..."

 +4        SET DIR(0)="Y"

 +5        SET DIR("A")="Want to overwrite the old version"

 +6        SET DIR("B")="NO"

           SET DIR("?")="If you answer 'Y', you will destroy the old version and create a new file with the same name"

 +7        DO ^DIR

 +8        KILL DIR

 +9        IF $DATA(DUOUT)

               SET DIRUT=1

 +10       IF X=U

               DO BACKUP

               QUIT 

 +11       DO CK

 +12       IF $DATA(AMQQQUIT)

               QUIT 

 +13       IF Y=""

               SET Y=0

 +14       IF 'Y

               DO BACKUP

               QUIT 

 +15       DO F1

 +16       QUIT 

 +17      ;