Routine: EASGTLKP

EASGTLKP ;ALB/CKN - GMT THRESHOLD LOOKUP ; 10/11/02 1:23pm

 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**13**;MAR 15,2001

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

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)

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

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

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  Apr 23, 2025@18:09:49                                                                                                                                                                                                    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

EASGTLKP.m