150 lines
7.3 KiB
Mathematica
150 lines
7.3 KiB
Mathematica
DG53672E ;ALB/BRM,ERC - DG*5.3*672 Post-install Updates ; 8/19/05 1:48pm
|
|
;;5.3;Registration;**672**;Aug 13, 1993
|
|
;
|
|
PRE ; Rename/Inactivate eligibility codes and enrollment statuses
|
|
;
|
|
N ELCODE,ENSTAT,NEWSTAT,NEWCODE
|
|
K XPDABORT
|
|
S ENSTAT="PENDING; NO ELIGIBILITY CODE IN VIVA"
|
|
S NEWSTAT="PENDING; NO ELIGIBILITY CODE"
|
|
D RENAM(ENSTAT,NEWSTAT,1)
|
|
D CHKIEN("PENDING; NO ELIGIBILITY CODE",15) Q:$G(XPDABORT)
|
|
D CHKIEN("PENDING; ELIGIBILITY STATUS IS UNVERIFIED",17) Q:$G(XPDABORT)
|
|
S ELCODE="TRICARE/CHAMPUS",NEWCODE="TRICARE"
|
|
D RENAM(ELCODE,NEWCODE,0)
|
|
S ELCODE="MEXICAN BORDER WAR" D INACT(ELCODE)
|
|
S ELCODE="REIMBURSABLE INSURANCE" D INACT(ELCODE)
|
|
D MAP1010
|
|
Q
|
|
;
|
|
RENAM(OLD,NEW,FLG) ; Rename Eligibility Code or Enrollment Status Code
|
|
;
|
|
; OLD - Old Name for Enrollment Status or Eligibility Code
|
|
; NEW - New Name for Enrollment Status or Eligibility Code
|
|
; FLG - Positive value if renaming Enrollment Status (optional)
|
|
;
|
|
N NAMEX,NAMEX1
|
|
I $G(FLG) D Q ;rename enrollment status
|
|
.S NAMEX=$E(OLD,1,30),NAMEX1=$E(NEW,1,30),DGIEN=""
|
|
.I '$O(^DGEN(27.15,"B",NAMEX,"")),'$O(^DGEN(27.15,"B",NAMEX1,"")) D BMES^XPDUTL(OLD_" does not exist in file #27.15 - Please contact EVS for assistance.") Q
|
|
.I '$O(^DIC(27.15,"B",NAMEX,"")),$O(^DIC(27.15,"B",NAMEX1,"")) D BMES^XPDUTL(OLD_" has already been renamed in file #27.15") Q
|
|
.F S DGIEN=$O(^DGEN(27.15,"B",NAMEX,DGIEN)) Q:'DGIEN D
|
|
..I $P($G(^DGEN(27.15,DGIEN,0)),"^")=NEW D BMES^XPDUTL(OLD_" has already been renamed in file #27.15.") Q
|
|
..S DGFDA(27.15,DGIEN_",",.01)=NEW
|
|
..D FILE^DIE("K","DGFDA","DGERR")
|
|
..I $D(DGERR) D ERRDISP(.DGERR,"Failed to Rename "_OLD_" in ENROLLMENT STATUS file (#27.15).") Q
|
|
..D BMES^XPDUTL(OLD_" renamed to "_NEW_" in file #27.15")
|
|
;
|
|
; rename eligibility code in file #8
|
|
S NAMEX=$E(OLD,1,30),NAMEX1=$E(NEW,1,30),DGIEN=""
|
|
D ; attempt rename in file #8.1 even if file #8 fails
|
|
.I '$O(^DIC(8,"B",NAMEX,"")),'$O(^DIC(8,"B",NAMEX1,"")) D BMES^XPDUTL(OLD_" does not exist in file #8 - Please contact EVS for assistance.") Q
|
|
.I '$O(^DIC(8,"B",NAMEX,"")),$O(^DIC(8,"B",NAMEX1,"")) D BMES^XPDUTL(OLD_" has already been renamed in file #8") Q
|
|
.F S DGIEN=$O(^DIC(8,"B",NAMEX,DGIEN)) Q:'DGIEN D
|
|
..I $P($G(^DIC(8,DGIEN,0)),"^")=NEW D BMES^XPDUTL(OLD_" has already been renamed in file #8") Q
|
|
..S DGFDA(8,DGIEN_",",.01)=NEW
|
|
..D FILE^DIE("K","DGFDA","DGERR")
|
|
..I $D(DGERR) D ERRDISP(.DGERR,"Failed to Rename "_OLD_" in ELIGIBILITY CODE file (#8).") Q
|
|
..D BMES^XPDUTL(OLD_" renamed to "_NEW_" in file #8")
|
|
;
|
|
; rename eligibility code in file #8.1
|
|
K DGFDA,DGERR
|
|
I '$O(^DIC(8.1,"B",NAMEX,"")),'$O(^DIC(8.1,"B",NAMEX1,"")) D BMES^XPDUTL(OLD_" does not exist in file #8.1 - Please contact EVS for assistance.") Q
|
|
I '$O(^DIC(8.1,"B",NAMEX,"")),$O(^DIC(8.1,"B",NAMEX1,"")) D BMES^XPDUTL(OLD_" has already been renamed in file #8.1") Q
|
|
S DGIEN="" F S DGIEN=$O(^DIC(8.1,"B",NAMEX,DGIEN)) Q:'DGIEN D
|
|
.I $P($G(^DIC(8.1,DGIEN,0)),"^")=NEW D BMES^XPDUTL(OLD_" has already been renamed in file #8.1") Q
|
|
.S DGFDA(8.1,DGIEN_",",.01)=NEW
|
|
.D FILE^DIE("K","DGFDA","DGERR")
|
|
.I $D(DGERR) D ERRDISP(.DGERR,"Failed to Rename "_OLD_" in MAS ELIGIBILITY CODE file (#8.1).") Q
|
|
.D BMES^XPDUTL(OLD_" renamed to "_NEW_" in file #8.1")
|
|
Q
|
|
CHKIEN(ENSTAT,ENIEN) ; Verify IEN of records in the Enrollment Status file (#27.15)
|
|
Q:$G(ENSTAT)="" Q:$G(ENIEN)=""
|
|
I $O(^DGEN(27.15,"B",$E(ENSTAT,1,30),""))=ENIEN Q
|
|
; The enrollment status is missing or has the wrong IEN, abort install
|
|
S XPDABORT=2
|
|
D BMES^XPDUTL(">>> ERROR IN ENROLLMENT STATUS FILE #27.15 <<<")
|
|
D BMES^XPDUTL("Enrollment Status '"_ENSTAT_"' should be record #"_ENIEN)
|
|
D BMES^XPDUTL("Please contact EVS for assistance")
|
|
D BMES^XPDUTL(">>>>>> INSTALLATION ABORTED <<<<<<")
|
|
Q
|
|
INACT(ELCODE) ; Inactivate Eligibility Codes
|
|
N DGIEN,DGERR,DGFDA,NAMEX
|
|
; This code is in the ELIGIBILITY CODE file (#8).
|
|
D ; allow file #8.1 checks to occur even if error msg for file #8
|
|
.S NAMEX=$E(ELCODE,1,30),DGIEN=""
|
|
.I '$O(^DIC(8,"B",NAMEX,"")) D BMES^XPDUTL(ELCODE_" does not exist in file #8 - Please contact EVS for assistance.")
|
|
.F S DGIEN=$O(^DIC(8,"B",NAMEX,DGIEN)) Q:'DGIEN D
|
|
..I $P($G(^DIC(8,DGIEN,0)),"^",7) D BMES^XPDUTL(ELCODE_" has already been deactivated in file #8.") Q
|
|
..S DGFDA(8,DGIEN_",",6)=1
|
|
..D FILE^DIE("K","DGFDA","DGERR")
|
|
..I $D(DGERR) D ERRDISP(.DGERR,"Failed to Inactivate "_ELCODE_" in ELIGIBILITY CODE file (#8).") Q
|
|
..D BMES^XPDUTL(ELCODE_" successfully deactivated in file #8")
|
|
;
|
|
; This code is in the MAS ELIGIBILITY CODE file (#8.1).
|
|
K DGFDA,DGERR
|
|
I '$O(^DIC(8.1,"B",NAMEX,"")) D BMES^XPDUTL(ELCODE_" does not exist in #8.1 - Please contact EVS for assistance.") Q
|
|
S DGIEN="" F S DGIEN=$O(^DIC(8.1,"B",NAMEX,DGIEN)) Q:'DGIEN D
|
|
.D OTHR8(DGIEN)
|
|
.I $P($G(^DIC(8.1,DGIEN,0)),"^",7) D BMES^XPDUTL(ELCODE_" has already been deactivated in file #8.1.") Q
|
|
.S DGFDA(8.1,DGIEN_",",6)=1
|
|
.D FILE^DIE("K","DGFDA","DGERR")
|
|
.I $D(DGERR) D ERRDISP(.DGERR,"Failed to Inactivate "_ELCODE_" in MAS ELIGIBILITY CODE file (#8.1).") Q
|
|
.D BMES^XPDUTL(ELCODE_" successfully deactivated in file #8.1")
|
|
Q
|
|
;
|
|
OTHR8(IEN) ; find all site-specific eligibility codes pointing to ELCODE
|
|
;
|
|
Q:'$G(IEN)
|
|
N IEN2,NAME,DGFDA,DGERR
|
|
S IEN2="" F S IEN2=$O(^DIC(8,"D",IEN,IEN2)) Q:'IEN2 D
|
|
.S NAME=$P($G(^DIC(8,IEN2,0)),"^")
|
|
.Q:NAME=$P($G(^DIC(8.1,IEN,0)),"^")
|
|
.I $P($G(^DIC(8,IEN2,0)),"^",7) D BMES^XPDUTL(NAME_" has already been deactivated in file #8.") Q
|
|
.S DGFDA(8,IEN2_",",6)=1
|
|
.D FILE^DIE("K","DGFDA","DGERR")
|
|
.I $D(DGERR) D ERRDISP(.DGERR,"Failed to Inactivate "_NAME_" in ELIGIBILITY CODE file (#8).") Q
|
|
.D BMES^XPDUTL(NAME_" successfully deactivated in file #8")
|
|
Q
|
|
ERRDISP(DGERR,TXT) ; Display FM error message.
|
|
N ERR,LINE
|
|
S (ERR,LINE)=0
|
|
D BMES^XPDUTL(TXT)
|
|
F S ERR=$O(DGERR("DIERR",ERR)) Q:'ERR F S LINE=$O(DGERR("DIERR",ERR,"TEXT",LINE)) Q:LINE']"" D BMES^XPDUTL(" "_DGERR("DIERR",ERR,"TEXT",LINE))
|
|
D BMES^XPDUTL("Please contact EVS for assistance")
|
|
Q
|
|
MAP1010 ;the 1010EZ Mapping file (#711) links a 1010EZ field with the Patient
|
|
;file field to which it maps. DG*5.3*672 changes the mapping of the
|
|
;DISABILITY RETIREMENT FROM MILITARY field from .362 - DISABILITY RET.
|
|
;FROM MILITARY? to .3602 - REC'ING MILITARY RETIREMENT? and from
|
|
;1010.158 - DISABILITY DISCHARGE ON 1010EZ to .3603 - DISCH. DUE TO
|
|
;DISABILITY?
|
|
N DG1010,DG362,DGFDA,DGFLD,DGMES,DGPARAM,ERR
|
|
S DG1010=$O(^EAS(711,"B","DISABILITY DISCHARGE CLAIMED",0))
|
|
S DG362=$O(^EAS(711,"B","DISABILITY RETIREMENT FROM MIL",0))
|
|
I $G(DG362)]"" S DGFDA(711,DG362_",",4)=.3602
|
|
I $G(DG1010)]"" S DGFDA(711,DG1010_",",4)=.3603
|
|
D FILE^DIE("S","DGFDA","DGERR")
|
|
S ERR=""
|
|
F S ERR=$O(DGERR("DIERR",ERR)) Q:'ERR D
|
|
. F S LINE=$O(DGERR("DIERR",ERR,"TEXT",LINE)) Q:LINE']"" D
|
|
. . D BMES^XPDUTL(" "_DGERR("DIERR",ERR,"TEXT",LINE))
|
|
. . D BMES^XPDUTL("Please contact EVS for assistance")
|
|
. . S DGPARAM(ERR)=$G(DGERR("DIERR",ERR,"PARAM",1))
|
|
I $G(DGPARAM(2)) Q ;if there are 2 params, then both failed
|
|
I '$D(DGPARAM) D FLD3602,FLD3603 ;if there are no params, then neither failed
|
|
;only one field failed, so determine which one and send success message
|
|
;for the other
|
|
I $G(DGPARAM(1))=.3602 D FLD3603
|
|
I $G(DGPARAM(1))=.3603 D FLD3602
|
|
I $D(DGMES) D BMES^XPDUTL(.DGMES)
|
|
Q
|
|
FLD3602 ;
|
|
S DGFLD="DISABILITY RETIREMENT FROM MILITARY"
|
|
S DGMES(1)="Changed mapping of "_DGFLD_" in file #711 from .362 to .3602"
|
|
Q
|
|
FLD3603 ;
|
|
S DGFLD="DISABILITY DISCHARGE CLAIMED"
|
|
S DGMES(2)="Changed mapping of "_DGFLD_" in file #711 from 1010.158 to .3603"
|
|
Q
|