VAUTL.m

VAUTL ;ALB/MRL - UTILITY FUNCTIONS; 13 APR 89

 ;;5.3;Registration;;Aug 13, 1993

 ;

FA ;Format Address

 ;REQUIRED VARIABLES = VADN-Address node; VAD(1)=Start with Piece;

 ;VAD(2)=Build array starting where

 ;RETURNS 'VADD' Array containing formated address information

 ;OPTIONAL = VAEXT-Numeric number of characters to extract

 ;

 F I=VAD(1):1:VAD(1)+2 I $P(VADN,"^",I)]"" S VADD(VAD(2))=$P(VADN,"^",I),VAD(2)=VAD(2)+2

 I VAD(2)=1 S VADD(1)="NO STREET",VAD(2)=VAD(2)+2

 S J=$S($D(^DIC(5,+$P(VADN,"^",VAD(1)+4),0)):$P(^(0),"^",2),1:"NO STATE"),J(1)=$P(VADN,"^",VAD(1)+3) S:J(1)']"" J(1)="NO CITY" S J(2)=$P(VADN,"^",VAD(1)+5) S:J(2)']"" J(2)="NO ZIP"

 S VADD(VAD(2))=J(1)_","_J_" "_J(2) K I,J,VAD,VADN I $S('$D(VAEXT):1,'VAEXT:1,1:0) Q

 ;

 S I=0 F I1=0:0 S I=$O(VADD(I)) Q:I'>0  S VADD(I)=$E(VADD(I),1,VAEXT)

 K I,I1,VAEXT Q

 ;

PA ;Print Address

 S I=0 F I1=0:0 S I=$O(VADD(I)) Q:I'>0  W:(I#2) ! S I2=$S((I#2):0,1:40) W ?I2,VADD(I)

 K I,I1,I2,VADD Q

VAUTL     ;ALB/MRL - UTILITY FUNCTIONS; 13 APR 89

 +1       ;;5.3;Registration;;Aug 13, 1993

 +2       ;

FA        ;Format Address

 +1       ;REQUIRED VARIABLES = VADN-Address node; VAD(1)=Start with Piece;

 +2       ;VAD(2)=Build array starting where

 +3       ;RETURNS 'VADD' Array containing formated address information

 +4       ;OPTIONAL = VAEXT-Numeric number of characters to extract

 +5       ;

 +6        FOR I=VAD(1):1:VAD(1)+2

               IF $PIECE(VADN,"^",I)]""

                   SET VADD(VAD(2))=$PIECE(VADN,"^",I)

                   SET VAD(2)=VAD(2)+2

 +7        IF VAD(2)=1

               SET VADD(1)="NO STREET"

               SET VAD(2)=VAD(2)+2

 +8        SET J=$SELECT($DATA(^DIC(5,+$PIECE(VADN,"^",VAD(1)+4),0)):$PIECE(^(0),"^",2),1:"NO STATE")

           SET J(1)=$PIECE(VADN,"^",VAD(1)+3)

           IF J(1)']""

               SET J(1)="NO CITY"

           SET J(2)=$PIECE(VADN,"^",VAD(1)+5)

           IF J(2)']""

               SET J(2)="NO ZIP"

 +9        SET VADD(VAD(2))=J(1)_","_J_" "_J(2)

           KILL I,J,VAD,VADN

           IF $SELECT('$DATA(VAEXT):1,'VAEXT:1,1:0)

               QUIT 

 +10      ;

 +11       SET I=0

           FOR I1=0:0

               SET I=$ORDER(VADD(I))

               IF I'>0

                   QUIT 

               SET VADD(I)=$EXTRACT(VADD(I),1,VAEXT)

 +12       KILL I,I1,VAEXT

           QUIT 

 +13      ;

PA        ;Print Address

 +1        SET I=0

           FOR I1=0:0

               SET I=$ORDER(VADD(I))

               IF I'>0

                   QUIT 

               IF (I#2)

                   WRITE !

               SET I2=$SELECT((I#2):0,1:40)

               WRITE ?I2,VADD(I)

 +2        KILL I,I1,I2,VADD

           QUIT