XMAFTP ;(WASH ISC)/TCPIP-FTP Options ;04/17/2002 07:29
;;8.0;MailMan;;Jun 28, 2002
; Entry points used by MailMan options (not covered by DBIA):
; GET XM-FTP-GET
; PUT XM-FTP-PUT
Q
GO ;Come here from GET or PUT (see tags below)
I ^%ZOSF("OS")'["VAX DSM" W !!,"Sorry...this option only works for VAX DSM" Q
N $ETRAP,$ESTACK S $ETRAP=""
S X="EXIT^XMAFTP",@^%ZOSF("TRAP")
N DIC,DIE,DIK,DD,DO,DTOUT,DUOUT,XMAFTP S XMAFTP=Z
S DIC="^XMBX(4.2995,",DIC(0)="AEQFZ",X="TMP"_$P($H,",",2)
S DIC("DR")="1///"_($H*86400+$P($H,",",2))_";2///"_$S($G(XMDUZ):XMDUZ,1:DUZ)_";4///"_Z
K DD,DO D FILE^DICN K DD,DO
Q:Y<0 S DIE=DIC,DA=+Y
S DIE("NO^")="BACKOUTOK"
;
;Ask data according to Get or Put option
S DR=$S(XMAFTP=1:"12;13;10;11;7;8;9",XMAFTP=2:"10;11;12;13;7;8;9",1:"")
G EXIT:DR=""
D ^DIE
G EXIT:$S(X="":1,$D(DTOUT):1,$D(DUOUT):1,1:0)
D SETXMF
W !!,"In process...it will take a little time to complete the transmission."
D FTP K XMSFTP
Q
EXIT S DIK="^XMBX(4.2995," D ^DIK
I '$D(ZTQUEUED),'$D(XMCHAN) W !!,"Process Aborted !!!",$C(7)
Q
SETXMF ;Set up XMSFTP array to use when doing tag FTP
S %1=$G(^XMBX(4.2995,DA,1))
S XMSFTP(4)=$P(%1,U,4)
S XMSFTP(5)=$P(%1,U,5)
I XMAFTP=1 S XMSFTP(1)=$P(%1,U,6),XMSFTP(2)=$P(%1,U,10),XMSFTP(2,"F")=$P(%1,U,9),XMSFTP(9)=$P(%1,U,7),XMSFTP(10)=$P(%1,U,8)
I XMAFTP=2 S XMSFTP(3)=$P(%1,U,6),XMSFTP(2)=$P(%1,U,8),XMSFTP(2,"F")=$P(%1,U,7),XMSFTP(9)=$P(%1,U,9),XMSFTP(10)=$P(%1,U,10)
Q
FTP ;Set up 4.2995 entry and XMnn.COM file
N XMIO S XMIO=$I
S (XMSFTP,X)=$G(^XMBX(4.2995,"F",0))+1,^(0)=X
S FILE="XM"_X_".COM" O FILE:NEW U FILE
W "$! FTP COM procedure for fetching file from server and sending it",!
W "$ set noon",!
W "$ assign/user nla0: sys$output",! ; Turn off echo
W "$ assign/user sys$input sys$command",!
I $L($G(XMSFTP(3))),$L($G(XMSFTP(2))) W "$ set def "_XMSFTP(2),!
I $L($G(XMSFTP(1))),$L($G(XMSFTP(10))) W "$ set def "_XMSFTP(10),!
W "$ FTP=""$TWG$TCP:[NETDIST.USER]FTP",!
W "$ FTP "
I $L($G(XMSFTP(1))) W XMSFTP(1),!
E W XMSFTP(3),!
S %2=$G(XMSFTP(4)) W %2,!
S %2=$G(XMSFTP(5)) I $L(%2) W %2,!
W "bin",!
TT I XMAFTP=1 D
.I $L($G(XMSFTP(2))) W "cd "_XMSFTP(2),!
.W "get "_XMSFTP(2,"F")_" "_$G(XMSFTP(9)),!
I XMAFTP=2 D
.I $L($G(XMSFTP(10))) W "cd "_XMSFTP(10),!
.W "put "_XMSFTP(2,"F")_" "_$G(XMSFTP(9)),!
W "quit",!
S DIE="^XMBX(4.2995,",DR=".01////"_FILE D ^DIE
C FILE
K FILE
U XMIO
Q
GET ;Entry for GET option
N Z S Z=1 G GO
PUT ;Entry for PUT option
N Z S Z=2 G GO
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXMAFTP 2537 printed Apr 09, 2024@21:15:17 Page 2
XMAFTP ;(WASH ISC)/TCPIP-FTP Options ;04/17/2002 07:29
+1 ;;8.0;MailMan;;Jun 28, 2002
+2 ; Entry points used by MailMan options (not covered by DBIA):
+3 ; GET XM-FTP-GET
+4 ; PUT XM-FTP-PUT
+5 QUIT
GO ;Come here from GET or PUT (see tags below)
+1 IF ^%ZOSF("OS")'["VAX DSM"
WRITE !!,"Sorry...this option only works for VAX DSM"
QUIT
+2 NEW $ETRAP,$ESTACK
SET $ETRAP=""
+3 SET X="EXIT^XMAFTP"
SET @^%ZOSF("TRAP")
+4 NEW DIC,DIE,DIK,DD,DO,DTOUT,DUOUT,XMAFTP
SET XMAFTP=Z
+5 SET DIC="^XMBX(4.2995,"
SET DIC(0)="AEQFZ"
SET X="TMP"_$PIECE($HOROLOG,",",2)
+6 SET DIC("DR")="1///"_($HOROLOG*86400+$PIECE($HOROLOG,",",2))_";2///"_$SELECT($GET(XMDUZ):XMDUZ,1:DUZ)_";4///"_Z
+7 KILL DD,DO
DO FILE^DICN
KILL DD,DO
+8 if Y<0
QUIT
SET DIE=DIC
SET DA=+Y
+9 SET DIE("NO^")="BACKOUTOK"
+10 ;
+11 ;Ask data according to Get or Put option
+12 SET DR=$SELECT(XMAFTP=1:"12;13;10;11;7;8;9",XMAFTP=2:"10;11;12;13;7;8;9",1:"")
+13 if DR=""
GOTO EXIT
+14 DO ^DIE
+15 if $SELECT(X="":1,$DATA(DTOUT):1,$DATA(DUOUT):1,1:0)
GOTO EXIT
+16 DO SETXMF
+17 WRITE !!,"In process...it will take a little time to complete the transmission."
+18 DO FTP
KILL XMSFTP
+19 QUIT
EXIT SET DIK="^XMBX(4.2995,"
DO ^DIK
+1 IF '$DATA(ZTQUEUED)
IF '$DATA(XMCHAN)
WRITE !!,"Process Aborted !!!",$CHAR(7)
+2 QUIT
SETXMF ;Set up XMSFTP array to use when doing tag FTP
+1 SET %1=$GET(^XMBX(4.2995,DA,1))
+2 SET XMSFTP(4)=$PIECE(%1,U,4)
+3 SET XMSFTP(5)=$PIECE(%1,U,5)
+4 IF XMAFTP=1
SET XMSFTP(1)=$PIECE(%1,U,6)
SET XMSFTP(2)=$PIECE(%1,U,10)
SET XMSFTP(2,"F")=$PIECE(%1,U,9)
SET XMSFTP(9)=$PIECE(%1,U,7)
SET XMSFTP(10)=$PIECE(%1,U,8)
+5 IF XMAFTP=2
SET XMSFTP(3)=$PIECE(%1,U,6)
SET XMSFTP(2)=$PIECE(%1,U,8)
SET XMSFTP(2,"F")=$PIECE(%1,U,7)
SET XMSFTP(9)=$PIECE(%1,U,9)
SET XMSFTP(10)=$PIECE(%1,U,10)
+6 QUIT
FTP ;Set up 4.2995 entry and XMnn.COM file
+1 NEW XMIO
SET XMIO=$IO
+2 SET (XMSFTP,X)=$GET(^XMBX(4.2995,"F",0))+1
SET ^(0)=X
+3 SET FILE="XM"_X_".COM"
OPEN FILE:NEW
USE FILE
+4 WRITE "$! FTP COM procedure for fetching file from server and sending it",!
+5 WRITE "$ set noon",!
+6 ; Turn off echo
WRITE "$ assign/user nla0: sys$output",!
+7 WRITE "$ assign/user sys$input sys$command",!
+8 IF $LENGTH($GET(XMSFTP(3)))
IF $LENGTH($GET(XMSFTP(2)))
WRITE "$ set def "_XMSFTP(2),!
+9 IF $LENGTH($GET(XMSFTP(1)))
IF $LENGTH($GET(XMSFTP(10)))
WRITE "$ set def "_XMSFTP(10),!
+10 WRITE "$ FTP=""$TWG$TCP:[NETDIST.USER]FTP",!
+11 WRITE "$ FTP "
+12 IF $LENGTH($GET(XMSFTP(1)))
WRITE XMSFTP(1),!
+13 IF '$TEST
WRITE XMSFTP(3),!
+14 SET %2=$GET(XMSFTP(4))
WRITE %2,!
+15 SET %2=$GET(XMSFTP(5))
IF $LENGTH(%2)
WRITE %2,!
+16 WRITE "bin",!
TT IF XMAFTP=1
Begin DoDot:1
+1 IF $LENGTH($GET(XMSFTP(2)))
WRITE "cd "_XMSFTP(2),!
+2 WRITE "get "_XMSFTP(2,"F")_" "_$GET(XMSFTP(9)),!
End DoDot:1
+3 IF XMAFTP=2
Begin DoDot:1
+4 IF $LENGTH($GET(XMSFTP(10)))
WRITE "cd "_XMSFTP(10),!
+5 WRITE "put "_XMSFTP(2,"F")_" "_$GET(XMSFTP(9)),!
End DoDot:1
+6 WRITE "quit",!
+7 SET DIE="^XMBX(4.2995,"
SET DR=".01////"_FILE
DO ^DIE
+8 CLOSE FILE
+9 KILL FILE
+10 USE XMIO
+11 QUIT
GET ;Entry for GET option
+1 NEW Z
SET Z=1
GOTO GO
PUT ;Entry for PUT option
+1 NEW Z
SET Z=2
GOTO GO
