source: FOIAVistA/trunk/r/MAILMAN-XM/XML4CRC1.m@ 1608

Last change on this file since 1608 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 3.3 KB
Line 
1XML4CRC1 ;(WASH ISC)/RFJ-Block Mode Protocol ;04/17/2002 10:57
2 ;;8.0;MailMan;;Jun 28, 2002
3OPEN D GET,OP
4 S:'$D(XMESC) XMESC=$C(126) S:'$D(XMFS) XMFS=255 S:'$D(XM) XM="" S (XMSSQ,XMRSQ)=1 Q
5GET S X=XMCHAN,DIC="^DIC(3.4,",DIC(0)="Z" D ^DIC S XMCHAN=+Y
6 I '$D(^DIC(3.4,XMCHAN,0)) S ER=1,Y="Invalid channel" Q
7G2 S XMPROT=$P(^DIC(3.4,XMCHAN,0),U,1)
8 F X=1:1:4 S @($P("XMSEN^XMREC^XMOPEN^XMCLOSE",U,X))=$S($D(^(X)):^(X),1:"Q")
9 Q
10OP I $D(XMOPEN) X:$L(XMOPEN) XMOPEN
11 I '$D(XMQUIET) S X=255 X ^%ZOSF("RM")
12 Q
13C X ^%ZOSF("EON")
14 I $D(XMCLOSE) X:$L(XMCLOSE) XMCLOSE
15 Q
16SEND ;Sends XMSG, returns ER=0 or 1, and XMLER=number of "soft" errors
17 I $L(XMSG)>255 S XMLER=0,ER=1 G SRQ
18 I XMSG'?.ANP S X=XMSG,XMSG="" F %=1:1:$L(X) S:$E(X,%)'?1C!($A(X,%)=9) XMSG=XMSG_$E(X,%)
19 D SRINIT S X=XMSG,XMLCC=XMLCC+$L(XMSG) D SUM
20SL S XMLER=XMLER+1 I (XMLER+1)>XMLMAXER D NEWSTRAT
21 I ER W XMLERR,$C(13) G SRQ
22 D BUFLUSH W XMSG,$C(13) W XMLINE,U,XMSUM,$C(13) R XMLX:XMLTIME G:XMLX=(XMLINE_U_XMLACK) SRQ
23 S XMLY=XMLX=(XMLINE_U_XMLNAK),XMLZ=0 D:'XMLY ENQ G SL:XMLY,SRQ
24ENQ ;Assume the ACK/NAK was garbled by noise and try to re-establish contact
25 S XMLZ=XMLZ+1 I XMLZ>XMLMAXER S (ER,XMLY)=1 Q
26 D BUFLUSH W XMLENQ,$C(13) R XMLX:XMLTIME Q:XMLX=(XMLINE_U_XMLACK)
27 I XMLX[XMLACK!(XMLX[XMLNAK),+XMLX=XMLINE!(+XMLX=XMLINE-1) S XMLY=1 Q
28 H 1 G ENQ
29REC ;Receives XMRG, returns ER=0 or 1, and XMLER=number of "soft" errors
30 D SRINIT S:'$D(XMLAN) XMLAN=XMLINE_U_XMLNAK
31RL S XMLER=XMLER+1 I (XMLER+1)>XMLMAXER D NEWSTRAT I ER=1 G SRQ
32 R XMRG#255:$S($D(XMSTIME):XMSTIME,1:XMLTIME) S XMLCC=$S('$D(XMLCC):$L(XMRG),1:XMLCC+$L(XMRG)),XMLZ=$S('$T:-1,XMRG=XMLENQ:0,XMRG=XMLERR:2,1:1),%=2
33 S %=2 D PROG^XML4CRC I $D(XMLIN),XMLIN'<1 G REC^XML4CRC:XMRG["*"
34 S ER=XMLZ=2 G:XMLZ>1 SRQ I XMLZ<1 D BUFLUSH W XMLAN,$C(13) G RL
35 R XMLY:XMLTIME I +XMLY=XMLINE S X=XMRG D SUM S XMLZ=XMSUM=$P(XMLY,U,2) G RL2
36 S XMLZ=0 I +XMLY=(XMLINE-1),XMLINE'=1 D BUFLUSH W +XMLY,U,XMLACK,$C(13) G RL
37RL2 D:$D(XMLBMER) KILL^XML4CRC S XMLAN=XMLINE_U_$S(XMLZ:XMLACK,1:XMLNAK) D BUFLUSH W XMLAN,$C(13)
38 G SRQ:XMLZ,RL
39SRINIT ;Initialize variables for Send/Receive
40 I '$D(XMLBTST) S XMLBTST=+$H_","_($P($H,",",2)-.001),XMLCC=0 ;Time stamp when message started
41 S XMLINE=$S('$D(XMLINE):1,1:XMLINE+1),XMLACK="ACK",XMLNAK="NAK"
42 S XMLENQ=$C(9)_"ENQ"_$C(9),XMLERR=$C(9)_"ERROR"_$C(9)
43 S XMLER=-1 ;soft error count
44 S XMLMAXER=5 ;maximum allowable soft errors
45 S XMLTIME=10 ;length of READ time
46 S ER=0 ;non-recoverable error flag
47 Q
48NEWSTRAT ;Select new strategy, one or both machines may be slow
49 I XMLMAXER=5 S ER=1 Q ;already tried new strategy, give up.
50 S XMTLER=$S('$D(XMTLER):XMLER,1:XMTLER+XMLER),XMLER=0 ;add to total
51 S XMLMAXER=5 ;reduce allowable soft errors
52 S XMLTIME=30 ;increase the READ time
53 Q
54SRQ ;Exit from Send/Receive
55 S XMTLER=$S('$D(XMTLER):XMLER,1:XMTLER+XMLER) ;Total errors
56 K XMLACK,XMLNAK,XMLENQ,XMLERR,XMLMAXER,XMLTIME,XMLX,XMLY,XMLZ
57 Q
58BUFLUSH ;Flush any characters out of the buffer
59 Q:'$D(XMBFLUSH)
60 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
61 X ^%ZOSF("TRMOFF") Q
62SUM ;Calculate checksum, accounting also for the character's position
63 I '$D(XMOS) D LPC^XMLSWP0
64 I $D(XMOS(0)) X XMOS(0) Q
65 I XMOS["VAX DSM" S XMSUM=$ZC(%LPC,X)+$L(X)*$L(X) Q
66 I XMOS["DSM" S XMSUM=$ZC(LPC,X)+$L(X)*$L(X) Q
67 I XMOS["M/11"!(XMOS["M/VX") S XMSUM=$ZC(X)+$L(X)*$L(X) Q
68 S XMSUM=0 F %=1:1:$L(X) S XMSUM=XMSUM+($A(X,%)*%)
69 Q
Note: See TracBrowser for help on using the repository browser.