- 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 Jan 18, 2025@03:13:36 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