source: WorldVistAEHR/trunk/r/MAILMAN-XM/XML.m@ 701

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

initial load of WorldVistAEHR

File size: 3.9 KB
Line 
1XML ;(WASH ISC)/THM/GJL-MailMan Physical link ;06/04/2002 08:26
2 ;;8.0;MailMan;;Jun 28, 2002
3 ; Entry points (DBIA 1283):
4 ; GET - Set up variables for communications protocol in file 3.4
5 ;
6 ; Entry points used by MailMan options (not covered by DBIA):
7 ; C XMDXPROT
8OPEN ;
9 N Y
10 I $G(XMCHAN)="" S XMCHAN="SCP"
11 D GET Q:ER
12 D OP Q:ER
13 S:'$D(XMESC) XMESC="~"
14 S:'$D(XMFS) XMFS=255
15 S:'$D(XM) XM=""
16 Q
17GET ; Set up variables for communications protocol in file 3.4
18 ; In:
19 ; XMCHAN - Name of the communications protocol
20 ; Out:
21 ; XMCHAN - IEN of the communications protocol
22 ; XMPROT - Name of the communications protocol
23 ; XMSEN - Xecute this variable to send a line
24 ; XMREC - Xecute this variable to receive a line
25 ; XMOPEN - Xecute this variable to open the channel
26 ; XMCLOSE - Xecute this variable to close the channel
27 ; XMOS - Operating System, used in ^XMLTCP
28 N DIC,X
29 S X=XMCHAN,DIC="^DIC(3.4,",DIC(0)="FO"
30 D ^DIC I Y<0 D Q
31 . D ERTRAN^XMC1(42244,XMCHAN) ;Invalid Communications Protocol: '|1|'
32 . S Y=XMTRAN
33 S XMCHAN=+Y,XMPROT=$P(Y,U,2)
34 S XMSEN=$G(^DIC(3.4,XMCHAN,1),"Q"),XMREC=$G(^(2),"Q"),XMOPEN=$G(^(3),"Q"),XMCLOSE=$G(^(4),"Q")
35 S XMOS=^%ZOSF("OS")
36 I XMOS["MSM" D
37 . S XMOS("MSMVER")=$P($ZV," 4.0.",2)
38 . S:+XMOS("MSMVER")=0 XMOS("MSMVER")=8
39 Q
40OP ;
41 I "Q"'[$G(XMOPEN) X XMOPEN
42 I 'XMC("BATCH"),'$D(XMQUIET) S X=255 X ^%ZOSF("RM")
43 Q
44C X ^%ZOSF("EON")
45 I $D(XMCLOSE) X:$L(XMCLOSE) XMCLOSE
46 Q
47 ; The following has nothing to do with the above.
48 ; These are used by the SCP Communications Protocol in file 3.4.
49SEND ; Sends XMSG, returns ER=0 or 1, and XMLER=number of "soft" errors
50 I $L(XMSG)>255 S XMLER=0,ER=1 G SRQ
51 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
52 D SRINIT S X=XMSG D SUM
53 I $G(XMINST) D XMTSTAT^XMTDR(XMINST,"S",XMSG,0)
54SL S XMLER=XMLER+1 I (XMLER+1)>XMLMAXER D NEWSTRAT
55 I ER W XMLERR,$C(13) G SRQ
56 D BUFLUSH W XMSG,$C(13) W XMLINE,U,XMSUM,$C(13) R XMLX:XMLTIME G:XMLX=(XMLINE_U_XMLACK) SRQ
57 S XMLY=XMLX=(XMLINE_U_XMLNAK),XMLZ=0 D:'XMLY ENQ G SL:XMLY,SRQ
58ENQ ; ACK/NAK garbled - try to re-establish contact
59 S XMLZ=XMLZ+1 I XMLZ>XMLMAXER S (ER,XMLY)=1 Q
60 D BUFLUSH W XMLENQ,$C(13) R XMLX:XMLTIME Q:XMLX=(XMLINE_U_XMLACK)
61 I XMLX[XMLACK!(XMLX[XMLNAK),+XMLX=XMLINE!(+XMLX=XMLINE-1) S XMLY=1 Q
62 H 1 G ENQ
63REC ; Receives XMRG, returns ER=0 or 1, and XMLER=number of "soft" errors
64 D SRINIT S:'$D(XMLAN) XMLAN=XMLINE_U_XMLNAK
65 I $D(XMRG),$G(XMINST) D XMTSTAT^XMTDR(XMINST,"R",XMRG,0)
66RL S XMLER=XMLER+1 I (XMLER+1)>XMLMAXER D NEWSTRAT I ER=1 G SRQ
67 R XMRG#255:$S($D(XMSTIME):XMSTIME,1:XMLTIME)
68 S XMLZ=$S('$T:-1,XMRG=XMLENQ:0,XMRG=XMLERR:2,1:1)
69 S ER=XMLZ=2 G:XMLZ>1 SRQ I 'XMLZ D BUFLUSH W XMLAN,$C(13) G RL
70 R XMLY:XMLTIME
71 I +XMLY=XMLINE S X=XMRG D SUM S XMLZ=XMSUM=$P(XMLY,U,2) G RL2
72 S XMLZ=0 I +XMLY=(XMLINE-1),XMLINE'=1 D BUFLUSH W +XMLY,U,XMLACK,$C(13) G RL
73RL2 S XMLAN=XMLINE_U_$S(XMLZ:XMLACK,1:XMLNAK) D BUFLUSH W XMLAN,$C(13)
74 G SRQ:XMLZ,RL
75SRINIT ; Initialize variables for Send/Receive
76 S XMLINE=$S('$D(XMLINE):1,1:XMLINE+1),XMLACK="ACK",XMLNAK="NAK"
77 S XMLENQ=$C(9)_"ENQ"_$C(9),XMLERR=$C(9)_"ERROR"_$C(9)
78 S XMLER=-1 ;soft error count
79 S XMLMAXER=5 ;maximum allowable soft errors
80 S XMLTIME=30 ;length of READ time
81 S ER=0 ;non-recoverable error flag
82 Q
83NEWSTRAT ; Select new strategy, one or both machines may be slow
84 I XMLMAXER=5 S ER=1 Q ;already tried new strategy, give up.
85 S XMTLER=$S('$D(XMTLER):XMLER,1:XMTLER+XMLER),XMLER=0 ;add to total
86 S XMLMAXER=5 ;reduce allowable soft errors
87 S XMLTIME=30 ;increase the READ time
88 Q
89SRQ ; Exit from Send/Receive
90 S XMTLER=$S('$D(XMTLER):XMLER,1:XMTLER+XMLER) ;Total errors
91 K XMLACK,XMLNAK,XMLENQ,XMLERR,XMLMAXER,XMLTIME,XMLX,XMLY,XMLZ
92 Q
93BUFLUSH ; Flush buffer
94 Q:'$D(XMBFLUSH)
95 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
96 X ^%ZOSF("TRMOFF")
97 Q
98SUM ; Calculate checksum, accounting also for the character's position
99 S XMSUM=0 F %=1:1:$L(X) S XMSUM=XMSUM+($A(X,%)*%)
100 Q
Note: See TracBrowser for help on using the repository browser.