- EAS1220P ;ALB/KUM - EAS*1.0*220 POST-INSTALL ;OCT 24, 2022@09:25
- ;;1.0;ENROLLMENT APPLICATION SYSTEM;**220**;MAR 15,2001;Build 6
- ;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@("EAS1220")=^XTMP("EAS1220")
- Q
- ;
- EN ; Display a message to inform the user that there will be a slight delay when installing the patch.
- ;
- N EASMESS
- S EASMESS(1)=">>>Beginning the EAS*1.0*220 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 2023 (income year 2022). 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("EAS1220")
- K ^XTMP("EAS1220H")
- M ^XTMP("EAS1220")=@XPDGREF@("EAS1220")
- S ^XTMP("EAS1220",0)=$$FMADD^XLFDT(DT,30)_U_DT_U_"EAS*1.0*220 - Create Zip Code FIPS code Xref"
- S ^XTMP("EAS1220H",0)=$$FMADD^XLFDT(DT,30)_U_DT_U_"EAS*1.0*220 - 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("EAS1220","DATA",2022,EASCNTR)) Q:'EASCNTR D
- .S EASGMT("YEAR")=3220000
- .S EASGMT("COUNTY NAME")=$$UP^XLFSTR($P(^XTMP("EAS1220","DATA",2022,EASCNTR),U,2))
- .S EASGMT("STATE")=$P(^XTMP("EAS1220","DATA",2022,EASCNTR),U)
- .S EASGMT("MSA")=$P(^XTMP("EAS1220","DATA",2022,EASCNTR),U,4)
- .;I EASGMT("MSA")=10000 S EASGMT("MSA")=0
- .F EASCNT=1:1:8 S EASGMT("THR"_EASCNT)=$P(^XTMP("EAS1220","DATA",2022,EASCNTR),U,(EASCNT+4))
- .S EASGMT("STATE")=$E("00",1,2-$L(EASGMT("STATE")))_EASGMT("STATE")
- .S EASGMT("FIPS")=$P(^XTMP("EAS1220","DATA",2022,EASCNTR),U,3)
- .S EASGMT("ST IEN")=$O(^DIC(5,"C",EASGMT("STATE"),""))
- .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
- .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("EAS1220H",EASRECR)=EASNODE_"^"_$G(EASERR)
- .I '$D(ZTQUEUED),'(EASCNTR#500) W "."
- S EASMSG(1)=" Process Complete!"
- S EASMSG(2)=" "
- S EASMSG(3)=" Number of records added: "_EASRECA
- S EASMSG(4)=" Number of duplicate records: "_EASRECR
- S EASMSG(5)=" "
- S EASMSG(6)=" NOTE: Only one entry per Year/State and County Code is filed and the "
- S EASMSG(7)=" remaining are identified as duplicates and cannot be uploaded."
- S EASMSG(8)=" "
- S EASMSG(9)=" Added records are stored in ^XTMP("_"""EAS1220"_""")"
- S EASMSG(10)=" Duplicates will not be filed in the GMT Threshold file (#712.5)."
- S EASMSG(11)=" Duplicate records are stored in ^XTMP("_"""EAS1220H"_""")"
- S EASMSG(12)=" These globals will be automatically purged in 30 days."
- S EASMSG(13)=" "
- S EASMSG(14)=">>> Patch EAS*1.0*220 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[HEAS1220P 5190 printed Feb 18, 2025@23:19:45 Page 2
- EAS1220P ;ALB/KUM - EAS*1.0*220 POST-INSTALL ;OCT 24, 2022@09:25
- +1 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**220**;MAR 15,2001;Build 6
- +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@("EAS1220")=^XTMP("EAS1220")
- +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
- +3 SET EASMESS(1)=">>>Beginning the EAS*1.0*220 Post-install routine..."
- +4 SET EASMESS(2)=" "
- +5 SET EASMESS(3)=" Updating GMT THRESHOLDS (#712.5) file with the updates for the"
- +6 SET EASMESS(4)=" calendar year 2023 (income year 2022). These updates should "
- +7 SET EASMESS(5)=" take under 2 minutes. Please be patient and allow the process "
- +8 SET EASMESS(6)=" to complete. "
- +9 SET EASMESS(7)=""
- +10 DO BMES^XPDUTL(.EASMESS)
- +11 DO ADD
- +12 QUIT
- +13 ;
- ADD ; Parse the data coming in and file it to the globals
- +1 KILL ^XTMP("EAS1220")
- +2 KILL ^XTMP("EAS1220H")
- +3 MERGE ^XTMP("EAS1220")=@XPDGREF@("EAS1220")
- +4 SET ^XTMP("EAS1220",0)=$$FMADD^XLFDT(DT,30)_U_DT_U_"EAS*1.0*220 - Create Zip Code FIPS code Xref"
- +5 SET ^XTMP("EAS1220H",0)=$$FMADD^XLFDT(DT,30)_U_DT_U_"EAS*1.0*220 - 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("EAS1220","DATA",2022,EASCNTR))
- if 'EASCNTR
- QUIT
- Begin DoDot:1
- +10 SET EASGMT("YEAR")=3220000
- +11 SET EASGMT("COUNTY NAME")=$$UP^XLFSTR($PIECE(^XTMP("EAS1220","DATA",2022,EASCNTR),U,2))
- +12 SET EASGMT("STATE")=$PIECE(^XTMP("EAS1220","DATA",2022,EASCNTR),U)
- +13 SET EASGMT("MSA")=$PIECE(^XTMP("EAS1220","DATA",2022,EASCNTR),U,4)
- +14 ;I EASGMT("MSA")=10000 S EASGMT("MSA")=0
- +15 FOR EASCNT=1:1:8
- SET EASGMT("THR"_EASCNT)=$PIECE(^XTMP("EAS1220","DATA",2022,EASCNTR),U,(EASCNT+4))
- +16 SET EASGMT("STATE")=$EXTRACT("00",1,2-$LENGTH(EASGMT("STATE")))_EASGMT("STATE")
- +17 SET EASGMT("FIPS")=$PIECE(^XTMP("EAS1220","DATA",2022,EASCNTR),U,3)
- +18 SET EASGMT("ST IEN")=$ORDER(^DIC(5,"C",EASGMT("STATE"),""))
- +19 SET EASDATA(.01)=$GET(EASGMT("YEAR"))
- +20 SET EASDATA(.02)=$GET(EASGMT("FIPS"))
- +21 SET EASDATA(.03)=$GET(EASGMT("ST IEN"))
- +22 SET EASDATA(.04)=$GET(EASGMT("COUNTY NAME"))
- +23 SET EASDATA(.05)=$GET(EASGMT("MSA"))
- +24 FOR EASJ=1:1:8
- SET EASDATA(.10+(EASJ*.01))=$GET(EASGMT("THR"_EASJ))
- +25 SET EASX=""
- FOR
- SET EASX=$ORDER(EASDATA(EASX))
- if 'EASX
- QUIT
- +26 SET EASADD=$$FILE(712.5,,.EASDATA,.EASERR)
- +27 IF EASADD
- SET EASRECA=EASRECA+1
- +28 IF 'EASADD
- Begin DoDot:2
- +29 SET EASRECR=EASRECR+1
- +30 SET EASNODE=EASDATA(.01)_"^"_EASDATA(.02)_"^"_EASDATA(.03)_"^"_EASDATA(.04)_"^"_EASDATA(.05)
- +31 SET EASNODE=EASNODE_"^"_EASDATA(.11)_"^"_EASDATA(.12)_"^"_EASDATA(.13)_"^"_EASDATA(.14)
- +32 SET EASNODE=EASNODE_"^"_EASDATA(.15)_"^"_EASDATA(.16)_"^"_EASDATA(.17)_"^"_EASDATA(.18)
- +33 SET ^XTMP("EAS1220H",EASRECR)=EASNODE_"^"_$GET(EASERR)
- End DoDot:2
- +34 IF '$DATA(ZTQUEUED)
- IF '(EASCNTR#500)
- WRITE "."
- End DoDot:1
- +35 SET EASMSG(1)=" Process Complete!"
- +36 SET EASMSG(2)=" "
- +37 SET EASMSG(3)=" Number of records added: "_EASRECA
- +38 SET EASMSG(4)=" Number of duplicate records: "_EASRECR
- +39 SET EASMSG(5)=" "
- +40 SET EASMSG(6)=" NOTE: Only one entry per Year/State and County Code is filed and the "
- +41 SET EASMSG(7)=" remaining are identified as duplicates and cannot be uploaded."
- +42 SET EASMSG(8)=" "
- +43 SET EASMSG(9)=" Added records are stored in ^XTMP("_"""EAS1220"_""")"
- +44 SET EASMSG(10)=" Duplicates will not be filed in the GMT Threshold file (#712.5)."
- +45 SET EASMSG(11)=" Duplicate records are stored in ^XTMP("_"""EAS1220H"_""")"
- +46 SET EASMSG(12)=" These globals will be automatically purged in 30 days."
- +47 SET EASMSG(13)=" "
- +48 SET EASMSG(14)=">>> Patch EAS*1.0*220 Post-install complete."
- +49 DO BMES^XPDUTL(.EASMSG)
- +50 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