source: FOIAVistA/trunk/r/ENROLLMENT_APPLICATION_SYSTEM-EAS/EASGTLKP.m@ 1397

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

initial load of FOIAVistA 6/30/08 version

File size: 2.7 KB
Line 
1EASGTLKP ;ALB/CKN - GMT THRESHOLD LOOKUP ; 10/11/02 1:23pm
2 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**13**;MAR 15,2001
3 Q
4EP ;
5 N STR,ZIP,COUNTY,STATE,DONE,TXT1,THRSHLD
6 S DONE=0,$P(STR,"=",79)="="
7 S TXT1="GMT Threshold Lookup by Zip Code or City"
8 W !,TXT1,!,$E(STR,1,$L(TXT1))
9 F D Q:DONE
10 . D ASKZIP Q:DONE
11 . D PROC
12 Q
13ASKZIP ;Prompt user for valid Postal code
14 N Y,TXT
15 S DIR(0)="P^5.12:QEM",DIR("A")="ZIP Code"
16 S TXT="Zip Code is invalid; there is no GMT Threshold associated with this value."
17 S DIR("PRE")="I $$CHK^EASGTLKP(X) W !!,TXT,!"
18 S DIR("?")="Enter the ZIP code [5 - 12 characters] that you wish to select."
19 D ^DIR K DIR
20 I $D(DIRUT) S DONE=1 Q
21 I $D(DUOUT) S DONE=1 Q
22 S ZIP=$P(Y,"^",2)
23 Q
24 ;
25CHK(X) ;
26 I +X=0 Q 0
27 I X'="",X'="^",'$D(^XIP(5.12,"B",X)),'$D(^XIP(5.12,"C",X)) Q 1
28 Q 0
29 ;
30PROC ;Lookup in GMT threshold file 712.5 for appropriate GMT Thresholds
31 N FIPS,DATA,YR,XIP,REC513,REC7125
32 S DATA=$$FIPS^EASAILK(ZIP) ;get FIPS code for entered ZIP code
33 I '+DATA W !,"GMT Thresholds not found for entered ZIP code." Q
34 S YR=($E($$NOW^XLFDT(),1,3)-1)_"0000"
35 S REC7125=$P($G(DATA),"^",3),FIPS=$P($G(DATA),"^")
36 I '+REC7125 W !,"GMT Threshold is not available for entered ZIP code." Q
37 S STATE=$P($G(^EAS(712.5,REC7125,0)),"^",3)
38 I STATE'="" S STATE=$P($G(^DIC(5,STATE,0)),"^")
39 S COUNTY=$P($G(^EAS(712.5,REC7125,0)),"^",4)
40 D PRINT
41 Q
42PRINT ;Display GMT thresholds
43 N J,K,TEXT
44 W !!,"County Name: ",COUNTY
45 I STATE'="" W !,"State: ",STATE,!,STR
46 W !,"Year",?10,"ZIP Code",?27,"FIPS Code",?40,"# in Household",?60,"GMT Threshold"
47 W !,STR
48 F J=1:1:8 D
49 . S THRSHLD=$P($G(^EAS(712.5,REC7125,1)),"^",J) W !
50 . I J=1 W $$FMTE^XLFDT(YR),?12,ZIP,?29,FIPS
51 . W ?46,(J),?63,"$"_$FN(THRSHLD,",")
52 W !,STR
53 S DIR(0)="E" D ^DIR K DIR
54 W @IOF
55 F K=1:1 S TEXT=$P($T(NOTE+K),";;",2) Q:TEXT="EXIT" W !,TEXT
56 Q
57NOTE ;;
58 ;;
59 ;;**NOTE**
60 ;;
61 ;;Family Size Adjustments
62 ;;The statutory guidance governing income limits requires that income limits are
63 ;;to be higher for larger families and lower for smaller families. The same family
64 ;;size adjustments are used for all income limits. They are as follows:
65 ;;
66 ;;Number of Persons in Family and Percentage Adjustments
67 ;; 1 2 3 4 5 6 7 8
68 ;;70% 80% 90% Base 108% 116% 124% 132%
69 ;;
70 ;;Income limits for families with more than eight persons are not included in the
71 ;;printed lists because of space limitations. For each person in excess of eight,
72 ;;8% of the four-person base should be added to the eight-person income limit.
73 ;;(For example, the nine-person limit equals 140 percent[132+8] of the relevant
74 ;;base income limit.) Income limits are rounded to the nearest $50.
75 ;;(Source of information - HUD)
76 ;;
77 ;;EXIT
Note: See TracBrowser for help on using the repository browser.