- 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 Feb 18, 2025@23:39:32 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