source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCFDADD.m@ 1006

Last change on this file since 1006 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.4 KB
Line 
1PRCFDADD ;WISC@ALTOONA/CTB-COMPRESS ADDRESS INTO PRINTABLE FORMAT ;10 Sep 89/3:08 PM
2V ;;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
17ADD ;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
Note: See TracBrowser for help on using the repository browser.