Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: EAS1220P

EAS1220P.m

Go to the documentation of this file.
  1. 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
  1. ;Per VHA Directive 2004-038, this routine should not be modified.
  1. ;
  1. ;ICRs
  1. ; Reference to BMES^XPDUTL in ICR #10141
  1. ; Reference to IENS^DILF,CLEAN^DILF in ICR #2054
  1. ; Reference to UPDATE^DIE in ICR #2053
  1. ; Reference to FMADD^XLFDT in ICR #10103
  1. ; Reference to ^DIC(5) in ICR #10056
  1. ; Reference to UP^XLFSTR in ICR #10104
  1. ;
  1. Q
  1. ;
  1. PRETRAN ;Load tables
  1. I $G(DUZ("AG"))'="V" Q
  1. M @XPDGREF@("EAS1220")=^XTMP("EAS1220")
  1. Q
  1. ;
  1. EN ; Display a message to inform the user that there will be a slight delay when installing the patch.
  1. ;
  1. N EASMESS
  1. S EASMESS(1)=">>>Beginning the EAS*1.0*220 Post-install routine..."
  1. S EASMESS(2)=" "
  1. S EASMESS(3)=" Updating GMT THRESHOLDS (#712.5) file with the updates for the"
  1. S EASMESS(4)=" calendar year 2023 (income year 2022). These updates should "
  1. S EASMESS(5)=" take under 2 minutes. Please be patient and allow the process "
  1. S EASMESS(6)=" to complete. "
  1. S EASMESS(7)=""
  1. D BMES^XPDUTL(.EASMESS)
  1. D ADD
  1. Q
  1. ;
  1. ADD ; Parse the data coming in and file it to the globals
  1. K ^XTMP("EAS1220")
  1. K ^XTMP("EAS1220H")
  1. M ^XTMP("EAS1220")=@XPDGREF@("EAS1220")
  1. S ^XTMP("EAS1220",0)=$$FMADD^XLFDT(DT,30)_U_DT_U_"EAS*1.0*220 - Create Zip Code FIPS code Xref"
  1. S ^XTMP("EAS1220H",0)=$$FMADD^XLFDT(DT,30)_U_DT_U_"EAS*1.0*220 - Duplicate FIPS not filed"
  1. N EASGMT,EASCNTR,EASCNT,EASJ,EASRECA,EASRECR,EASDATA,EASMSG,EASADD,EASX,EASNODE
  1. S EASRECA=0,EASRECR=0
  1. D BMES^XPDUTL(" Updating.")
  1. S EASCNTR="" F S EASCNTR=$O(^XTMP("EAS1220","DATA",2022,EASCNTR)) Q:'EASCNTR D
  1. .S EASGMT("YEAR")=3220000
  1. .S EASGMT("COUNTY NAME")=$$UP^XLFSTR($P(^XTMP("EAS1220","DATA",2022,EASCNTR),U,2))
  1. .S EASGMT("STATE")=$P(^XTMP("EAS1220","DATA",2022,EASCNTR),U)
  1. .S EASGMT("MSA")=$P(^XTMP("EAS1220","DATA",2022,EASCNTR),U,4)
  1. .;I EASGMT("MSA")=10000 S EASGMT("MSA")=0
  1. .F EASCNT=1:1:8 S EASGMT("THR"_EASCNT)=$P(^XTMP("EAS1220","DATA",2022,EASCNTR),U,(EASCNT+4))
  1. .S EASGMT("STATE")=$E("00",1,2-$L(EASGMT("STATE")))_EASGMT("STATE")
  1. .S EASGMT("FIPS")=$P(^XTMP("EAS1220","DATA",2022,EASCNTR),U,3)
  1. .S EASGMT("ST IEN")=$O(^DIC(5,"C",EASGMT("STATE"),""))
  1. .S EASDATA(.01)=$G(EASGMT("YEAR"))
  1. .S EASDATA(.02)=$G(EASGMT("FIPS"))
  1. .S EASDATA(.03)=$G(EASGMT("ST IEN"))
  1. .S EASDATA(.04)=$G(EASGMT("COUNTY NAME"))
  1. .S EASDATA(.05)=$G(EASGMT("MSA"))
  1. .F EASJ=1:1:8 S EASDATA(.10+(EASJ*.01))=$G(EASGMT("THR"_EASJ))
  1. .S EASX="" F S EASX=$O(EASDATA(EASX)) Q:'EASX
  1. .S EASADD=$$FILE(712.5,,.EASDATA,.EASERR)
  1. .I EASADD S EASRECA=EASRECA+1
  1. .I 'EASADD D
  1. ..S EASRECR=EASRECR+1
  1. ..S EASNODE=EASDATA(.01)_"^"_EASDATA(.02)_"^"_EASDATA(.03)_"^"_EASDATA(.04)_"^"_EASDATA(.05)
  1. ..S EASNODE=EASNODE_"^"_EASDATA(.11)_"^"_EASDATA(.12)_"^"_EASDATA(.13)_"^"_EASDATA(.14)
  1. ..S EASNODE=EASNODE_"^"_EASDATA(.15)_"^"_EASDATA(.16)_"^"_EASDATA(.17)_"^"_EASDATA(.18)
  1. ..S ^XTMP("EAS1220H",EASRECR)=EASNODE_"^"_$G(EASERR)
  1. .I '$D(ZTQUEUED),'(EASCNTR#500) W "."
  1. S EASMSG(1)=" Process Complete!"
  1. S EASMSG(2)=" "
  1. S EASMSG(3)=" Number of records added: "_EASRECA
  1. S EASMSG(4)=" Number of duplicate records: "_EASRECR
  1. S EASMSG(5)=" "
  1. S EASMSG(6)=" NOTE: Only one entry per Year/State and County Code is filed and the "
  1. S EASMSG(7)=" remaining are identified as duplicates and cannot be uploaded."
  1. S EASMSG(8)=" "
  1. S EASMSG(9)=" Added records are stored in ^XTMP("_"""EAS1220"_""")"
  1. S EASMSG(10)=" Duplicates will not be filed in the GMT Threshold file (#712.5)."
  1. S EASMSG(11)=" Duplicate records are stored in ^XTMP("_"""EAS1220H"_""")"
  1. S EASMSG(12)=" These globals will be automatically purged in 30 days."
  1. S EASMSG(13)=" "
  1. S EASMSG(14)=">>> Patch EAS*1.0*220 Post-install complete."
  1. D BMES^XPDUTL(.EASMSG)
  1. Q
  1. FILE(EASFILE,EASENDA,EASDATA,EASERR) ; File Data
  1. ;Description: Creates a new record and files the data.
  1. ; Input:
  1. ; EASFILE - File or sub-file number
  1. ; EASENDA - New name for traditional FileMan DA array with same
  1. ; meaning. Pass by reference. Only needed if adding to a
  1. ; subfile.
  1. ; EASDATA - Data array to file, pass by reference
  1. ; Format: EASDATA(<field #>)=<value>
  1. ;
  1. ; Output:
  1. ; Function Value - If no error then it returns the ien of the created record, else returns NULL.
  1. ; EASENDA - returns the ien of the new record, NULL if none created. If needed, pass by reference.
  1. ; EASERR - optional error message - if needed, pass by reference
  1. ;
  1. ;
  1. N EASFDA,EASFLD,EASIENA,EASIENS,EASERRS,EASIEN,DIERR
  1. ;
  1. ;EASIENS - Internal Entry Number String defined by FM
  1. ;EASIENA - the Internal Entry Number Array defined by FM
  1. ;EASFDA - the FDA array defined by FM
  1. ;EASIEN - the ien of the new record
  1. ;
  1. S EASENDA="+1"
  1. S EASIENS=$$IENS^DILF(.EASENDA)
  1. S EASFLD=0
  1. F S EASFLD=$O(EASDATA(EASFLD)) Q:'EASFLD D
  1. .S EASFDA(EASFILE,EASIENS,EASFLD)=$G(EASDATA(EASFLD))
  1. D UPDATE^DIE("","EASFDA","EASIENA","EASERRS(1)")
  1. I +$G(DIERR) D
  1. .S EASERR=$G(EASERRS(1,"DIERR",1,"TEXT",1))
  1. .S EASIEN=""
  1. E D
  1. .S EASIEN=EASIENA(1)
  1. .S EASERR=""
  1. D CLEAN^DILF
  1. S EASENDA=EASIEN
  1. Q EASIEN