EAS1207P ;DEV/BJR - EAS*1.0*207 POST-INSTALL ; Sep 14, 2021@09:25
;;1.0;ENROLLMENT APPLICATION SYSTEM;**207**;MAR 15,2001;Build 4
;
Q
;
; ICR #10141 supports BMES^XPDUTL call
; ICR #2054 supports IENS^DILF and CLEAN^DILF calls
; ICR #2053 supports UPDATE^DIE call
; ICR #10103 supports FMADD^XLFDT call
; ICR #10056 supports ^DIC(5) direct global read
; ICR #10104 supports UP^XLFSTR call
;
PRETRAN ;Load tables
I $G(DUZ("AG"))'="V" Q
M @XPDGREF@("EAS1207")=^XTMP("EAS1207")
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)="POST-INSTALLATION PROCESSING"
S EASMESS(2)="---------------------------"
S EASMESS(3)="This installation will take some time due to the large size of the file."
S EASMESS(4)="Please be patient and allow the process to complete. Thank you!"
S EASMESS(5)=""
D BMES^XPDUTL(.EASMESS)
D ADD
Q
ADD ; Parse the data coming in and file it to the globals
K ^XTMP("EAS1207")
M ^XTMP("EAS1207")=@XPDGREF@("EAS1207")
S ^XTMP("EAS1207",0)=$$FMADD^XLFDT(DT,30)_U_DT_U_"Create Zip Code FIPS code Xref"
S ^XTMP("EAS1207H",0)=$$FMADD^XLFDT(DT,30)_U_DT_U_"Duplicate FIPS not filed"
N EASGMT,EASCNTR,EASCNT,EASJ,EASRECA,EASRECR,EASDATA,EASMSG,EASADD,EASX,EASNODE
S EASRECA=0,EASRECR=0
S EASCNTR="" F S EASCNTR=$O(^XTMP("EAS1207","DATA",2021,EASCNTR)) Q:'EASCNTR D
.S EASGMT("YEAR")=3210000
.S EASGMT("COUNTY NAME")=$$UP^XLFSTR($P(^XTMP("EAS1207","DATA",2021,EASCNTR),U,2))
.S EASGMT("STATE")=$P(^XTMP("EAS1207","DATA",2021,EASCNTR),U)
.S EASGMT("MSA")=$P(^XTMP("EAS1207","DATA",2021,EASCNTR),U,4)
.I EASGMT("MSA")=10000 S EASGMT("MSA")=0
.F EASCNT=1:1:8 S EASGMT("THR"_EASCNT)=$P(^XTMP("EAS1207","DATA",2021,EASCNTR),U,(EASCNT+4))
.S EASGMT("STATE")=$E("00",1,2-$L(EASGMT("STATE")))_EASGMT("STATE")
.S EASGMT("FIPS")=$P(^XTMP("EAS1207","DATA",2021,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("EAS1207H",EASRECR)=EASNODE_"^"_$G(EASERR)
S EASMSG(1)="Number of records added: "_EASRECA
S EASMSG(2)="Number of duplicate records: "_EASRECR
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
;
; Example: To add a record in subfile 2.0361 in the record with ien=353
; with the field .01 value = 21:
; S EASDATA(.01)=21,EASENDA(1)=353 I $$FILE^EAS1207(2.0361,.EASENDA,.EASDATA) W!,"DONE"
;
; Example: If creating a record not in a subfile, would look like this:
; S EASDATA(.01)=21 I $$FILE^EAS1207(867,,.EASDATA) W !,"DONE"
;
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[HEAS1207P 4546 printed Nov 22, 2024@17:03:28 Page 2
EAS1207P ;DEV/BJR - EAS*1.0*207 POST-INSTALL ; Sep 14, 2021@09:25
+1 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**207**;MAR 15,2001;Build 4
+2 ;
+3 QUIT
+4 ;
+5 ; ICR #10141 supports BMES^XPDUTL call
+6 ; ICR #2054 supports IENS^DILF and CLEAN^DILF calls
+7 ; ICR #2053 supports UPDATE^DIE call
+8 ; ICR #10103 supports FMADD^XLFDT call
+9 ; ICR #10056 supports ^DIC(5) direct global read
+10 ; ICR #10104 supports UP^XLFSTR call
+11 ;
PRETRAN ;Load tables
+1 IF $GET(DUZ("AG"))'="V"
QUIT
+2 MERGE @XPDGREF@("EAS1207")=^XTMP("EAS1207")
+3 QUIT
+4 ;
EN ; Display a message to inform the user that there will be a slight
+1 ; delay when installing the patch.
+2 ;
+3 NEW EASMESS
+4 SET EASMESS(1)="POST-INSTALLATION PROCESSING"
+5 SET EASMESS(2)="---------------------------"
+6 SET EASMESS(3)="This installation will take some time due to the large size of the file."
+7 SET EASMESS(4)="Please be patient and allow the process to complete. Thank you!"
+8 SET EASMESS(5)=""
+9 DO BMES^XPDUTL(.EASMESS)
+10 DO ADD
+11 QUIT
ADD ; Parse the data coming in and file it to the globals
+1 KILL ^XTMP("EAS1207")
+2 MERGE ^XTMP("EAS1207")=@XPDGREF@("EAS1207")
+3 SET ^XTMP("EAS1207",0)=$$FMADD^XLFDT(DT,30)_U_DT_U_"Create Zip Code FIPS code Xref"
+4 SET ^XTMP("EAS1207H",0)=$$FMADD^XLFDT(DT,30)_U_DT_U_"Duplicate FIPS not filed"
+5 NEW EASGMT,EASCNTR,EASCNT,EASJ,EASRECA,EASRECR,EASDATA,EASMSG,EASADD,EASX,EASNODE
+6 SET EASRECA=0
SET EASRECR=0
+7 SET EASCNTR=""
FOR
SET EASCNTR=$ORDER(^XTMP("EAS1207","DATA",2021,EASCNTR))
if 'EASCNTR
QUIT
Begin DoDot:1
+8 SET EASGMT("YEAR")=3210000
+9 SET EASGMT("COUNTY NAME")=$$UP^XLFSTR($PIECE(^XTMP("EAS1207","DATA",2021,EASCNTR),U,2))
+10 SET EASGMT("STATE")=$PIECE(^XTMP("EAS1207","DATA",2021,EASCNTR),U)
+11 SET EASGMT("MSA")=$PIECE(^XTMP("EAS1207","DATA",2021,EASCNTR),U,4)
+12 IF EASGMT("MSA")=10000
SET EASGMT("MSA")=0
+13 FOR EASCNT=1:1:8
SET EASGMT("THR"_EASCNT)=$PIECE(^XTMP("EAS1207","DATA",2021,EASCNTR),U,(EASCNT+4))
+14 SET EASGMT("STATE")=$EXTRACT("00",1,2-$LENGTH(EASGMT("STATE")))_EASGMT("STATE")
+15 SET EASGMT("FIPS")=$PIECE(^XTMP("EAS1207","DATA",2021,EASCNTR),U,3)
+16 SET EASGMT("ST IEN")=$ORDER(^DIC(5,"C",EASGMT("STATE"),""))
+17 SET EASDATA(.01)=$GET(EASGMT("YEAR"))
+18 SET EASDATA(.02)=$GET(EASGMT("FIPS"))
+19 SET EASDATA(.03)=$GET(EASGMT("ST IEN"))
+20 SET EASDATA(.04)=$GET(EASGMT("COUNTY NAME"))
+21 SET EASDATA(.05)=$GET(EASGMT("MSA"))
+22 FOR EASJ=1:1:8
SET EASDATA(.10+(EASJ*.01))=$GET(EASGMT("THR"_EASJ))
+23 SET EASX=""
FOR
SET EASX=$ORDER(EASDATA(EASX))
if 'EASX
QUIT
+24 SET EASADD=$$FILE(712.5,,.EASDATA,.EASERR)
+25 IF EASADD
SET EASRECA=EASRECA+1
+26 IF 'EASADD
Begin DoDot:2
+27 SET EASRECR=EASRECR+1
+28 SET EASNODE=EASDATA(.01)_"^"_EASDATA(.02)_"^"_EASDATA(.03)_"^"_EASDATA(.04)_"^"_EASDATA(.05)
+29 SET EASNODE=EASNODE_"^"_EASDATA(.11)_"^"_EASDATA(.12)_"^"_EASDATA(.13)_"^"_EASDATA(.14)
+30 SET EASNODE=EASNODE_"^"_EASDATA(.15)_"^"_EASDATA(.16)_"^"_EASDATA(.17)_"^"_EASDATA(.18)
+31 SET ^XTMP("EAS1207H",EASRECR)=EASNODE_"^"_$GET(EASERR)
End DoDot:2
End DoDot:1
+32 SET EASMSG(1)="Number of records added: "_EASRECA
+33 SET EASMSG(2)="Number of duplicate records: "_EASRECR
+34 DO BMES^XPDUTL(.EASMSG)
+35 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 ; Example: To add a record in subfile 2.0361 in the record with ien=353
+16 ; with the field .01 value = 21:
+17 ; S EASDATA(.01)=21,EASENDA(1)=353 I $$FILE^EAS1207(2.0361,.EASENDA,.EASDATA) W!,"DONE"
+18 ;
+19 ; Example: If creating a record not in a subfile, would look like this:
+20 ; S EASDATA(.01)=21 I $$FILE^EAS1207(867,,.EASDATA) W !,"DONE"
+21 ;
+22 NEW EASFDA,EASFLD,EASIENA,EASIENS,EASERRS,EASIEN,DIERR
+23 ;
+24 ;EASIENS - Internal Entry Number String defined by FM
+25 ;EASIENA - the Internal Entry Number Array defined by FM
+26 ;EASFDA - the FDA array defined by FM
+27 ;EASIEN - the ien of the new record
+28 ;
+29 SET EASENDA="+1"
+30 SET EASIENS=$$IENS^DILF(.EASENDA)
+31 SET EASFLD=0
+32 FOR
SET EASFLD=$ORDER(EASDATA(EASFLD))
if 'EASFLD
QUIT
Begin DoDot:1
+33 SET EASFDA(EASFILE,EASIENS,EASFLD)=$GET(EASDATA(EASFLD))
End DoDot:1
+34 DO UPDATE^DIE("","EASFDA","EASIENA","EASERRS(1)")
+35 IF +$GET(DIERR)
Begin DoDot:1
+36 SET EASERR=$GET(EASERRS(1,"DIERR",1,"TEXT",1))
+37 SET EASIEN=""
End DoDot:1
+38 IF '$TEST
Begin DoDot:1
+39 SET EASIEN=EASIENA(1)
+40 SET EASERR=""
End DoDot:1
+41 DO CLEAN^DILF
+42 SET EASENDA=EASIEN
+43 QUIT EASIEN
