- 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 Jan 18, 2025@03:13:30 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