- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAUTL 969 printed Mar 13, 2025@22:08:41 Page 2
- 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
