| [613] | 1 | PRCFDADD ;WISC@ALTOONA/CTB-COMPRESS ADDRESS INTO PRINTABLE FORMAT ;10 Sep 89/3:08 PM
|
|---|
| 2 | V ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;TAKES ADDRESS IN PRCFA("TMP",X) AND COMPRESSES IT INTO PRINTABLE
|
|---|
| 5 | ;ARRAY PRCFA("TMP1",X)
|
|---|
| 6 | ;SOURCE ARRAY MUST BE IN FOLLOWING FORMAT
|
|---|
| 7 | ;$P(PRCFA("TMP",1),"^",1,6) ADDRESS LINES
|
|---|
| 8 | ;$P(PRCFA("TMP",2),"^",1,3)=CITY_"^"_STATE_"^"_ZIP
|
|---|
| 9 | ;$P(PRCFA("TMP",3),"^",1,3)= OTHER PRINTABLE LINES
|
|---|
| 10 | N I,J,X S J=1 F I=1:1:6 I $P(PRCFA("TMP",1),"^",I)]"" S PRCFA("TMP1",J)=$P(PRCFA("TMP",1),"^",I),J=J+1
|
|---|
| 11 | S PRCFA("TMP1",J)="" S:$P(PRCFA("TMP",2),"^")]"" PRCFA("TMP1",J)=$P(PRCFA("TMP",2),"^")_", "
|
|---|
| 12 | I +$P(PRCFA("TMP",2),"^",2)>0 S PRCFA("TMP1",J)=PRCFA("TMP1",J)_$P(^DIC(5,$P(PRCFA("TMP",2),"^",2),0),"^",2)_" "_$P(PRCFA("TMP",2),"^",3),J=J+1
|
|---|
| 13 | I $D(PRCFA("TMP",3)) F I=1:1:3 I $P(PRCFA("TMP",3),"^",I)]"" S PRCFA("TMP1",J)=$P(PRCFA("TMP",3),"^",I),J=J+1
|
|---|
| 14 | I $D(PRCFOUT) F I=0:0 S I=$O(PRCFA("TMP1",I)) Q:'I S X="S "_PRCFOUT_I_")=PRCFA(""TMP1"",I)" X X
|
|---|
| 15 | K PRCFA("TMP") K:$D(PRCFOUT) PRCFOUT,PRCFA("TMP1")
|
|---|
| 16 | Q
|
|---|
| 17 | ADD ;IDENTIFIER FOR FILE 440
|
|---|
| 18 | ;REQUIRES Z8 TO CONTAIN NODE 7 OF VENDOR FILE
|
|---|
| 19 | W !,?10,"PAYMENT ADDRESS: ",$P(Z8,"^",3)
|
|---|
| 20 | I $P(Z8,"^",4)]"" W !?28,$P(Z8,"^",4)
|
|---|
| 21 | I $P(Z8,"^",5)]"" W !?28,$P(Z8,"^",5)
|
|---|
| 22 | I $P(Z8,"^",6)]"" W !?28,$P(Z8,"^",6)
|
|---|
| 23 | W !?28,$P(Z8,"^",7),", ",$S($D(^DIC(5,+$P(Z8,U,8),0)):$P(^(0),"^",2),1:"")," ",$P(Z8,U,9)
|
|---|
| 24 | K Z8 W ! Q
|
|---|
