- XMS ;ISC-SF/GMB-SMTP Send ;07/11/2002 07:52
- ;;8.0;MailMan;;Jun 28, 2002
- ENTER ;
- ; Variables
- ; XMINST Institution number
- ; XMSITE Institution name
- ; XMIO same as ZTIO
- D INIT
- ; Fall through...
- SEND ;
- S XMC("DIR")="S"
- S:'$D(XMC("TURN")) XMC("TURN")=0
- D SYNCH Q:ER
- I $D(XMC("CHRISTEN")) D CHRISTN,TESTLNK Q
- I $D(XMC("TEST")) D TESTLNK Q
- D HELO(XMINST,XMSITE) L -^DIC(4.2,XMINST,0) Q:ER
- D PROCESS(XMINST,.XMB)
- D TURN(XMINST)
- D QUIT
- Q
- INIT ;
- S ER=0
- S $P(^XMBS(4.2999,XMINST,3),U,6)=$E(IO,1,9)_" "_XMPROT
- S:'$D(XMC("START")) XMC("START")=$$TSTAMP^XMXUTIL1-.001
- I '$D(DT) D DT^DICRW
- S:'$D(XMC("BATCH")) XMC("BATCH")=0
- S XMTLER=0
- Q
- SYNCH ; Recv: "220 REMOTE.DOMAIN.EXT MailMan 8.0 ready"
- I XMC("BATCH") S XMC("MAILMAN")=+$P($T(XMS+1),";",3) Q
- S XMC("MAILMAN")=0
- N XMI,XMX
- F XMI=1:1:5 D Q:ER Q:$E(XMRG)=2
- . X XMREC Q:ER
- . S XMX=$P(XMRG," MailMan ",2)
- . I XMX>4,XMX[" ready" S XMC("MAILMAN")=+XMX
- . I $E(XMRG)'=2 S XMSG="NOOP" X XMSEN Q
- Q
- HELO(XMINST,XMSITE) ;
- ; Send: "HELO LOCAL.DOMAIN.EXT <security num>"
- ; Recv: "250 OK REMOTE.DOMAIN.EXT <security num> [8.0,DUP,SER,FTP]"
- N XMINREC,XMSVAL,I
- S XMINREC=^DIC(4.2,XMINST,0)
- S XMSVAL=$P(XMINREC,U,15) ; Security code
- I XMSVAL L +^DIC(4.2,XMINST,0):0 E D Q
- . D ERTRAN^XMC1(42350) ;Domain file locked.
- S XMSG="HELO "_^XMB("NETNAME")_$S('XMSVAL:"",1:"<"_XMSVAL_">") X XMSEN
- I ER D ERTRAN^XMC1(42351,XMSG) Q ;HELO SEND failed: |1|
- Q:XMC("BATCH")
- X XMREC I ER D ERTRAN^XMC1(42352) Q ;HELO RECEIVE failed.
- I $E(XMRG)'=2 D Q
- . D ERTRAN^XMC1(42353,^XMB("NETNAME"),XMSITE) ;|1| not recognized by |2|
- ;I $P(XMRG,"[",2)'="" S XMC("CAPABLE")=$P(XMRG,"[",2)
- F I=1:1:$L(XMRG," ") Q:$P(XMRG," ",I)["."
- S XMC("HELO SEND")=$P(XMRG," ",I)
- Q:'XMSVAL
- S XMSVAL=$P($P(XMRG,"<",2),">")
- I XMSVAL<1000000 D Q
- . N XMPARM,XMINSTR
- . S XMSG="500 Invalid domain validation response" X XMSEN
- . S XMPARM(1)=XMSITE,XMINSTR("FROM")="POSTMASTER"
- . D TASKBULL^XMXBULL(.5,"XMVALBAD",.XMPARM,,,.XMINSTR)
- . S ER=1,ER("MSG")=XMSG
- ;Double set below prevents replicated ^DIC from
- ;going out of synch when link is down.
- S ^DIC(4.2,XMINST,0)=XMINREC,$P(XMINREC,U,15)=XMSVAL,^(0)=XMINREC
- Q
- PROCESS(XMINST,XMB) ;
- N XMK,XMZ
- S XMK=XMINST+1000
- I '$$BMSGCT^XMXUTIL(.5,XMK) D Q
- . D DOTRAN^XMC1(42358) ; There are no messages in the queue to send
- ; First send msgs the postmaster has flagged to go first
- ; (NETWORK MESSAGE FLAG) set to 1), then send rest.
- F S XMZ=$$NEXT(XMK) Q:XMZ="" D Q:ER
- . L +^XMNET(XMINST,XMZ):0 E D Q
- . . S XMC("NOREQUEUE")=1
- . . D ERTRAN^XMC1(42354) ;Queue being transmitted by another job - Aborting now.
- . D SENDMSG^XMS1(XMK,XMZ,.XMB)
- . I '$D(^XMB(3.9,XMZ,1,"AQUEUE",XMINST)) D ZAPIT^XMXMSGS2(.5,XMK,XMZ) H 1
- . I ER,$G(ER("NONFATAL")) D
- . . K ER S ER=0
- . . I $D(^XMB(3.7,.5,2,XMK,1,XMZ,0)) D XP^XMXMSGS1(.5,XMK,XMZ,2) ; Set xmit priority LOW
- . . D RSET
- . L -^XMNET(XMINST,XMZ)
- Q
- NEXT(XMK) ; Returns the next message (XMZ) in basket XMK to go out.
- ; The next XMZ flagged 'high-priority' is next.
- ; Barring that, the next 'regular-priority' XMZ is next.
- ; Barring that, the next 'low-priority' XMZ is next.
- ; If an XMZ was involved in the failure of the previous transmission,
- ; that XMZ will be 'low-priority'.
- N XMZ,XMOK
- S XMZ=$$NEXTPRI(XMK,1) Q:XMZ XMZ ; Get next high priority msg, if any
- S (XMZ,XMOK)=0 ; Get next regular priority msg, if any
- F S XMZ=$O(^XMB(3.7,.5,2,XMK,1,XMZ)) Q:'XMZ D Q:XMOK
- . Q:$D(^XMB(3.7,.5,2,XMK,1,"AC",2,XMZ)) ; Skip if low priority
- . S:$$NEXTOK(XMK,XMZ) XMOK=1 ; Check msg OK
- Q:XMZ XMZ
- Q $$NEXTPRI(XMK,2) ; Get next low priority msg, if any
- NEXTPRI(XMK,XMTPRI) ; Get the next high/low priority message
- N XMZ
- F S XMZ=$O(^XMB(3.7,.5,2,XMK,1,"AC",XMTPRI,0)) Q:'XMZ D Q:XMZ
- . I '$D(^XMB(3.7,.5,2,XMK,1,XMZ,0)) D Q
- . . K ^XMB(3.7,.5,2,XMK,1,"AC",XMTPRI,XMZ) ; msg not in bskt, kill xref
- . . S XMZ=0
- . I '$$NEXTOK(XMK,XMZ) S XMZ=0 ; Check msg OK
- Q XMZ
- NEXTOK(XMK,XMZ) ; Ensure msg is in file 3.9 & still has recipients q'd
- I $D(^XMB(3.9,XMZ,0)),$O(^XMB(3.9,XMZ,1,"AQUEUE",XMK-1000,0)) Q 1
- D ZAPIT^XMXMSGS2(.5,XMK,XMZ)
- Q 0
- QUIT ;
- Q:$G(XMC("QUIT"))
- S XMSG="QUIT" X XMSEN Q:ER
- X XMREC
- S XMC("QUIT")=1
- Q
- RSET ; Send: "RSET"
- ; Recv: "250"
- S XMSG="RSET" X XMSEN Q:ER!XMC("BATCH")
- X XMREC Q:ER
- I $E(XMRG)'=2 S ER=1
- Q
- TURN(XMINST) ; Turn around channel
- ; Send: "TURN"
- ; Recv: "250 REMOTE.DOMAIN.EXT has messages to export"
- ; or: "502 REMOTE.DOMAIN.EXT has no messages to export"
- Q:XMC("TURN")!XMC("BATCH")
- I $F("Yy",$P(^DIC(4.2,XMINST,0),U,16))>1 D Q
- . D DOTRAN^XMC1(42355.1,XMSITE) ; TURN command disabled for |1|
- S XMC("TURN")=1
- N XMFDA,XMIENS
- S XMIENS=XMINST_","
- S XMFDA(4.2999,XMIENS,1)=$H
- S XMFDA(4.2999,XMIENS,25)=$S($D(ZTQUEUED):$G(ZTSK),1:"@") ; Task number
- D FILE^DIE("","XMFDA")
- S XMSG="TURN" X XMSEN Q:ER
- X XMREC Q:$E(XMRG)'="2"!ER
- D DOTRAN^XMC1(42355) ;Turning around receiver
- G RECEIVE^XMR ; Go into receive mode
- Q
- CHRISTN ; Christen the remote domain
- S XMSG="CHRS "_XMC("CHRISTEN") X XMSEN Q:ER X XMREC Q:ER
- Q
- TESTLNK ; Test the link
- N XMSTIME,XMETIME,XMTLER,XMCHARS,XMUERR,XMLINES
- S XMSG="ECHO" X XMSEN I ER D TESTERR Q
- X XMREC I ER D TESTERR Q
- S XMSTIME=$$NOW^XLFDT
- D TESTIT(.XMLINES,.XMCHARS,.XMUERR,.XMTLER)
- S XMETIME=$$NOW^XLFDT
- D:ER TESTERR
- U IO(0)
- D TESTRSLT(XMSTIME,XMETIME,XMLINES,XMCHARS,XMUERR,XMTLER)
- Q
- TESTERR ;
- S XMSG="****Physical link protocol error. Unable to proceed" D TRAN^XMC1
- Q
- TESTIT(XMLINES,XMCHARS,XMUERR,XMTLER) ;
- N I
- S (I,XMLINES,XMCHARS,XMUERR,XMTLER)=0
- F S I=$O(^TMP("XMS",$J,"S",I)) Q:'I S XMSG=^(I) D Q:ER
- . S XMLINES=XMLINES+1
- . S XMCHARS=XMCHARS+$L(XMSG)
- . X XMSEN Q:ER X XMREC Q:ER
- . Q:XMRG=XMSG
- . S XMUERR=XMUERR+1
- . U IO(0)
- . S XMSG="*****Sent: "_XMSG D TRAN^XMC1
- . S XMSG="*****Rec'd: "_XMRG D TRAN^XMC1
- . U IO
- Q:ER
- S XMSG="." X XMSEN Q:ER X XMREC
- Q
- TESTRSLT(XMSTIME,XMETIME,XMLINES,XMCHARS,XMUERR,XMTLER) ;
- S XMSG=XMLINES_" Lines,"_XMCHARS_" characters transmitted." D TRAN^XMC1
- S XMSG="Errors detected: "_XMUERR_" unrecoverable, "_XMTLER_" recoverable."
- S XMSG=$J(XMCHARS/$$FMDIFF^XLFDT(XMETIME,XMSTIME,2),0,1)_" chars/sec effective transmission rate." D TRAN^XMC1
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXMS 6336 printed Feb 18, 2025@23:39:21 Page 2
- XMS ;ISC-SF/GMB-SMTP Send ;07/11/2002 07:52
- +1 ;;8.0;MailMan;;Jun 28, 2002
- ENTER ;
- +1 ; Variables
- +2 ; XMINST Institution number
- +3 ; XMSITE Institution name
- +4 ; XMIO same as ZTIO
- +5 DO INIT
- +6 ; Fall through...
- SEND ;
- +1 SET XMC("DIR")="S"
- +2 if '$DATA(XMC("TURN"))
- SET XMC("TURN")=0
- +3 DO SYNCH
- if ER
- QUIT
- +4 IF $DATA(XMC("CHRISTEN"))
- DO CHRISTN
- DO TESTLNK
- QUIT
- +5 IF $DATA(XMC("TEST"))
- DO TESTLNK
- QUIT
- +6 DO HELO(XMINST,XMSITE)
- LOCK -^DIC(4.2,XMINST,0)
- if ER
- QUIT
- +7 DO PROCESS(XMINST,.XMB)
- +8 DO TURN(XMINST)
- +9 DO QUIT
- +10 QUIT
- INIT ;
- +1 SET ER=0
- +2 SET $PIECE(^XMBS(4.2999,XMINST,3),U,6)=$EXTRACT(IO,1,9)_" "_XMPROT
- +3 if '$DATA(XMC("START"))
- SET XMC("START")=$$TSTAMP^XMXUTIL1-.001
- +4 IF '$DATA(DT)
- DO DT^DICRW
- +5 if '$DATA(XMC("BATCH"))
- SET XMC("BATCH")=0
- +6 SET XMTLER=0
- +7 QUIT
- SYNCH ; Recv: "220 REMOTE.DOMAIN.EXT MailMan 8.0 ready"
- +1 IF XMC("BATCH")
- SET XMC("MAILMAN")=+$PIECE($TEXT(XMS+1),";",3)
- QUIT
- +2 SET XMC("MAILMAN")=0
- +3 NEW XMI,XMX
- +4 FOR XMI=1:1:5
- Begin DoDot:1
- +5 XECUTE XMREC
- if ER
- QUIT
- +6 SET XMX=$PIECE(XMRG," MailMan ",2)
- +7 IF XMX>4
- IF XMX[" ready"
- SET XMC("MAILMAN")=+XMX
- +8 IF $EXTRACT(XMRG)'=2
- SET XMSG="NOOP"
- XECUTE XMSEN
- QUIT
- End DoDot:1
- if ER
- QUIT
- if $EXTRACT(XMRG)=2
- QUIT
- +9 QUIT
- HELO(XMINST,XMSITE) ;
- +1 ; Send: "HELO LOCAL.DOMAIN.EXT <security num>"
- +2 ; Recv: "250 OK REMOTE.DOMAIN.EXT <security num> [8.0,DUP,SER,FTP]"
- +3 NEW XMINREC,XMSVAL,I
- +4 SET XMINREC=^DIC(4.2,XMINST,0)
- +5 ; Security code
- SET XMSVAL=$PIECE(XMINREC,U,15)
- +6 IF XMSVAL
- LOCK +^DIC(4.2,XMINST,0):0
- IF '$TEST
- Begin DoDot:1
- +7 ;Domain file locked.
- DO ERTRAN^XMC1(42350)
- End DoDot:1
- QUIT
- +8 SET XMSG="HELO "_^XMB("NETNAME")_$SELECT('XMSVAL:"",1:"<"_XMSVAL_">")
- XECUTE XMSEN
- +9 ;HELO SEND failed: |1|
- IF ER
- DO ERTRAN^XMC1(42351,XMSG)
- QUIT
- +10 if XMC("BATCH")
- QUIT
- +11 ;HELO RECEIVE failed.
- XECUTE XMREC
- IF ER
- DO ERTRAN^XMC1(42352)
- QUIT
- +12 IF $EXTRACT(XMRG)'=2
- Begin DoDot:1
- +13 ;|1| not recognized by |2|
- DO ERTRAN^XMC1(42353,^XMB("NETNAME"),XMSITE)
- End DoDot:1
- QUIT
- +14 ;I $P(XMRG,"[",2)'="" S XMC("CAPABLE")=$P(XMRG,"[",2)
- +15 FOR I=1:1:$LENGTH(XMRG," ")
- if $PIECE(XMRG," ",I)["."
- QUIT
- +16 SET XMC("HELO SEND")=$PIECE(XMRG," ",I)
- +17 if 'XMSVAL
- QUIT
- +18 SET XMSVAL=$PIECE($PIECE(XMRG,"<",2),">")
- +19 IF XMSVAL<1000000
- Begin DoDot:1
- +20 NEW XMPARM,XMINSTR
- +21 SET XMSG="500 Invalid domain validation response"
- XECUTE XMSEN
- +22 SET XMPARM(1)=XMSITE
- SET XMINSTR("FROM")="POSTMASTER"
- +23 DO TASKBULL^XMXBULL(.5,"XMVALBAD",.XMPARM,,,.XMINSTR)
- +24 SET ER=1
- SET ER("MSG")=XMSG
- End DoDot:1
- QUIT
- +25 ;Double set below prevents replicated ^DIC from
- +26 ;going out of synch when link is down.
- +27 SET ^DIC(4.2,XMINST,0)=XMINREC
- SET $PIECE(XMINREC,U,15)=XMSVAL
- SET ^(0)=XMINREC
- +28 QUIT
- PROCESS(XMINST,XMB) ;
- +1 NEW XMK,XMZ
- +2 SET XMK=XMINST+1000
- +3 IF '$$BMSGCT^XMXUTIL(.5,XMK)
- Begin DoDot:1
- +4 ; There are no messages in the queue to send
- DO DOTRAN^XMC1(42358)
- End DoDot:1
- QUIT
- +5 ; First send msgs the postmaster has flagged to go first
- +6 ; (NETWORK MESSAGE FLAG) set to 1), then send rest.
- +7 FOR
- SET XMZ=$$NEXT(XMK)
- if XMZ=""
- QUIT
- Begin DoDot:1
- +8 LOCK +^XMNET(XMINST,XMZ):0
- IF '$TEST
- Begin DoDot:2
- +9 SET XMC("NOREQUEUE")=1
- +10 ;Queue being transmitted by another job - Aborting now.
- DO ERTRAN^XMC1(42354)
- End DoDot:2
- QUIT
- +11 DO SENDMSG^XMS1(XMK,XMZ,.XMB)
- +12 IF '$DATA(^XMB(3.9,XMZ,1,"AQUEUE",XMINST))
- DO ZAPIT^XMXMSGS2(.5,XMK,XMZ)
- HANG 1
- +13 IF ER
- IF $GET(ER("NONFATAL"))
- Begin DoDot:2
- +14 KILL ER
- SET ER=0
- +15 ; Set xmit priority LOW
- IF $DATA(^XMB(3.7,.5,2,XMK,1,XMZ,0))
- DO XP^XMXMSGS1(.5,XMK,XMZ,2)
- +16 DO RSET
- End DoDot:2
- +17 LOCK -^XMNET(XMINST,XMZ)
- End DoDot:1
- if ER
- QUIT
- +18 QUIT
- NEXT(XMK) ; Returns the next message (XMZ) in basket XMK to go out.
- +1 ; The next XMZ flagged 'high-priority' is next.
- +2 ; Barring that, the next 'regular-priority' XMZ is next.
- +3 ; Barring that, the next 'low-priority' XMZ is next.
- +4 ; If an XMZ was involved in the failure of the previous transmission,
- +5 ; that XMZ will be 'low-priority'.
- +6 NEW XMZ,XMOK
- +7 ; Get next high priority msg, if any
- SET XMZ=$$NEXTPRI(XMK,1)
- if XMZ
- QUIT XMZ
- +8 ; Get next regular priority msg, if any
- SET (XMZ,XMOK)=0
- +9 FOR
- SET XMZ=$ORDER(^XMB(3.7,.5,2,XMK,1,XMZ))
- if 'XMZ
- QUIT
- Begin DoDot:1
- +10 ; Skip if low priority
- if $DATA(^XMB(3.7,.5,2,XMK,1,"AC",2,XMZ))
- QUIT
- +11 ; Check msg OK
- if $$NEXTOK(XMK,XMZ)
- SET XMOK=1
- End DoDot:1
- if XMOK
- QUIT
- +12 if XMZ
- QUIT XMZ
- +13 ; Get next low priority msg, if any
- QUIT $$NEXTPRI(XMK,2)
- NEXTPRI(XMK,XMTPRI) ; Get the next high/low priority message
- +1 NEW XMZ
- +2 FOR
- SET XMZ=$ORDER(^XMB(3.7,.5,2,XMK,1,"AC",XMTPRI,0))
- if 'XMZ
- QUIT
- Begin DoDot:1
- +3 IF '$DATA(^XMB(3.7,.5,2,XMK,1,XMZ,0))
- Begin DoDot:2
- +4 ; msg not in bskt, kill xref
- KILL ^XMB(3.7,.5,2,XMK,1,"AC",XMTPRI,XMZ)
- +5 SET XMZ=0
- End DoDot:2
- QUIT
- +6 ; Check msg OK
- IF '$$NEXTOK(XMK,XMZ)
- SET XMZ=0
- End DoDot:1
- if XMZ
- QUIT
- +7 QUIT XMZ
- NEXTOK(XMK,XMZ) ; Ensure msg is in file 3.9 & still has recipients q'd
- +1 IF $DATA(^XMB(3.9,XMZ,0))
- IF $ORDER(^XMB(3.9,XMZ,1,"AQUEUE",XMK-1000,0))
- QUIT 1
- +2 DO ZAPIT^XMXMSGS2(.5,XMK,XMZ)
- +3 QUIT 0
- QUIT ;
- +1 if $GET(XMC("QUIT"))
- QUIT
- +2 SET XMSG="QUIT"
- XECUTE XMSEN
- if ER
- QUIT
- +3 XECUTE XMREC
- +4 SET XMC("QUIT")=1
- +5 QUIT
- RSET ; Send: "RSET"
- +1 ; Recv: "250"
- +2 SET XMSG="RSET"
- XECUTE XMSEN
- if ER!XMC("BATCH")
- QUIT
- +3 XECUTE XMREC
- if ER
- QUIT
- +4 IF $EXTRACT(XMRG)'=2
- SET ER=1
- +5 QUIT
- TURN(XMINST) ; Turn around channel
- +1 ; Send: "TURN"
- +2 ; Recv: "250 REMOTE.DOMAIN.EXT has messages to export"
- +3 ; or: "502 REMOTE.DOMAIN.EXT has no messages to export"
- +4 if XMC("TURN")!XMC("BATCH")
- QUIT
- +5 IF $FIND("Yy",$PIECE(^DIC(4.2,XMINST,0),U,16))>1
- Begin DoDot:1
- +6 ; TURN command disabled for |1|
- DO DOTRAN^XMC1(42355.1,XMSITE)
- End DoDot:1
- QUIT
- +7 SET XMC("TURN")=1
- +8 NEW XMFDA,XMIENS
- +9 SET XMIENS=XMINST_","
- +10 SET XMFDA(4.2999,XMIENS,1)=$HOROLOG
- +11 ; Task number
- SET XMFDA(4.2999,XMIENS,25)=$SELECT($DATA(ZTQUEUED):$GET(ZTSK),1:"@")
- +12 DO FILE^DIE("","XMFDA")
- +13 SET XMSG="TURN"
- XECUTE XMSEN
- if ER
- QUIT
- +14 XECUTE XMREC
- if $EXTRACT(XMRG)'="2"!ER
- QUIT
- +15 ;Turning around receiver
- DO DOTRAN^XMC1(42355)
- +16 ; Go into receive mode
- GOTO RECEIVE^XMR
- +17 QUIT
- CHRISTN ; Christen the remote domain
- +1 SET XMSG="CHRS "_XMC("CHRISTEN")
- XECUTE XMSEN
- if ER
- QUIT
- XECUTE XMREC
- if ER
- QUIT
- +2 QUIT
- TESTLNK ; Test the link
- +1 NEW XMSTIME,XMETIME,XMTLER,XMCHARS,XMUERR,XMLINES
- +2 SET XMSG="ECHO"
- XECUTE XMSEN
- IF ER
- DO TESTERR
- QUIT
- +3 XECUTE XMREC
- IF ER
- DO TESTERR
- QUIT
- +4 SET XMSTIME=$$NOW^XLFDT
- +5 DO TESTIT(.XMLINES,.XMCHARS,.XMUERR,.XMTLER)
- +6 SET XMETIME=$$NOW^XLFDT
- +7 if ER
- DO TESTERR
- +8 USE IO(0)
- +9 DO TESTRSLT(XMSTIME,XMETIME,XMLINES,XMCHARS,XMUERR,XMTLER)
- +10 QUIT
- TESTERR ;
- +1 SET XMSG="****Physical link protocol error. Unable to proceed"
- DO TRAN^XMC1
- +2 QUIT
- TESTIT(XMLINES,XMCHARS,XMUERR,XMTLER) ;
- +1 NEW I
- +2 SET (I,XMLINES,XMCHARS,XMUERR,XMTLER)=0
- +3 FOR
- SET I=$ORDER(^TMP("XMS",$JOB,"S",I))
- if 'I
- QUIT
- SET XMSG=^(I)
- Begin DoDot:1
- +4 SET XMLINES=XMLINES+1
- +5 SET XMCHARS=XMCHARS+$LENGTH(XMSG)
- +6 XECUTE XMSEN
- if ER
- QUIT
- XECUTE XMREC
- if ER
- QUIT
- +7 if XMRG=XMSG
- QUIT
- +8 SET XMUERR=XMUERR+1
- +9 USE IO(0)
- +10 SET XMSG="*****Sent: "_XMSG
- DO TRAN^XMC1
- +11 SET XMSG="*****Rec'd: "_XMRG
- DO TRAN^XMC1
- +12 USE IO
- End DoDot:1
- if ER
- QUIT
- +13 if ER
- QUIT
- +14 SET XMSG="."
- XECUTE XMSEN
- if ER
- QUIT
- XECUTE XMREC
- +15 QUIT
- TESTRSLT(XMSTIME,XMETIME,XMLINES,XMCHARS,XMUERR,XMTLER) ;
- +1 SET XMSG=XMLINES_" Lines,"_XMCHARS_" characters transmitted."
- DO TRAN^XMC1
- +2 SET XMSG="Errors detected: "_XMUERR_" unrecoverable, "_XMTLER_" recoverable."
- +3 SET XMSG=$JUSTIFY(XMCHARS/$$FMDIFF^XLFDT(XMETIME,XMSTIME,2),0,1)_" chars/sec effective transmission rate."
- DO TRAN^XMC1
- +4 QUIT