Routine: EAS1223P

EAS1223P ;ALB/SJD - EAS*1.0*223 POST-INSTALL ;JUL 18, 2023@09:25

 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**223**;MAR 15,2001;Build 3

 ;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

PRETRAN ;Load tables

 I $G(DUZ("AG"))'="V" Q

 M @XPDGREF@("EAS1223")=^XTMP("EAS1223")

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*223 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 2024 (income year 2023). 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

ADD ; Parse the data coming in and file it to the globals

 K ^XTMP("EAS1223")

 K ^XTMP("EAS1223H")

 M ^XTMP("EAS1223")=@XPDGREF@("EAS1223")

 S ^XTMP("EAS1223",0)=$$FMADD^XLFDT(DT,30)_U_DT_U_"EAS*1.0*223 - Create Zip Code FIPS code Xref"

 S ^XTMP("EAS1223H",0)=$$FMADD^XLFDT(DT,30)_U_DT_U_"EAS*1.0*223 - 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("EAS1223","DATA",2023,EASCNTR)) Q:'EASCNTR  D

 .S EASGMT("YEAR")=3230000

 .; Start extracting data from HUD data set in ^XTMP

 .S EASGMT("COUNTY NAME")=$$UP^XLFSTR($P(^XTMP("EAS1223","DATA",2023,EASCNTR),U,2))

 .S EASGMT("STATE")=$P(^XTMP("EAS1223","DATA",2023,EASCNTR),U)

 .S EASGMT("MSA")=$P(^XTMP("EAS1223","DATA",2023,EASCNTR),U,4)

 .F EASCNT=1:1:8 S EASGMT("THR"_EASCNT)=$P(^XTMP("EAS1223","DATA",2023,EASCNTR),U,(EASCNT+4))

 .S EASGMT("STATE")=$E("00",1,2-$L(EASGMT("STATE")))_EASGMT("STATE")

 .S EASGMT("FIPS")=$P(^XTMP("EAS1223","DATA",2023,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("EAS1223H",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("_"""EAS1223"_""")"

 S EASMSG(13)="     Duplicates will not be filed in the GMT THRESHOLDS (#712.5) file."

 S EASMSG(14)="     Duplicate records are stored in ^XTMP("_"""EAS1223H"_""")"

 S EASMSG(15)="     These globals will be automatically purged in 30 days."

 S EASMSG(16)=" "

 S EASMSG(17)=">>> Patch EAS*1.0*223 Post-install complete."

 D BMES^XPDUTL(.EASMSG)

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[HEAS1223P   5880     printed  Feb 18, 2025@23:19:46                                                                                                                                                                                                    Page 2

EAS1223P  ;ALB/SJD - EAS*1.0*223 POST-INSTALL ;JUL 18, 2023@09:25

 +1       ;;1.0;ENROLLMENT APPLICATION SYSTEM;**223**;MAR 15,2001;Build 3

 +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@("EAS1223")=^XTMP("EAS1223")

 +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*223 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 2024 (income year 2023). 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("EAS1223")

 +2        KILL ^XTMP("EAS1223H")

 +3        MERGE ^XTMP("EAS1223")=@XPDGREF@("EAS1223")

 +4        SET ^XTMP("EAS1223",0)=$$FMADD^XLFDT(DT,30)_U_DT_U_"EAS*1.0*223 - Create Zip Code FIPS code Xref"

 +5        SET ^XTMP("EAS1223H",0)=$$FMADD^XLFDT(DT,30)_U_DT_U_"EAS*1.0*223 - 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("EAS1223","DATA",2023,EASCNTR))

               if 'EASCNTR

                   QUIT

               Begin DoDot:1

 +10               SET EASGMT("YEAR")=3230000

 +11      ; Start extracting data from HUD data set in ^XTMP

 +12               SET EASGMT("COUNTY NAME")=$$UP^XLFSTR($PIECE(^XTMP("EAS1223","DATA",2023,EASCNTR),U,2))

 +13               SET EASGMT("STATE")=$PIECE(^XTMP("EAS1223","DATA",2023,EASCNTR),U)

 +14               SET EASGMT("MSA")=$PIECE(^XTMP("EAS1223","DATA",2023,EASCNTR),U,4)

 +15               FOR EASCNT=1:1:8

                       SET EASGMT("THR"_EASCNT)=$PIECE(^XTMP("EAS1223","DATA",2023,EASCNTR),U,(EASCNT+4))

 +16               SET EASGMT("STATE")=$EXTRACT("00",1,2-$LENGTH(EASGMT("STATE")))_EASGMT("STATE")

 +17               SET EASGMT("FIPS")=$PIECE(^XTMP("EAS1223","DATA",2023,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("EAS1223H",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("_"""EAS1223"_""")"

 +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("_"""EAS1223H"_""")"

 +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*223 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

EAS1223P.m