XML ;(WASH ISC)/THM/GJL-MailMan Physical link ;06/04/2002 08:26
;;8.0;MailMan;;Jun 28, 2002
; Entry points (DBIA 1283):
; GET - Set up variables for communications protocol in file 3.4
;
; Entry points used by MailMan options (not covered by DBIA):
; C XMDXPROT
OPEN ;
N Y
I $G(XMCHAN)="" S XMCHAN="SCP"
D GET Q:ER
D OP Q:ER
S:'$D(XMESC) XMESC="~"
S:'$D(XMFS) XMFS=255
S:'$D(XM) XM=""
Q
GET ; Set up variables for communications protocol in file 3.4
; In:
; XMCHAN - Name of the communications protocol
; Out:
; XMCHAN - IEN of the communications protocol
; XMPROT - Name of the communications protocol
; XMSEN - Xecute this variable to send a line
; XMREC - Xecute this variable to receive a line
; XMOPEN - Xecute this variable to open the channel
; XMCLOSE - Xecute this variable to close the channel
; XMOS - Operating System, used in ^XMLTCP
N DIC,X
S X=XMCHAN,DIC="^DIC(3.4,",DIC(0)="FO"
D ^DIC I Y<0 D Q
. D ERTRAN^XMC1(42244,XMCHAN) ;Invalid Communications Protocol: '|1|'
. S Y=XMTRAN
S XMCHAN=+Y,XMPROT=$P(Y,U,2)
S XMSEN=$G(^DIC(3.4,XMCHAN,1),"Q"),XMREC=$G(^(2),"Q"),XMOPEN=$G(^(3),"Q"),XMCLOSE=$G(^(4),"Q")
S XMOS=^%ZOSF("OS")
I XMOS["MSM" D
. S XMOS("MSMVER")=$P($ZV," 4.0.",2)
. S:+XMOS("MSMVER")=0 XMOS("MSMVER")=8
Q
OP ;
I "Q"'[$G(XMOPEN) X XMOPEN
I 'XMC("BATCH"),'$D(XMQUIET) S X=255 X ^%ZOSF("RM")
Q
C X ^%ZOSF("EON")
I $D(XMCLOSE) X:$L(XMCLOSE) XMCLOSE
Q
; The following has nothing to do with the above.
; These are used by the SCP Communications Protocol in file 3.4.
SEND ; Sends XMSG, returns ER=0 or 1, and XMLER=number of "soft" errors
I $L(XMSG)>255 S XMLER=0,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)
SL S XMLER=XMLER+1 I (XMLER+1)>XMLMAXER D NEWSTRAT
I ER W XMLERR,$C(13) G SRQ
D BUFLUSH W XMSG,$C(13) W XMLINE,U,XMSUM,$C(13) R XMLX:XMLTIME G:XMLX=(XMLINE_U_XMLACK) SRQ
S XMLY=XMLX=(XMLINE_U_XMLNAK),XMLZ=0 D:'XMLY ENQ G SL:XMLY,SRQ
ENQ ; ACK/NAK garbled - try to re-establish contact
S XMLZ=XMLZ+1 I XMLZ>XMLMAXER S (ER,XMLY)=1 Q
D BUFLUSH W XMLENQ,$C(13) R XMLX:XMLTIME Q:XMLX=(XMLINE_U_XMLACK)
I XMLX[XMLACK!(XMLX[XMLNAK),+XMLX=XMLINE!(+XMLX=XMLINE-1) S XMLY=1 Q
H 1 G ENQ
REC ; Receives XMRG, returns ER=0 or 1, and XMLER=number of "soft" errors
D SRINIT S:'$D(XMLAN) XMLAN=XMLINE_U_XMLNAK
I $D(XMRG),$G(XMINST) D XMTSTAT^XMTDR(XMINST,"R",XMRG,0)
RL S XMLER=XMLER+1 I (XMLER+1)>XMLMAXER D NEWSTRAT I ER=1 G SRQ
R XMRG#255:$S($D(XMSTIME):XMSTIME,1:XMLTIME)
S XMLZ=$S('$T:-1,XMRG=XMLENQ:0,XMRG=XMLERR:2,1:1)
S ER=XMLZ=2 G:XMLZ>1 SRQ I 'XMLZ D BUFLUSH W XMLAN,$C(13) G RL
R XMLY:XMLTIME
I +XMLY=XMLINE S X=XMRG D SUM S XMLZ=XMSUM=$P(XMLY,U,2) G RL2
S XMLZ=0 I +XMLY=(XMLINE-1),XMLINE'=1 D BUFLUSH W +XMLY,U,XMLACK,$C(13) G RL
RL2 S XMLAN=XMLINE_U_$S(XMLZ:XMLACK,1:XMLNAK) D BUFLUSH W XMLAN,$C(13)
G SRQ:XMLZ,RL
SRINIT ; Initialize variables for Send/Receive
S XMLINE=$S('$D(XMLINE):1,1:XMLINE+1),XMLACK="ACK",XMLNAK="NAK"
S XMLENQ=$C(9)_"ENQ"_$C(9),XMLERR=$C(9)_"ERROR"_$C(9)
S XMLER=-1 ;soft error count
S XMLMAXER=5 ;maximum allowable soft errors
S XMLTIME=30 ;length of READ time
S ER=0 ;non-recoverable error flag
Q
NEWSTRAT ; Select new strategy, one or both machines may be slow
I XMLMAXER=5 S ER=1 Q ;already tried new strategy, give up.
S XMTLER=$S('$D(XMTLER):XMLER,1:XMTLER+XMLER),XMLER=0 ;add to total
S XMLMAXER=5 ;reduce allowable soft errors
S XMLTIME=30 ;increase the READ time
Q
SRQ ; Exit from Send/Receive
S XMTLER=$S('$D(XMTLER):XMLER,1:XMTLER+XMLER) ;Total errors
K XMLACK,XMLNAK,XMLENQ,XMLERR,XMLMAXER,XMLTIME,XMLX,XMLY,XMLZ
Q
BUFLUSH ; Flush buffer
Q:'$D(XMBFLUSH)
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
X ^%ZOSF("TRMOFF")
Q
SUM ; Calculate checksum, accounting also for the character's position
S XMSUM=0 F %=1:1:$L(X) S XMSUM=XMSUM+($A(X,%)*%)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXML 4121 printed Apr 09, 2024@21:14:41 Page 2
XML ;(WASH ISC)/THM/GJL-MailMan Physical link ;06/04/2002 08:26
+1 ;;8.0;MailMan;;Jun 28, 2002
+2 ; Entry points (DBIA 1283):
+3 ; GET - Set up variables for communications protocol in file 3.4
+4 ;
+5 ; Entry points used by MailMan options (not covered by DBIA):
+6 ; C XMDXPROT
OPEN ;
+1 NEW Y
+2 IF $GET(XMCHAN)=""
SET XMCHAN="SCP"
+3 DO GET
if ER
QUIT
+4 DO OP
if ER
QUIT
+5 if '$DATA(XMESC)
SET XMESC="~"
+6 if '$DATA(XMFS)
SET XMFS=255
+7 if '$DATA(XM)
SET XM=""
+8 QUIT
GET ; Set up variables for communications protocol in file 3.4
+1 ; In:
+2 ; XMCHAN - Name of the communications protocol
+3 ; Out:
+4 ; XMCHAN - IEN of the communications protocol
+5 ; XMPROT - Name of the communications protocol
+6 ; XMSEN - Xecute this variable to send a line
+7 ; XMREC - Xecute this variable to receive a line
+8 ; XMOPEN - Xecute this variable to open the channel
+9 ; XMCLOSE - Xecute this variable to close the channel
+10 ; XMOS - Operating System, used in ^XMLTCP
+11 NEW DIC,X
+12 SET X=XMCHAN
SET DIC="^DIC(3.4,"
SET DIC(0)="FO"
+13 DO ^DIC
IF Y<0
Begin DoDot:1
+14 ;Invalid Communications Protocol: '|1|'
DO ERTRAN^XMC1(42244,XMCHAN)
+15 SET Y=XMTRAN
End DoDot:1
QUIT
+16 SET XMCHAN=+Y
SET XMPROT=$PIECE(Y,U,2)
+17 SET XMSEN=$GET(^DIC(3.4,XMCHAN,1),"Q")
SET XMREC=$GET(^(2),"Q")
SET XMOPEN=$GET(^(3),"Q")
SET XMCLOSE=$GET(^(4),"Q")
+18 SET XMOS=^%ZOSF("OS")
+19 IF XMOS["MSM"
Begin DoDot:1
+20 SET XMOS("MSMVER")=$PIECE($ZV," 4.0.",2)
+21 if +XMOS("MSMVER")=0
SET XMOS("MSMVER")=8
End DoDot:1
+22 QUIT
OP ;
+1 IF "Q"'[$GET(XMOPEN)
XECUTE XMOPEN
+2 IF 'XMC("BATCH")
IF '$DATA(XMQUIET)
SET X=255
XECUTE ^%ZOSF("RM")
+3 QUIT
C XECUTE ^%ZOSF("EON")
+1 IF $DATA(XMCLOSE)
if $LENGTH(XMCLOSE)
XECUTE XMCLOSE
+2 QUIT
+3 ; The following has nothing to do with the above.
+4 ; These are used by the SCP Communications Protocol in file 3.4.
SEND ; Sends XMSG, returns ER=0 or 1, and XMLER=number of "soft" errors
+1 IF $LENGTH(XMSG)>255
SET XMLER=0
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 IF $GET(XMINST)
DO XMTSTAT^XMTDR(XMINST,"S",XMSG,0)
SL SET XMLER=XMLER+1
IF (XMLER+1)>XMLMAXER
DO NEWSTRAT
+1 IF ER
WRITE XMLERR,$CHAR(13)
GOTO SRQ
+2 DO BUFLUSH
WRITE XMSG,$CHAR(13)
WRITE XMLINE,U,XMSUM,$CHAR(13)
READ XMLX:XMLTIME
if XMLX=(XMLINE_U_XMLACK)
GOTO SRQ
+3 SET XMLY=XMLX=(XMLINE_U_XMLNAK)
SET XMLZ=0
if 'XMLY
DO ENQ
if XMLY
GOTO SL
GOTO SRQ
ENQ ; ACK/NAK garbled - try to re-establish contact
+1 SET XMLZ=XMLZ+1
IF XMLZ>XMLMAXER
SET (ER,XMLY)=1
QUIT
+2 DO BUFLUSH
WRITE XMLENQ,$CHAR(13)
READ XMLX:XMLTIME
if XMLX=(XMLINE_U_XMLACK)
QUIT
+3 IF XMLX[XMLACK!(XMLX[XMLNAK)
IF +XMLX=XMLINE!(+XMLX=XMLINE-1)
SET XMLY=1
QUIT
+4 HANG 1
GOTO ENQ
REC ; Receives XMRG, returns ER=0 or 1, and XMLER=number of "soft" errors
+1 DO SRINIT
if '$DATA(XMLAN)
SET XMLAN=XMLINE_U_XMLNAK
+2 IF $DATA(XMRG)
IF $GET(XMINST)
DO XMTSTAT^XMTDR(XMINST,"R",XMRG,0)
RL SET XMLER=XMLER+1
IF (XMLER+1)>XMLMAXER
DO NEWSTRAT
IF ER=1
GOTO SRQ
+1 READ XMRG#255:$SELECT($DATA(XMSTIME):XMSTIME,1:XMLTIME)
+2 SET XMLZ=$SELECT('$TEST:-1,XMRG=XMLENQ:0,XMRG=XMLERR:2,1:1)
+3 SET ER=XMLZ=2
if XMLZ>1
GOTO SRQ
IF 'XMLZ
DO BUFLUSH
WRITE XMLAN,$CHAR(13)
GOTO RL
+4 READ XMLY:XMLTIME
+5 IF +XMLY=XMLINE
SET X=XMRG
DO SUM
SET XMLZ=XMSUM=$PIECE(XMLY,U,2)
GOTO RL2
+6 SET XMLZ=0
IF +XMLY=(XMLINE-1)
IF XMLINE'=1
DO BUFLUSH
WRITE +XMLY,U,XMLACK,$CHAR(13)
GOTO RL
RL2 SET XMLAN=XMLINE_U_$SELECT(XMLZ:XMLACK,1:XMLNAK)
DO BUFLUSH
WRITE XMLAN,$CHAR(13)
+1 if XMLZ
GOTO SRQ
GOTO RL
SRINIT ; Initialize variables for Send/Receive
+1 SET XMLINE=$SELECT('$DATA(XMLINE):1,1:XMLINE+1)
SET XMLACK="ACK"
SET XMLNAK="NAK"
+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=5
+5 ;length of READ time
SET XMLTIME=30
+6 ;non-recoverable error flag
SET ER=0
+7 QUIT
NEWSTRAT ; Select new strategy, one or both machines may be slow
+1 ;already tried new strategy, give up.
IF XMLMAXER=5
SET ER=1
QUIT
+2 ;add to total
SET XMTLER=$SELECT('$DATA(XMTLER):XMLER,1:XMTLER+XMLER)
SET XMLER=0
+3 ;reduce allowable soft errors
SET XMLMAXER=5
+4 ;increase the READ time
SET XMLTIME=30
+5 QUIT
SRQ ; Exit from Send/Receive
+1 ;Total errors
SET XMTLER=$SELECT('$DATA(XMTLER):XMLER,1:XMTLER+XMLER)
+2 KILL XMLACK,XMLNAK,XMLENQ,XMLERR,XMLMAXER,XMLTIME,XMLX,XMLY,XMLZ
+3 QUIT
BUFLUSH ; Flush buffer
+1 if '$DATA(XMBFLUSH)
QUIT
+2 XECUTE ^%ZOSF("TRMON")
SET X=$PIECE($HOROLOG,",",2)
FOR %=1:1
READ %:0
if '$TEST
QUIT
SET %=$PIECE($HOROLOG,",",2)
if %<X
SET %=%+86400
if %-X>15
QUIT
+3 XECUTE ^%ZOSF("TRMOFF")
+4 QUIT
SUM ; Calculate checksum, accounting also for the character's position
+1 SET XMSUM=0
FOR %=1:1:$LENGTH(X)
SET XMSUM=XMSUM+($ASCII(X,%)*%)
+2 QUIT
