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 Dec 13, 2024@03:04:01 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
