- DG53768P ;ALB/PHH - 2007 MEANS TEST THRESHOLDS ;11/27/2007
- ;;5.3;Registration;**768**;Aug 13, 1993;Build 1
- ;
- ; This routine will upload the 2008 Means Test Thresholds and
- ; Maximum Annual Pension Rates onto your system.
- ;
- EN ; Entry point for post-install
- D MT
- D MAPR
- Q
- ;
- MT ; Update Means Test Thresholds
- N DA,DIE,DIC,DINUM,DR,I,X,Y,EXST
- S EXST=0
- D BMES^XPDUTL(">>>Means Test Thresholds for 2008 being installed...")
- I $D(^DG(43,1,"MT",3080000)) D
- .D BMES^XPDUTL(" ...Entry exists for income year 2007, entry being deleted")
- .D MES^XPDUTL(" and replaced with nationally released thresholds.")
- .S DIK="^DG(43,1,""MT"",",DA=3080000,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)=3080000
- D FILE^DICN
- S DA=+Y
- ;
- I +Y'=3080000 D Q
- . D BMES^XPDUTL(" ...Problem encountered adding 2008 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^28429^MT COPAY EXEMPT VET INCOME
- ;;3^5688^MT COPAY EXEMPT 1ST DEP INCOME
- ;;4^1909^MT COPAY EXEMPT INCOME PER DEP
- ;;8^80000^THRESHOLD PROPERTY
- ;;17^8950^CHILD INCOME EXCLUSION
- ;;QUIT
- Q
- ;
- MAPR ; Update Maximum Annual Pension Rates
- ;
- D BMES^XPDUTL(">>>Setting Maximum Annual Pension Rate Parameters...")
- ;
- ;set MAPR rate parameter to 5(%)
- D SETPARM("DGMT MAPR GLOBAL RATE",2007,5)
- ;
- ;set MAPR max values
- D SETPARM("DGMT MAPR 0 DEPENDENTS",2007,11181)
- D SETPARM("DGMT MAPR 1 DEPENDENTS",2007,14643)
- D SETPARM("DGMT MAPR N DEPENDENTS",2007,1909)
- Q
- ;
- SETPARM(DGPARM,DGINST,DGVALU) ;set PACKAGE entity parameters
- ;
- ; DBIA: #2263 SUPPORTED PARAMETER TOOL ENTRY POINTS
- ;
- ; Input:
- ; DGPARM - PARAMETER DEFINITION name
- ; DGINST - parameter instance
- ; DGVALU - parameter value
- ;
- ; Output:
- ; None
- ;
- N DGERR
- ;
- D EN^XPAR("PKG",DGPARM,DGINST,DGVALU,.DGERR)
- I $G(DGERR) D Q
- .D MES^XPDUTL(DGPARM_" parameter, instance "_DGINST_", FAILED! ("_DGVALU_")")
- ;
- I '$G(DGERR) D
- .I DGPARM="DGMT MAPR GLOBAL RATE" D
- ..D MES^XPDUTL(" "_DGPARM_" parameter, instance "_DGINST_", set to "_DGVALU_"%.")
- .I DGPARM'="DGMT MAPR GLOBAL RATE" D
- ..D MES^XPDUTL(" "_DGPARM_" parameter, instance "_DGINST_", set to $"_$FN(DGVALU,",")_".")
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDG53768P 2603 printed Jan 18, 2025@03:39:27 Page 2
- DG53768P ;ALB/PHH - 2007 MEANS TEST THRESHOLDS ;11/27/2007
- +1 ;;5.3;Registration;**768**;Aug 13, 1993;Build 1
- +2 ;
- +3 ; This routine will upload the 2008 Means Test Thresholds and
- +4 ; Maximum Annual Pension Rates onto your system.
- +5 ;
- EN ; Entry point for post-install
- +1 DO MT
- +2 DO MAPR
- +3 QUIT
- +4 ;
- MT ; Update Means Test Thresholds
- +1 NEW DA,DIE,DIC,DINUM,DR,I,X,Y,EXST
- +2 SET EXST=0
- +3 DO BMES^XPDUTL(">>>Means Test Thresholds for 2008 being installed...")
- +4 IF $DATA(^DG(43,1,"MT",3080000))
- Begin DoDot:1
- +5 DO BMES^XPDUTL(" ...Entry exists for income year 2007, entry being deleted")
- +6 DO MES^XPDUTL(" and replaced with nationally released thresholds.")
- +7 SET DIK="^DG(43,1,""MT"","
- SET DA=3080000
- SET DA(1)=1
- +8 DO ^DIK
- DO IX1^DIK
- +9 KILL DA,D0,DIK
- End DoDot:1
- +10 KILL DO
- +11 SET DIC="^DG(43,1,""MT"","
- +12 SET DIC(0)="L"
- +13 SET DA(1)=1
- +14 SET (DINUM,X)=3080000
- +15 DO FILE^DICN
- +16 SET DA=+Y
- +17 ;
- +18 IF +Y'=3080000
- Begin DoDot:1
- +19 DO BMES^XPDUTL(" ...Problem encountered adding 2008 thresholds. Please try")
- +20 DO MES^XPDUTL(" again or contact the CIO Field Office for assistance.")
- End DoDot:1
- QUIT
- +21 ;
- +22 DO MES^XPDUTL("")
- +23 SET DIE=DIC
- SET DR=""
- +24 ; build dr string
- FOR I=1:1
- SET X=$PIECE($TEXT(DATA+I),";;",2)
- if X="QUIT"
- QUIT
- Begin DoDot:1
- +25 SET DR=DR_+X_"////"_$PIECE(X,"^",2)_";"
- +26 DO MES^XPDUTL(" "_$PIECE(X,"^",3)_" set to $"_$FNUMBER($PIECE(X,"^",2),","))
- End DoDot:1
- +27 DO ^DIE
- +28 QUIT
- +29 ;
- DATA ; lines to stuff in values (field////value)
- +1 ;;2^28429^MT COPAY EXEMPT VET INCOME
- +2 ;;3^5688^MT COPAY EXEMPT 1ST DEP INCOME
- +3 ;;4^1909^MT COPAY EXEMPT INCOME PER DEP
- +4 ;;8^80000^THRESHOLD PROPERTY
- +5 ;;17^8950^CHILD INCOME EXCLUSION
- +6 ;;QUIT
- +7 QUIT
- +8 ;
- MAPR ; Update Maximum Annual Pension Rates
- +1 ;
- +2 DO BMES^XPDUTL(">>>Setting Maximum Annual Pension Rate Parameters...")
- +3 ;
- +4 ;set MAPR rate parameter to 5(%)
- +5 DO SETPARM("DGMT MAPR GLOBAL RATE",2007,5)
- +6 ;
- +7 ;set MAPR max values
- +8 DO SETPARM("DGMT MAPR 0 DEPENDENTS",2007,11181)
- +9 DO SETPARM("DGMT MAPR 1 DEPENDENTS",2007,14643)
- +10 DO SETPARM("DGMT MAPR N DEPENDENTS",2007,1909)
- +11 QUIT
- +12 ;
- SETPARM(DGPARM,DGINST,DGVALU) ;set PACKAGE entity parameters
- +1 ;
- +2 ; DBIA: #2263 SUPPORTED PARAMETER TOOL ENTRY POINTS
- +3 ;
- +4 ; Input:
- +5 ; DGPARM - PARAMETER DEFINITION name
- +6 ; DGINST - parameter instance
- +7 ; DGVALU - parameter value
- +8 ;
- +9 ; Output:
- +10 ; None
- +11 ;
- +12 NEW DGERR
- +13 ;
- +14 DO EN^XPAR("PKG",DGPARM,DGINST,DGVALU,.DGERR)
- +15 IF $GET(DGERR)
- Begin DoDot:1
- +16 DO MES^XPDUTL(DGPARM_" parameter, instance "_DGINST_", FAILED! ("_DGVALU_")")
- End DoDot:1
- QUIT
- +17 ;
- +18 IF '$GET(DGERR)
- Begin DoDot:1
- +19 IF DGPARM="DGMT MAPR GLOBAL RATE"
- Begin DoDot:2
- +20 DO MES^XPDUTL(" "_DGPARM_" parameter, instance "_DGINST_", set to "_DGVALU_"%.")
- End DoDot:2
- +21 IF DGPARM'="DGMT MAPR GLOBAL RATE"
- Begin DoDot:2
- +22 DO MES^XPDUTL(" "_DGPARM_" parameter, instance "_DGINST_", set to $"_$FNUMBER(DGVALU,",")_".")
- End DoDot:2
- End DoDot:1
- +23 QUIT