| 1 | XMKPR1 ;ISC-SF/GMB-^XMKPR (cont.) ;09/06/2002  09:11
 | 
|---|
| 2 |  ;;8.0;MailMan;**3**;Jun 28, 2002
 | 
|---|
| 3 |  ; Reference to ^XTV(8989.3 - IA #3749
 | 
|---|
| 4 | SCRIPT(XMINST,XMSITE,XMB,XMOKTYPE) ; Get first/next Transmission Script
 | 
|---|
| 5 |  ; XMINST   (in)  Pointer to domain file
 | 
|---|
| 6 |  ; XMSITE   (in)  Name (.01 field) of domain pointed to by XMINST
 | 
|---|
| 7 |  ; XMOKTYPE (in)  array of script types which are acceptable
 | 
|---|
| 8 |  ; XMB      (out) XMB("SCR IEN")      Pointer to script within domain
 | 
|---|
| 9 |  ;                XMB("FIRST SCRIPT") Pointer to first script tried
 | 
|---|
| 10 |  ;                XMB("SCR REC")      Script zero node
 | 
|---|
| 11 |  ;                XMB("ITERATIONS")   Number of cycles of scripts
 | 
|---|
| 12 |  ;                XMB("TRIES")        Number of tries with one script
 | 
|---|
| 13 |  ;                XMB("IP TRIED")     IP addresses tried so far
 | 
|---|
| 14 |  ; If no transmission scripts are prioritized use old data/defaults.
 | 
|---|
| 15 |  ; If failure, then XMB("SCR IEN")=0
 | 
|---|
| 16 |  ; XMPRI    Priority
 | 
|---|
| 17 |  ; XMTYPE   Script type
 | 
|---|
| 18 |  ; XMDEFALT Default script settings
 | 
|---|
| 19 |  ; XMSLIST  Array of possible scripts
 | 
|---|
| 20 |  ; XMSFIRST First possible script
 | 
|---|
| 21 |  ; XMSNEXT  Next possible script
 | 
|---|
| 22 |  N XMSLIST,XMSFIRST,XMSNEXT,XMPRI,XMTYPE,I,XMREC,XMIEN
 | 
|---|
| 23 |  I $D(XMB("SCR REC")),(XMB("TRIES")+1)<$P(XMB("SCR REC"),U,3) D  Q
 | 
|---|
| 24 |  . S XMB("TRIES")=XMB("TRIES")+1
 | 
|---|
| 25 |  . D DEFAULT(XMINST,XMSITE,.XMB) ; refresh the script
 | 
|---|
| 26 |  . ;I $G(ER)=25,$$USEDNS D NEXTIP(XMSITE,.XMB)
 | 
|---|
| 27 |  . I $G(ER)=25!($P(XMB("SCR REC"),U,6)=""),$$USEDNS D NEXTIP(XMSITE,.XMB)
 | 
|---|
| 28 |  ; We are here because the # attempts made is more than the max allowed,
 | 
|---|
| 29 |  ; or because we are about to make our first attempt.
 | 
|---|
| 30 |  ; In either case, we need a (next) script to try.
 | 
|---|
| 31 |  I '$D(XMOKTYPE) S (XMOKTYPE("SMTP"),XMOKTYPE("TCPCHAN"),XMOKTYPE("NONE"))=""
 | 
|---|
| 32 |  S XMIEN=0
 | 
|---|
| 33 |  F  S XMIEN=$O(^DIC(4.2,XMINST,1,XMIEN)) Q:XMIEN'>0  D
 | 
|---|
| 34 |  . S XMREC=$G(^DIC(4.2,XMINST,1,XMIEN,0))
 | 
|---|
| 35 |  . Q:$P(XMREC,U,7)  ; Out of service
 | 
|---|
| 36 |  . S XMTYPE=$P(XMREC,U,4)
 | 
|---|
| 37 |  . S:XMTYPE="" XMTYPE="NONE"
 | 
|---|
| 38 |  . Q:'$D(XMOKTYPE(XMTYPE))
 | 
|---|
| 39 |  . S XMPRI=$P(XMREC,U,2) S:XMPRI="" XMPRI=9999
 | 
|---|
| 40 |  . S XMSLIST(XMPRI,XMIEN)=XMIEN
 | 
|---|
| 41 |  I '$D(XMSLIST) S XMB("SCR IEN")=0 Q
 | 
|---|
| 42 |  S XMIEN=+$G(XMB("SCR IEN"))
 | 
|---|
| 43 |  S XMSFIRST="XMSLIST"
 | 
|---|
| 44 |  S XMSFIRST=$Q(@XMSFIRST)
 | 
|---|
| 45 |  I XMIEN=0!('$D(^DIC(4.2,XMINST,1,XMIEN,0))) D  ; First attempt, so take the first script
 | 
|---|
| 46 |  . S XMB("SCR IEN")=@XMSFIRST
 | 
|---|
| 47 |  . S XMB("FIRST SCRIPT")=XMB("SCR IEN")
 | 
|---|
| 48 |  . S XMB("ITERATIONS")=0
 | 
|---|
| 49 |  E  D  ; Try the next script after the one we just tried.
 | 
|---|
| 50 |  . ; If that was the last one, go back to the first.
 | 
|---|
| 51 |  . S XMPRI=$P(^DIC(4.2,XMINST,1,XMIEN,0),U,2) S:XMPRI="" XMPRI=9999
 | 
|---|
| 52 |  . S XMSNEXT="XMSLIST(XMPRI,XMIEN)"
 | 
|---|
| 53 |  . S XMSNEXT=$Q(@XMSNEXT)
 | 
|---|
| 54 |  . I XMSNEXT="" D
 | 
|---|
| 55 |  . . S XMB("SCR IEN")=@XMSFIRST
 | 
|---|
| 56 |  . . S XMB("ITERATIONS")=XMB("ITERATIONS")+1
 | 
|---|
| 57 |  . E  S XMB("SCR IEN")=@XMSNEXT
 | 
|---|
| 58 |  D INITSCR(XMINST,XMSITE,.XMB)
 | 
|---|
| 59 |  Q
 | 
|---|
| 60 | NEXTIP(XMSITE,XMB) ;
 | 
|---|
| 61 |  I ","_$G(XMB("IP TRIED"))_","[(","_$P(XMB("SCR REC"),U,6)_",")!($P(XMB("SCR REC"),U,6)="") D
 | 
|---|
| 62 |  . N XMIP
 | 
|---|
| 63 |  . S XMIP=$$NEXTIPF^XMKPRD(XMSITE,$G(XMB("IP TRIED")))
 | 
|---|
| 64 |  . I XMIP'="" S $P(XMB("SCR REC"),U,6)=XMIP
 | 
|---|
| 65 |  I $P(XMB("SCR REC"),U,6)="" S $P(XMB("SCR REC"),U,6)=$P($G(XMB("IP TRIED")),",",1)
 | 
|---|
| 66 |  I $G(XMB("IP TRIED"))="" S XMB("IP TRIED")=$P(XMB("SCR REC"),U,6) Q
 | 
|---|
| 67 |  I ","_XMB("IP TRIED")_","[(","_$P(XMB("SCR REC"),U,6)_",") Q
 | 
|---|
| 68 |  S XMB("IP TRIED")=XMB("IP TRIED")_","_$P(XMB("SCR REC"),U,6)
 | 
|---|
| 69 |  Q
 | 
|---|
| 70 | INITSCR(XMINST,XMSITE,XMB) ;
 | 
|---|
| 71 |  S:'$D(XMB("ITERATIONS")) XMB("ITERATIONS")=0
 | 
|---|
| 72 |  S XMB("TRIES")=0
 | 
|---|
| 73 |  S:'$D(XMB("FIRST SCRIPT")) XMB("FIRST SCRIPT")=XMB("SCR IEN")
 | 
|---|
| 74 |  S XMB("IP TRIED")=""
 | 
|---|
| 75 |  D DEFAULT(XMINST,XMSITE,.XMB)
 | 
|---|
| 76 |  S:XMB("IP TRIED")="" XMB("IP TRIED")=$P(XMB("SCR REC"),U,6)
 | 
|---|
| 77 |  Q
 | 
|---|
| 78 | DEFAULT(XMINST,XMSITE,XMB) ;
 | 
|---|
| 79 |  N XMDEFALT,I
 | 
|---|
| 80 |  ; Pickup data from selected script
 | 
|---|
| 81 |  S XMB("SCR REC")=^DIC(4.2,XMINST,1,XMB("SCR IEN"),0)
 | 
|---|
| 82 |  ;I $P(XMB("SCR REC"),U,6)="",$$USEDNS D NEXTIP(XMSITE,.XMB)
 | 
|---|
| 83 |  ; Create defaults
 | 
|---|
| 84 |  S XMDEFALT=^DIC(4.2,XMINST,0)
 | 
|---|
| 85 |  ; Piece 17=Physical link device; Piece 12=Host IP Address;
 | 
|---|
| 86 |  ; $P(^XMB(1,1,"NETWORK"),U,1) is the number of attempts before failure
 | 
|---|
| 87 |  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)
 | 
|---|
| 88 |  ;
 | 
|---|
| 89 |  I $P(XMDEFALT,U,5)="" D
 | 
|---|
| 90 |  . N XMIO
 | 
|---|
| 91 |  . S XMIO=$P($G(^XMB(1,1,"NETWORK")),U,5)
 | 
|---|
| 92 |  . I XMIO'="" S $P(XMDEFALT,U,5)=XMIO
 | 
|---|
| 93 |  ;Use defaults if no data in transmission script fields
 | 
|---|
| 94 |  F I=3:1:$L(XMDEFALT,U) S:$P(XMB("SCR REC"),U,I)="" $P(XMB("SCR REC"),U,I)=$P(XMDEFALT,U,I)
 | 
|---|
| 95 |  Q
 | 
|---|
| 96 | USEDNS() ; Function returns 1 if we can use DNS; 0 if we can't.
 | 
|---|
| 97 |  Q:'$P($G(^XMB(1,1,"NETWORK")),U,2) 0  ; Site says don't use DNS
 | 
|---|
| 98 |  Q:$T(^XLFNSLK)="" 0  ; DNS API is not present
 | 
|---|
| 99 |  Q:$P($G(^XTV(8989.3,1,"DNS")),U,1)="" 0  ; No DNS IP address
 | 
|---|
| 100 |  Q 1
 | 
|---|