XMCD ;(WASH ISC)/THM-Communications Diagnostics ;04/17/2002 08:27
;;8.0;MailMan;;Jun 28, 2002
; Entry points used by MailMan options (not covered by DBIA):
; DIALER XMDXMODEM
; TRAN XMDXSCRIPT
; SMTP XMDXSMTP
Q
DIALER ; Test the modem autodialer
W !!,"This tests the modem autodialer by allowing you to enter a phone number"
W !,"which this program will then dial on the selected modem.",!!
N XMABORT,XMPHONE,XMHANG,XMSTAT,XMDIAL,DIR,X,Y
S (XMABORT,ER)=0
F D ^%ZIS Q:POP D Q:XMABORT
. D D1^XMC1B
. U IO(0)
. I XMC("MODEM")="" W !,$C(7),"This device has no modem defined for it." Q
. W !,^%ZIS(2,XMC("MODEM"),0)," is the defined modem for device ",IO
. I $L(XMSTAT) W !,"Checking status..." U IO X XMSTAT U IO(0) W " Status: ",Y
. I '$L(XMDIAL) W !,"No dialer logic specified for this modem type" Q
. I '$L(XMHANG) W !,"No hangup logic specified for this modem type",$C(7) Q
. F D Q:XMABORT!'ER
. . K DIR,X,Y
. . S DIR(0)="F^3:30"
. . S DIR("A")="Enter the phone number to dial"
. . D ^DIR I $D(DIRUT) S XMABORT=1 Q
. . S XMPHONE=Y
. . U IO X XMDIAL U IO(0)
. . I ER W !,$C(7),"Call failed: ",Y
. Q:XMABORT
. W !,"Successful. Now hanging up ..."
. U IO X XMHANG U IO(0)
. I ER W !,$C(7),"Hang up unsuccessful" Q
. W !,"Hang up successful."
D KILL^XMC
Q
SMTP ; SMTP Tester
W !!,"This procedure will test the Simple Mail Transfer Protocol,"
W !,"allowing you to interactively enter each of the SMTP commands."
W !,"The messages will not actually be delivered to the named recipients."
W !,"That which you type will be preceded with an 'S: '."
W !,"The SMTP responses will be preceded with an 'R: '"
W !!,"Terminate the session with a QUIT command",!!
D TST^XMR
Q
TRAN ; Test transmission error rates, speeds
N XMSECURE,%X,%Y
W !!,"This will test a link by executing the script, then sending 20 lines"
W !,"in echo test mode. It will report the number of recoverable and "
W !,"unrecoverable errors, as well as the transmission efficiency."
D LOADCODE^XMJMCODE
S %X="XMSECURE(",%Y="^TMP(""XMS"",$J,""S""," D %XY^%RCR
K XMSECURE
S XMC("TEST")=1
D PLAY^XMCX
K XMC("TEST"),^TMP("XMS",$J,"S")
D KILL^XMC
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXMCD 2223 printed Nov 22, 2024@17:21:20 Page 2
XMCD ;(WASH ISC)/THM-Communications Diagnostics ;04/17/2002 08:27
+1 ;;8.0;MailMan;;Jun 28, 2002
+2 ; Entry points used by MailMan options (not covered by DBIA):
+3 ; DIALER XMDXMODEM
+4 ; TRAN XMDXSCRIPT
+5 ; SMTP XMDXSMTP
+6 QUIT
DIALER ; Test the modem autodialer
+1 WRITE !!,"This tests the modem autodialer by allowing you to enter a phone number"
+2 WRITE !,"which this program will then dial on the selected modem.",!!
+3 NEW XMABORT,XMPHONE,XMHANG,XMSTAT,XMDIAL,DIR,X,Y
+4 SET (XMABORT,ER)=0
+5 FOR
DO ^%ZIS
if POP
QUIT
Begin DoDot:1
+6 DO D1^XMC1B
+7 USE IO(0)
+8 IF XMC("MODEM")=""
WRITE !,$CHAR(7),"This device has no modem defined for it."
QUIT
+9 WRITE !,^%ZIS(2,XMC("MODEM"),0)," is the defined modem for device ",IO
+10 IF $LENGTH(XMSTAT)
WRITE !,"Checking status..."
USE IO
XECUTE XMSTAT
USE IO(0)
WRITE " Status: ",Y
+11 IF '$LENGTH(XMDIAL)
WRITE !,"No dialer logic specified for this modem type"
QUIT
+12 IF '$LENGTH(XMHANG)
WRITE !,"No hangup logic specified for this modem type",$CHAR(7)
QUIT
+13 FOR
Begin DoDot:2
+14 KILL DIR,X,Y
+15 SET DIR(0)="F^3:30"
+16 SET DIR("A")="Enter the phone number to dial"
+17 DO ^DIR
IF $DATA(DIRUT)
SET XMABORT=1
QUIT
+18 SET XMPHONE=Y
+19 USE IO
XECUTE XMDIAL
USE IO(0)
+20 IF ER
WRITE !,$CHAR(7),"Call failed: ",Y
End DoDot:2
if XMABORT!'ER
QUIT
+21 if XMABORT
QUIT
+22 WRITE !,"Successful. Now hanging up ..."
+23 USE IO
XECUTE XMHANG
USE IO(0)
+24 IF ER
WRITE !,$CHAR(7),"Hang up unsuccessful"
QUIT
+25 WRITE !,"Hang up successful."
End DoDot:1
if XMABORT
QUIT
+26 DO KILL^XMC
+27 QUIT
SMTP ; SMTP Tester
+1 WRITE !!,"This procedure will test the Simple Mail Transfer Protocol,"
+2 WRITE !,"allowing you to interactively enter each of the SMTP commands."
+3 WRITE !,"The messages will not actually be delivered to the named recipients."
+4 WRITE !,"That which you type will be preceded with an 'S: '."
+5 WRITE !,"The SMTP responses will be preceded with an 'R: '"
+6 WRITE !!,"Terminate the session with a QUIT command",!!
+7 DO TST^XMR
+8 QUIT
TRAN ; Test transmission error rates, speeds
+1 NEW XMSECURE,%X,%Y
+2 WRITE !!,"This will test a link by executing the script, then sending 20 lines"
+3 WRITE !,"in echo test mode. It will report the number of recoverable and "
+4 WRITE !,"unrecoverable errors, as well as the transmission efficiency."
+5 DO LOADCODE^XMJMCODE
+6 SET %X="XMSECURE("
SET %Y="^TMP(""XMS"",$J,""S"","
DO %XY^%RCR
+7 KILL XMSECURE
+8 SET XMC("TEST")=1
+9 DO PLAY^XMCX
+10 KILL XMC("TEST"),^TMP("XMS",$JOB,"S")
+11 DO KILL^XMC
+12 QUIT
