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

DG53672E.m

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