source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DG53637P.m@ 1169

Last change on this file since 1169 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.3 KB
RevLine 
[613]1DG53637P ;ALB/PHH - 2005 MEANS TEST THRESHOLDS ;12/6/2004
2 ;;5.3;Registration;**637**;Aug 13, 1993
3 ;
4 ; This routine will upload the 2005 means test thresholds onto your
5 ; system.
6 ;
7EN N DA,DIE,DIC,DINUM,DR,I,X,Y,EXST
8 S EXST=0
9 D BMES^XPDUTL(">>>Means Test Thresholds for 2005 being installed...")
10 I $D(^DG(43,1,"MT",3050000)) D
11 .D BMES^XPDUTL(" ...Entry exists for income year 2004, entry being deleted")
12 .D MES^XPDUTL(" and replaced with nationally released thresholds.")
13 .S DIK="^DG(43,1,""MT"",",DA=3050000,DA(1)=1
14 .D ^DIK,IX1^DIK
15 .K DA,D0,DIK
16 K DO
17 S DIC="^DG(43,1,""MT"","
18 S DIC(0)="L"
19 S DA(1)=1
20 S (DINUM,X)=3050000
21 D FILE^DICN
22 S DA=+Y
23 ;
24 I +Y'=3050000 D Q
25 . D BMES^XPDUTL(" ...Problem encountered adding 2005 thresholds. Please try")
26 . D MES^XPDUTL(" again or contact the CIO Field Office for assistance.")
27 ;
28 D MES^XPDUTL("")
29 S DIE=DIC,DR=""
30 F I=1:1 S X=$P($T(DATA+I),";;",2) Q:X="QUIT" D ; build dr string
31 . S DR=DR_+X_"////"_$P(X,"^",2)_";"
32 . D MES^XPDUTL(" "_$P(X,"^",3)_" set to $"_$FN($P(X,"^",2),","))
33 D ^DIE
34 Q
35 ;
36 ;
37DATA ; lines to stuff in values (field////value)
38 ;;2^25842^MT COPAY EXEMPT VET INCOME
39 ;;3^5171^MT COPAY EXEMPT 1ST DEP INCOME
40 ;;4^1734^MT COPAY EXEMPT INCOME PER DEP
41 ;;8^80000^THRESHOLD PROPERTY
42 ;;17^8200^CHILD INCOME EXCLUSION
43 ;;QUIT
44 Q
Note: See TracBrowser for help on using the repository browser.