VATRAN ;ALB/MTC - Establish VADATS Transmission Variables ; 5/25/88 @ 12
;;5.3;Registration;;Aug 13, 1993
;Pass in VATNAME=name (.01 field) as in File 407.7
;Returns VATERR=null if no error
; VATERR=1 or 2 or 3 can't process (see error messages ERR^VATRAN)
; if VATERR=null, then VAT array is returned as follows:
; VAT(1),VAT(2),...=Receiving User(s),format: 'receiving user"@"domain mail router'
; VAT("F")=MailMan Message Length - Fixed record
; VAT("V")=MailMan Message Length - Variable record
K VAT,VATR S VATERR=1 G ERR:'$D(VATNAME) S VATN=$S('$D(^VAT(407.7,"B",VATNAME)):0,1:$O(^VAT(407.7,"B",VATNAME,0))) G ERR:'VATN S W=$S($D(^VAT(407.7,+VATN,0)):^(0),1:0) G ERR:W']"" S VAT("F")=$P(W,U,2),VAT("V")=$P(W,U,3),VATERR=2
I $D(^VAT(407.7,VATN,"R")) F V=0:0 S V=$O(^VAT(407.7,VATN,"R",V)) Q:'V I $P(^(V,0),"^",3) S W=^(0),VATR(V)=$P(W,"^")_"^"_$P(W,"^",2)
G ERR:'$D(VATR) S Q=0
F V=0:0 S V=$O(VATR(V)) Q:'V S W=$S($D(^DIC(4.2,+$P(VATR(V),U,2),0)):^(0),1:"") I W]"" S VAT(V)=$P(VATR(V),U)_"@"_$P(W,U) I $P(W,U)["Q-" S Q=Q+1
I Q>1 S VATERR=4 G ERR
S VATERR=""
Q K VATN,VATR,V,W Q
ERR S V=$P($T(@VATERR),";;",2) W !,V,*7 K VAT G Q
1 ;;No such Transmission Router Name in TRANSMISSION ROUTERS File
2 ;;Transmission is turned OFF for receiving domains in TRANSMISSION ROUTERS file
3 ;;You do not hold the key to transmit to the domain (obsolete error)
4 ;;Can not transmit to 2 different QUEUEs in Austin, correct the Transmission file
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVATRAN 1515 printed Dec 13, 2024@03:03:58 Page 2
VATRAN ;ALB/MTC - Establish VADATS Transmission Variables ; 5/25/88 @ 12
+1 ;;5.3;Registration;;Aug 13, 1993
+2 ;Pass in VATNAME=name (.01 field) as in File 407.7
+3 ;Returns VATERR=null if no error
+4 ; VATERR=1 or 2 or 3 can't process (see error messages ERR^VATRAN)
+5 ; if VATERR=null, then VAT array is returned as follows:
+6 ; VAT(1),VAT(2),...=Receiving User(s),format: 'receiving user"@"domain mail router'
+7 ; VAT("F")=MailMan Message Length - Fixed record
+8 ; VAT("V")=MailMan Message Length - Variable record
+9 KILL VAT,VATR
SET VATERR=1
if '$DATA(VATNAME)
GOTO ERR
SET VATN=$SELECT('$DATA(^VAT(407.7,"B",VATNAME)):0,1:$ORDER(^VAT(407.7,"B",VATNAME,0)))
if 'VATN
GOTO ERR
SET W=$SELECT($DATA(^VAT(407.7,+VATN,0)):^(0),1:0)
if W']""
GOTO ERR
SET VAT("F")=$PIECE(W,U,2)
SET VAT("V")=$PIECE(W,U,3)
SET VATERR=2
+10 IF $DATA(^VAT(407.7,VATN,"R"))
FOR V=0:0
SET V=$ORDER(^VAT(407.7,VATN,"R",V))
if 'V
QUIT
IF $PIECE(^(V,0),"^",3)
SET W=^(0)
SET VATR(V)=$PIECE(W,"^")_"^"_$PIECE(W,"^",2)
+11 if '$DATA(VATR)
GOTO ERR
SET Q=0
+12 FOR V=0:0
SET V=$ORDER(VATR(V))
if 'V
QUIT
SET W=$SELECT($DATA(^DIC(4.2,+$PIECE(VATR(V),U,2),0)):^(0),1:"")
IF W]""
SET VAT(V)=$PIECE(VATR(V),U)_"@"_$PIECE(W,U)
IF $PIECE(W,U)["Q-"
SET Q=Q+1
+13 IF Q>1
SET VATERR=4
GOTO ERR
+14 SET VATERR=""
Q KILL VATN,VATR,V,W
QUIT
ERR SET V=$PIECE($TEXT(@VATERR),";;",2)
WRITE !,V,*7
KILL VAT
GOTO Q
1 ;;No such Transmission Router Name in TRANSMISSION ROUTERS File
2 ;;Transmission is turned OFF for receiving domains in TRANSMISSION ROUTERS file
3 ;;You do not hold the key to transmit to the domain (obsolete error)
4 ;;Can not transmit to 2 different QUEUEs in Austin, correct the Transmission file
