- 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 Jan 18, 2025@03:12:14 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