AZAXVL.m

AZAXVL ;IHS/PHXAO/AEF - PRINT VENDOR ADDRESS LIST

 ;;1.0;ANNE'S SPECIAL ROUTINES;;JULY 16, 2004

 ;

EN ;EP -- MAIN ENTRY POINT

 ;

 Q

LOOP ;

 ;----- LOOP THROUGH VENDOR FILE

 ;

 N D0

 S D0=0

 F  S D0=$O(^AUTTVNDR(D0)) Q:'D0  D

 . W !

 . W $P($G(^AUTTVNDR(D0,0)),U)

 . W ?33,$P($G(^AUTTVNDR(D0,11)),U,13)

 . D MADD(D0)

 . W !

 Q

MADD(D0) ;

 ;----- PRINT MAILING ADDRESS

 ;

 N DATA

 ;

 S DATA=$G(^AUTTVNDR(D0,13))

 W ?49,$P(DATA,U,1)

 I $P(DATA,U,10)]"" W !?49,$P(DATA,U,10)

 W !?49,$E($P(DATA,U,2),1,13)

 W ", "

 W $P($G(^DIC(5,+$P(DATA,U,3),0)),U,2)

 W "  "

 W $P(DATA,U,4)

 Q

AZAXVL    ;IHS/PHXAO/AEF - PRINT VENDOR ADDRESS LIST

 +1       ;;1.0;ANNE'S SPECIAL ROUTINES;;JULY 16, 2004

 +2       ;

EN        ;EP -- MAIN ENTRY POINT

 +1       ;

 +2        QUIT 

LOOP      ;

 +1       ;----- LOOP THROUGH VENDOR FILE

 +2       ;

 +3        NEW D0

 +4        SET D0=0

 +5        FOR 

               SET D0=$ORDER(^AUTTVNDR(D0))

               IF 'D0

                   QUIT 

               Begin DoDot:1

 +6                WRITE !

 +7                WRITE $PIECE($GET(^AUTTVNDR(D0,0)),U)

 +8                WRITE ?33,$PIECE($GET(^AUTTVNDR(D0,11)),U,13)

 +9                DO MADD(D0)

 +10               WRITE !

               End DoDot:1

 +11       QUIT 

MADD(D0)  ;

 +1       ;----- PRINT MAILING ADDRESS

 +2       ;

 +3        NEW DATA

 +4       ;

 +5        SET DATA=$GET(^AUTTVNDR(D0,13))

 +6        WRITE ?49,$PIECE(DATA,U,1)

 +7        IF $PIECE(DATA,U,10)]""

               WRITE !?49,$PIECE(DATA,U,10)

 +8        WRITE !?49,$EXTRACT($PIECE(DATA,U,2),1,13)

 +9        WRITE ", "

 +10       WRITE $PIECE($GET(^DIC(5,+$PIECE(DATA,U,3),0)),U,2)

 +11       WRITE "  "

 +12       WRITE $PIECE(DATA,U,4)

 +13       QUIT