XMTDR ;ISC-SF/GMB-Transmit messages in a queue ;08/28/2003 09:22
;;8.0;MailMan;**22,48**;Jun 28, 2002;Build 5
PLAY(XMINST,XMSITE,XMB) ;
N XMIO,XMTLER,XM,XMTURN
S:'$D(ZTQUEUED) XM="D"
S XMIO=$P(XMB("SCR REC"),U,5)
D ENT^XMC1
Q
TASK ; Task Manager comes here to send message to remote site
; (Tasked by QUEUE^XMKPR or REQUEUE^XMKPR)
; Was ZTSK^XMS0 (ISC-WASH/THM/CAP)
; Variables supplied by TaskMan:
; XMINST Institution number
; XMPOLL Are we polling? 0=no; 1=yes
;
; Variables used here:
; XMSITE Institution name
; XMIO same as ZTIO
; XMB("SCR IEN") Points to which script for XMINST in ^DIC(4.2 to use
; XMB("SCR REC") The script record
; XMB("TRIES") # of tries
I '$D(XMINST) S XMINST=XMB("XMSCR") K XMB ; Transition: v7.1 to v8.0
S ZTREQ="@"
Q:$$OBE(XMINST)
I '$$NEXT^XMS(XMINST+1000),'$G(XMPOLL) D XMTFINIS(XMINST) Q
N XMB,XMC,XMSITE,XM,XMIO
S XM=$G(XM)
S XMIO=ZTIO
S XMSITE=$P(^DIC(4.2,XMINST,0),U,1)
D XMTGET(XMINST,.XMB)
D XMTAUDT(XMINST,.XMB)
I XMB("TRIES")+1=$P(XMB("SCR REC"),U,3) D GET^XMCXT(1) ; Record transcript
D ENT^XMC1
I $G(ER),'$G(XMPOLL),'$G(XMC("NOREQUEUE")) D REQUEUE^XMKPR(XMINST,XMSITE,.XMB) Q
D XMTFINIS(XMINST)
I $G(XMC("S"))!$G(XMC("R")) D CHKSETIP(XMINST,XMSITE,.XMB)
Q
CHKSETIP(XMINST,XMSITE,XMB) ;
N XMOLDIP,XMIP,XMIENS,XMTXT,XMPARM
S XMIP=$P(XMB("SCR REC"),U,6) Q:XMIP=""
S XMIENS=XMINST_","
;I $P(^DIC(4.2,XMINST,0),U,12)'=XMIP D
;. S XMFDA(4.2,XMIENS,6.5)=XMIP ; successful IP address
;. D FILE^DIE("","XMFDA")
Q:+XMB("SCR IEN")'=XMB("SCR IEN")!'XMB("SCR IEN")
S XMOLDIP=$P(^DIC(4.2,XMINST,1,XMB("SCR IEN"),0),U,6)
Q:XMOLDIP=XMIP
I $$FIND1^DIC(4.2,"","MQX",XMC("HELO SEND"),"B^C")'=XMINST D Q
. Q:'$G(XMC("PLAY"))!$D(ZTQUEUED)
. ;We will not change the IP address in the script because the site
. ;self-identifed as |1|, which is not |2| or any of its synonyms.
. N XMPARM,XMTEXT
. S XMPARM(1)=XMC("HELO SEND"),XMPARM(2)=XMSITE
. D BLD^DIALOG(42269,.XMPARM,"","XMTEXT","F")
. D MSG^DIALOG("WM","","","","XMTEXT")
S XMIENS=XMB("SCR IEN")_","_XMIENS
S XMFDA(4.21,XMIENS,1.4)=XMIP ; successful IP address
D FILE^DIE("","XMFDA")
S XMPARM(1)=XMOLDIP,XMPARM(2)=XMIP,XMPARM(3)=$$MMDT^XMXUTIL1($$NOW^XLFDT)
I $G(XMC("PLAY")),'$D(ZTQUEUED) W !,$$EZBLD^DIALOG(42267,.XMPARM) ;Changed IP address in script from '|1|' to '|2|'
S XMTXT(1,0)=$$EZBLD^DIALOG(42268,.XMPARM) ;|3| - Changed IP address from '|1|' to '|2|' (MailMan)
D WP^DIE(4.21,XMIENS,99,"A","XMTXT") ; Add line to script notes
Q
OBE(XMINST) ; Overcome by Events?
N XMTSK
S XMTSK=+$$TSKEXIST^XMKPR(XMINST)
I XMTSK,ZTSK'=XMTSK Q 1
Q 0
XMTGET(XMINST,XMB) ;
N XMTREC
L +^XMBS(4.2999,XMINST,4):0 L -^XMBS(4.2999,XMINST,4) ; ensure latest
S XMTREC=^XMBS(4.2999,XMINST,4)
S XMB("SCR IEN")=$P(XMTREC,U,3)
S XMB("TRIES")=$P(XMTREC,U,4)
S XMB("ITERATIONS")=$P(XMTREC,U,6)
S XMB("FIRST SCRIPT")=$P(XMTREC,U,7)
S XMB("IP TRIED")=$P(XMTREC,U,8)
S XMB("SCR REC")=^XMBS(4.2999,XMINST,5)
Q
XMTAUDT(XMINST,XMB) ;
N XMTREC,XMFDA,XMIENS,XMIEN,XMNOW
L +^XMBS(4.2999,XMINST)
S XMNOW=$$NOW^XLFDT
S XMIENS=XMINST_","
S XMFDA(4.2999,XMIENS,1)="@" ; current time
S XMFDA(4.2999,XMIENS,2)="@" ; msg in transit
S XMFDA(4.2999,XMIENS,3)="@" ; line last transmitted
S XMFDA(4.2999,XMIENS,4)="@" ; errors this transmission
S XMFDA(4.2999,XMIENS,5)="@" ; rate of transmission
S XMFDA(4.2999,XMIENS,6)="@" ; device
S XMTREC=^XMBS(4.2999,XMINST,4)
I '$P(XMTREC,U,1)!$P(XMTREC,U,2) D
. ; There's no start time or there is a finish time, so start audit anew
. K ^XMBS(4.2999,XMINST,6) ; kill off the audit multiple
. S XMFDA(4.2999,XMIENS,41)=XMNOW ; start time
. S XMFDA(4.2999,XMIENS,42)="@" ; finish time
S XMFDA(4.2999,XMIENS,45)=XMNOW ; latest try time
D FILE^DIE("","XMFDA")
K XMFDA
S XMFDA(4.29992,"+1,"_XMIENS,.01)=XMNOW ; audit try time
S XMFDA(4.29992,"+1,"_XMIENS,1)=$E($P(XMB("SCR REC"),U),1,10) ; audit script name
S XMFDA(4.29992,"+1,"_XMIENS,3)=$E($P(XMB("SCR REC"),U,6),1,39) ; audit IP address - XM*8.0*48 updated for IPv6 compatibility
D UPDATE^DIE("","XMFDA","XMIEN")
L -^XMBS(4.2999,XMINST)
S XMB("AUDIT IENS")=XMIEN(1)_","_XMIENS
Q
XMTFINIS(XMINST) ;
N XMFDA,XMIENS
L +^XMBS(4.2999,XMINST)
K ^XMBS(4.2999,XMINST,3) ; current xmit stats
;K ^XMBS(4.2999,XMINST,4) ; latest xmit info (don't delete)
;K ^XMBS(4.2999,XMINST,5) ; script
;K ^XMBS(4.2999,XMINST,6) ; xmit audit history (don't delete)
S XMIENS=XMINST_","
S XMFDA(4.2999,XMIENS,42)=$$NOW^XLFDT ; finish time
D FILE^DIE("","XMFDA")
L -^XMBS(4.2999,XMINST)
Q
ERRTRAP ; (Called from ^XMCTRAP)
I '$D(ZTSK)!$G(XMPOLL) D XMTFINIS(XMINST) Q
D REQUEUE^XMKPR(XMINST,XMSITE,.XMB)
Q
XMTSTAT(XMINST,XMWHICH,XMTXT,XMINCR) ; Statistics recording for message transmission
; We write to 4.2999 every 20 lines up to 100, and then every 100 lines
; after that.
; XMWHICH S=Send; R=Receive
; XMTXT XMSG or XMRG (What is sent or received)
S XMC("C",XMWHICH)=$G(XMC("C",XMWHICH))+$L(XMTXT) ; chars xmit this session
S XMC("L")=$G(XMC("L"))+$G(XMINCR,1) ; lines xmit this session
Q:XMC("L")#$S(XMC("L")>100:100,1:20)
S ^XMBS(4.2999,XMINST,3)=$H_U_$G(XMZ)_U_XMC("L")_U_$G(XMLER)_U_$J($G(XMC("C","R"))+$G(XMC("C","S"))/($$TSTAMP^XMXUTIL1-XMC("START")),0,0)_U_$E(IO,1,9)_" "_XMPROT_U_$G(ZTSK)_U_$G(XMC("DIR"))
Q
XMTHIST(XMINST,XMWHICH,XMLINES) ; Update history statistics for sending/receiving msgs
N XMMONTH,XMREC,XMOFF
S XMMONTH=$E(DT,1,5)
S XMREC=$G(^XMBS(4.2999,XMINST,100,XMMONTH,0))
I XMREC="" D
. S XMREC=XMMONTH_"00"
. D STATMON(XMINST,XMMONTH)
S XMC(XMWHICH)=$G(XMC(XMWHICH))+1
S XMOFF=(XMWHICH="R") ; 0 if "S"; 1 if "R"
S $P(XMREC,U,2+XMOFF)=$P(XMREC,U,2+XMOFF)+1 ; msgs sent/rcvd
S $P(XMREC,U,4)=$P(XMREC,U,4)+$G(XMC("C","S"))-$G(XMC("C","S","CHK")) ; chars sent
S $P(XMREC,U,5)=$P(XMREC,U,5)+$G(XMC("C","R"))-$G(XMC("C","R","CHK")) ; chars rcvd
S $P(XMREC,U,6+XMOFF)=$P(XMREC,U,6+XMOFF)+XMLINES ; lines sent/rcvd
S ^XMBS(4.2999,XMINST,100,XMMONTH,0)=XMREC
S XMC("C","S","CHK")=$G(XMC("C","S")) ; chars sent checkpoint
S XMC("C","R","CHK")=$G(XMC("C","R")) ; chars rcvd checkpoint
Q
STATMON(XMINST,XMMONTH) ; Set up a record for a month for a domain
D:'$D(^XMBS(4.2999,XMINST,0)) STAT(XMINST)
N XMFDA,XMIEN
S XMFDA(4.29991,"+1,"_XMINST_",",.01)=XMMONTH_"00"
S XMIEN(1)=XMMONTH
D UPDATE^DIE("","XMFDA","XMIEN")
Q
STAT(XMINST) ; Set up record for domain in 4.2999 MESSAGE STATISTICS file
Q:$D(^XMBS(4.2999,XMINST,0))
N XMFDA,XMIEN
S XMFDA(4.2999,"+1,",.01)=XMINST
S XMIEN(1)=XMINST
D UPDATE^DIE("","XMFDA","XMIEN") Q:'$D(DIERR)
; Just in case the call fails, we must do it ourselves
S ^XMBS(4.2999,XMINST,0)=XMINST
S ^XMBS(4.2999,"B",XMINST,XMINST)=""
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXMTDR 6820 printed Oct 16, 2024@18:14:05 Page 2
XMTDR ;ISC-SF/GMB-Transmit messages in a queue ;08/28/2003 09:22
+1 ;;8.0;MailMan;**22,48**;Jun 28, 2002;Build 5
PLAY(XMINST,XMSITE,XMB) ;
+1 NEW XMIO,XMTLER,XM,XMTURN
+2 if '$DATA(ZTQUEUED)
SET XM="D"
+3 SET XMIO=$PIECE(XMB("SCR REC"),U,5)
+4 DO ENT^XMC1
+5 QUIT
TASK ; Task Manager comes here to send message to remote site
+1 ; (Tasked by QUEUE^XMKPR or REQUEUE^XMKPR)
+2 ; Was ZTSK^XMS0 (ISC-WASH/THM/CAP)
+3 ; Variables supplied by TaskMan:
+4 ; XMINST Institution number
+5 ; XMPOLL Are we polling? 0=no; 1=yes
+6 ;
+7 ; Variables used here:
+8 ; XMSITE Institution name
+9 ; XMIO same as ZTIO
+10 ; XMB("SCR IEN") Points to which script for XMINST in ^DIC(4.2 to use
+11 ; XMB("SCR REC") The script record
+12 ; XMB("TRIES") # of tries
+13 ; Transition: v7.1 to v8.0
IF '$DATA(XMINST)
SET XMINST=XMB("XMSCR")
KILL XMB
+14 SET ZTREQ="@"
+15 if $$OBE(XMINST)
QUIT
+16 IF '$$NEXT^XMS(XMINST+1000)
IF '$GET(XMPOLL)
DO XMTFINIS(XMINST)
QUIT
+17 NEW XMB,XMC,XMSITE,XM,XMIO
+18 SET XM=$GET(XM)
+19 SET XMIO=ZTIO
+20 SET XMSITE=$PIECE(^DIC(4.2,XMINST,0),U,1)
+21 DO XMTGET(XMINST,.XMB)
+22 DO XMTAUDT(XMINST,.XMB)
+23 ; Record transcript
IF XMB("TRIES")+1=$PIECE(XMB("SCR REC"),U,3)
DO GET^XMCXT(1)
+24 DO ENT^XMC1
+25 IF $GET(ER)
IF '$GET(XMPOLL)
IF '$GET(XMC("NOREQUEUE"))
DO REQUEUE^XMKPR(XMINST,XMSITE,.XMB)
QUIT
+26 DO XMTFINIS(XMINST)
+27 IF $GET(XMC("S"))!$GET(XMC("R"))
DO CHKSETIP(XMINST,XMSITE,.XMB)
+28 QUIT
CHKSETIP(XMINST,XMSITE,XMB) ;
+1 NEW XMOLDIP,XMIP,XMIENS,XMTXT,XMPARM
+2 SET XMIP=$PIECE(XMB("SCR REC"),U,6)
if XMIP=""
QUIT
+3 SET XMIENS=XMINST_","
+4 ;I $P(^DIC(4.2,XMINST,0),U,12)'=XMIP D
+5 ;. S XMFDA(4.2,XMIENS,6.5)=XMIP ; successful IP address
+6 ;. D FILE^DIE("","XMFDA")
+7 if +XMB("SCR IEN")'=XMB("SCR IEN")!'XMB("SCR IEN")
QUIT
+8 SET XMOLDIP=$PIECE(^DIC(4.2,XMINST,1,XMB("SCR IEN"),0),U,6)
+9 if XMOLDIP=XMIP
QUIT
+10 IF $$FIND1^DIC(4.2,"","MQX",XMC("HELO SEND"),"B^C")'=XMINST
Begin DoDot:1
+11 if '$GET(XMC("PLAY"))!$DATA(ZTQUEUED)
QUIT
+12 ;We will not change the IP address in the script because the site
+13 ;self-identifed as |1|, which is not |2| or any of its synonyms.
+14 NEW XMPARM,XMTEXT
+15 SET XMPARM(1)=XMC("HELO SEND")
SET XMPARM(2)=XMSITE
+16 DO BLD^DIALOG(42269,.XMPARM,"","XMTEXT","F")
+17 DO MSG^DIALOG("WM","","","","XMTEXT")
End DoDot:1
QUIT
+18 SET XMIENS=XMB("SCR IEN")_","_XMIENS
+19 ; successful IP address
SET XMFDA(4.21,XMIENS,1.4)=XMIP
+20 DO FILE^DIE("","XMFDA")
+21 SET XMPARM(1)=XMOLDIP
SET XMPARM(2)=XMIP
SET XMPARM(3)=$$MMDT^XMXUTIL1($$NOW^XLFDT)
+22 ;Changed IP address in script from '|1|' to '|2|'
IF $GET(XMC("PLAY"))
IF '$DATA(ZTQUEUED)
WRITE !,$$EZBLD^DIALOG(42267,.XMPARM)
+23 ;|3| - Changed IP address from '|1|' to '|2|' (MailMan)
SET XMTXT(1,0)=$$EZBLD^DIALOG(42268,.XMPARM)
+24 ; Add line to script notes
DO WP^DIE(4.21,XMIENS,99,"A","XMTXT")
+25 QUIT
OBE(XMINST) ; Overcome by Events?
+1 NEW XMTSK
+2 SET XMTSK=+$$TSKEXIST^XMKPR(XMINST)
+3 IF XMTSK
IF ZTSK'=XMTSK
QUIT 1
+4 QUIT 0
XMTGET(XMINST,XMB) ;
+1 NEW XMTREC
+2 ; ensure latest
LOCK +^XMBS(4.2999,XMINST,4):0
LOCK -^XMBS(4.2999,XMINST,4)
+3 SET XMTREC=^XMBS(4.2999,XMINST,4)
+4 SET XMB("SCR IEN")=$PIECE(XMTREC,U,3)
+5 SET XMB("TRIES")=$PIECE(XMTREC,U,4)
+6 SET XMB("ITERATIONS")=$PIECE(XMTREC,U,6)
+7 SET XMB("FIRST SCRIPT")=$PIECE(XMTREC,U,7)
+8 SET XMB("IP TRIED")=$PIECE(XMTREC,U,8)
+9 SET XMB("SCR REC")=^XMBS(4.2999,XMINST,5)
+10 QUIT
XMTAUDT(XMINST,XMB) ;
+1 NEW XMTREC,XMFDA,XMIENS,XMIEN,XMNOW
+2 LOCK +^XMBS(4.2999,XMINST)
+3 SET XMNOW=$$NOW^XLFDT
+4 SET XMIENS=XMINST_","
+5 ; current time
SET XMFDA(4.2999,XMIENS,1)="@"
+6 ; msg in transit
SET XMFDA(4.2999,XMIENS,2)="@"
+7 ; line last transmitted
SET XMFDA(4.2999,XMIENS,3)="@"
+8 ; errors this transmission
SET XMFDA(4.2999,XMIENS,4)="@"
+9 ; rate of transmission
SET XMFDA(4.2999,XMIENS,5)="@"
+10 ; device
SET XMFDA(4.2999,XMIENS,6)="@"
+11 SET XMTREC=^XMBS(4.2999,XMINST,4)
+12 IF '$PIECE(XMTREC,U,1)!$PIECE(XMTREC,U,2)
Begin DoDot:1
+13 ; There's no start time or there is a finish time, so start audit anew
+14 ; kill off the audit multiple
KILL ^XMBS(4.2999,XMINST,6)
+15 ; start time
SET XMFDA(4.2999,XMIENS,41)=XMNOW
+16 ; finish time
SET XMFDA(4.2999,XMIENS,42)="@"
End DoDot:1
+17 ; latest try time
SET XMFDA(4.2999,XMIENS,45)=XMNOW
+18 DO FILE^DIE("","XMFDA")
+19 KILL XMFDA
+20 ; audit try time
SET XMFDA(4.29992,"+1,"_XMIENS,.01)=XMNOW
+21 ; audit script name
SET XMFDA(4.29992,"+1,"_XMIENS,1)=$EXTRACT($PIECE(XMB("SCR REC"),U),1,10)
+22 ; audit IP address - XM*8.0*48 updated for IPv6 compatibility
SET XMFDA(4.29992,"+1,"_XMIENS,3)=$EXTRACT($PIECE(XMB("SCR REC"),U,6),1,39)
+23 DO UPDATE^DIE("","XMFDA","XMIEN")
+24 LOCK -^XMBS(4.2999,XMINST)
+25 SET XMB("AUDIT IENS")=XMIEN(1)_","_XMIENS
+26 QUIT
XMTFINIS(XMINST) ;
+1 NEW XMFDA,XMIENS
+2 LOCK +^XMBS(4.2999,XMINST)
+3 ; current xmit stats
KILL ^XMBS(4.2999,XMINST,3)
+4 ;K ^XMBS(4.2999,XMINST,4) ; latest xmit info (don't delete)
+5 ;K ^XMBS(4.2999,XMINST,5) ; script
+6 ;K ^XMBS(4.2999,XMINST,6) ; xmit audit history (don't delete)
+7 SET XMIENS=XMINST_","
+8 ; finish time
SET XMFDA(4.2999,XMIENS,42)=$$NOW^XLFDT
+9 DO FILE^DIE("","XMFDA")
+10 LOCK -^XMBS(4.2999,XMINST)
+11 QUIT
ERRTRAP ; (Called from ^XMCTRAP)
+1 IF '$DATA(ZTSK)!$GET(XMPOLL)
DO XMTFINIS(XMINST)
QUIT
+2 DO REQUEUE^XMKPR(XMINST,XMSITE,.XMB)
+3 QUIT
XMTSTAT(XMINST,XMWHICH,XMTXT,XMINCR) ; Statistics recording for message transmission
+1 ; We write to 4.2999 every 20 lines up to 100, and then every 100 lines
+2 ; after that.
+3 ; XMWHICH S=Send; R=Receive
+4 ; XMTXT XMSG or XMRG (What is sent or received)
+5 ; chars xmit this session
SET XMC("C",XMWHICH)=$GET(XMC("C",XMWHICH))+$LENGTH(XMTXT)
+6 ; lines xmit this session
SET XMC("L")=$GET(XMC("L"))+$GET(XMINCR,1)
+7 if XMC("L")#$SELECT(XMC("L")>100
QUIT
+8 SET ^XMBS(4.2999,XMINST,3)=$HOROLOG_U_$GET(XMZ)_U_XMC("L")_U_$GET(XMLER)_U_$JUSTIFY($GET(XMC("C","R"))+$GET(XMC("C","S"))/($$TSTAMP^XMXUTIL1-XMC("START")),0,0)_U_$EXTRACT(IO,1,9)_" "_XMPROT_U_$GET(ZTSK)_U_$GET(XMC("DIR"))
+9 QUIT
XMTHIST(XMINST,XMWHICH,XMLINES) ; Update history statistics for sending/receiving msgs
+1 NEW XMMONTH,XMREC,XMOFF
+2 SET XMMONTH=$EXTRACT(DT,1,5)
+3 SET XMREC=$GET(^XMBS(4.2999,XMINST,100,XMMONTH,0))
+4 IF XMREC=""
Begin DoDot:1
+5 SET XMREC=XMMONTH_"00"
+6 DO STATMON(XMINST,XMMONTH)
End DoDot:1
+7 SET XMC(XMWHICH)=$GET(XMC(XMWHICH))+1
+8 ; 0 if "S"; 1 if "R"
SET XMOFF=(XMWHICH="R")
+9 ; msgs sent/rcvd
SET $PIECE(XMREC,U,2+XMOFF)=$PIECE(XMREC,U,2+XMOFF)+1
+10 ; chars sent
SET $PIECE(XMREC,U,4)=$PIECE(XMREC,U,4)+$GET(XMC("C","S"))-$GET(XMC("C","S","CHK"))
+11 ; chars rcvd
SET $PIECE(XMREC,U,5)=$PIECE(XMREC,U,5)+$GET(XMC("C","R"))-$GET(XMC("C","R","CHK"))
+12 ; lines sent/rcvd
SET $PIECE(XMREC,U,6+XMOFF)=$PIECE(XMREC,U,6+XMOFF)+XMLINES
+13 SET ^XMBS(4.2999,XMINST,100,XMMONTH,0)=XMREC
+14 ; chars sent checkpoint
SET XMC("C","S","CHK")=$GET(XMC("C","S"))
+15 ; chars rcvd checkpoint
SET XMC("C","R","CHK")=$GET(XMC("C","R"))
+16 QUIT
STATMON(XMINST,XMMONTH) ; Set up a record for a month for a domain
+1 if '$DATA(^XMBS(4.2999,XMINST,0))
DO STAT(XMINST)
+2 NEW XMFDA,XMIEN
+3 SET XMFDA(4.29991,"+1,"_XMINST_",",.01)=XMMONTH_"00"
+4 SET XMIEN(1)=XMMONTH
+5 DO UPDATE^DIE("","XMFDA","XMIEN")
+6 QUIT
STAT(XMINST) ; Set up record for domain in 4.2999 MESSAGE STATISTICS file
+1 if $DATA(^XMBS(4.2999,XMINST,0))
QUIT
+2 NEW XMFDA,XMIEN
+3 SET XMFDA(4.2999,"+1,",.01)=XMINST
+4 SET XMIEN(1)=XMINST
+5 DO UPDATE^DIE("","XMFDA","XMIEN")
if '$DATA(DIERR)
QUIT
+6 ; Just in case the call fails, we must do it ourselves
+7 SET ^XMBS(4.2999,XMINST,0)=XMINST
+8 SET ^XMBS(4.2999,"B",XMINST,XMINST)=""
+9 QUIT
