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

DG53976P.m

Go to the documentation of this file. 
  1. DG53976P ;ALB/JAM - DG*5.3*976 POST INSTALL TO UPDATE HEALTH BENEFIT PLANS FOR COMMUNITY CARE PROGRAM ;12/27/18 9:18pm
  1.  ;;5.3;Registration;**976**;Aug 13, 1993;Build 14
  1.  ;
  1.  ;  Integration Agreements:
  1.  ;        10141 : BMES^XPDUTL
  1.  ;              : MES^XPDUTL
  1.  ;        10018 : UPDATE^DIE
  1.  Q
  1. POST ; Entry point for post-install
  1.  ;
  1.  L +^DGHBP(25.11,0):10 I '$T D BMES^XPDUTL("     Health Benefit Plan (#25.11) File is locked by another user.  Please log YOUR IT Services ticket.") Q
  1.  D BMES^XPDUTL("    Adding Entry in HEALTH BENEFIT PLAN (#25.11) File -")
  1.  D MES^XPDUTL("     Veteran Plan - CCP Grandfather   ")
  1.  D UPDPS1
  1.  D BMES^XPDUTL("    Adding Entry in HEALTH BENEFIT PLAN (#25.11) File -")
  1.  D MES^XPDUTL("     Veteran Plan - CCP State with no Full-Service Medical Facility    ")
  1.  D UPDPS2
  1.  D BMES^XPDUTL("    Adding Entry in HEALTH BENEFIT PLAN (#25.11) File - ")
  1.  D MES^XPDUTL("     Veteran Plan - CCP Urgent Care    ")
  1.  D UPDPS3
  1.  D BMES^XPDUTL("    Adding Entry in HEALTH BENEFIT PLAN (#25.11) File -")
  1.  D MES^XPDUTL("     Veteran Plan - CCP Basic    ")
  1.  D UPDPS4
  1.  D BMES^XPDUTL("    Adding Entry in HEALTH BENEFIT PLAN (#25.11) File -")
  1.  D MES^XPDUTL("     Veteran Plan - CCP Hardship Determination    ")
  1.  D UPDPS5
  1.  ;
  1.  L -^DGHBP(25.11,0)
  1.  Q
  1.  ;
  1. UPDPS1 ;Setup new Health Benefit Plan - Veteran Plan - CCP Grandfather
  1.  ;
  1.  N DGFIELDS,DGERR
  1.  S DGERR=""
  1.  S DGFIELDS("NAME")="Veteran Plan - CCP Grandfather"
  1.  S DGFIELDS("PLANCODE")=211
  1.  S DGFIELDS("COVERAGECODE")="CC01001"
  1.  S DGFIELDS("SD",1)="Veteran Plan - CCP Grandfather"
  1.  S DGFIELDS("LD",1)="Grandfathered Veterans have their eligibility extended from Veterans Choice"
  1.  S DGFIELDS("LD",2)="Program to the new Community Care Program established under the MISSION Act."
  1.  S DGFIELDS("LD",3)="There are two groups of Grandfathered Veterans: "
  1.  S DGFIELDS("LD",4)="'5 Lowest Population Density States'"
  1.  S DGFIELDS("LD",5)="or 'Received Title 38 Care'."
  1.  S DGFIELDS("LD",6)="Both groups require that the enrolled Veteran"
  1.  S DGFIELDS("LD",7)="(1) was distance-eligible on the day before the MISSION Act was signed (June 5, 2018), and"
  1.  S DGFIELDS("LD",8)="(2) live in a place that is still distance-eligible under Veterans Choice"
  1.  S DGFIELDS("LD",9)="rules as of the start of the MISSION Act on June 6, 2019."
  1.  D UPDREQ(.DGFIELDS,.DGERR)
  1.  I DGERR'="" D
  1.  . D BMES^XPDUTL("     *** An Error occurred during updating Plan:")
  1.  . D MES^XPDUTL("     *** "_DGERR_" ***")
  1.  . D MES^XPDUTL("     Please log YOUR IT Services ticket.")
  1.  Q
  1. UPDPS2 ;Setup new Health Benefit Plan - Veteran Plan - CCP State with no Full-Service Medical Facility
  1.  ;
  1.  N DGFIELDS,DGERR
  1.  S DGERR=""
  1.  S DGFIELDS("NAME")="Veteran Plan - CCP State with no Full-Service Medical Facility"
  1.  S DGFIELDS("PLANCODE")=209
  1.  S DGFIELDS("COVERAGECODE")="CC01002"
  1.  S DGFIELDS("SD",1)="Veteran Plan - CCP State with no Full-Service Medical Facility"
  1.  S DGFIELDS("LD",1)="Enrolled Veterans who reside in a state with no full-service "
  1.  S DGFIELDS("LD",2)="VA health care facility."
  1.  S DGFIELDS("LD",3)="This eligibility will be determined and assigned with the start of the MISSION Act on June 6, 2019."
  1.  D UPDREQ(.DGFIELDS,.DGERR)
  1.  I DGERR'="" D
  1.  . D BMES^XPDUTL("     *** An Error occurred during updating Plan:")
  1.  . D MES^XPDUTL("     *** "_DGERR_" ***")
  1.  . D MES^XPDUTL("     Please log YOUR IT Services ticket.")
  1.  Q
  1.  ;
  1. UPDPS3 ;Setup new Health Benefit Plan - Veteran Plan - CCP Urgent Care
  1.  ;
  1.  N DGFIELDS,DGERR
  1.  S DGERR=""
  1.  S DGFIELDS("NAME")="Veteran Plan - CCP Urgent Care"
  1.  S DGFIELDS("PLANCODE")=210
  1.  S DGFIELDS("COVERAGECODE")="CC01003"
  1.  S DGFIELDS("SD",1)="Veteran Plan - CCP Urgent Care"
  1.  S DGFIELDS("LD",1)="Enrolled Veterans who have received Title 38 care within the past two years who meet the administrative eligibility for non-VA Urgent Care for services."
  1.  S DGFIELDS("LD",2)="This eligibility will be determined and assigned with the start of the MISSION Act on June 6, 2019."
  1.  D UPDREQ(.DGFIELDS,.DGERR)
  1.  I DGERR'="" D
  1.  . D BMES^XPDUTL("     *** An Error occurred during updating Plan:")
  1.  . D MES^XPDUTL("     *** "_DGERR_" ***")
  1.  . D MES^XPDUTL("     Please log YOUR IT Services ticket.")
  1.  Q
  1.  ;
  1. UPDPS4 ;Setup new Health Benefit Plan - Veteran Plan - CCP Basic
  1.  ;
  1.  N DGFIELDS,DGERR
  1.  S DGERR=""
  1.  S DGFIELDS("NAME")="Veteran Plan - CCP Basic"
  1.  S DGFIELDS("PLANCODE")=208
  1.  S DGFIELDS("COVERAGECODE")="CC01006"
  1.  S DGFIELDS("SD",1)="Veteran Plan - CCP Basic"
  1.  S DGFIELDS("LD",1)="The Veteran must be enrolled in the VA healthcare system."
  1.  S DGFIELDS("LD",2)="Veteran is eligible for the Community Care Program but does not meet"
  1.  S DGFIELDS("LD",3)="the criteria for Community Care services."
  1.  D UPDREQ(.DGFIELDS,.DGERR)
  1.  I DGERR'="" D
  1.  . D BMES^XPDUTL("     *** An Error occurred during updating Plan:")
  1.  . D MES^XPDUTL("     *** "_DGERR_" ***")
  1.  . D MES^XPDUTL("     Please log YOUR IT Services ticket.")
  1.  Q
  1.  ;
  1. UPDPS5 ;Setup new Health Benefit Plan - Veteran Plan - CCP Hardship Determination
  1.  ;
  1.  N DGFIELDS,DGERR
  1.  S DGERR=""
  1.  S DGFIELDS("NAME")="Veteran Plan - CCP Hardship Determination"
  1.  S DGFIELDS("OLDNAME")="Veteran Plan - CCP Admin VCCPE Consults"
  1.  S DGFIELDS("PLANCODE")=212
  1.  S DGFIELDS("COVERAGECODE")="CC01007"
  1.  S DGFIELDS("SD",1)="Veteran Plan - CCP Hardship Determination"
  1.  S DGFIELDS("LD",1)="The Veteran must be enrolled in the VA health care system. The Veteran who may"
  1.  S DGFIELDS("LD",2)="meet new MISSION Act access standards (wait time and drive time) may still face"
  1.  S DGFIELDS("LD",3)="an unusual or excessive burden in accessing care at the VA based on:"
  1.  S DGFIELDS("LD",4)=". Geographical challenges"
  1.  S DGFIELDS("LD",5)=". Environmental factors such as:"
  1.  S DGFIELDS("LD",6)="o Roads that are not accessible to the general public, such as a road through a military base or restricted area"
  1.  S DGFIELDS("LD",7)="o Traffic, or"
  1.  S DGFIELDS("LD",8)="o Hazardous weather conditions"
  1.  S DGFIELDS("LD",9)=". A medical condition that impacts the ability to travel"
  1.  S DGFIELDS("LD",10)="Or"
  1.  S DGFIELDS("LD",11)=". Meets MISSION Act access standard, but, must travel by air, boat, or ferry"
  1.  S DGFIELDS("LD",12)="And"
  1.  S DGFIELDS("LD",13)=". Veteran has received a ""COMMUNITY CARE-HARDSHIP DETERMINATION"" consult and"
  1.  S DGFIELDS("LD",14)="  the consult has not expired then the Veteran will be eligible for Hardship."
  1.  D UPDREQ(.DGFIELDS,.DGERR)
  1.  I DGERR'="" D
  1.  . D BMES^XPDUTL("     *** An Error occurred during updating Plan:")
  1.  . D MES^XPDUTL("     *** "_DGERR_" ***")
  1.  . D MES^XPDUTL("     Please log YOUR IT Services ticket.")
  1.  Q
  1.  ;
  1. UPDREQ(DGFIELDS,DGERR) ; Update entries in the HEALTH BENEFIT PLAN File (25.11)
  1.  ;
  1.  ;  Input: DGFIELDS - Array of Field Values
  1.  ;
  1.  ;  Output:   DGERR - Error Text
  1.  ;
  1.  N DGIEN,DGNAME,DGPCODE,DGCCODE,DGSD,DGLD,DGFDA,DGPFMSG,DGPFMS1,DGUPDATE,DGRENAME
  1.  K DGERR
  1.  S DGERR=""
  1.  S DGNAME=$G(DGFIELDS("NAME"))
  1.  S DGRENAME=$G(DGFIELDS("OLDNAME"))
  1.  S DGPCODE=$G(DGFIELDS("PLANCODE"))
  1.  M DGSD=DGFIELDS("SD")
  1.  M DGLD=DGFIELDS("LD")
  1.  S DGCCODE=$G(DGFIELDS("COVERAGECODE"))
  1.  I DGNAME="" S DGERR="Missing Health Benefit Plan Name" Q
  1.  D  Q:DGERR'=""
  1.  . I DGPCODE="" S DGERR="Missing Plan Code" Q
  1.  . I '$D(DGSD) S DGERR="Missing Short Description" Q
  1.  . I '$D(DGLD) S DGERR="Missing Long Description" Q
  1.  . I DGCCODE="" S DGERR="Missing Coverage Code" Q
  1.  ;
  1.  ; Check if entry exists, use it if it does (and rename if a new name is specified)
  1.  S DGUPDATE=0,DGIEN=""
  1.  I DGRENAME'="" D
  1.  . S DGIEN=$O(^DGHBP(25.11,"B",DGRENAME,0))
  1.  . I DGIEN D
  1.  . . S DGUPDATE=1
  1.  . . D MES^XPDUTL("      Plan name "_DGRENAME)
  1.  . . D MES^XPDUTL("       will be renamed to "_DGNAME)
  1.  I DGIEN="" D
  1.  . S DGIEN=$O(^DGHBP(25.11,"B",DGNAME,0))
  1.  . I DGIEN D
  1.  . . S DGUPDATE=1
  1.  . . D MES^XPDUTL("      Plan already exists - it will be updated.")
  1.  I 'DGIEN S DGIEN="+1"
  1.  S DGIEN=DGIEN_","
  1.  ;
  1.  S DGFDA(25.11,DGIEN,.01)=DGNAME
  1.  S:DGPCODE'="" DGFDA(25.11,DGIEN,.02)=DGPCODE
  1.  S:DGCCODE'="" DGFDA(25.11,DGIEN,.05)=DGCCODE
  1.  D UPDATE^DIE("E","DGFDA","","DGERR")
  1.  I $D(DGERR("DIERR")) S DGERR=$G(DGERR("DIERR",1,"TEXT",1)) Q
  1.  S DGIEN=$O(^DGHBP(25.11,"B",DGNAME,0))
  1.  I 'DGIEN D BMES^XPDUTL("    "_DGIEN_" entry is not found to update Short and Long Description fields.  ") Q
  1.  D WP^DIE(25.11,DGIEN_",",.03,"","DGSD","DGPFMSG") ; SHORT DESCRIPTION
  1.  I $D(DGPFMSG) S DGERR=$G(DGPFMSG("DIERR",1,"TEXT",1)) Q
  1.  D WP^DIE(25.11,DGIEN_",",.04,"","DGLD","DGPFMS1") ; LONG DESCRIPTION
  1.  I $D(DGPFMS1) S DGERR=$G(DGPFMS1("DIERR",1,"TEXT",1)) Q
  1.  D MES^XPDUTL("      Plan has been "_$S(DGUPDATE=1:"updated",1:"added")_".")
  1.  Q
  1.  ;