PRCFDADD.m

PRCFDADD ;WISC@ALTOONA/CTB-COMPRESS ADDRESS INTO PRINTABLE FORMAT ;10 Sep 89/3:08 PM

V ;;5.1;IFCAP;;Oct 20, 2000

 ;Per VHA Directive 10-93-142, this routine should not be modified.

 ;TAKES ADDRESS IN PRCFA("TMP",X) AND COMPRESSES IT INTO PRINTABLE

 ;ARRAY PRCFA("TMP1",X)

 ;SOURCE ARRAY MUST BE IN FOLLOWING FORMAT

 ;$P(PRCFA("TMP",1),"^",1,6) ADDRESS LINES

 ;$P(PRCFA("TMP",2),"^",1,3)=CITY_"^"_STATE_"^"_ZIP

 ;$P(PRCFA("TMP",3),"^",1,3)= OTHER PRINTABLE LINES

 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

 S PRCFA("TMP1",J)="" S:$P(PRCFA("TMP",2),"^")]"" PRCFA("TMP1",J)=$P(PRCFA("TMP",2),"^")_", "

 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

 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

 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

 K PRCFA("TMP") K:$D(PRCFOUT) PRCFOUT,PRCFA("TMP1")

 Q

ADD ;IDENTIFIER FOR FILE 440

 ;REQUIRES Z8 TO CONTAIN NODE 7 OF VENDOR FILE

 W !,?10,"PAYMENT ADDRESS:  ",$P(Z8,"^",3)

 I $P(Z8,"^",4)]"" W !?28,$P(Z8,"^",4)

 I $P(Z8,"^",5)]"" W !?28,$P(Z8,"^",5)

 I $P(Z8,"^",6)]"" W !?28,$P(Z8,"^",6)

 W !?28,$P(Z8,"^",7),", ",$S($D(^DIC(5,+$P(Z8,U,8),0)):$P(^(0),"^",2),1:"")," ",$P(Z8,U,9)

 K Z8 W ! Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PRCFDADD   1433     printed  Apr 09, 2024@21:05:58                                                                                                                                                                                                    Page 2

PRCFDADD  ;WISC@ALTOONA/CTB-COMPRESS ADDRESS INTO PRINTABLE FORMAT ;10 Sep 89/3:08 PM

V         ;;5.1;IFCAP;;Oct 20, 2000

 +1       ;Per VHA Directive 10-93-142, this routine should not be modified.

 +2       ;TAKES ADDRESS IN PRCFA("TMP",X) AND COMPRESSES IT INTO PRINTABLE

 +3       ;ARRAY PRCFA("TMP1",X)

 +4       ;SOURCE ARRAY MUST BE IN FOLLOWING FORMAT

 +5       ;$P(PRCFA("TMP",1),"^",1,6) ADDRESS LINES

 +6       ;$P(PRCFA("TMP",2),"^",1,3)=CITY_"^"_STATE_"^"_ZIP

 +7       ;$P(PRCFA("TMP",3),"^",1,3)= OTHER PRINTABLE LINES

 +8        NEW I,J,X

           SET J=1

           FOR I=1:1:6

               IF $PIECE(PRCFA("TMP",1),"^",I)]""

                   SET PRCFA("TMP1",J)=$PIECE(PRCFA("TMP",1),"^",I)

                   SET J=J+1

 +9        SET PRCFA("TMP1",J)=""

           if $PIECE(PRCFA("TMP",2),"^")]""

               SET PRCFA("TMP1",J)=$PIECE(PRCFA("TMP",2),"^")_", "

 +10       IF +$PIECE(PRCFA("TMP",2),"^",2)>0

               SET PRCFA("TMP1",J)=PRCFA("TMP1",J)_$PIECE(^DIC(5,$PIECE(PRCFA("TMP",2),"^",2),0),"^",2)_"  "_$PIECE(PRCFA("TMP",2),"^",3)

               SET J=J+1

 +11       IF $DATA(PRCFA("TMP",3))

               FOR I=1:1:3

                   IF $PIECE(PRCFA("TMP",3),"^",I)]""

                       SET PRCFA("TMP1",J)=$PIECE(PRCFA("TMP",3),"^",I)

                       SET J=J+1

 +12       IF $DATA(PRCFOUT)

               FOR I=0:0

                   SET I=$ORDER(PRCFA("TMP1",I))

                   if 'I

                       QUIT 

                   SET X="S "_PRCFOUT_I_")=PRCFA(""TMP1"",I)"

                   XECUTE X

 +13       KILL PRCFA("TMP")

           if $DATA(PRCFOUT)

               KILL PRCFOUT,PRCFA("TMP1")

 +14       QUIT 

ADD       ;IDENTIFIER FOR FILE 440

 +1       ;REQUIRES Z8 TO CONTAIN NODE 7 OF VENDOR FILE

 +2        WRITE !,?10,"PAYMENT ADDRESS:  ",$PIECE(Z8,"^",3)

 +3        IF $PIECE(Z8,"^",4)]""

               WRITE !?28,$PIECE(Z8,"^",4)

 +4        IF $PIECE(Z8,"^",5)]""

               WRITE !?28,$PIECE(Z8,"^",5)

 +5        IF $PIECE(Z8,"^",6)]""

               WRITE !?28,$PIECE(Z8,"^",6)

 +6        WRITE !?28,$PIECE(Z8,"^",7),", ",$SELECT($DATA(^DIC(5,+$PIECE(Z8,U,8),0)):$PIECE(^(0),"^",2),1:"")," ",$PIECE(Z8,U,9)

 +7        KILL Z8

           WRITE !

           QUIT