XMC1B ;(WASH ISC)/THM-Script Interpreter (Open/Close) ;06/11/2002 09:33
;;8.0;MailMan;;Jun 28, 2002
; In:
; XMB
; XMC1
OPEN ;OPEN Command
; O H=DOMAIN.EXT,P=TCP/IP-MAILMAN
N XMI,XMCP,XMCP1,XMCP2
F XMI=1:1:$L(XMC1,",") S XMCP=$P(XMC1,",",XMI) D Q:ER
. S XMCP1=$P(XMCP,"=",1),XMCP2=$P(XMCP,"=",2)
. I XMCP1=$E("HOST",1,$L(XMCP1)) D HOST(XMCP2) Q
. I XMCP1=$E("PROTOCOL",1,$L(XMCP1)) D PROT(XMCP2) Q
. D ERTRAN^XMC1(42245,XMCP1) ;Invalid parameter: '|1|'
Q:ER
I $G(XMPROT)="" D PROT("SCP")
D DEVICE Q:ER
Q
HOST(X) ; Host - Set IP address used by transmission scripts in file 4.6
S XMHOST=$P(XMB("SCR REC"),U,6)
I XMHOST="" S XMHOST="NO-IP"
Q
PROT(XMCHAN) ; Communications Protocol
N Y
D GET^XML
Q
DEVICE ;
S XMCP2=$S($D(ZTQUEUED)&$L($G(ZTIO)):ZTIO,$D(ZTQUEUED)&$L($G(ION)):ION,$L($G(XMIO)):XMIO,1:$P(XMB("SCR REC"),U,5))
Q:XMCP2=""
D TRYDEV(XMCP2) Q:'ER
I $G(XMIO)="",$G(XMIO)=$G(ZTIO),$G(XMIO)'=XMCP2 D TRYDEV(XMIO)
Q
TRYDEV(X) ; Device specification parsing
S ER=0 I $D(ZTQUEUED),IO'="" U IO D D1 Q
I X="" S ER=1 Q
S %ZIS="R",IOP=X D ^%ZIS K IOP
I POP D ERTRAN^XMC1(42246,X) Q ;Device '|1|' could not be opened by %ZIS.
S XMHANG("OPEN")=9
D D1
Q
D1 ;
S XMC("DEVICE")=$P(^%ZIS(1,IOS,0),U),XMC("MODEM")=$P(^(0),U,6)
I $L(XMC("MODEM")),$D(^%ZIS(2,XMC("MODEM"),50)) S XMDIAL=^(50),XMHANG=^(51),XMSTAT=$G(^(52))
Q:IOT="RES"
U IO X ^%ZOSF("EOFF") S X=255 X ^%ZOSF("RM") X ^%ZOSF("TYPE-AHEAD")
Q
CLOSE ; Close channel
I $G(XMHANG)'="" X XMHANG D:$L(IO) FLUSH^XMC1
;|1| sent, |2| received, |3| retransmissions.
D DOTRAN^XMC1($S($G(XMTLER):42248,1:42247),+$G(XMC("S")),+$G(XMC("R")),$G(XMTLER))
I '$D(ZTQUEUED),$G(XMHANG("OPEN"))=9 D ^%ZISC
S IOP="HOME" D ^%ZIS
; Instead of the above line, v7.1 does this: *******************
; I '$D(ZTQUEUED) D HOME^%ZIS
; I $D(ZTQUEUED) S IO("C")=1 D ^%ZISC
I $G(XMINST),$D(^XMBS(4.2999,XMINST,3)) S $P(^(3),U,1,6)="^^^^^"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXMC1B 1959 printed Dec 13, 2024@02:11:12 Page 2
XMC1B ;(WASH ISC)/THM-Script Interpreter (Open/Close) ;06/11/2002 09:33
+1 ;;8.0;MailMan;;Jun 28, 2002
+2 ; In:
+3 ; XMB
+4 ; XMC1
OPEN ;OPEN Command
+1 ; O H=DOMAIN.EXT,P=TCP/IP-MAILMAN
+2 NEW XMI,XMCP,XMCP1,XMCP2
+3 FOR XMI=1:1:$LENGTH(XMC1,",")
SET XMCP=$PIECE(XMC1,",",XMI)
Begin DoDot:1
+4 SET XMCP1=$PIECE(XMCP,"=",1)
SET XMCP2=$PIECE(XMCP,"=",2)
+5 IF XMCP1=$EXTRACT("HOST",1,$LENGTH(XMCP1))
DO HOST(XMCP2)
QUIT
+6 IF XMCP1=$EXTRACT("PROTOCOL",1,$LENGTH(XMCP1))
DO PROT(XMCP2)
QUIT
+7 ;Invalid parameter: '|1|'
DO ERTRAN^XMC1(42245,XMCP1)
End DoDot:1
if ER
QUIT
+8 if ER
QUIT
+9 IF $GET(XMPROT)=""
DO PROT("SCP")
+10 DO DEVICE
if ER
QUIT
+11 QUIT
HOST(X) ; Host - Set IP address used by transmission scripts in file 4.6
+1 SET XMHOST=$PIECE(XMB("SCR REC"),U,6)
+2 IF XMHOST=""
SET XMHOST="NO-IP"
+3 QUIT
PROT(XMCHAN) ; Communications Protocol
+1 NEW Y
+2 DO GET^XML
+3 QUIT
DEVICE ;
+1 SET XMCP2=$SELECT($DATA(ZTQUEUED)&$LENGTH($GET(ZTIO)):ZTIO,$DATA(ZTQUEUED)&$LENGTH($GET(ION)):ION,$LENGTH($GET(XMIO)):XMIO,1:$PIECE(XMB("SCR REC"),U,5))
+2 if XMCP2=""
QUIT
+3 DO TRYDEV(XMCP2)
if 'ER
QUIT
+4 IF $GET(XMIO)=""
IF $GET(XMIO)=$GET(ZTIO)
IF $GET(XMIO)'=XMCP2
DO TRYDEV(XMIO)
+5 QUIT
TRYDEV(X) ; Device specification parsing
+1 SET ER=0
IF $DATA(ZTQUEUED)
IF IO'=""
USE IO
DO D1
QUIT
+2 IF X=""
SET ER=1
QUIT
+3 SET %ZIS="R"
SET IOP=X
DO ^%ZIS
KILL IOP
+4 ;Device '|1|' could not be opened by %ZIS.
IF POP
DO ERTRAN^XMC1(42246,X)
QUIT
+5 SET XMHANG("OPEN")=9
+6 DO D1
+7 QUIT
D1 ;
+1 SET XMC("DEVICE")=$PIECE(^%ZIS(1,IOS,0),U)
SET XMC("MODEM")=$PIECE(^(0),U,6)
+2 IF $LENGTH(XMC("MODEM"))
IF $DATA(^%ZIS(2,XMC("MODEM"),50))
SET XMDIAL=^(50)
SET XMHANG=^(51)
SET XMSTAT=$GET(^(52))
+3 if IOT="RES"
QUIT
+4 USE IO
XECUTE ^%ZOSF("EOFF")
SET X=255
XECUTE ^%ZOSF("RM")
XECUTE ^%ZOSF("TYPE-AHEAD")
+5 QUIT
CLOSE ; Close channel
+1 IF $GET(XMHANG)'=""
XECUTE XMHANG
if $LENGTH(IO)
DO FLUSH^XMC1
+2 ;|1| sent, |2| received, |3| retransmissions.
+3 DO DOTRAN^XMC1($SELECT($GET(XMTLER):42248,1:42247),+$GET(XMC("S")),+$GET(XMC("R")),$GET(XMTLER))
+4 IF '$DATA(ZTQUEUED)
IF $GET(XMHANG("OPEN"))=9
DO ^%ZISC
+5 SET IOP="HOME"
DO ^%ZIS
+6 ; Instead of the above line, v7.1 does this: *******************
+7 ; I '$D(ZTQUEUED) D HOME^%ZIS
+8 ; I $D(ZTQUEUED) S IO("C")=1 D ^%ZISC
+9 IF $GET(XMINST)
IF $DATA(^XMBS(4.2999,XMINST,3))
SET $PIECE(^(3),U,1,6)="^^^^^"
+10 QUIT
