EASGTLKP ;ALB/CKN - GMT THRESHOLD LOOKUP ; 10/11/02 1:23pm
;;1.0;ENROLLMENT APPLICATION SYSTEM;**13**;MAR 15,2001
Q
EP ;
N STR,ZIP,COUNTY,STATE,DONE,TXT1,THRSHLD
S DONE=0,$P(STR,"=",79)="="
S TXT1="GMT Threshold Lookup by Zip Code or City"
W !,TXT1,!,$E(STR,1,$L(TXT1))
F D Q:DONE
. D ASKZIP Q:DONE
. D PROC
Q
ASKZIP ;Prompt user for valid Postal code
N Y,TXT
S DIR(0)="P^5.12:QEM",DIR("A")="ZIP Code"
S TXT="Zip Code is invalid; there is no GMT Threshold associated with this value."
S DIR("PRE")="I $$CHK^EASGTLKP(X) W !!,TXT,!"
S DIR("?")="Enter the ZIP code [5 - 12 characters] that you wish to select."
D ^DIR K DIR
I $D(DIRUT) S DONE=1 Q
I $D(DUOUT) S DONE=1 Q
S ZIP=$P(Y,"^",2)
Q
;
CHK(X) ;
I +X=0 Q 0
I X'="",X'="^",'$D(^XIP(5.12,"B",X)),'$D(^XIP(5.12,"C",X)) Q 1
Q 0
;
PROC ;Lookup in GMT threshold file 712.5 for appropriate GMT Thresholds
N FIPS,DATA,YR,XIP,REC513,REC7125
S DATA=$$FIPS^EASAILK(ZIP) ;get FIPS code for entered ZIP code
I '+DATA W !,"GMT Thresholds not found for entered ZIP code." Q
S YR=($E($$NOW^XLFDT(),1,3)-1)_"0000"
S REC7125=$P($G(DATA),"^",3),FIPS=$P($G(DATA),"^")
I '+REC7125 W !,"GMT Threshold is not available for entered ZIP code." Q
S STATE=$P($G(^EAS(712.5,REC7125,0)),"^",3)
I STATE'="" S STATE=$P($G(^DIC(5,STATE,0)),"^")
S COUNTY=$P($G(^EAS(712.5,REC7125,0)),"^",4)
D PRINT
Q
PRINT ;Display GMT thresholds
N J,K,TEXT
W !!,"County Name: ",COUNTY
I STATE'="" W !,"State: ",STATE,!,STR
W !,"Year",?10,"ZIP Code",?27,"FIPS Code",?40,"# in Household",?60,"GMT Threshold"
W !,STR
F J=1:1:8 D
. S THRSHLD=$P($G(^EAS(712.5,REC7125,1)),"^",J) W !
. I J=1 W $$FMTE^XLFDT(YR),?12,ZIP,?29,FIPS
. W ?46,(J),?63,"$"_$FN(THRSHLD,",")
W !,STR
S DIR(0)="E" D ^DIR K DIR
W @IOF
F K=1:1 S TEXT=$P($T(NOTE+K),";;",2) Q:TEXT="EXIT" W !,TEXT
Q
NOTE ;;
;;
;;**NOTE**
;;
;;Family Size Adjustments
;;The statutory guidance governing income limits requires that income limits are
;;to be higher for larger families and lower for smaller families. The same family
;;size adjustments are used for all income limits. They are as follows:
;;
;;Number of Persons in Family and Percentage Adjustments
;; 1 2 3 4 5 6 7 8
;;70% 80% 90% Base 108% 116% 124% 132%
;;
;;Income limits for families with more than eight persons are not included in the
;;printed lists because of space limitations. For each person in excess of eight,
;;8% of the four-person base should be added to the eight-person income limit.
;;(For example, the nine-person limit equals 140 percent[132+8] of the relevant
;;base income limit.) Income limits are rounded to the nearest $50.
;;(Source of information - HUD)
;;
;;EXIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEASGTLKP 2824 printed Nov 22, 2024@17:05:28 Page 2
EASGTLKP ;ALB/CKN - GMT THRESHOLD LOOKUP ; 10/11/02 1:23pm
+1 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**13**;MAR 15,2001
+2 QUIT
EP ;
+1 NEW STR,ZIP,COUNTY,STATE,DONE,TXT1,THRSHLD
+2 SET DONE=0
SET $PIECE(STR,"=",79)="="
+3 SET TXT1="GMT Threshold Lookup by Zip Code or City"
+4 WRITE !,TXT1,!,$EXTRACT(STR,1,$LENGTH(TXT1))
+5 FOR
Begin DoDot:1
+6 DO ASKZIP
if DONE
QUIT
+7 DO PROC
End DoDot:1
if DONE
QUIT
+8 QUIT
ASKZIP ;Prompt user for valid Postal code
+1 NEW Y,TXT
+2 SET DIR(0)="P^5.12:QEM"
SET DIR("A")="ZIP Code"
+3 SET TXT="Zip Code is invalid; there is no GMT Threshold associated with this value."
+4 SET DIR("PRE")="I $$CHK^EASGTLKP(X) W !!,TXT,!"
+5 SET DIR("?")="Enter the ZIP code [5 - 12 characters] that you wish to select."
+6 DO ^DIR
KILL DIR
+7 IF $DATA(DIRUT)
SET DONE=1
QUIT
+8 IF $DATA(DUOUT)
SET DONE=1
QUIT
+9 SET ZIP=$PIECE(Y,"^",2)
+10 QUIT
+11 ;
CHK(X) ;
+1 IF +X=0
QUIT 0
+2 IF X'=""
IF X'="^"
IF '$DATA(^XIP(5.12,"B",X))
IF '$DATA(^XIP(5.12,"C",X))
QUIT 1
+3 QUIT 0
+4 ;
PROC ;Lookup in GMT threshold file 712.5 for appropriate GMT Thresholds
+1 NEW FIPS,DATA,YR,XIP,REC513,REC7125
+2 ;get FIPS code for entered ZIP code
SET DATA=$$FIPS^EASAILK(ZIP)
+3 IF '+DATA
WRITE !,"GMT Thresholds not found for entered ZIP code."
QUIT
+4 SET YR=($EXTRACT($$NOW^XLFDT(),1,3)-1)_"0000"
+5 SET REC7125=$PIECE($GET(DATA),"^",3)
SET FIPS=$PIECE($GET(DATA),"^")
+6 IF '+REC7125
WRITE !,"GMT Threshold is not available for entered ZIP code."
QUIT
+7 SET STATE=$PIECE($GET(^EAS(712.5,REC7125,0)),"^",3)
+8 IF STATE'=""
SET STATE=$PIECE($GET(^DIC(5,STATE,0)),"^")
+9 SET COUNTY=$PIECE($GET(^EAS(712.5,REC7125,0)),"^",4)
+10 DO PRINT
+11 QUIT
PRINT ;Display GMT thresholds
+1 NEW J,K,TEXT
+2 WRITE !!,"County Name: ",COUNTY
+3 IF STATE'=""
WRITE !,"State: ",STATE,!,STR
+4 WRITE !,"Year",?10,"ZIP Code",?27,"FIPS Code",?40,"# in Household",?60,"GMT Threshold"
+5 WRITE !,STR
+6 FOR J=1:1:8
Begin DoDot:1
+7 SET THRSHLD=$PIECE($GET(^EAS(712.5,REC7125,1)),"^",J)
WRITE !
+8 IF J=1
WRITE $$FMTE^XLFDT(YR),?12,ZIP,?29,FIPS
+9 WRITE ?46,(J),?63,"$"_$FNUMBER(THRSHLD,",")
End DoDot:1
+10 WRITE !,STR
+11 SET DIR(0)="E"
DO ^DIR
KILL DIR
+12 WRITE @IOF
+13 FOR K=1:1
SET TEXT=$PIECE($TEXT(NOTE+K),";;",2)
if TEXT="EXIT"
QUIT
WRITE !,TEXT
+14 QUIT
NOTE ;;
+1 ;;
+2 ;;**NOTE**
+3 ;;
+4 ;;Family Size Adjustments
+5 ;;The statutory guidance governing income limits requires that income limits are
+6 ;;to be higher for larger families and lower for smaller families. The same family
+7 ;;size adjustments are used for all income limits. They are as follows:
+8 ;;
+9 ;;Number of Persons in Family and Percentage Adjustments
+10 ;; 1 2 3 4 5 6 7 8
+11 ;;70% 80% 90% Base 108% 116% 124% 132%
+12 ;;
+13 ;;Income limits for families with more than eight persons are not included in the
+14 ;;printed lists because of space limitations. For each person in excess of eight,
+15 ;;8% of the four-person base should be added to the eight-person income limit.
+16 ;;(For example, the nine-person limit equals 140 percent[132+8] of the relevant
+17 ;;base income limit.) Income limits are rounded to the nearest $50.
+18 ;;(Source of information - HUD)
+19 ;;
+20 ;;EXIT
