DG53551P.m

DG53551P ;ALB/PHH - 2004 MEANS TEST THRESHOLDS ;12/10/03

 ;;5.3;Registration;**551,1015**;Aug 13, 1993;Build 21

 ;

 ; This routine will upload the 2004 means test thresholds onto your

 ; system.

 ;

EN ; Enter values distributed in VHA DIRECTIVE 2003-069, MEANS TEST AND

 ; GEOGRAPHIC-BASED MEANS TEST THRESHOLDS FOR CALENDAR YEAR 2004.

 ;

 N DA,DIE,DIC,DINUM,DR,I,X,Y,EXST

 S EXST=0

 D BMES^XPDUTL(">>>Means Test Thresholds for 2004 being installed...")

 I $D(^DG(43,1,"MT",3040000)) D

 .D BMES^XPDUTL(" ...Entry exists for income year 2003, entry being deleted")

 .D MES^XPDUTL("     and replaced with nationally released thresholds.")

 .S DIK="^DG(43,1,""MT"",",DA=3040000,DA(1)=1

 .D ^DIK,IX1^DIK

 .K DA,D0,DIK

 K DO

 S DIC="^DG(43,1,""MT"","

 S DIC(0)="L"

 S DA(1)=1

 S (DINUM,X)=3040000

 D FILE^DICN

 S DA=+Y

 ;

 I +Y'=3040000 D  Q

 . D BMES^XPDUTL("   ...Problem encountered adding 2004 thresholds.  Please try")

 . D MES^XPDUTL("      again or contact the CIO Field Office for assistance.")

 ;

 D MES^XPDUTL("")

 S DIE=DIC,DR=""

 F I=1:1 S X=$P($T(DATA+I),";;",2) Q:X="QUIT"  D   ; build dr string

 . S DR=DR_+X_"////"_$P(X,"^",2)_";"

 . D MES^XPDUTL("   "_$P(X,"^",3)_" set to $"_$FN($P(X,"^",2),","))

 D ^DIE

 Q

 ;

 ;

DATA ; lines to stuff in values (field////value)

 ;;2^25162^MT COPAY EXEMPT VET INCOME

 ;;3^5035^MT COPAY EXEMPT 1ST DEP INCOME

 ;;4^1688^MT COPAY EXEMPT INCOME PER DEP

 ;;8^80000^THRESHOLD PROPERTY

 ;;17^7950^CHILD INCOME EXCLUSION

 ;;QUIT

 Q

DG53551P  ;ALB/PHH - 2004 MEANS TEST THRESHOLDS ;12/10/03

 +1       ;;5.3;Registration;**551,1015**;Aug 13, 1993;Build 21

 +2       ;

 +3       ; This routine will upload the 2004 means test thresholds onto your

 +4       ; system.

 +5       ;

EN        ; Enter values distributed in VHA DIRECTIVE 2003-069, MEANS TEST AND

 +1       ; GEOGRAPHIC-BASED MEANS TEST THRESHOLDS FOR CALENDAR YEAR 2004.

 +2       ;

 +3        NEW DA,DIE,DIC,DINUM,DR,I,X,Y,EXST

 +4        SET EXST=0

 +5        DO BMES^XPDUTL(">>>Means Test Thresholds for 2004 being installed...")

 +6        IF $DATA(^DG(43,1,"MT",3040000))

               Begin DoDot:1

 +7                DO BMES^XPDUTL(" ...Entry exists for income year 2003, entry being deleted")

 +8                DO MES^XPDUTL("     and replaced with nationally released thresholds.")

 +9                SET DIK="^DG(43,1,""MT"","

                   SET DA=3040000

                   SET DA(1)=1

 +10               DO ^DIK

                   DO IX1^DIK

 +11               KILL DA,D0,DIK

               End DoDot:1

 +12       KILL DO

 +13       SET DIC="^DG(43,1,""MT"","

 +14       SET DIC(0)="L"

 +15       SET DA(1)=1

 +16       SET (DINUM,X)=3040000

 +17       DO FILE^DICN

 +18       SET DA=+Y

 +19      ;

 +20       IF +Y'=3040000

               Begin DoDot:1

 +21               DO BMES^XPDUTL("   ...Problem encountered adding 2004 thresholds.  Please try")

 +22               DO MES^XPDUTL("      again or contact the CIO Field Office for assistance.")

               End DoDot:1

               QUIT 

 +23      ;

 +24       DO MES^XPDUTL("")

 +25       SET DIE=DIC

           SET DR=""

 +26      ; build dr string

           FOR I=1:1

               SET X=$PIECE($TEXT(DATA+I),";;",2)

               IF X="QUIT"

                   QUIT 

               Begin DoDot:1

 +27               SET DR=DR_+X_"////"_$PIECE(X,"^",2)_";"

 +28               DO MES^XPDUTL("   "_$PIECE(X,"^",3)_" set to $"_$FNUMBER($PIECE(X,"^",2),","))

               End DoDot:1

 +29       DO ^DIE

 +30       QUIT 

 +31      ;

 +32      ;

DATA      ; lines to stuff in values (field////value)

 +1       ;;2^25162^MT COPAY EXEMPT VET INCOME

 +2       ;;3^5035^MT COPAY EXEMPT 1ST DEP INCOME

 +3       ;;4^1688^MT COPAY EXEMPT INCOME PER DEP

 +4       ;;8^80000^THRESHOLD PROPERTY

 +5       ;;17^7950^CHILD INCOME EXCLUSION

 +6       ;;QUIT

 +7        QUIT