- 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 Mar 13, 2025@22:08:38 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
