EAS1224P ;ALB/SJD - EAS*1.0*224 POST-INSTALL ;AUG 28, 2024@09:25
;;1.0;ENROLLMENT APPLICATION SYSTEM;**224**;MAR 15,2001;Build 1
;Per VHA Directive 2004-038, this routine should not be modified.
;
;ICRs
; Reference to BMES^XPDUTL in ICR #10141
; Reference to IENS^DILF,CLEAN^DILF in ICR #2054
; Reference to UPDATE^DIE in ICR #2053
; Reference to FMADD^XLFDT in ICR #10103
; Reference to ^DIC(5) in ICR #10056
; Reference to UP^XLFSTR in ICR #10104
;
Q
;
PRETRAN ;Load tables
I $G(DUZ("AG"))'="V" Q
M @XPDGREF@("EAS1224")=^XTMP("EAS1224")
Q
;
EN ; Display a message to inform the user that there will be a slight delay when installing the patch.
;
N EASMESS,Y,EASDTS,EASDTE
D NOW^%DTC S Y=% D DD^%DT
S EASDTS=Y ;Start Time
S EASMESS(1)=">>> Beginning the EAS*1.0*224 Post-install routine..."
S EASMESS(2)=" "
S EASMESS(3)=" Updating GMT THRESHOLDS (#712.5) file with the updates for the"
S EASMESS(4)=" calendar year 2025 (income year 2024). These updates should "
S EASMESS(5)=" take under 2 minutes. Please be patient and allow the process "
S EASMESS(6)=" to complete. "
S EASMESS(7)=""
D BMES^XPDUTL(.EASMESS)
D ADD
Q
;
ADD ; Parse the data coming in and file it to the globals
K ^XTMP("EAS1224")
K ^XTMP("EAS1224H")
M ^XTMP("EAS1224")=@XPDGREF@("EAS1224")
S ^XTMP("EAS1224",0)=$$FMADD^XLFDT(DT,30)_U_DT_U_"EAS*1.0*224 - Create Zip Code FIPS code Xref"
S ^XTMP("EAS1224H",0)=$$FMADD^XLFDT(DT,30)_U_DT_U_"EAS*1.0*224 - Duplicate FIPS not filed"
N EASGMT,EASCNTR,EASCNT,EASJ,EASRECA,EASRECR,EASDATA,EASMSG,EASADD,EASX,EASNODE
S EASRECA=0,EASRECR=0
D BMES^XPDUTL(" Updating.")
S EASCNTR="" F S EASCNTR=$O(^XTMP("EAS1224","DATA",2024,EASCNTR)) Q:'EASCNTR D
.S EASGMT("YEAR")=3240000
.; Start extracting data from HUD data set in ^XTMP
.S EASGMT("COUNTY NAME")=$$UP^XLFSTR($P(^XTMP("EAS1224","DATA",2024,EASCNTR),U,2))
.S EASGMT("STATE")=$P(^XTMP("EAS1224","DATA",2024,EASCNTR),U)
.S EASGMT("MSA")=$P(^XTMP("EAS1224","DATA",2024,EASCNTR),U,4)
.F EASCNT=1:1:8 S EASGMT("THR"_EASCNT)=$P(^XTMP("EAS1224","DATA",2024,EASCNTR),U,(EASCNT+4))
.S EASGMT("STATE")=$E("00",1,2-$L(EASGMT("STATE")))_EASGMT("STATE")
.S EASGMT("FIPS")=$P(^XTMP("EAS1224","DATA",2024,EASCNTR),U,3)
.S EASGMT("ST IEN")=$O(^DIC(5,"C",EASGMT("STATE"),""))
.; Start setting EASDATA array with HUD data to populate File (#712.5)
.; Data will be passed into tag FILE
.; Data Descriptions:
.; .01 - Fiscal Year
.; .02 - FIPS (ZIP Code)
.; .03 - State IEN
.; .04 - State County Name
.; .05 - MSA
.; .11 through .18 - l80 HUD thresholds (pieces 5 - 12)
.S EASDATA(.01)=$G(EASGMT("YEAR"))
.S EASDATA(.02)=$G(EASGMT("FIPS"))
.S EASDATA(.03)=$G(EASGMT("ST IEN"))
.S EASDATA(.04)=$G(EASGMT("COUNTY NAME"))
.S EASDATA(.05)=$G(EASGMT("MSA"))
.F EASJ=1:1:8 S EASDATA(.10+(EASJ*.01))=$G(EASGMT("THR"_EASJ))
.S EASX="" F S EASX=$O(EASDATA(EASX)) Q:'EASX
.S EASADD=$$FILE(712.5,,.EASDATA,.EASERR)
.I EASADD S EASRECA=EASRECA+1
.; If an error is returned from the FILE tag, set error data and message (Duplicates)
.I 'EASADD D
..S EASRECR=EASRECR+1
..S EASNODE=EASDATA(.01)_"^"_EASDATA(.02)_"^"_EASDATA(.03)_"^"_EASDATA(.04)_"^"_EASDATA(.05)
..S EASNODE=EASNODE_"^"_EASDATA(.11)_"^"_EASDATA(.12)_"^"_EASDATA(.13)_"^"_EASDATA(.14)
..S EASNODE=EASNODE_"^"_EASDATA(.15)_"^"_EASDATA(.16)_"^"_EASDATA(.17)_"^"_EASDATA(.18)
..S ^XTMP("EAS1224H",EASRECR)=EASNODE_"^"_$G(EASERR)
.I '$D(ZTQUEUED),'(EASCNTR#500) W "."
D NOW^%DTC S Y=% D DD^%DT
S EASDTE=Y ;End time
S EASMSG(1)=" Process Complete!"
S EASMSG(2)=" "
S EASMSG(3)=" Job Start Date and Time: "_EASDTS
S EASMSG(4)=" Job End Date and Time: "_EASDTE
S EASMSG(5)=" "
S EASMSG(6)=" Number of records added: "_EASRECA
S EASMSG(7)=" Number of duplicate records: "_EASRECR
S EASMSG(8)=" "
S EASMSG(9)=" NOTE: Only one entry per Year/State and County Code is filed and the "
S EASMSG(10)=" remaining are identified as duplicates and cannot be uploaded."
S EASMSG(11)=" "
S EASMSG(12)=" Added records are stored in ^XTMP("_"""EAS1224"_""")"
S EASMSG(13)=" Duplicates will not be filed in the GMT THRESHOLDS (#712.5) file."
S EASMSG(14)=" Duplicate records are stored in ^XTMP("_"""EAS1224H"_""")"
S EASMSG(15)=" These globals will be automatically purged in 30 days."
S EASMSG(16)=" "
S EASMSG(17)=">>> Patch EAS*1.0*224 Post-install complete."
D BMES^XPDUTL(.EASMSG)
Q
FILE(EASFILE,EASENDA,EASDATA,EASERR) ; File Data
;Description: Creates a new record and files the data.
; Input:
; EASFILE - File or sub-file number
; EASENDA - New name for traditional FileMan DA array with same
; meaning. Pass by reference. Only needed if adding to a
; subfile.
; EASDATA - Data array to file, pass by reference
; Format: EASDATA(<field #>)=<value>
;
; Output:
; Function Value - If no error then it returns the ien of the created record, else returns NULL.
; EASENDA - returns the ien of the new record, NULL if none created. If needed, pass by reference.
; EASERR - optional error message - if needed, pass by reference
;
;
N EASFDA,EASFLD,EASIENA,EASIENS,EASERRS,EASIEN,DIERR
;
;EASIENS - Internal Entry Number String defined by FM
;EASIENA - the Internal Entry Number Array defined by FM
;EASFDA - the FDA array defined by FM
;EASIEN - the ien of the new record
;
S EASENDA="+1"
S EASIENS=$$IENS^DILF(.EASENDA)
S EASFLD=0
F S EASFLD=$O(EASDATA(EASFLD)) Q:'EASFLD D
.S EASFDA(EASFILE,EASIENS,EASFLD)=$G(EASDATA(EASFLD))
D UPDATE^DIE("","EASFDA","EASIENA","EASERRS(1)")
I +$G(DIERR) D
.S EASERR=$G(EASERRS(1,"DIERR",1,"TEXT",1))
.S EASIEN=""
E D
.S EASIEN=EASIENA(1)
.S EASERR=""
D CLEAN^DILF
S EASENDA=EASIEN
Q EASIEN
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEAS1224P 5880 printed Sep 23, 2025@19:29:28 Page 2
EAS1224P ;ALB/SJD - EAS*1.0*224 POST-INSTALL ;AUG 28, 2024@09:25
+1 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**224**;MAR 15,2001;Build 1
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ;ICRs
+5 ; Reference to BMES^XPDUTL in ICR #10141
+6 ; Reference to IENS^DILF,CLEAN^DILF in ICR #2054
+7 ; Reference to UPDATE^DIE in ICR #2053
+8 ; Reference to FMADD^XLFDT in ICR #10103
+9 ; Reference to ^DIC(5) in ICR #10056
+10 ; Reference to UP^XLFSTR in ICR #10104
+11 ;
+12 QUIT
+13 ;
PRETRAN ;Load tables
+1 IF $GET(DUZ("AG"))'="V"
QUIT
+2 MERGE @XPDGREF@("EAS1224")=^XTMP("EAS1224")
+3 QUIT
+4 ;
EN ; Display a message to inform the user that there will be a slight delay when installing the patch.
+1 ;
+2 NEW EASMESS,Y,EASDTS,EASDTE
+3 DO NOW^%DTC
SET Y=%
DO DD^%DT
+4 ;Start Time
SET EASDTS=Y
+5 SET EASMESS(1)=">>> Beginning the EAS*1.0*224 Post-install routine..."
+6 SET EASMESS(2)=" "
+7 SET EASMESS(3)=" Updating GMT THRESHOLDS (#712.5) file with the updates for the"
+8 SET EASMESS(4)=" calendar year 2025 (income year 2024). These updates should "
+9 SET EASMESS(5)=" take under 2 minutes. Please be patient and allow the process "
+10 SET EASMESS(6)=" to complete. "
+11 SET EASMESS(7)=""
+12 DO BMES^XPDUTL(.EASMESS)
+13 DO ADD
+14 QUIT
+15 ;
ADD ; Parse the data coming in and file it to the globals
+1 KILL ^XTMP("EAS1224")
+2 KILL ^XTMP("EAS1224H")
+3 MERGE ^XTMP("EAS1224")=@XPDGREF@("EAS1224")
+4 SET ^XTMP("EAS1224",0)=$$FMADD^XLFDT(DT,30)_U_DT_U_"EAS*1.0*224 - Create Zip Code FIPS code Xref"
+5 SET ^XTMP("EAS1224H",0)=$$FMADD^XLFDT(DT,30)_U_DT_U_"EAS*1.0*224 - Duplicate FIPS not filed"
+6 NEW EASGMT,EASCNTR,EASCNT,EASJ,EASRECA,EASRECR,EASDATA,EASMSG,EASADD,EASX,EASNODE
+7 SET EASRECA=0
SET EASRECR=0
+8 DO BMES^XPDUTL(" Updating.")
+9 SET EASCNTR=""
FOR
SET EASCNTR=$ORDER(^XTMP("EAS1224","DATA",2024,EASCNTR))
if 'EASCNTR
QUIT
Begin DoDot:1
+10 SET EASGMT("YEAR")=3240000
+11 ; Start extracting data from HUD data set in ^XTMP
+12 SET EASGMT("COUNTY NAME")=$$UP^XLFSTR($PIECE(^XTMP("EAS1224","DATA",2024,EASCNTR),U,2))
+13 SET EASGMT("STATE")=$PIECE(^XTMP("EAS1224","DATA",2024,EASCNTR),U)
+14 SET EASGMT("MSA")=$PIECE(^XTMP("EAS1224","DATA",2024,EASCNTR),U,4)
+15 FOR EASCNT=1:1:8
SET EASGMT("THR"_EASCNT)=$PIECE(^XTMP("EAS1224","DATA",2024,EASCNTR),U,(EASCNT+4))
+16 SET EASGMT("STATE")=$EXTRACT("00",1,2-$LENGTH(EASGMT("STATE")))_EASGMT("STATE")
+17 SET EASGMT("FIPS")=$PIECE(^XTMP("EAS1224","DATA",2024,EASCNTR),U,3)
+18 SET EASGMT("ST IEN")=$ORDER(^DIC(5,"C",EASGMT("STATE"),""))
+19 ; Start setting EASDATA array with HUD data to populate File (#712.5)
+20 ; Data will be passed into tag FILE
+21 ; Data Descriptions:
+22 ; .01 - Fiscal Year
+23 ; .02 - FIPS (ZIP Code)
+24 ; .03 - State IEN
+25 ; .04 - State County Name
+26 ; .05 - MSA
+27 ; .11 through .18 - l80 HUD thresholds (pieces 5 - 12)
+28 SET EASDATA(.01)=$GET(EASGMT("YEAR"))
+29 SET EASDATA(.02)=$GET(EASGMT("FIPS"))
+30 SET EASDATA(.03)=$GET(EASGMT("ST IEN"))
+31 SET EASDATA(.04)=$GET(EASGMT("COUNTY NAME"))
+32 SET EASDATA(.05)=$GET(EASGMT("MSA"))
+33 FOR EASJ=1:1:8
SET EASDATA(.10+(EASJ*.01))=$GET(EASGMT("THR"_EASJ))
+34 SET EASX=""
FOR
SET EASX=$ORDER(EASDATA(EASX))
if 'EASX
QUIT
+35 SET EASADD=$$FILE(712.5,,.EASDATA,.EASERR)
+36 IF EASADD
SET EASRECA=EASRECA+1
+37 ; If an error is returned from the FILE tag, set error data and message (Duplicates)
+38 IF 'EASADD
Begin DoDot:2
+39 SET EASRECR=EASRECR+1
+40 SET EASNODE=EASDATA(.01)_"^"_EASDATA(.02)_"^"_EASDATA(.03)_"^"_EASDATA(.04)_"^"_EASDATA(.05)
+41 SET EASNODE=EASNODE_"^"_EASDATA(.11)_"^"_EASDATA(.12)_"^"_EASDATA(.13)_"^"_EASDATA(.14)
+42 SET EASNODE=EASNODE_"^"_EASDATA(.15)_"^"_EASDATA(.16)_"^"_EASDATA(.17)_"^"_EASDATA(.18)
+43 SET ^XTMP("EAS1224H",EASRECR)=EASNODE_"^"_$GET(EASERR)
End DoDot:2
+44 IF '$DATA(ZTQUEUED)
IF '(EASCNTR#500)
WRITE "."
End DoDot:1
+45 DO NOW^%DTC
SET Y=%
DO DD^%DT
+46 ;End time
SET EASDTE=Y
+47 SET EASMSG(1)=" Process Complete!"
+48 SET EASMSG(2)=" "
+49 SET EASMSG(3)=" Job Start Date and Time: "_EASDTS
+50 SET EASMSG(4)=" Job End Date and Time: "_EASDTE
+51 SET EASMSG(5)=" "
+52 SET EASMSG(6)=" Number of records added: "_EASRECA
+53 SET EASMSG(7)=" Number of duplicate records: "_EASRECR
+54 SET EASMSG(8)=" "
+55 SET EASMSG(9)=" NOTE: Only one entry per Year/State and County Code is filed and the "
+56 SET EASMSG(10)=" remaining are identified as duplicates and cannot be uploaded."
+57 SET EASMSG(11)=" "
+58 SET EASMSG(12)=" Added records are stored in ^XTMP("_"""EAS1224"_""")"
+59 SET EASMSG(13)=" Duplicates will not be filed in the GMT THRESHOLDS (#712.5) file."
+60 SET EASMSG(14)=" Duplicate records are stored in ^XTMP("_"""EAS1224H"_""")"
+61 SET EASMSG(15)=" These globals will be automatically purged in 30 days."
+62 SET EASMSG(16)=" "
+63 SET EASMSG(17)=">>> Patch EAS*1.0*224 Post-install complete."
+64 DO BMES^XPDUTL(.EASMSG)
+65 QUIT
FILE(EASFILE,EASENDA,EASDATA,EASERR) ; File Data
+1 ;Description: Creates a new record and files the data.
+2 ; Input:
+3 ; EASFILE - File or sub-file number
+4 ; EASENDA - New name for traditional FileMan DA array with same
+5 ; meaning. Pass by reference. Only needed if adding to a
+6 ; subfile.
+7 ; EASDATA - Data array to file, pass by reference
+8 ; Format: EASDATA(<field #>)=<value>
+9 ;
+10 ; Output:
+11 ; Function Value - If no error then it returns the ien of the created record, else returns NULL.
+12 ; EASENDA - returns the ien of the new record, NULL if none created. If needed, pass by reference.
+13 ; EASERR - optional error message - if needed, pass by reference
+14 ;
+15 ;
+16 NEW EASFDA,EASFLD,EASIENA,EASIENS,EASERRS,EASIEN,DIERR
+17 ;
+18 ;EASIENS - Internal Entry Number String defined by FM
+19 ;EASIENA - the Internal Entry Number Array defined by FM
+20 ;EASFDA - the FDA array defined by FM
+21 ;EASIEN - the ien of the new record
+22 ;
+23 SET EASENDA="+1"
+24 SET EASIENS=$$IENS^DILF(.EASENDA)
+25 SET EASFLD=0
+26 FOR
SET EASFLD=$ORDER(EASDATA(EASFLD))
if 'EASFLD
QUIT
Begin DoDot:1
+27 SET EASFDA(EASFILE,EASIENS,EASFLD)=$GET(EASDATA(EASFLD))
End DoDot:1
+28 DO UPDATE^DIE("","EASFDA","EASIENA","EASERRS(1)")
+29 IF +$GET(DIERR)
Begin DoDot:1
+30 SET EASERR=$GET(EASERRS(1,"DIERR",1,"TEXT",1))
+31 SET EASIEN=""
End DoDot:1
+32 IF '$TEST
Begin DoDot:1
+33 SET EASIEN=EASIENA(1)
+34 SET EASERR=""
End DoDot:1
+35 DO CLEAN^DILF
+36 SET EASENDA=EASIEN
+37 QUIT EASIEN
