XMCD.m

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