Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: XMTDR

XMTDR.m

Go to the documentation of this file.
  1. 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
  1. PLAY(XMINST,XMSITE,XMB) ;
  1. N XMIO,XMTLER,XM,XMTURN
  1. S:'$D(ZTQUEUED) XM="D"
  1. S XMIO=$P(XMB("SCR REC"),U,5)
  1. D ENT^XMC1
  1. Q
  1. TASK ; Task Manager comes here to send message to remote site
  1. ; (Tasked by QUEUE^XMKPR or REQUEUE^XMKPR)
  1. ; Was ZTSK^XMS0 (ISC-WASH/THM/CAP)
  1. ; Variables supplied by TaskMan:
  1. ; XMINST Institution number
  1. ; XMPOLL Are we polling? 0=no; 1=yes
  1. ;
  1. ; Variables used here:
  1. ; XMSITE Institution name
  1. ; XMIO same as ZTIO
  1. ; XMB("SCR IEN") Points to which script for XMINST in ^DIC(4.2 to use
  1. ; XMB("SCR REC") The script record
  1. ; XMB("TRIES") # of tries
  1. I '$D(XMINST) S XMINST=XMB("XMSCR") K XMB ; Transition: v7.1 to v8.0
  1. S ZTREQ="@"
  1. Q:$$OBE(XMINST)
  1. I '$$NEXT^XMS(XMINST+1000),'$G(XMPOLL) D XMTFINIS(XMINST) Q
  1. N XMB,XMC,XMSITE,XM,XMIO
  1. S XM=$G(XM)
  1. S XMIO=ZTIO
  1. S XMSITE=$P(^DIC(4.2,XMINST,0),U,1)
  1. D XMTGET(XMINST,.XMB)
  1. D XMTAUDT(XMINST,.XMB)
  1. I XMB("TRIES")+1=$P(XMB("SCR REC"),U,3) D GET^XMCXT(1) ; Record transcript
  1. D ENT^XMC1
  1. I $G(ER),'$G(XMPOLL),'$G(XMC("NOREQUEUE")) D REQUEUE^XMKPR(XMINST,XMSITE,.XMB) Q
  1. D XMTFINIS(XMINST)
  1. I $G(XMC("S"))!$G(XMC("R")) D CHKSETIP(XMINST,XMSITE,.XMB)
  1. Q
  1. CHKSETIP(XMINST,XMSITE,XMB) ;
  1. N XMOLDIP,XMIP,XMIENS,XMTXT,XMPARM
  1. S XMIP=$P(XMB("SCR REC"),U,6) Q:XMIP=""
  1. S XMIENS=XMINST_","
  1. ;I $P(^DIC(4.2,XMINST,0),U,12)'=XMIP D
  1. ;. S XMFDA(4.2,XMIENS,6.5)=XMIP ; successful IP address
  1. ;. D FILE^DIE("","XMFDA")
  1. Q:+XMB("SCR IEN")'=XMB("SCR IEN")!'XMB("SCR IEN")
  1. S XMOLDIP=$P(^DIC(4.2,XMINST,1,XMB("SCR IEN"),0),U,6)
  1. Q:XMOLDIP=XMIP
  1. I $$FIND1^DIC(4.2,"","MQX",XMC("HELO SEND"),"B^C")'=XMINST D Q
  1. . Q:'$G(XMC("PLAY"))!$D(ZTQUEUED)
  1. . ;We will not change the IP address in the script because the site
  1. . ;self-identifed as |1|, which is not |2| or any of its synonyms.
  1. . N XMPARM,XMTEXT
  1. . S XMPARM(1)=XMC("HELO SEND"),XMPARM(2)=XMSITE
  1. . D BLD^DIALOG(42269,.XMPARM,"","XMTEXT","F")
  1. . D MSG^DIALOG("WM","","","","XMTEXT")
  1. S XMIENS=XMB("SCR IEN")_","_XMIENS
  1. S XMFDA(4.21,XMIENS,1.4)=XMIP ; successful IP address
  1. D FILE^DIE("","XMFDA")
  1. S XMPARM(1)=XMOLDIP,XMPARM(2)=XMIP,XMPARM(3)=$$MMDT^XMXUTIL1($$NOW^XLFDT)
  1. I $G(XMC("PLAY")),'$D(ZTQUEUED) W !,$$EZBLD^DIALOG(42267,.XMPARM) ;Changed IP address in script from '|1|' to '|2|'
  1. S XMTXT(1,0)=$$EZBLD^DIALOG(42268,.XMPARM) ;|3| - Changed IP address from '|1|' to '|2|' (MailMan)
  1. D WP^DIE(4.21,XMIENS,99,"A","XMTXT") ; Add line to script notes
  1. Q
  1. OBE(XMINST) ; Overcome by Events?
  1. N XMTSK
  1. S XMTSK=+$$TSKEXIST^XMKPR(XMINST)
  1. I XMTSK,ZTSK'=XMTSK Q 1
  1. Q 0
  1. XMTGET(XMINST,XMB) ;
  1. N XMTREC
  1. L +^XMBS(4.2999,XMINST,4):0 L -^XMBS(4.2999,XMINST,4) ; ensure latest
  1. S XMTREC=^XMBS(4.2999,XMINST,4)
  1. S XMB("SCR IEN")=$P(XMTREC,U,3)
  1. S XMB("TRIES")=$P(XMTREC,U,4)
  1. S XMB("ITERATIONS")=$P(XMTREC,U,6)
  1. S XMB("FIRST SCRIPT")=$P(XMTREC,U,7)
  1. S XMB("IP TRIED")=$P(XMTREC,U,8)
  1. S XMB("SCR REC")=^XMBS(4.2999,XMINST,5)
  1. Q
  1. XMTAUDT(XMINST,XMB) ;
  1. N XMTREC,XMFDA,XMIENS,XMIEN,XMNOW
  1. L +^XMBS(4.2999,XMINST)
  1. S XMNOW=$$NOW^XLFDT
  1. S XMIENS=XMINST_","
  1. S XMFDA(4.2999,XMIENS,1)="@" ; current time
  1. S XMFDA(4.2999,XMIENS,2)="@" ; msg in transit
  1. S XMFDA(4.2999,XMIENS,3)="@" ; line last transmitted
  1. S XMFDA(4.2999,XMIENS,4)="@" ; errors this transmission
  1. S XMFDA(4.2999,XMIENS,5)="@" ; rate of transmission
  1. S XMFDA(4.2999,XMIENS,6)="@" ; device
  1. S XMTREC=^XMBS(4.2999,XMINST,4)
  1. I '$P(XMTREC,U,1)!$P(XMTREC,U,2) D
  1. . ; There's no start time or there is a finish time, so start audit anew
  1. . K ^XMBS(4.2999,XMINST,6) ; kill off the audit multiple
  1. . S XMFDA(4.2999,XMIENS,41)=XMNOW ; start time
  1. . S XMFDA(4.2999,XMIENS,42)="@" ; finish time
  1. S XMFDA(4.2999,XMIENS,45)=XMNOW ; latest try time
  1. D FILE^DIE("","XMFDA")
  1. K XMFDA
  1. S XMFDA(4.29992,"+1,"_XMIENS,.01)=XMNOW ; audit try time
  1. S XMFDA(4.29992,"+1,"_XMIENS,1)=$E($P(XMB("SCR REC"),U),1,10) ; audit script name
  1. 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
  1. D UPDATE^DIE("","XMFDA","XMIEN")
  1. L -^XMBS(4.2999,XMINST)
  1. S XMB("AUDIT IENS")=XMIEN(1)_","_XMIENS
  1. Q
  1. XMTFINIS(XMINST) ;
  1. N XMFDA,XMIENS
  1. L +^XMBS(4.2999,XMINST)
  1. K ^XMBS(4.2999,XMINST,3) ; current xmit stats
  1. ;K ^XMBS(4.2999,XMINST,4) ; latest xmit info (don't delete)
  1. ;K ^XMBS(4.2999,XMINST,5) ; script
  1. ;K ^XMBS(4.2999,XMINST,6) ; xmit audit history (don't delete)
  1. S XMIENS=XMINST_","
  1. S XMFDA(4.2999,XMIENS,42)=$$NOW^XLFDT ; finish time
  1. D FILE^DIE("","XMFDA")
  1. L -^XMBS(4.2999,XMINST)
  1. Q
  1. ERRTRAP ; (Called from ^XMCTRAP)
  1. I '$D(ZTSK)!$G(XMPOLL) D XMTFINIS(XMINST) Q
  1. D REQUEUE^XMKPR(XMINST,XMSITE,.XMB)
  1. Q
  1. 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
  1. ; after that.
  1. ; XMWHICH S=Send; R=Receive
  1. ; XMTXT XMSG or XMRG (What is sent or received)
  1. S XMC("C",XMWHICH)=$G(XMC("C",XMWHICH))+$L(XMTXT) ; chars xmit this session
  1. S XMC("L")=$G(XMC("L"))+$G(XMINCR,1) ; lines xmit this session
  1. Q:XMC("L")#$S(XMC("L")>100:100,1:20)
  1. 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"))
  1. Q
  1. XMTHIST(XMINST,XMWHICH,XMLINES) ; Update history statistics for sending/receiving msgs
  1. N XMMONTH,XMREC,XMOFF
  1. S XMMONTH=$E(DT,1,5)
  1. S XMREC=$G(^XMBS(4.2999,XMINST,100,XMMONTH,0))
  1. I XMREC="" D
  1. . S XMREC=XMMONTH_"00"
  1. . D STATMON(XMINST,XMMONTH)
  1. S XMC(XMWHICH)=$G(XMC(XMWHICH))+1
  1. S XMOFF=(XMWHICH="R") ; 0 if "S"; 1 if "R"
  1. S $P(XMREC,U,2+XMOFF)=$P(XMREC,U,2+XMOFF)+1 ; msgs sent/rcvd
  1. S $P(XMREC,U,4)=$P(XMREC,U,4)+$G(XMC("C","S"))-$G(XMC("C","S","CHK")) ; chars sent
  1. S $P(XMREC,U,5)=$P(XMREC,U,5)+$G(XMC("C","R"))-$G(XMC("C","R","CHK")) ; chars rcvd
  1. S $P(XMREC,U,6+XMOFF)=$P(XMREC,U,6+XMOFF)+XMLINES ; lines sent/rcvd
  1. S ^XMBS(4.2999,XMINST,100,XMMONTH,0)=XMREC
  1. S XMC("C","S","CHK")=$G(XMC("C","S")) ; chars sent checkpoint
  1. S XMC("C","R","CHK")=$G(XMC("C","R")) ; chars rcvd checkpoint
  1. Q
  1. STATMON(XMINST,XMMONTH) ; Set up a record for a month for a domain
  1. D:'$D(^XMBS(4.2999,XMINST,0)) STAT(XMINST)
  1. N XMFDA,XMIEN
  1. S XMFDA(4.29991,"+1,"_XMINST_",",.01)=XMMONTH_"00"
  1. S XMIEN(1)=XMMONTH
  1. D UPDATE^DIE("","XMFDA","XMIEN")
  1. Q
  1. STAT(XMINST) ; Set up record for domain in 4.2999 MESSAGE STATISTICS file
  1. Q:$D(^XMBS(4.2999,XMINST,0))
  1. N XMFDA,XMIEN
  1. S XMFDA(4.2999,"+1,",.01)=XMINST
  1. S XMIEN(1)=XMINST
  1. D UPDATE^DIE("","XMFDA","XMIEN") Q:'$D(DIERR)
  1. ; Just in case the call fails, we must do it ourselves
  1. S ^XMBS(4.2999,XMINST,0)=XMINST
  1. S ^XMBS(4.2999,"B",XMINST,XMINST)=""
  1. Q