- XMKPR ;ISC-SF/GMB-Post, remote ;10/09/2002 09:40
- ;;8.0;MailMan;**5,6**;Jun 28, 2002
- ; Replaces ^XMBPOST and the first part of ^XMS1 (ISC-WASH/THM/RWF/CAP)
- ; Schedule a task to deliver remote
- REMOTE(XMZ,XMINST) ; For addresses containing "@"
- N XMSITE,XMREC,XMPOLL
- S XMREC=^DIC(4.2,XMINST,0)
- S XMSITE=$P(XMREC,U)
- D PUTMSG^XMXMSGS2(.5,XMINST+1000,XMSITE,XMZ)
- Q:$P(XMREC,U,2)'["S" ; S means to start task immediately
- D:'$$TSKEXIST(XMINST) QUEUE(XMINST,XMSITE)
- Q
- TSKEXIST(XMINST,XMTSK) ;Is Task scheduled ? (0=no,ZTSK^$H=pending,ZTSK=running)
- ; Note: ZTSK does not exist when 'playing a script', or for an incoming
- ; transmission.
- S:'$G(XMTSK) XMTSK=$$GETTSK(XMINST)
- Q:'XMTSK 0
- I $D(ZTQUEUED),$G(ZTSK)=XMTSK Q ZTSK
- N ZTSK
- S ZTSK=XMTSK
- D STAT^%ZTLOAD
- Q:ZTSK(1)=0 0 ; "Undefined"
- I ZTSK(1)=1 D Q ZTSK_U_ZTSK("D") ; "Active: Pending"
- . D ISQED^%ZTLOAD ; ZTSK("D")=$H when scheduled
- I ZTSK(1)=2 Q ZTSK ; "Active: Running"
- ;I ZTSK(1)=2 N %1 D L -^DIC(4.2,+$G(XMINST),"XMNETSEND") Q %1
- ;. ; "Active: Running" - This check isn't reliable,
- ;. ; because the lock is not set for incoming, only for outgoing.
- ;. L +^DIC(4.2,+$G(XMINST),"XMNETSEND"):2 ; Is it really running?
- ;. I $T D KILLTSK(XMINST,ZTSK) S %1=0 Q ; Nope
- ;. S %1=ZTSK ; Yep
- Q:ZTSK(1)=3 0 ; "Inactive: Finished"
- I ZTSK(1)=4 D KILLTSK(XMINST,ZTSK) Q 0 ; "Inactive: Available"
- I ZTSK(1)=5 D KILLTSK(XMINST,ZTSK) Q 0 ; "Interrupted"
- Q
- GETTSK(XMINST) ;
- L +^XMBS(4.2999,XMINST,3):0 L -^XMBS(4.2999,XMINST,3) ; ensure latest
- Q $P($G(^XMBS(4.2999,XMINST,3)),U,7)
- KILLTSK(XMINST,ZTSK) ;
- D KILL^%ZTLOAD
- S $P(^XMBS(4.2999,XMINST,3),U,7)=""
- S $P(^XMBS(4.2999,XMINST,4),U,2)=$$NOW^XLFDT
- Q
- QUEUE(XMINST,XMSITE,XMB,ZTDTH,ZTSK) ;
- ; Was ENQ^XMS1 used by ^XMC2,^XMS5,^XMS5B ***
- ; in:
- ; XMINST domain IEN in domain file
- ; XMSITE domain name
- ; XMB (optional) script choice (default: highest priority script)
- ; ZTDTH (optional) task start time (default: now)
- ; out:
- ; ZTSK task number
- N I,XMIENS,XMFDA,ZTIO,ZTDESC,ZTRTN
- I '$D(^XMBS(4.2999,XMINST,0)) D STAT^XMTDR(XMINST)
- L +^XMBS(4.2999,XMINST):1
- I '$G(XMB("SCR IEN")) D Q:'XMB("SCR IEN")
- . D XMTCHECK(XMINST,.XMB)
- . D SCRIPT^XMKPR1(XMINST,XMSITE,.XMB)
- S ZTIO=$P(XMB("SCR REC"),U,5)
- S ZTDESC=$$EZBLD^DIALOG(42000,XMSITE) ; MailMan: To |1|
- S:'$G(ZTDTH) ZTDTH=$H
- F I="XMINST","XMPOLL" S ZTSAVE(I)=""
- S ZTRTN="TASK^XMTDR"
- D ^%ZTLOAD
- S ^XMBS(4.2999,XMINST,3)="" ; current xmit stats
- S $P(^XMBS(4.2999,XMINST,3),U,7)=ZTSK
- S XMIENS=XMINST_","
- I 'XMB("TRIES"),'XMB("ITERATIONS") D
- . S XMFDA(4.2999,XMIENS,41)="@" ; xmit start date/time
- . S XMFDA(4.2999,XMIENS,42)="@" ; xmit finish date/time
- . S XMFDA(4.2999,XMIENS,45)="@" ; xmit latest try date/time
- . K ^XMBS(4.2999,XMINST,6) ; xmit audit multiple
- S XMFDA(4.2999,XMIENS,25)=ZTSK ; task number
- S XMFDA(4.2999,XMIENS,43)=XMB("SCR IEN") ; ien of script to be used
- S XMFDA(4.2999,XMIENS,44)=XMB("TRIES") ; xmit tries
- S XMFDA(4.2999,XMIENS,46)=XMB("ITERATIONS") ; xmit iterations
- S XMFDA(4.2999,XMIENS,47)=XMB("FIRST SCRIPT") ; ien of first script
- S XMFDA(4.2999,XMIENS,48)=XMB("IP TRIED") ; IP addresses tried
- S XMFDA(4.2999,XMIENS,51)=XMB("SCR REC") ; script record
- D FILE^DIE("","XMFDA")
- L -^XMBS(4.2999,XMINST)
- Q
- XMTCHECK(XMINST,XMB) ;
- N XMTREC
- L +^XMBS(4.2999,XMINST,4):0 L -^XMBS(4.2999,XMINST,4) ; ensure latest
- S XMTREC=$G(^XMBS(4.2999,XMINST,4))
- Q:'$P(XMTREC,U,1)!$P(XMTREC,U,2)
- ; Start time, but no finish time.
- ; Previous transmission attempt was aborted. Pick up where we left off.
- S XMB("SCR IEN")=$P(XMTREC,U,3)
- S XMB("TRIES")=$P(XMTREC,U,4)
- S XMB("LAST TRY")=$P(XMTREC,U,5)
- 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")=$G(^XMBS(4.2999,XMINST,5))
- Q
- REQUEUE(XMINST,XMSITE,XMB) ;
- N XMFDA,XMIENS,ZTDTH,ZTIO,ZTDESC,ZTRTN
- S XMFDA(4.29992,XMB("AUDIT IENS"),2)=$E($G(ER("MSG"),$$EZBLD^DIALOG(42192)),1,200) ;Unknown Error
- D FILE^DIE("","XMFDA")
- I XMB("TRIES")+1=$P(XMB("SCR REC"),U,3) D POSTFAIL(XMINST,XMSITE,.XMB)
- D SCRIPT^XMKPR1(XMINST,XMSITE,.XMB) Q:'XMB("SCR IEN")
- S XMIENS=XMINST_","
- S XMFDA(4.2999,XMIENS,43)=XMB("SCR IEN") ; ien of script to be used
- S XMFDA(4.2999,XMIENS,44)=XMB("TRIES") ; xmit tries
- S XMFDA(4.2999,XMIENS,46)=XMB("ITERATIONS") ; xmit iterations
- S XMFDA(4.2999,XMIENS,48)=XMB("IP TRIED") ; IP addresses tried
- S XMFDA(4.2999,XMIENS,51)=XMB("SCR REC") ; script record
- D FILE^DIE("","XMFDA")
- ; XMB("TRIES") starts off at 0 with every script.
- ; Each time the script is retried, XMB("TRIES") is bumped up by 1.
- ; XMB("ITERATIONS") starts off at 0. After a cycle of scripts is tried,
- ; XMB("ITERATIONS") is bumped up by 1 when the cycle is started again.
- ; We start every new cycle after one hour.
- ; We start every new try after one minute
- I XMB("TRIES") D
- . S ZTDTH=$$HADD^XLFDT($H,"","",1) ; New try, add 1 minute
- E I XMB("ITERATIONS"),XMB("SCR IEN")=XMB("FIRST SCRIPT") D
- . S ZTDTH=$$HADD^XLFDT($H,"",1) ; New iteration, add 1 hour
- E S ZTDTH=$H ; First try, new script within same iteration
- S ZTIO=$P(XMB("SCR REC"),U,5)
- S ZTDESC=$$EZBLD^DIALOG(42000.1,XMSITE) ;MailMan: To |1| (requeue)
- ; ("_XMB("ITERATIONS")_","_XMB("SCR IEN")_","_XMB("TRIES")_")"
- S ZTRTN="TASK^XMTDR"
- S ZTREQ=ZTDTH_U_ZTIO_U_ZTDESC_U_ZTRTN
- D DOTRAN^XMC1(42000.2,XMSITE) ;|1| Requeued
- Q
- POSTFAIL(XMINST,XMSITE,XMB) ; Postmaster message on queue failure
- N XMPARM,XMINSTR,XMI,XMJ,XMTRIES,XMFIRST
- K ^TMP("XM",$J)
- S XMINSTR("FROM")="POSTMASTER",XMINSTR("ADDR FLAGS")="R"
- S XMTRIES=$P(XMB("SCR REC"),U,3)
- S XMPARM(1)=XMSITE,XMPARM(2)=XMTRIES
- S XMJ=0
- S XMJ=XMJ+1,^TMP("XM",$J,XMJ,0)=""
- S XMFIRST=$P($G(^XMBS(4.2999,XMINST,6,0)),U,3)-XMTRIES
- S:XMFIRST<0 XMFIRST=0
- S XMI=XMFIRST ; Get tries audit from ^XMBS(4.2999, "XMIT AUDIT" multiple
- F S XMI=$O(^XMBS(4.2999,XMINST,6,XMI)) Q:'XMI S XMJ=XMJ+1,^TMP("XM",$J,XMJ,0)=^(XMI,0)
- S XMJ=XMJ+1,^TMP("XM",$J,XMJ,0)=""
- S XMJ=XMJ+1,^TMP("XM",$J,XMJ,0)=$$EZBLD^DIALOG(42190) ;A transcript of the last delivery attempt follows:
- S XMJ=XMJ+1,^TMP("XM",$J,XMJ,0)=""
- S XMI=0
- F S XMI=$O(^TMP("XMC",XMC("AUDIT"),XMI)) Q:'XMI S XMJ=XMJ+1,^TMP("XM",$J,XMJ,0)=^(XMI,0)
- I XMFIRST'=0 D
- . N XMMAX ; Maximum number of old audit records
- . S XMMAX=100
- . S XMJ=XMJ+1,^TMP("XM",$J,XMJ,0)="**********************************************"
- . S XMJ=XMJ+1,^TMP("XM",$J,XMJ,0)=""
- . I XMFIRST'>XMMAX D
- . . S XMI=0
- . . S XMJ=XMJ+1,^TMP("XM",$J,XMJ,0)=$$EZBLD^DIALOG(42191) ;The following errors occurred in previous attempts:
- . E D
- . . S XMI=XMFIRST-XMMAX
- . . S XMJ=XMJ+1,^TMP("XM",$J,XMJ,0)=$$EZBLD^DIALOG(42191.1,$$FMTE^XLFDT($P(^XMBS(4.2999,XMINST,6,1,0),U,1),5)) ;The errors started on |1|.
- . . S XMJ=XMJ+1,^TMP("XM",$J,XMJ,0)=""
- . . S XMJ=XMJ+1,^TMP("XM",$J,XMJ,0)=$$EZBLD^DIALOG(42191.2,XMMAX) ;The following errors occurred in the previous |1| attempts:
- . ; Get tries audit from ^XMBS(4.2999, "XMIT AUDIT" multiple
- . S XMJ=XMJ+1,^TMP("XM",$J,XMJ,0)=""
- . F S XMI=$O(^XMBS(4.2999,XMINST,6,XMI)) Q:XMI>XMFIRST S XMJ=XMJ+1,^TMP("XM",$J,XMJ,0)=^(XMI,0)
- D TASKBULL^XMXBULL(.5,"XM SEND ERR TRANSMISSION",.XMPARM,"^TMP(""XM"",$J)",.5,.XMINSTR)
- K ^TMP("XM",$J)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXMKPR 7368 printed Jan 18, 2025@03:13:29 Page 2
- XMKPR ;ISC-SF/GMB-Post, remote ;10/09/2002 09:40
- +1 ;;8.0;MailMan;**5,6**;Jun 28, 2002
- +2 ; Replaces ^XMBPOST and the first part of ^XMS1 (ISC-WASH/THM/RWF/CAP)
- +3 ; Schedule a task to deliver remote
- REMOTE(XMZ,XMINST) ; For addresses containing "@"
- +1 NEW XMSITE,XMREC,XMPOLL
- +2 SET XMREC=^DIC(4.2,XMINST,0)
- +3 SET XMSITE=$PIECE(XMREC,U)
- +4 DO PUTMSG^XMXMSGS2(.5,XMINST+1000,XMSITE,XMZ)
- +5 ; S means to start task immediately
- if $PIECE(XMREC,U,2)'["S"
- QUIT
- +6 if '$$TSKEXIST(XMINST)
- DO QUEUE(XMINST,XMSITE)
- +7 QUIT
- TSKEXIST(XMINST,XMTSK) ;Is Task scheduled ? (0=no,ZTSK^$H=pending,ZTSK=running)
- +1 ; Note: ZTSK does not exist when 'playing a script', or for an incoming
- +2 ; transmission.
- +3 if '$GET(XMTSK)
- SET XMTSK=$$GETTSK(XMINST)
- +4 if 'XMTSK
- QUIT 0
- +5 IF $DATA(ZTQUEUED)
- IF $GET(ZTSK)=XMTSK
- QUIT ZTSK
- +6 NEW ZTSK
- +7 SET ZTSK=XMTSK
- +8 DO STAT^%ZTLOAD
- +9 ; "Undefined"
- if ZTSK(1)=0
- QUIT 0
- +10 ; "Active: Pending"
- IF ZTSK(1)=1
- Begin DoDot:1
- +11 ; ZTSK("D")=$H when scheduled
- DO ISQED^%ZTLOAD
- End DoDot:1
- QUIT ZTSK_U_ZTSK("D")
- +12 ; "Active: Running"
- IF ZTSK(1)=2
- QUIT ZTSK
- +13 ;I ZTSK(1)=2 N %1 D L -^DIC(4.2,+$G(XMINST),"XMNETSEND") Q %1
- +14 ;. ; "Active: Running" - This check isn't reliable,
- +15 ;. ; because the lock is not set for incoming, only for outgoing.
- +16 ;. L +^DIC(4.2,+$G(XMINST),"XMNETSEND"):2 ; Is it really running?
- +17 ;. I $T D KILLTSK(XMINST,ZTSK) S %1=0 Q ; Nope
- +18 ;. S %1=ZTSK ; Yep
- +19 ; "Inactive: Finished"
- if ZTSK(1)=3
- QUIT 0
- +20 ; "Inactive: Available"
- IF ZTSK(1)=4
- DO KILLTSK(XMINST,ZTSK)
- QUIT 0
- +21 ; "Interrupted"
- IF ZTSK(1)=5
- DO KILLTSK(XMINST,ZTSK)
- QUIT 0
- +22 QUIT
- GETTSK(XMINST) ;
- +1 ; ensure latest
- LOCK +^XMBS(4.2999,XMINST,3):0
- LOCK -^XMBS(4.2999,XMINST,3)
- +2 QUIT $PIECE($GET(^XMBS(4.2999,XMINST,3)),U,7)
- KILLTSK(XMINST,ZTSK) ;
- +1 DO KILL^%ZTLOAD
- +2 SET $PIECE(^XMBS(4.2999,XMINST,3),U,7)=""
- +3 SET $PIECE(^XMBS(4.2999,XMINST,4),U,2)=$$NOW^XLFDT
- +4 QUIT
- QUEUE(XMINST,XMSITE,XMB,ZTDTH,ZTSK) ;
- +1 ; Was ENQ^XMS1 used by ^XMC2,^XMS5,^XMS5B ***
- +2 ; in:
- +3 ; XMINST domain IEN in domain file
- +4 ; XMSITE domain name
- +5 ; XMB (optional) script choice (default: highest priority script)
- +6 ; ZTDTH (optional) task start time (default: now)
- +7 ; out:
- +8 ; ZTSK task number
- +9 NEW I,XMIENS,XMFDA,ZTIO,ZTDESC,ZTRTN
- +10 IF '$DATA(^XMBS(4.2999,XMINST,0))
- DO STAT^XMTDR(XMINST)
- +11 LOCK +^XMBS(4.2999,XMINST):1
- +12 IF '$GET(XMB("SCR IEN"))
- Begin DoDot:1
- +13 DO XMTCHECK(XMINST,.XMB)
- +14 DO SCRIPT^XMKPR1(XMINST,XMSITE,.XMB)
- End DoDot:1
- if 'XMB("SCR IEN")
- QUIT
- +15 SET ZTIO=$PIECE(XMB("SCR REC"),U,5)
- +16 ; MailMan: To |1|
- SET ZTDESC=$$EZBLD^DIALOG(42000,XMSITE)
- +17 if '$GET(ZTDTH)
- SET ZTDTH=$HOROLOG
- +18 FOR I="XMINST","XMPOLL"
- SET ZTSAVE(I)=""
- +19 SET ZTRTN="TASK^XMTDR"
- +20 DO ^%ZTLOAD
- +21 ; current xmit stats
- SET ^XMBS(4.2999,XMINST,3)=""
- +22 SET $PIECE(^XMBS(4.2999,XMINST,3),U,7)=ZTSK
- +23 SET XMIENS=XMINST_","
- +24 IF 'XMB("TRIES")
- IF 'XMB("ITERATIONS")
- Begin DoDot:1
- +25 ; xmit start date/time
- SET XMFDA(4.2999,XMIENS,41)="@"
- +26 ; xmit finish date/time
- SET XMFDA(4.2999,XMIENS,42)="@"
- +27 ; xmit latest try date/time
- SET XMFDA(4.2999,XMIENS,45)="@"
- +28 ; xmit audit multiple
- KILL ^XMBS(4.2999,XMINST,6)
- End DoDot:1
- +29 ; task number
- SET XMFDA(4.2999,XMIENS,25)=ZTSK
- +30 ; ien of script to be used
- SET XMFDA(4.2999,XMIENS,43)=XMB("SCR IEN")
- +31 ; xmit tries
- SET XMFDA(4.2999,XMIENS,44)=XMB("TRIES")
- +32 ; xmit iterations
- SET XMFDA(4.2999,XMIENS,46)=XMB("ITERATIONS")
- +33 ; ien of first script
- SET XMFDA(4.2999,XMIENS,47)=XMB("FIRST SCRIPT")
- +34 ; IP addresses tried
- SET XMFDA(4.2999,XMIENS,48)=XMB("IP TRIED")
- +35 ; script record
- SET XMFDA(4.2999,XMIENS,51)=XMB("SCR REC")
- +36 DO FILE^DIE("","XMFDA")
- +37 LOCK -^XMBS(4.2999,XMINST)
- +38 QUIT
- XMTCHECK(XMINST,XMB) ;
- +1 NEW XMTREC
- +2 ; ensure latest
- LOCK +^XMBS(4.2999,XMINST,4):0
- LOCK -^XMBS(4.2999,XMINST,4)
- +3 SET XMTREC=$GET(^XMBS(4.2999,XMINST,4))
- +4 if '$PIECE(XMTREC,U,1)!$PIECE(XMTREC,U,2)
- QUIT
- +5 ; Start time, but no finish time.
- +6 ; Previous transmission attempt was aborted. Pick up where we left off.
- +7 SET XMB("SCR IEN")=$PIECE(XMTREC,U,3)
- +8 SET XMB("TRIES")=$PIECE(XMTREC,U,4)
- +9 SET XMB("LAST TRY")=$PIECE(XMTREC,U,5)
- +10 SET XMB("ITERATIONS")=$PIECE(XMTREC,U,6)
- +11 SET XMB("FIRST SCRIPT")=$PIECE(XMTREC,U,7)
- +12 SET XMB("IP TRIED")=$PIECE(XMTREC,U,8)
- +13 SET XMB("SCR REC")=$GET(^XMBS(4.2999,XMINST,5))
- +14 QUIT
- REQUEUE(XMINST,XMSITE,XMB) ;
- +1 NEW XMFDA,XMIENS,ZTDTH,ZTIO,ZTDESC,ZTRTN
- +2 ;Unknown Error
- SET XMFDA(4.29992,XMB("AUDIT IENS"),2)=$EXTRACT($GET(ER("MSG"),$$EZBLD^DIALOG(42192)),1,200)
- +3 DO FILE^DIE("","XMFDA")
- +4 IF XMB("TRIES")+1=$PIECE(XMB("SCR REC"),U,3)
- DO POSTFAIL(XMINST,XMSITE,.XMB)
- +5 DO SCRIPT^XMKPR1(XMINST,XMSITE,.XMB)
- if 'XMB("SCR IEN")
- QUIT
- +6 SET XMIENS=XMINST_","
- +7 ; ien of script to be used
- SET XMFDA(4.2999,XMIENS,43)=XMB("SCR IEN")
- +8 ; xmit tries
- SET XMFDA(4.2999,XMIENS,44)=XMB("TRIES")
- +9 ; xmit iterations
- SET XMFDA(4.2999,XMIENS,46)=XMB("ITERATIONS")
- +10 ; IP addresses tried
- SET XMFDA(4.2999,XMIENS,48)=XMB("IP TRIED")
- +11 ; script record
- SET XMFDA(4.2999,XMIENS,51)=XMB("SCR REC")
- +12 DO FILE^DIE("","XMFDA")
- +13 ; XMB("TRIES") starts off at 0 with every script.
- +14 ; Each time the script is retried, XMB("TRIES") is bumped up by 1.
- +15 ; XMB("ITERATIONS") starts off at 0. After a cycle of scripts is tried,
- +16 ; XMB("ITERATIONS") is bumped up by 1 when the cycle is started again.
- +17 ; We start every new cycle after one hour.
- +18 ; We start every new try after one minute
- +19 IF XMB("TRIES")
- Begin DoDot:1
- +20 ; New try, add 1 minute
- SET ZTDTH=$$HADD^XLFDT($HOROLOG,"","",1)
- End DoDot:1
- +21 IF '$TEST
- IF XMB("ITERATIONS")
- IF XMB("SCR IEN")=XMB("FIRST SCRIPT")
- Begin DoDot:1
- +22 ; New iteration, add 1 hour
- SET ZTDTH=$$HADD^XLFDT($HOROLOG,"",1)
- End DoDot:1
- +23 ; First try, new script within same iteration
- IF '$TEST
- SET ZTDTH=$HOROLOG
- +24 SET ZTIO=$PIECE(XMB("SCR REC"),U,5)
- +25 ;MailMan: To |1| (requeue)
- SET ZTDESC=$$EZBLD^DIALOG(42000.1,XMSITE)
- +26 ; ("_XMB("ITERATIONS")_","_XMB("SCR IEN")_","_XMB("TRIES")_")"
- +27 SET ZTRTN="TASK^XMTDR"
- +28 SET ZTREQ=ZTDTH_U_ZTIO_U_ZTDESC_U_ZTRTN
- +29 ;|1| Requeued
- DO DOTRAN^XMC1(42000.2,XMSITE)
- +30 QUIT
- POSTFAIL(XMINST,XMSITE,XMB) ; Postmaster message on queue failure
- +1 NEW XMPARM,XMINSTR,XMI,XMJ,XMTRIES,XMFIRST
- +2 KILL ^TMP("XM",$JOB)
- +3 SET XMINSTR("FROM")="POSTMASTER"
- SET XMINSTR("ADDR FLAGS")="R"
- +4 SET XMTRIES=$PIECE(XMB("SCR REC"),U,3)
- +5 SET XMPARM(1)=XMSITE
- SET XMPARM(2)=XMTRIES
- +6 SET XMJ=0
- +7 SET XMJ=XMJ+1
- SET ^TMP("XM",$JOB,XMJ,0)=""
- +8 SET XMFIRST=$PIECE($GET(^XMBS(4.2999,XMINST,6,0)),U,3)-XMTRIES
- +9 if XMFIRST<0
- SET XMFIRST=0
- +10 ; Get tries audit from ^XMBS(4.2999, "XMIT AUDIT" multiple
- SET XMI=XMFIRST
- +11 FOR
- SET XMI=$ORDER(^XMBS(4.2999,XMINST,6,XMI))
- if 'XMI
- QUIT
- SET XMJ=XMJ+1
- SET ^TMP("XM",$JOB,XMJ,0)=^(XMI,0)
- +12 SET XMJ=XMJ+1
- SET ^TMP("XM",$JOB,XMJ,0)=""
- +13 ;A transcript of the last delivery attempt follows:
- SET XMJ=XMJ+1
- SET ^TMP("XM",$JOB,XMJ,0)=$$EZBLD^DIALOG(42190)
- +14 SET XMJ=XMJ+1
- SET ^TMP("XM",$JOB,XMJ,0)=""
- +15 SET XMI=0
- +16 FOR
- SET XMI=$ORDER(^TMP("XMC",XMC("AUDIT"),XMI))
- if 'XMI
- QUIT
- SET XMJ=XMJ+1
- SET ^TMP("XM",$JOB,XMJ,0)=^(XMI,0)
- +17 IF XMFIRST'=0
- Begin DoDot:1
- +18 ; Maximum number of old audit records
- NEW XMMAX
- +19 SET XMMAX=100
- +20 SET XMJ=XMJ+1
- SET ^TMP("XM",$JOB,XMJ,0)="**********************************************"
- +21 SET XMJ=XMJ+1
- SET ^TMP("XM",$JOB,XMJ,0)=""
- +22 IF XMFIRST'>XMMAX
- Begin DoDot:2
- +23 SET XMI=0
- +24 ;The following errors occurred in previous attempts:
- SET XMJ=XMJ+1
- SET ^TMP("XM",$JOB,XMJ,0)=$$EZBLD^DIALOG(42191)
- End DoDot:2
- +25 IF '$TEST
- Begin DoDot:2
- +26 SET XMI=XMFIRST-XMMAX
- +27 ;The errors started on |1|.
- SET XMJ=XMJ+1
- SET ^TMP("XM",$JOB,XMJ,0)=$$EZBLD^DIALOG(42191.1,$$FMTE^XLFDT($PIECE(^XMBS(4.2999,XMINST,6,1,0),U,1),5))
- +28 SET XMJ=XMJ+1
- SET ^TMP("XM",$JOB,XMJ,0)=""
- +29 ;The following errors occurred in the previous |1| attempts:
- SET XMJ=XMJ+1
- SET ^TMP("XM",$JOB,XMJ,0)=$$EZBLD^DIALOG(42191.2,XMMAX)
- End DoDot:2
- +30 ; Get tries audit from ^XMBS(4.2999, "XMIT AUDIT" multiple
- +31 SET XMJ=XMJ+1
- SET ^TMP("XM",$JOB,XMJ,0)=""
- +32 FOR
- SET XMI=$ORDER(^XMBS(4.2999,XMINST,6,XMI))
- if XMI>XMFIRST
- QUIT
- SET XMJ=XMJ+1
- SET ^TMP("XM",$JOB,XMJ,0)=^(XMI,0)
- End DoDot:1
- +33 DO TASKBULL^XMXBULL(.5,"XM SEND ERR TRANSMISSION",.XMPARM,"^TMP(""XM"",$J)",.5,.XMINSTR)
- +34 KILL ^TMP("XM",$JOB)
- +35 QUIT