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