VATRAN.m

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 ---VATRAN   1515     printed  Apr 09, 2024@21:55:17                                                                                                                                                                                                      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