| 1 | XMAFTP ;(WASH ISC)/TCPIP-FTP Options ;04/17/2002 07:29
|
|---|
| 2 | ;;8.0;MailMan;;Jun 28, 2002
|
|---|
| 3 | ; Entry points used by MailMan options (not covered by DBIA):
|
|---|
| 4 | ; GET XM-FTP-GET
|
|---|
| 5 | ; PUT XM-FTP-PUT
|
|---|
| 6 | Q
|
|---|
| 7 | GO ;Come here from GET or PUT (see tags below)
|
|---|
| 8 | I ^%ZOSF("OS")'["VAX DSM" W !!,"Sorry...this option only works for VAX DSM" Q
|
|---|
| 9 | N $ETRAP,$ESTACK S $ETRAP=""
|
|---|
| 10 | S X="EXIT^XMAFTP",@^%ZOSF("TRAP")
|
|---|
| 11 | N DIC,DIE,DIK,DD,DO,DTOUT,DUOUT,XMAFTP S XMAFTP=Z
|
|---|
| 12 | S DIC="^XMBX(4.2995,",DIC(0)="AEQFZ",X="TMP"_$P($H,",",2)
|
|---|
| 13 | S DIC("DR")="1///"_($H*86400+$P($H,",",2))_";2///"_$S($G(XMDUZ):XMDUZ,1:DUZ)_";4///"_Z
|
|---|
| 14 | K DD,DO D FILE^DICN K DD,DO
|
|---|
| 15 | Q:Y<0 S DIE=DIC,DA=+Y
|
|---|
| 16 | S DIE("NO^")="BACKOUTOK"
|
|---|
| 17 | ;
|
|---|
| 18 | ;Ask data according to Get or Put option
|
|---|
| 19 | S DR=$S(XMAFTP=1:"12;13;10;11;7;8;9",XMAFTP=2:"10;11;12;13;7;8;9",1:"")
|
|---|
| 20 | G EXIT:DR=""
|
|---|
| 21 | D ^DIE
|
|---|
| 22 | G EXIT:$S(X="":1,$D(DTOUT):1,$D(DUOUT):1,1:0)
|
|---|
| 23 | D SETXMF
|
|---|
| 24 | W !!,"In process...it will take a little time to complete the transmission."
|
|---|
| 25 | D FTP K XMSFTP
|
|---|
| 26 | Q
|
|---|
| 27 | EXIT S DIK="^XMBX(4.2995," D ^DIK
|
|---|
| 28 | I '$D(ZTQUEUED),'$D(XMCHAN) W !!,"Process Aborted !!!",$C(7)
|
|---|
| 29 | Q
|
|---|
| 30 | SETXMF ;Set up XMSFTP array to use when doing tag FTP
|
|---|
| 31 | S %1=$G(^XMBX(4.2995,DA,1))
|
|---|
| 32 | S XMSFTP(4)=$P(%1,U,4)
|
|---|
| 33 | S XMSFTP(5)=$P(%1,U,5)
|
|---|
| 34 | 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)
|
|---|
| 35 | 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)
|
|---|
| 36 | Q
|
|---|
| 37 | FTP ;Set up 4.2995 entry and XMnn.COM file
|
|---|
| 38 | N XMIO S XMIO=$I
|
|---|
| 39 | S (XMSFTP,X)=$G(^XMBX(4.2995,"F",0))+1,^(0)=X
|
|---|
| 40 | S FILE="XM"_X_".COM" O FILE:NEW U FILE
|
|---|
| 41 | W "$! FTP COM procedure for fetching file from server and sending it",!
|
|---|
| 42 | W "$ set noon",!
|
|---|
| 43 | W "$ assign/user nla0: sys$output",! ; Turn off echo
|
|---|
| 44 | W "$ assign/user sys$input sys$command",!
|
|---|
| 45 | I $L($G(XMSFTP(3))),$L($G(XMSFTP(2))) W "$ set def "_XMSFTP(2),!
|
|---|
| 46 | I $L($G(XMSFTP(1))),$L($G(XMSFTP(10))) W "$ set def "_XMSFTP(10),!
|
|---|
| 47 | W "$ FTP=""$TWG$TCP:[NETDIST.USER]FTP",!
|
|---|
| 48 | W "$ FTP "
|
|---|
| 49 | I $L($G(XMSFTP(1))) W XMSFTP(1),!
|
|---|
| 50 | E W XMSFTP(3),!
|
|---|
| 51 | S %2=$G(XMSFTP(4)) W %2,!
|
|---|
| 52 | S %2=$G(XMSFTP(5)) I $L(%2) W %2,!
|
|---|
| 53 | W "bin",!
|
|---|
| 54 | TT I XMAFTP=1 D
|
|---|
| 55 | .I $L($G(XMSFTP(2))) W "cd "_XMSFTP(2),!
|
|---|
| 56 | .W "get "_XMSFTP(2,"F")_" "_$G(XMSFTP(9)),!
|
|---|
| 57 | I XMAFTP=2 D
|
|---|
| 58 | .I $L($G(XMSFTP(10))) W "cd "_XMSFTP(10),!
|
|---|
| 59 | .W "put "_XMSFTP(2,"F")_" "_$G(XMSFTP(9)),!
|
|---|
| 60 | W "quit",!
|
|---|
| 61 | S DIE="^XMBX(4.2995,",DR=".01////"_FILE D ^DIE
|
|---|
| 62 | C FILE
|
|---|
| 63 | K FILE
|
|---|
| 64 | U XMIO
|
|---|
| 65 | Q
|
|---|
| 66 | GET ;Entry for GET option
|
|---|
| 67 | N Z S Z=1 G GO
|
|---|
| 68 | PUT ;Entry for PUT option
|
|---|
| 69 | N Z S Z=2 G GO
|
|---|
