BZXFIXAD.m

BZXFIXAD ;IHS/PHXAO/AEF - FIX BAD ADDRESSES IN VA PATIENT FILE

 ;;1.0;ANNE'S SPECIAL ROUTINES;;JUNE 22, 2004

 ;

 ;

DESC ;

 ;;THIS ROUTINE LOOPS THROUGH THE VA PATIENT FILE #2 AND FIXES BAD

 ;;ADDRESSES IN THE MAILING ADDRESS-STREET FIELD #.111. TO PREVENT

 ;;REJECTS BY AHCCCS.

 ;;

 ;;$$END

 ;

EN ;EP -- MAIN ENTRY POINT

 ;

 N BZXD0

 ;

 S BZXD0=0

 F  S BZXD0=$O(^DPT(BZXD0)) Q:'BZXD0  D

 . D ONE(BZXD0)

 ;

 W !!,"DONE"

 Q

ONE(BZXD0) ;

 ;----- FIX ONE ENTRY

 ;

 N BZXADD,DA,DIE,DR,X,Y

 ;

 S BZXADD=$P($G(^DPT(BZXD0,.11)),U)

 Q:BZXADD'?1"BOX "1.N

 ;

 W !,BZXD0,?12,$P($G(^DPT(BZXD0,0)),U)

 W !,?12,BZXADD

 ;

 I $E(BZXADD,1,3)="BOX" D

 . S BZXADD="PO "_BZXADD

 ;

 S DA=BZXD0

 S DIE="^DPT("

 S DR=".111///^S X=BZXADD"

 D ^DIE

 ;

 W !?12,BZXADD

 W !

 Q

BZXFIXAD  ;IHS/PHXAO/AEF - FIX BAD ADDRESSES IN VA PATIENT FILE

 +1       ;;1.0;ANNE'S SPECIAL ROUTINES;;JUNE 22, 2004

 +2       ;

 +3       ;

DESC      ;

 +1       ;;THIS ROUTINE LOOPS THROUGH THE VA PATIENT FILE #2 AND FIXES BAD

 +2       ;;ADDRESSES IN THE MAILING ADDRESS-STREET FIELD #.111. TO PREVENT

 +3       ;;REJECTS BY AHCCCS.

 +4       ;;

 +5       ;;$$END

 +6       ;

EN        ;EP -- MAIN ENTRY POINT

 +1       ;

 +2        NEW BZXD0

 +3       ;

 +4        SET BZXD0=0

 +5        FOR 

               SET BZXD0=$ORDER(^DPT(BZXD0))

               IF 'BZXD0

                   QUIT 

               Begin DoDot:1

 +6                DO ONE(BZXD0)

               End DoDot:1

 +7       ;

 +8        WRITE !!,"DONE"

 +9        QUIT 

ONE(BZXD0) ;

 +1       ;----- FIX ONE ENTRY

 +2       ;

 +3        NEW BZXADD,DA,DIE,DR,X,Y

 +4       ;

 +5        SET BZXADD=$PIECE($GET(^DPT(BZXD0,.11)),U)

 +6        IF BZXADD'?1"BOX "1.N

               QUIT 

 +7       ;

 +8        WRITE !,BZXD0,?12,$PIECE($GET(^DPT(BZXD0,0)),U)

 +9        WRITE !,?12,BZXADD

 +10      ;

 +11       IF $EXTRACT(BZXADD,1,3)="BOX"

               Begin DoDot:1

 +12               SET BZXADD="PO "_BZXADD

               End DoDot:1

 +13      ;

 +14       SET DA=BZXD0

 +15       SET DIE="^DPT("

 +16       SET DR=".111///^S X=BZXADD"

 +17       DO ^DIE

 +18      ;

 +19       WRITE !?12,BZXADD

 +20       WRITE !

 +21       QUIT