XMKPR1 ;ISC-SF/GMB-^XMKPR (cont.) ;09/06/2002 09:11
;;8.0;MailMan;**3**;Jun 28, 2002
; Reference to ^XTV(8989.3 - IA #3749
SCRIPT(XMINST,XMSITE,XMB,XMOKTYPE) ; Get first/next Transmission Script
; XMINST (in) Pointer to domain file
; XMSITE (in) Name (.01 field) of domain pointed to by XMINST
; XMOKTYPE (in) array of script types which are acceptable
; XMB (out) XMB("SCR IEN") Pointer to script within domain
; XMB("FIRST SCRIPT") Pointer to first script tried
; XMB("SCR REC") Script zero node
; XMB("ITERATIONS") Number of cycles of scripts
; XMB("TRIES") Number of tries with one script
; XMB("IP TRIED") IP addresses tried so far
; If no transmission scripts are prioritized use old data/defaults.
; If failure, then XMB("SCR IEN")=0
; XMPRI Priority
; XMTYPE Script type
; XMDEFALT Default script settings
; XMSLIST Array of possible scripts
; XMSFIRST First possible script
; XMSNEXT Next possible script
N XMSLIST,XMSFIRST,XMSNEXT,XMPRI,XMTYPE,I,XMREC,XMIEN
I $D(XMB("SCR REC")),(XMB("TRIES")+1)<$P(XMB("SCR REC"),U,3) D Q
. S XMB("TRIES")=XMB("TRIES")+1
. D DEFAULT(XMINST,XMSITE,.XMB) ; refresh the script
. ;I $G(ER)=25,$$USEDNS D NEXTIP(XMSITE,.XMB)
. I $G(ER)=25!($P(XMB("SCR REC"),U,6)=""),$$USEDNS D NEXTIP(XMSITE,.XMB)
; We are here because the # attempts made is more than the max allowed,
; or because we are about to make our first attempt.
; In either case, we need a (next) script to try.
I '$D(XMOKTYPE) S (XMOKTYPE("SMTP"),XMOKTYPE("TCPCHAN"),XMOKTYPE("NONE"))=""
S XMIEN=0
F S XMIEN=$O(^DIC(4.2,XMINST,1,XMIEN)) Q:XMIEN'>0 D
. S XMREC=$G(^DIC(4.2,XMINST,1,XMIEN,0))
. Q:$P(XMREC,U,7) ; Out of service
. S XMTYPE=$P(XMREC,U,4)
. S:XMTYPE="" XMTYPE="NONE"
. Q:'$D(XMOKTYPE(XMTYPE))
. S XMPRI=$P(XMREC,U,2) S:XMPRI="" XMPRI=9999
. S XMSLIST(XMPRI,XMIEN)=XMIEN
I '$D(XMSLIST) S XMB("SCR IEN")=0 Q
S XMIEN=+$G(XMB("SCR IEN"))
S XMSFIRST="XMSLIST"
S XMSFIRST=$Q(@XMSFIRST)
I XMIEN=0!('$D(^DIC(4.2,XMINST,1,XMIEN,0))) D ; First attempt, so take the first script
. S XMB("SCR IEN")=@XMSFIRST
. S XMB("FIRST SCRIPT")=XMB("SCR IEN")
. S XMB("ITERATIONS")=0
E D ; Try the next script after the one we just tried.
. ; If that was the last one, go back to the first.
. S XMPRI=$P(^DIC(4.2,XMINST,1,XMIEN,0),U,2) S:XMPRI="" XMPRI=9999
. S XMSNEXT="XMSLIST(XMPRI,XMIEN)"
. S XMSNEXT=$Q(@XMSNEXT)
. I XMSNEXT="" D
. . S XMB("SCR IEN")=@XMSFIRST
. . S XMB("ITERATIONS")=XMB("ITERATIONS")+1
. E S XMB("SCR IEN")=@XMSNEXT
D INITSCR(XMINST,XMSITE,.XMB)
Q
NEXTIP(XMSITE,XMB) ;
I ","_$G(XMB("IP TRIED"))_","[(","_$P(XMB("SCR REC"),U,6)_",")!($P(XMB("SCR REC"),U,6)="") D
. N XMIP
. S XMIP=$$NEXTIPF^XMKPRD(XMSITE,$G(XMB("IP TRIED")))
. I XMIP'="" S $P(XMB("SCR REC"),U,6)=XMIP
I $P(XMB("SCR REC"),U,6)="" S $P(XMB("SCR REC"),U,6)=$P($G(XMB("IP TRIED")),",",1)
I $G(XMB("IP TRIED"))="" S XMB("IP TRIED")=$P(XMB("SCR REC"),U,6) Q
I ","_XMB("IP TRIED")_","[(","_$P(XMB("SCR REC"),U,6)_",") Q
S XMB("IP TRIED")=XMB("IP TRIED")_","_$P(XMB("SCR REC"),U,6)
Q
INITSCR(XMINST,XMSITE,XMB) ;
S:'$D(XMB("ITERATIONS")) XMB("ITERATIONS")=0
S XMB("TRIES")=0
S:'$D(XMB("FIRST SCRIPT")) XMB("FIRST SCRIPT")=XMB("SCR IEN")
S XMB("IP TRIED")=""
D DEFAULT(XMINST,XMSITE,.XMB)
S:XMB("IP TRIED")="" XMB("IP TRIED")=$P(XMB("SCR REC"),U,6)
Q
DEFAULT(XMINST,XMSITE,XMB) ;
N XMDEFALT,I
; Pickup data from selected script
S XMB("SCR REC")=^DIC(4.2,XMINST,1,XMB("SCR IEN"),0)
;I $P(XMB("SCR REC"),U,6)="",$$USEDNS D NEXTIP(XMSITE,.XMB)
; Create defaults
S XMDEFALT=^DIC(4.2,XMINST,0)
; Piece 17=Physical link device; Piece 12=Host IP Address;
; $P(^XMB(1,1,"NETWORK"),U,1) is the number of attempts before failure
S XMDEFALT=$P(XMDEFALT,U)_"^0^"_$S(+$G(^XMB(1,1,"NETWORK")):+^("NETWORK"),1:10)_"^SMTP^"_$P(XMDEFALT,U,17)_U_$P(XMDEFALT,U,12)
;
I $P(XMDEFALT,U,5)="" D
. N XMIO
. S XMIO=$P($G(^XMB(1,1,"NETWORK")),U,5)
. I XMIO'="" S $P(XMDEFALT,U,5)=XMIO
;Use defaults if no data in transmission script fields
F I=3:1:$L(XMDEFALT,U) S:$P(XMB("SCR REC"),U,I)="" $P(XMB("SCR REC"),U,I)=$P(XMDEFALT,U,I)
Q
USEDNS() ; Function returns 1 if we can use DNS; 0 if we can't.
Q:'$P($G(^XMB(1,1,"NETWORK")),U,2) 0 ; Site says don't use DNS
Q:$T(^XLFNSLK)="" 0 ; DNS API is not present
Q:$P($G(^XTV(8989.3,1,"DNS")),U,1)="" 0 ; No DNS IP address
Q 1
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXMKPR1 4537 printed Dec 13, 2024@02:12:29 Page 2
XMKPR1 ;ISC-SF/GMB-^XMKPR (cont.) ;09/06/2002 09:11
+1 ;;8.0;MailMan;**3**;Jun 28, 2002
+2 ; Reference to ^XTV(8989.3 - IA #3749
SCRIPT(XMINST,XMSITE,XMB,XMOKTYPE) ; Get first/next Transmission Script
+1 ; XMINST (in) Pointer to domain file
+2 ; XMSITE (in) Name (.01 field) of domain pointed to by XMINST
+3 ; XMOKTYPE (in) array of script types which are acceptable
+4 ; XMB (out) XMB("SCR IEN") Pointer to script within domain
+5 ; XMB("FIRST SCRIPT") Pointer to first script tried
+6 ; XMB("SCR REC") Script zero node
+7 ; XMB("ITERATIONS") Number of cycles of scripts
+8 ; XMB("TRIES") Number of tries with one script
+9 ; XMB("IP TRIED") IP addresses tried so far
+10 ; If no transmission scripts are prioritized use old data/defaults.
+11 ; If failure, then XMB("SCR IEN")=0
+12 ; XMPRI Priority
+13 ; XMTYPE Script type
+14 ; XMDEFALT Default script settings
+15 ; XMSLIST Array of possible scripts
+16 ; XMSFIRST First possible script
+17 ; XMSNEXT Next possible script
+18 NEW XMSLIST,XMSFIRST,XMSNEXT,XMPRI,XMTYPE,I,XMREC,XMIEN
+19 IF $DATA(XMB("SCR REC"))
IF (XMB("TRIES")+1)<$PIECE(XMB("SCR REC"),U,3)
Begin DoDot:1
+20 SET XMB("TRIES")=XMB("TRIES")+1
+21 ; refresh the script
DO DEFAULT(XMINST,XMSITE,.XMB)
+22 ;I $G(ER)=25,$$USEDNS D NEXTIP(XMSITE,.XMB)
+23 IF $GET(ER)=25!($PIECE(XMB("SCR REC"),U,6)="")
IF $$USEDNS
DO NEXTIP(XMSITE,.XMB)
End DoDot:1
QUIT
+24 ; We are here because the # attempts made is more than the max allowed,
+25 ; or because we are about to make our first attempt.
+26 ; In either case, we need a (next) script to try.
+27 IF '$DATA(XMOKTYPE)
SET (XMOKTYPE("SMTP"),XMOKTYPE("TCPCHAN"),XMOKTYPE("NONE"))=""
+28 SET XMIEN=0
+29 FOR
SET XMIEN=$ORDER(^DIC(4.2,XMINST,1,XMIEN))
if XMIEN'>0
QUIT
Begin DoDot:1
+30 SET XMREC=$GET(^DIC(4.2,XMINST,1,XMIEN,0))
+31 ; Out of service
if $PIECE(XMREC,U,7)
QUIT
+32 SET XMTYPE=$PIECE(XMREC,U,4)
+33 if XMTYPE=""
SET XMTYPE="NONE"
+34 if '$DATA(XMOKTYPE(XMTYPE))
QUIT
+35 SET XMPRI=$PIECE(XMREC,U,2)
if XMPRI=""
SET XMPRI=9999
+36 SET XMSLIST(XMPRI,XMIEN)=XMIEN
End DoDot:1
+37 IF '$DATA(XMSLIST)
SET XMB("SCR IEN")=0
QUIT
+38 SET XMIEN=+$GET(XMB("SCR IEN"))
+39 SET XMSFIRST="XMSLIST"
+40 SET XMSFIRST=$QUERY(@XMSFIRST)
+41 ; First attempt, so take the first script
IF XMIEN=0!('$DATA(^DIC(4.2,XMINST,1,XMIEN,0)))
Begin DoDot:1
+42 SET XMB("SCR IEN")=@XMSFIRST
+43 SET XMB("FIRST SCRIPT")=XMB("SCR IEN")
+44 SET XMB("ITERATIONS")=0
End DoDot:1
+45 ; Try the next script after the one we just tried.
IF '$TEST
Begin DoDot:1
+46 ; If that was the last one, go back to the first.
+47 SET XMPRI=$PIECE(^DIC(4.2,XMINST,1,XMIEN,0),U,2)
if XMPRI=""
SET XMPRI=9999
+48 SET XMSNEXT="XMSLIST(XMPRI,XMIEN)"
+49 SET XMSNEXT=$QUERY(@XMSNEXT)
+50 IF XMSNEXT=""
Begin DoDot:2
+51 SET XMB("SCR IEN")=@XMSFIRST
+52 SET XMB("ITERATIONS")=XMB("ITERATIONS")+1
End DoDot:2
+53 IF '$TEST
SET XMB("SCR IEN")=@XMSNEXT
End DoDot:1
+54 DO INITSCR(XMINST,XMSITE,.XMB)
+55 QUIT
NEXTIP(XMSITE,XMB) ;
+1 IF ","_$GET(XMB("IP TRIED"))_","[(","_$PIECE(XMB("SCR REC"),U,6)_",")!($PIECE(XMB("SCR REC"),U,6)="")
Begin DoDot:1
+2 NEW XMIP
+3 SET XMIP=$$NEXTIPF^XMKPRD(XMSITE,$GET(XMB("IP TRIED")))
+4 IF XMIP'=""
SET $PIECE(XMB("SCR REC"),U,6)=XMIP
End DoDot:1
+5 IF $PIECE(XMB("SCR REC"),U,6)=""
SET $PIECE(XMB("SCR REC"),U,6)=$PIECE($GET(XMB("IP TRIED")),",",1)
+6 IF $GET(XMB("IP TRIED"))=""
SET XMB("IP TRIED")=$PIECE(XMB("SCR REC"),U,6)
QUIT
+7 IF ","_XMB("IP TRIED")_","[(","_$PIECE(XMB("SCR REC"),U,6)_",")
QUIT
+8 SET XMB("IP TRIED")=XMB("IP TRIED")_","_$PIECE(XMB("SCR REC"),U,6)
+9 QUIT
INITSCR(XMINST,XMSITE,XMB) ;
+1 if '$DATA(XMB("ITERATIONS"))
SET XMB("ITERATIONS")=0
+2 SET XMB("TRIES")=0
+3 if '$DATA(XMB("FIRST SCRIPT"))
SET XMB("FIRST SCRIPT")=XMB("SCR IEN")
+4 SET XMB("IP TRIED")=""
+5 DO DEFAULT(XMINST,XMSITE,.XMB)
+6 if XMB("IP TRIED")=""
SET XMB("IP TRIED")=$PIECE(XMB("SCR REC"),U,6)
+7 QUIT
DEFAULT(XMINST,XMSITE,XMB) ;
+1 NEW XMDEFALT,I
+2 ; Pickup data from selected script
+3 SET XMB("SCR REC")=^DIC(4.2,XMINST,1,XMB("SCR IEN"),0)
+4 ;I $P(XMB("SCR REC"),U,6)="",$$USEDNS D NEXTIP(XMSITE,.XMB)
+5 ; Create defaults
+6 SET XMDEFALT=^DIC(4.2,XMINST,0)
+7 ; Piece 17=Physical link device; Piece 12=Host IP Address;
+8 ; $P(^XMB(1,1,"NETWORK"),U,1) is the number of attempts before failure
+9 SET XMDEFALT=$PIECE(XMDEFALT,U)_"^0^"_$SELECT(+$GET(^XMB(1,1,"NETWORK")):+^("NETWORK"),1:10)_"^SMTP^"_$PIECE(XMDEFALT,U,17)_U_$PIECE(XMDEFALT,U,12)
+10 ;
+11 IF $PIECE(XMDEFALT,U,5)=""
Begin DoDot:1
+12 NEW XMIO
+13 SET XMIO=$PIECE($GET(^XMB(1,1,"NETWORK")),U,5)
+14 IF XMIO'=""
SET $PIECE(XMDEFALT,U,5)=XMIO
End DoDot:1
+15 ;Use defaults if no data in transmission script fields
+16 FOR I=3:1:$LENGTH(XMDEFALT,U)
if $PIECE(XMB("SCR REC"),U,I)=""
SET $PIECE(XMB("SCR REC"),U,I)=$PIECE(XMDEFALT,U,I)
+17 QUIT
USEDNS() ; Function returns 1 if we can use DNS; 0 if we can't.
+1 ; Site says don't use DNS
if '$PIECE($GET(^XMB(1,1,"NETWORK")),U,2)
QUIT 0
+2 ; DNS API is not present
if $TEXT(^XLFNSLK)=""
QUIT 0
+3 ; No DNS IP address
if $PIECE($GET(^XTV(8989.3,1,"DNS")),U,1)=""
QUIT 0
+4 QUIT 1
