DG53150P.m

DG53150P ;ALB/SEK - 1998 MEANS TEST THRESHOLD UPDATE ROUTINE; 02 December 1997

 ;;5.3;Registration;**150**;Aug 13, 1993

 ;

 ; This routine will upload the 1998 means test thresholds onto your system.

 ;

EN ; enter values distributed by Roscoe Butler.  VHA Directive soon to be released.

 N DA,DIE,DIC,DINUM,X,Y

 D BMES^XPDUTL(">>>Means Test Thesholds for 1998 being installed...")

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

 . D BMES^XPDUTL("   ...Thresholds already exist for 1998...nothing done.")

 ;

 S DIC="^DG(43,1,""MT"",",DIC(0)="L"

 S (DINUM,X)=2980000

 D FILE^DICN

 S DA=+Y

 ;

 I +Y'=2980000 D  Q

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

 . D MES^XPDUTL("      again or contact your IRM 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^22064^CAT A VET INCOME

 ;;3^4416^CAT A FIRST DEPENDENT INCOME

 ;;4^1476^CAT A INCOME PER DEPENDENT

 ;;8^50000^THRESHOLD PROPERTY

 ;;17^6950^CHILD INCOME EXCLUSION

 ;;QUIT

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---DG53150P   1263     printed  Apr 09, 2024@22:00:51                                                                                                                                                                                                    Page 2

DG53150P  ;ALB/SEK - 1998 MEANS TEST THRESHOLD UPDATE ROUTINE; 02 December 1997

 +1       ;;5.3;Registration;**150**;Aug 13, 1993

 +2       ;

 +3       ; This routine will upload the 1998 means test thresholds onto your system.

 +4       ;

EN        ; enter values distributed by Roscoe Butler.  VHA Directive soon to be released.

 +1        NEW DA,DIE,DIC,DINUM,X,Y

 +2        DO BMES^XPDUTL(">>>Means Test Thesholds for 1998 being installed...")

 +3        IF $DATA(^DG(43,1,"MT",2980000))

               Begin DoDot:1

 +4                DO BMES^XPDUTL("   ...Thresholds already exist for 1998...nothing done.")

               End DoDot:1

               QUIT 

 +5       ;

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

           SET DIC(0)="L"

 +7        SET (DINUM,X)=2980000

 +8        DO FILE^DICN

 +9        SET DA=+Y

 +10      ;

 +11       IF +Y'=2980000

               Begin DoDot:1

 +12               DO BMES^XPDUTL("   ...Problem encountered adding 1998 thresholds.  Please try")

 +13               DO MES^XPDUTL("      again or contact your IRM Field Office for assistance.")

               End DoDot:1

               QUIT 

 +14      ;

 +15       DO MES^XPDUTL("")

 +16       SET DIE=DIC

           SET DR=""

 +17      ; build dr string

           FOR I=1:1

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

               if X="QUIT"

                   QUIT 

               Begin DoDot:1

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

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

               End DoDot:1

 +20       DO ^DIE

 +21       QUIT 

 +22      ;

 +23      ;

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

 +1       ;;2^22064^CAT A VET INCOME

 +2       ;;3^4416^CAT A FIRST DEPENDENT INCOME

 +3       ;;4^1476^CAT A INCOME PER DEPENDENT

 +4       ;;8^50000^THRESHOLD PROPERTY

 +5       ;;17^6950^CHILD INCOME EXCLUSION

 +6       ;;QUIT