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