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 ;
