- 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
- 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
