source: WorldVistAEHR/trunk/r/MAILMAN-XM/XMAFTP.m@ 703

Last change on this file since 703 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.4 KB
Line 
1XMAFTP ;(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
7GO ;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
27EXIT S DIK="^XMBX(4.2995," D ^DIK
28 I '$D(ZTQUEUED),'$D(XMCHAN) W !!,"Process Aborted !!!",$C(7)
29 Q
30SETXMF ;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
37FTP ;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",!
54TT 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
66GET ;Entry for GET option
67 N Z S Z=1 G GO
68PUT ;Entry for PUT option
69 N Z S Z=2 G GO
Note: See TracBrowser for help on using the repository browser.