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

XMKPR1.m

Go to the documentation of this file.
  1. XMKPR1 ;ISC-SF/GMB-^XMKPR (cont.) ;09/06/2002 09:11
  1. ;;8.0;MailMan;**3**;Jun 28, 2002
  1. ; Reference to ^XTV(8989.3 - IA #3749
  1. SCRIPT(XMINST,XMSITE,XMB,XMOKTYPE) ; Get first/next Transmission Script
  1. ; XMINST (in) Pointer to domain file
  1. ; XMSITE (in) Name (.01 field) of domain pointed to by XMINST
  1. ; XMOKTYPE (in) array of script types which are acceptable
  1. ; XMB (out) XMB("SCR IEN") Pointer to script within domain
  1. ; XMB("FIRST SCRIPT") Pointer to first script tried
  1. ; XMB("SCR REC") Script zero node
  1. ; XMB("ITERATIONS") Number of cycles of scripts
  1. ; XMB("TRIES") Number of tries with one script
  1. ; XMB("IP TRIED") IP addresses tried so far
  1. ; If no transmission scripts are prioritized use old data/defaults.
  1. ; If failure, then XMB("SCR IEN")=0
  1. ; XMPRI Priority
  1. ; XMTYPE Script type
  1. ; XMDEFALT Default script settings
  1. ; XMSLIST Array of possible scripts
  1. ; XMSFIRST First possible script
  1. ; XMSNEXT Next possible script
  1. N XMSLIST,XMSFIRST,XMSNEXT,XMPRI,XMTYPE,I,XMREC,XMIEN
  1. I $D(XMB("SCR REC")),(XMB("TRIES")+1)<$P(XMB("SCR REC"),U,3) D Q
  1. . S XMB("TRIES")=XMB("TRIES")+1
  1. . D DEFAULT(XMINST,XMSITE,.XMB) ; refresh the script
  1. . ;I $G(ER)=25,$$USEDNS D NEXTIP(XMSITE,.XMB)
  1. . I $G(ER)=25!($P(XMB("SCR REC"),U,6)=""),$$USEDNS D NEXTIP(XMSITE,.XMB)
  1. ; We are here because the # attempts made is more than the max allowed,
  1. ; or because we are about to make our first attempt.
  1. ; In either case, we need a (next) script to try.
  1. I '$D(XMOKTYPE) S (XMOKTYPE("SMTP"),XMOKTYPE("TCPCHAN"),XMOKTYPE("NONE"))=""
  1. S XMIEN=0
  1. F S XMIEN=$O(^DIC(4.2,XMINST,1,XMIEN)) Q:XMIEN'>0 D
  1. . S XMREC=$G(^DIC(4.2,XMINST,1,XMIEN,0))
  1. . Q:$P(XMREC,U,7) ; Out of service
  1. . S XMTYPE=$P(XMREC,U,4)
  1. . S:XMTYPE="" XMTYPE="NONE"
  1. . Q:'$D(XMOKTYPE(XMTYPE))
  1. . S XMPRI=$P(XMREC,U,2) S:XMPRI="" XMPRI=9999
  1. . S XMSLIST(XMPRI,XMIEN)=XMIEN
  1. I '$D(XMSLIST) S XMB("SCR IEN")=0 Q
  1. S XMIEN=+$G(XMB("SCR IEN"))
  1. S XMSFIRST="XMSLIST"
  1. S XMSFIRST=$Q(@XMSFIRST)
  1. I XMIEN=0!('$D(^DIC(4.2,XMINST,1,XMIEN,0))) D ; First attempt, so take the first script
  1. . S XMB("SCR IEN")=@XMSFIRST
  1. . S XMB("FIRST SCRIPT")=XMB("SCR IEN")
  1. . S XMB("ITERATIONS")=0
  1. E D ; Try the next script after the one we just tried.
  1. . ; If that was the last one, go back to the first.
  1. . S XMPRI=$P(^DIC(4.2,XMINST,1,XMIEN,0),U,2) S:XMPRI="" XMPRI=9999
  1. . S XMSNEXT="XMSLIST(XMPRI,XMIEN)"
  1. . S XMSNEXT=$Q(@XMSNEXT)
  1. . I XMSNEXT="" D
  1. . . S XMB("SCR IEN")=@XMSFIRST
  1. . . S XMB("ITERATIONS")=XMB("ITERATIONS")+1
  1. . E S XMB("SCR IEN")=@XMSNEXT
  1. D INITSCR(XMINST,XMSITE,.XMB)
  1. Q
  1. NEXTIP(XMSITE,XMB) ;
  1. I ","_$G(XMB("IP TRIED"))_","[(","_$P(XMB("SCR REC"),U,6)_",")!($P(XMB("SCR REC"),U,6)="") D
  1. . N XMIP
  1. . S XMIP=$$NEXTIPF^XMKPRD(XMSITE,$G(XMB("IP TRIED")))
  1. . I XMIP'="" S $P(XMB("SCR REC"),U,6)=XMIP
  1. I $P(XMB("SCR REC"),U,6)="" S $P(XMB("SCR REC"),U,6)=$P($G(XMB("IP TRIED")),",",1)
  1. I $G(XMB("IP TRIED"))="" S XMB("IP TRIED")=$P(XMB("SCR REC"),U,6) Q
  1. I ","_XMB("IP TRIED")_","[(","_$P(XMB("SCR REC"),U,6)_",") Q
  1. S XMB("IP TRIED")=XMB("IP TRIED")_","_$P(XMB("SCR REC"),U,6)
  1. Q
  1. INITSCR(XMINST,XMSITE,XMB) ;
  1. S:'$D(XMB("ITERATIONS")) XMB("ITERATIONS")=0
  1. S XMB("TRIES")=0
  1. S:'$D(XMB("FIRST SCRIPT")) XMB("FIRST SCRIPT")=XMB("SCR IEN")
  1. S XMB("IP TRIED")=""
  1. D DEFAULT(XMINST,XMSITE,.XMB)
  1. S:XMB("IP TRIED")="" XMB("IP TRIED")=$P(XMB("SCR REC"),U,6)
  1. Q
  1. DEFAULT(XMINST,XMSITE,XMB) ;
  1. N XMDEFALT,I
  1. ; Pickup data from selected script
  1. S XMB("SCR REC")=^DIC(4.2,XMINST,1,XMB("SCR IEN"),0)
  1. ;I $P(XMB("SCR REC"),U,6)="",$$USEDNS D NEXTIP(XMSITE,.XMB)
  1. ; Create defaults
  1. S XMDEFALT=^DIC(4.2,XMINST,0)
  1. ; Piece 17=Physical link device; Piece 12=Host IP Address;
  1. ; $P(^XMB(1,1,"NETWORK"),U,1) is the number of attempts before failure
  1. 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)
  1. ;
  1. I $P(XMDEFALT,U,5)="" D
  1. . N XMIO
  1. . S XMIO=$P($G(^XMB(1,1,"NETWORK")),U,5)
  1. . I XMIO'="" S $P(XMDEFALT,U,5)=XMIO
  1. ;Use defaults if no data in transmission script fields
  1. F I=3:1:$L(XMDEFALT,U) S:$P(XMB("SCR REC"),U,I)="" $P(XMB("SCR REC"),U,I)=$P(XMDEFALT,U,I)
  1. Q
  1. USEDNS() ; Function returns 1 if we can use DNS; 0 if we can't.
  1. Q:'$P($G(^XMB(1,1,"NETWORK")),U,2) 0 ; Site says don't use DNS
  1. Q:$T(^XLFNSLK)="" 0 ; DNS API is not present
  1. Q:$P($G(^XTV(8989.3,1,"DNS")),U,1)="" 0 ; No DNS IP address
  1. Q 1