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