Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: XML1CRC

XML1CRC.m

Go to the documentation of this file.
  1. XML1CRC ;(WASH ISC)/RJ-OS Check Sum ;04/17/2002 10:58
  1. ;;8.0;MailMan;**45**;Jun 28, 2002;Build 8
  1. OPEN D GET,OP
  1. S:'$D(XMESC) XMESC="~" S:'$D(XMFS) XMFS=255 S:'$D(XM) XM="" S (XMSSQ,XMRSQ)=1 Q
  1. GET S X=XMCHAN,DIC="^DIC(3.4,",DIC(0)="Z" D ^DIC S XMCHAN=+Y
  1. I '$D(^DIC(3.4,XMCHAN,0)) S ER=1,Y="Invalid channel" Q
  1. G2 S XMPROT=$P(^DIC(3.4,XMCHAN,0),U)
  1. F X=1:1:4 S @($P("XMSEN^XMREC^XMOPEN^XMCLOSE",U,X))=$S($D(^(X)):^(X),1:"Q")
  1. Q
  1. OP I $D(XMOPEN) X:$L(XMOPEN) XMOPEN
  1. I '$D(XMQUIET) S X=255 X ^%ZOSF("RM")
  1. Q
  1. C X ^%ZOSF("EON")
  1. I $D(XMCLOSE) X:$L(XMCLOSE) XMCLOSE
  1. Q
  1. SEND ;returns ER(0 OR 1), XMLER=number of "soft" errors
  1. I $L(XMSG)>255 S XMLER=0,ER=1 G SRQ
  1. 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
  1. D SRINIT S X=XMSG D SUM
  1. I $G(XMINST) D XMTSTAT^XMTDR(XMINST,"S",XMSG,0) ; 1SCP
  1. SL S XMLER=XMLER+1 I (XMLER+1)>XMLMAXER D NEWSTRAT
  1. I ER W XMLERR,$C(13) G SRQ
  1. D BUFLUSH W XMSG,$C(13),XMLINE,U,XMSUM,$C(13) R XMLX:XMLTIME G:XMLX=(XMLINE_U_XMLACK) SRQ
  1. S XMLY=XMLX=(XMLINE_U_XMLNAK),XMLZ=0 D:'XMLY ENQ G SL:XMLY,SRQ
  1. ENQ ;ACK/NAK garbled / re-establish contact
  1. S XMLZ=XMLZ+1 I XMLZ>XMLMAXER S (ER,XMLY)=1 Q
  1. D BUFLUSH W XMLENQ,$C(13) R XMLX:XMLTIME Q:XMLX=(XMLINE_U_XMLACK)
  1. I XMLX[XMLACK!(XMLX[XMLNAK),+XMLX=XMLINE!(+XMLX=XMLINE-1) S XMLY=1 Q
  1. H 1 G ENQ
  1. REC ;SEE SEND
  1. D SRINIT S:'$D(XMLAN) XMLAN=XMLINE_U_XMLNAK
  1. I $D(XMRG),$G(XMINST) D XMTSTAT^XMTDR(XMINST,"R",XMRG,0) ; 1SCP
  1. RL S XMLER=XMLER+1 I (XMLER+1)>XMLMAXER D NEWSTRAT I ER=1 G SRQ
  1. R XMRG#255:$S($D(XMSTIME):XMSTIME,1:XMLTIME)
  1. S XMLZ=$S('$T:-1,XMRG=XMLENQ:0,XMRG=XMLERR:2,1:1)
  1. S ER=XMLZ=2 G:XMLZ>1 SRQ I 'XMLZ D BUFLUSH W XMLAN,$C(13) G RL
  1. R XMLY:XMLTIME I +XMLY=XMLINE S X=XMRG D SUM S XMLZ=XMSUM=$P(XMLY,U,2) G RL2
  1. S XMLZ=0 I +XMLY=(XMLINE-1),XMLINE'=1 D BUFLUSH W +XMLY,U,XMLACK,$C(13) G RL
  1. RL2 S XMLAN=XMLINE_U_$S(XMLZ:XMLACK,1:XMLNAK) D BUFLUSH W XMLAN,$C(13)
  1. G SRQ:XMLZ,RL
  1. SRINIT ;
  1. S XMLINE=$S('$D(XMLINE):1,1:XMLINE+1),XMLACK="ACK",XMLNAK="NAK"
  1. S XMLENQ=$C(9)_"ENQ"_$C(9),XMLERR=$C(9)_"ERROR"_$C(9)
  1. S XMLER=-1 ;soft error count
  1. S XMLMAXER=5 ;maximum allowable soft errors
  1. S XMLTIME=30 ;length of READ time
  1. S ER=0 ;non-recoverable error flag
  1. Q
  1. NEWSTRAT ;machines have various loads
  1. I XMLMAXER=5 S ER=1 Q ;already tried new strategy, give up.
  1. S XMTLER=$S('$D(XMTLER):XMLER,1:XMTLER+XMLER),XMLER=0 ;add to total
  1. S XMLMAXER=5 ;reduce allowable soft errors
  1. S XMLTIME=30 ;increase the READ time
  1. Q
  1. SRQ ;Exit from Send/Receive
  1. S XMTLER=$S('$D(XMTLER):XMLER,1:XMTLER+XMLER) ;Total errors
  1. K XMLACK,XMLNAK,XMLENQ,XMLERR,XMLMAXER,XMLTIME,XMLX,XMLY,XMLZ
  1. Q
  1. BUFLUSH ;Flush any characters out of the buffer
  1. Q:'$D(XMBFLUSH)
  1. X ^%ZOSF("TRMON") S X=$P($H,",",2) F %=1:1 R %:0 Q:'$T S %=$P($H,",",2) S:%<X %=%+86400 Q:%-X>15
  1. X ^%ZOSF("TRMOFF") Q
  1. SUM ;Calculate checksum
  1. I '$D(XMOS) D LPC^XMLSWP0
  1. I $D(XMOS(0)) X XMOS(0) S XMSUM=Y Q
  1. I XMOS["VAX DSM" X "S XMSUM=$ZC(%LPC,X)" Q
  1. I XMOS["DSM" X "S XMSUM=$ZC(LPC,X)" Q
  1. I XMOS["M/11"!(XMOS["M/VX") X "S XMSUM=$ZC(X)" Q
  1. S XMSUM=$A(X) Q:$L(X)=1 S I=1
  1. A S I=I+1 I $L(X)<I K %,%0,%1 S XMSUM=XMSUM+$L(X)*$L(X) Q
  1. S Y=$A(X,I) F %=256:0 Q:%\4<Y S %=%\2
  1. B S %0=XMSUM#%,%=%\2 G A:%=0 S %0=%0\%,%1=Y\% I %1=1 S Y=Y-%
  1. G B:%1+%0=0 I %1'=%0 S:%0=0 XMSUM=XMSUM+% G B
  1. G B:%0=0 S XMSUM=XMSUM-%
  1. G B