- XMRFTPUX ;(WASH ISC)/THM/CAP-SMTP Receiver (RFC 821) ;04/17/2002 11:20
- ;;8.0;MailMan;;Jun 28, 2002
- ;Modified for TCP/IP under INET_SERVERS of Wollongong
- ;Send out FTP jobs that are due
- FTP N %,DA,DIK,XMA0,XMC0,XMSFTP,Y,Z,XMCOM S XMA0=$H*86400+$P($H,",",2)
- F1 S Z=0,Z=$O(^XMBX(4.2995,Z)) G FQ:+Z'=Z I '$D(^(Z,0)) G QQ^XMRTCP
- S Y=^XMBX(4.2995,Z,0),XMSFTP=$P(Y,U,4),XMRTCPY="MM-FTP-"_$P(Y,U),XMCOM=$P(Y,U)
- I XMCOM'?1"XM".E D RUNQ G QQ^XMRTCP
- F2 F S %=$S($G(XMC0):XMC0,1:$$CK^XMRTCP(1)) G F3:%
- ;Copy file to export directory
- F3 S XMC0=% I XMSFTP S %=$$FCHK(Z,XMA0,XMSFTP) G F1:%
- S XMRTCP("NAME")=XMRTCPY D REN
- G RUN
- FQ I $G(XMC0) L -^XMBX("TCPCHAN-COUNT",XMC0)
- Q
- ;Submit FTP process
- RUN I $$NEWERR^%ZTER N $ETRAP,$ESTACK S $ETRAP=""
- S X="RUNQ^XMRFTP",@^%ZOSF("TRAP")
- S %=$ZC(%SPAWN,"@"_XMCOM),%=$ZC(%SPAWN,"DELETE "_XMCOM_".*")
- RUNQ ;Remove from 4.2995
- I $D(Z) N DIK,DA S DIK="^XMBX(4.2995,",DA=Z K XMRTCPY D ^DIK Q
- Q
- REN I $$NEWERR^%ZTER N $ETRAP,$ESTACK S $ETRAP=""
- S X="DUPNAME^XMRTCP",@^%ZOSF("TRAP")
- I ^%ZOSF("OS")["VAX" S X=$ZC(%SETPRN,$E(XMRTCP("NAME"),1,13))
- D START^XMRTCPGO
- Q
- FCHK(Z,Y,F) ;Is file in export directory ?
- Q 0 ;****************
- N %,%0,%1,%2,I,X,XMIO
- S XMIO=$I,%=^XMBX(4.2995,Z,0),%0=$P(%,U,5),%2=$P(%,U,4)
- I '%0 S $P(^XMBX(4.2995,Z,0),U,5)=Y,%=$$EXPORT^MAGAPI("MAIL",F,"WAIT") Q %
- S %=$P(^MAG(2005,%2,0),U,2)
- CONT S %0="XMS"_$E(Z,$L(Z)-4,$L(Z))_".LIS"
- I $$NEWERR^%ZTER N $ETRAP,$ESTACK S $ETRAP=""
- S X="FPQ^XMRFTP",@^%ZOSF("TRAP"),X=$ZC(%SPAWN,"PURGE "_%0)
- FPQ I $$NEWERR^%ZTER N $ETRAP,$ESTACK S $ETRAP=""
- S X="Q0^XMRFTP",@^%ZOSF("TRAP"),X=$ZC(%SPAWN,"DIR/OUTPUT="_%0_" NFA0:[EXPORT.MAIL]"_%)
- O %0 U %0
- I $$NEWERR^%ZTER N $ETRAP,$ESTACK S $ETRAP=""
- S X="FCHKQ^XMRFTP",@^%ZOSF("TRAP")
- F R X:9 Q:X[%
- FCHKQ C %0 U XMIO
- I X'[% Q 1
- Q 0
- Q0 Q 1
- FER N X S X=$P($G(^XMBX(4.2995,Z,0)),U,2)
- I 'X S X=$H*86400+$P($H,",",2),$P(^(0),U,2)=X
- Q:$H*86400+$P($H,",",2)-%>99
- N Z S XMDUZ=.5,XMSUB="ERROR moving File from Image Server"
- S XMTEXT="A(",A(1)="The error was: "_%_"."
- S A(2)="The COM file being processed was: "_Y,XMY(.5)=""
- D ^XMD Q
- IMAGENT(Y,F) ;
- N %,%0,XMIO,X
- I ^%ZOSF("OS")["MSM" S X=$ZOS(12,NEWPATH,"") I $P(X,U)=F QUIT "5 -IMAGE ALREADY THERE"
- S Z=$P($H,",",2)#1000,XMIO=$I,%=F
- G CONT
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXMRFTPUX 2303 printed Jan 18, 2025@03:14 Page 2
- XMRFTPUX ;(WASH ISC)/THM/CAP-SMTP Receiver (RFC 821) ;04/17/2002 11:20
- +1 ;;8.0;MailMan;;Jun 28, 2002
- +2 ;Modified for TCP/IP under INET_SERVERS of Wollongong
- +3 ;Send out FTP jobs that are due
- FTP NEW %,DA,DIK,XMA0,XMC0,XMSFTP,Y,Z,XMCOM
- SET XMA0=$HOROLOG*86400+$PIECE($HOROLOG,",",2)
- F1 SET Z=0
- SET Z=$ORDER(^XMBX(4.2995,Z))
- if +Z'=Z
- GOTO FQ
- IF '$DATA(^(Z,0))
- GOTO QQ^XMRTCP
- +1 SET Y=^XMBX(4.2995,Z,0)
- SET XMSFTP=$PIECE(Y,U,4)
- SET XMRTCPY="MM-FTP-"_$PIECE(Y,U)
- SET XMCOM=$PIECE(Y,U)
- +2 IF XMCOM'?1"XM".E
- DO RUNQ
- GOTO QQ^XMRTCP
- F2 FOR
- SET %=$SELECT($GET(XMC0):XMC0,1:$$CK^XMRTCP(1))
- if %
- GOTO F3
- +1 ;Copy file to export directory
- F3 SET XMC0=%
- IF XMSFTP
- SET %=$$FCHK(Z,XMA0,XMSFTP)
- if %
- GOTO F1
- +1 SET XMRTCP("NAME")=XMRTCPY
- DO REN
- +2 GOTO RUN
- FQ IF $GET(XMC0)
- LOCK -^XMBX("TCPCHAN-COUNT",XMC0)
- +1 QUIT
- +2 ;Submit FTP process
- RUN IF $$NEWERR^%ZTER
- NEW $ETRAP,$ESTACK
- SET $ETRAP=""
- +1 SET X="RUNQ^XMRFTP"
- SET @^%ZOSF("TRAP")
- +2 SET %=$ZC(%SPAWN,"@"_XMCOM)
- SET %=$ZC(%SPAWN,"DELETE "_XMCOM_".*")
- RUNQ ;Remove from 4.2995
- +1 IF $DATA(Z)
- NEW DIK,DA
- SET DIK="^XMBX(4.2995,"
- SET DA=Z
- KILL XMRTCPY
- DO ^DIK
- QUIT
- +2 QUIT
- REN IF $$NEWERR^%ZTER
- NEW $ETRAP,$ESTACK
- SET $ETRAP=""
- +1 SET X="DUPNAME^XMRTCP"
- SET @^%ZOSF("TRAP")
- +2 IF ^%ZOSF("OS")["VAX"
- SET X=$ZC(%SETPRN,$EXTRACT(XMRTCP("NAME"),1,13))
- +3 DO START^XMRTCPGO
- +4 QUIT
- FCHK(Z,Y,F) ;Is file in export directory ?
- +1 ;****************
- QUIT 0
- +2 NEW %,%0,%1,%2,I,X,XMIO
- +3 SET XMIO=$IO
- SET %=^XMBX(4.2995,Z,0)
- SET %0=$PIECE(%,U,5)
- SET %2=$PIECE(%,U,4)
- +4 IF '%0
- SET $PIECE(^XMBX(4.2995,Z,0),U,5)=Y
- SET %=$$EXPORT^MAGAPI("MAIL",F,"WAIT")
- QUIT %
- +5 SET %=$PIECE(^MAG(2005,%2,0),U,2)
- CONT SET %0="XMS"_$EXTRACT(Z,$LENGTH(Z)-4,$LENGTH(Z))_".LIS"
- +1 IF $$NEWERR^%ZTER
- NEW $ETRAP,$ESTACK
- SET $ETRAP=""
- +2 SET X="FPQ^XMRFTP"
- SET @^%ZOSF("TRAP")
- SET X=$ZC(%SPAWN,"PURGE "_%0)
- FPQ IF $$NEWERR^%ZTER
- NEW $ETRAP,$ESTACK
- SET $ETRAP=""
- +1 SET X="Q0^XMRFTP"
- SET @^%ZOSF("TRAP")
- SET X=$ZC(%SPAWN,"DIR/OUTPUT="_%0_" NFA0:[EXPORT.MAIL]"_%)
- +2 OPEN %0
- USE %0
- +3 IF $$NEWERR^%ZTER
- NEW $ETRAP,$ESTACK
- SET $ETRAP=""
- +4 SET X="FCHKQ^XMRFTP"
- SET @^%ZOSF("TRAP")
- +5 FOR
- READ X:9
- if X[%
- QUIT
- FCHKQ CLOSE %0
- USE XMIO
- +1 IF X'[%
- QUIT 1
- +2 QUIT 0
- Q0 QUIT 1
- FER NEW X
- SET X=$PIECE($GET(^XMBX(4.2995,Z,0)),U,2)
- +1 IF 'X
- SET X=$HOROLOG*86400+$PIECE($HOROLOG,",",2)
- SET $PIECE(^(0),U,2)=X
- +2 if $HOROLOG*86400+$PIECE($HOROLOG,",",2)-%>99
- QUIT
- +3 NEW Z
- SET XMDUZ=.5
- SET XMSUB="ERROR moving File from Image Server"
- +4 SET XMTEXT="A("
- SET A(1)="The error was: "_%_"."
- +5 SET A(2)="The COM file being processed was: "_Y
- SET XMY(.5)=""
- +6 DO ^XMD
- QUIT
- IMAGENT(Y,F) ;
- +1 NEW %,%0,XMIO,X
- +2 IF ^%ZOSF("OS")["MSM"
- SET X=$ZOS(12,NEWPATH,"")
- IF $PIECE(X,U)=F
- QUIT "5 -IMAGE ALREADY THERE"
- +3 SET Z=$PIECE($HOROLOG,",",2)#1000
- SET XMIO=$IO
- SET %=F
- +4 GOTO CONT