XMLPC ;(WASH ISC)/CAP-Protocol 4 PC Platforms ;03/27/2002 15:54
;;8.0;MailMan;;Jun 28, 2002
SEND ;returns ER(0 OR 1), XMLER=number of "soft" errors
S (XMLER,XMLZ,XMTLER)=0 I $L(XMSG)>255 S ER=1 G SRQ
I XMSG'?.ANP F %=1:1:$L(XMSG) I $E(XMSG,%)?1C,$A(XMSG,%)'=9 S XMSG=$E(XMSG,1,%-1)_$E(XMSG,%+1,999) Q:XMSG?.ANP S %=%-1
D SRINIT S X=XMSG D SUM
I $G(XMINST) D XMTSTAT^XMTDR(XMINST,"S",XMSG,0) ; PC1
SL S XMLER=XMLER+1 I XMLER>XMLMAXER S ER=1 G SRQ
W "~*~^",$C(13),XMSG,$C(13),XMLINE,U,XMSUM,$C(13)
SA R XMLX:XMLTIME I XMLX?.E1"ACK" W XMLX_$C(13) G SRQ:XMLX-XMLINE=0,SA
S XMLZ=XMLZ+1 I XMLZ>XMLMAXER S ER=1 G SRQ
G SL
REC ;SEE SEND
D SRINIT
I $D(XMRG),$G(XMINST) D XMTSTAT^XMTDR(XMINST,"R",XMRG,0) ; PC1
RL S XMLER=XMLER+1 I XMLER>XMLMAXER S ER=1 G SRQ
R X:XMLTIME I X'="~*~^" G RL
R XMRG#255:$S($D(XMSTIME):XMSTIME,1:XMLTIME)
I $E(XMRG,1,5)=" ~*~^" S XMRG=$E(XMRG,2,$L(XMRG))
R XMLY:XMLTIME
I +XMLY-XMLINE<0 S X=$$ACK(+XMLY_"ACK") G RL
S X=XMRG D SUM S XMLZ=XMSUM=$P(XMLY,U,2)
S X=$$ACK(XMLINE_"ACK"),(XMLER,XMTLER)=0
G SRQ:X=1 S ER=1 G SRQ
ACK(Y) N X,I S I=0
AA S I=I+1 I I>30 Q 0
W Y_$C(13) R X:XMLTIME
G AA:X'=Y
Q 1
SRINIT ;
S XMLINE=$S('$D(XMLINE):1,1:XMLINE+1)
S XMLENQ=$C(9)_"ENQ"_$C(9),XMLERR=$C(9)_"ERROR"_$C(9)
S XMLER=-1 ;soft error count
S XMLMAXER=500 ;maximum allowable soft errors
S XMLTIME=9 ;length of READ time
S ER=0 ;non-recoverable error flag
Q
SRQ ;Exit from Send/Receive
S XMTLER=$S('$D(XMTLER):XMLER,1:XMTLER+XMLER) ;Total errors
K XMLERR,XMLMAXER,XMLTIME,XMLX,XMLY,XMLZ
Q
SUM ;Calculate checksum
I '$D(XMOS) D LPC^XMLSWP0
I $D(XMOS(0)) X XMOS(0) S XMSUM=Y Q
S XMSUM=$A(X) Q:$L(X)=1 S I=1
A S I=I+1 I $L(X)<I K %,%0,%1 S XMSUM=XMSUM+$L(X)*$L(X) Q
S Y=$A(X,I) F %=256:0 Q:%\4<Y S %=%\2
B S %0=XMSUM#%,%=%\2 G A:%=0 S %0=%0\%,%1=Y\% I %1=1 S Y=Y-%
G B:%1+%0=0 I %1'=%0 S:%0=0 XMSUM=XMSUM+% G B
G B:%0=0 S XMSUM=XMSUM-%
G B
OPEN ;SET DEVICE PARAMETERS
N X S X=$G(^%ZOSF("OS")) I X["VAX" S X=0 X ^%ZOSF("RM") U IO:PACK
I X["DTM" U IO:WRAP=0
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXMLPC 2060 printed Nov 22, 2024@17:22:40 Page 2
XMLPC ;(WASH ISC)/CAP-Protocol 4 PC Platforms ;03/27/2002 15:54
+1 ;;8.0;MailMan;;Jun 28, 2002
SEND ;returns ER(0 OR 1), XMLER=number of "soft" errors
+1 SET (XMLER,XMLZ,XMTLER)=0
IF $LENGTH(XMSG)>255
SET ER=1
GOTO SRQ
+2 IF XMSG'?.ANP
FOR %=1:1:$LENGTH(XMSG)
IF $EXTRACT(XMSG,%)?1C
IF $ASCII(XMSG,%)'=9
SET XMSG=$EXTRACT(XMSG,1,%-1)_$EXTRACT(XMSG,%+1,999)
if XMSG?.ANP
QUIT
SET %=%-1
+3 DO SRINIT
SET X=XMSG
DO SUM
+4 ; PC1
IF $GET(XMINST)
DO XMTSTAT^XMTDR(XMINST,"S",XMSG,0)
SL SET XMLER=XMLER+1
IF XMLER>XMLMAXER
SET ER=1
GOTO SRQ
+1 WRITE "~*~^",$CHAR(13),XMSG,$CHAR(13),XMLINE,U,XMSUM,$CHAR(13)
SA READ XMLX:XMLTIME
IF XMLX?.E1"ACK"
WRITE XMLX_$CHAR(13)
if XMLX-XMLINE=0
GOTO SRQ
GOTO SA
+1 SET XMLZ=XMLZ+1
IF XMLZ>XMLMAXER
SET ER=1
GOTO SRQ
+2 GOTO SL
REC ;SEE SEND
+1 DO SRINIT
+2 ; PC1
IF $DATA(XMRG)
IF $GET(XMINST)
DO XMTSTAT^XMTDR(XMINST,"R",XMRG,0)
RL SET XMLER=XMLER+1
IF XMLER>XMLMAXER
SET ER=1
GOTO SRQ
+1 READ X:XMLTIME
IF X'="~*~^"
GOTO RL
+2 READ XMRG#255:$SELECT($DATA(XMSTIME):XMSTIME,1:XMLTIME)
+3 IF $EXTRACT(XMRG,1,5)=" ~*~^"
SET XMRG=$EXTRACT(XMRG,2,$LENGTH(XMRG))
+4 READ XMLY:XMLTIME
+5 IF +XMLY-XMLINE<0
SET X=$$ACK(+XMLY_"ACK")
GOTO RL
+6 SET X=XMRG
DO SUM
SET XMLZ=XMSUM=$PIECE(XMLY,U,2)
+7 SET X=$$ACK(XMLINE_"ACK")
SET (XMLER,XMTLER)=0
+8 if X=1
GOTO SRQ
SET ER=1
GOTO SRQ
ACK(Y) NEW X,I
SET I=0
AA SET I=I+1
IF I>30
QUIT 0
+1 WRITE Y_$CHAR(13)
READ X:XMLTIME
+2 if X'=Y
GOTO AA
+3 QUIT 1
SRINIT ;
+1 SET XMLINE=$SELECT('$DATA(XMLINE):1,1:XMLINE+1)
+2 SET XMLENQ=$CHAR(9)_"ENQ"_$CHAR(9)
SET XMLERR=$CHAR(9)_"ERROR"_$CHAR(9)
+3 ;soft error count
SET XMLER=-1
+4 ;maximum allowable soft errors
SET XMLMAXER=500
+5 ;length of READ time
SET XMLTIME=9
+6 ;non-recoverable error flag
SET ER=0
+7 QUIT
SRQ ;Exit from Send/Receive
+1 ;Total errors
SET XMTLER=$SELECT('$DATA(XMTLER):XMLER,1:XMTLER+XMLER)
+2 KILL XMLERR,XMLMAXER,XMLTIME,XMLX,XMLY,XMLZ
+3 QUIT
SUM ;Calculate checksum
+1 IF '$DATA(XMOS)
DO LPC^XMLSWP0
+2 IF $DATA(XMOS(0))
XECUTE XMOS(0)
SET XMSUM=Y
QUIT
+3 SET XMSUM=$ASCII(X)
if $LENGTH(X)=1
QUIT
SET I=1
A SET I=I+1
IF $LENGTH(X)<I
KILL %,%0,%1
SET XMSUM=XMSUM+$LENGTH(X)*$LENGTH(X)
QUIT
+1 SET Y=$ASCII(X,I)
FOR %=256:0
if %\4<Y
QUIT
SET %=%\2
B SET %0=XMSUM#%
SET %=%\2
if %=0
GOTO A
SET %0=%0\%
SET %1=Y\%
IF %1=1
SET Y=Y-%
+1 if %1+%0=0
GOTO B
IF %1'=%0
if %0=0
SET XMSUM=XMSUM+%
GOTO B
+2 if %0=0
GOTO B
SET XMSUM=XMSUM-%
+3 GOTO B
OPEN ;SET DEVICE PARAMETERS
+1 NEW X
SET X=$GET(^%ZOSF("OS"))
IF X["VAX"
SET X=0
XECUTE ^%ZOSF("RM")
USE IO:PACK
+2 IF X["DTM"
USE IO:WRAP=0
+3 QUIT
