EMERGENCY Released DG*5.3*976 SEQ #857 Extracted from mail message **KIDS**:DG*5.3*976^ **INSTALL NAME** DG*5.3*976 "BLD",10915,0) DG*5.3*976^REGISTRATION^0^3190502^y "BLD",10915,1,0) ^^1^1^3190131^ "BLD",10915,1,1,0) Please refer to the Patch Description in FORUM for patch DG*5.3*976 "BLD",10915,4,0) ^9.64PA^^ "BLD",10915,6.3) 14 "BLD",10915,"ABPKG") n "BLD",10915,"INID") ^y "BLD",10915,"INIT") POST^DG53976P "BLD",10915,"KRN",0) ^9.67PA^779.2^20 "BLD",10915,"KRN",.4,0) .4 "BLD",10915,"KRN",.401,0) .401 "BLD",10915,"KRN",.402,0) .402 "BLD",10915,"KRN",.403,0) .403 "BLD",10915,"KRN",.5,0) .5 "BLD",10915,"KRN",.84,0) .84 "BLD",10915,"KRN",3.6,0) 3.6 "BLD",10915,"KRN",3.8,0) 3.8 "BLD",10915,"KRN",9.2,0) 9.2 "BLD",10915,"KRN",9.8,0) 9.8 "BLD",10915,"KRN",19,0) 19 "BLD",10915,"KRN",19.1,0) 19.1 "BLD",10915,"KRN",101,0) 101 "BLD",10915,"KRN",409.61,0) 409.61 "BLD",10915,"KRN",771,0) 771 "BLD",10915,"KRN",779.2,0) 779.2 "BLD",10915,"KRN",870,0) 870 "BLD",10915,"KRN",8989.51,0) 8989.51 "BLD",10915,"KRN",8989.52,0) 8989.52 "BLD",10915,"KRN",8994,0) 8994 "BLD",10915,"KRN","B",.4,.4) "BLD",10915,"KRN","B",.401,.401) "BLD",10915,"KRN","B",.402,.402) "BLD",10915,"KRN","B",.403,.403) "BLD",10915,"KRN","B",.5,.5) "BLD",10915,"KRN","B",.84,.84) "BLD",10915,"KRN","B",3.6,3.6) "BLD",10915,"KRN","B",3.8,3.8) "BLD",10915,"KRN","B",9.2,9.2) "BLD",10915,"KRN","B",9.8,9.8) "BLD",10915,"KRN","B",19,19) "BLD",10915,"KRN","B",19.1,19.1) "BLD",10915,"KRN","B",101,101) "BLD",10915,"KRN","B",409.61,409.61) "BLD",10915,"KRN","B",771,771) "BLD",10915,"KRN","B",779.2,779.2) "BLD",10915,"KRN","B",870,870) "BLD",10915,"KRN","B",8989.51,8989.51) "BLD",10915,"KRN","B",8989.52,8989.52) "BLD",10915,"KRN","B",8994,8994) "BLD",10915,"QDEF") ^^^^NO^^^^NO^^NO "BLD",10915,"QUES",0) ^9.62^^ "BLD",10915,"REQB",0) ^9.611^1^1 "BLD",10915,"REQB",1,0) DG*5.3*941^1 "BLD",10915,"REQB","B","DG*5.3*941",1) "INIT") POST^DG53976P "MBREQ") 0 "PKG",47,-1) 1^1 "PKG",47,0) REGISTRATION^DG^PATIENT REGISTRATION, ADMISSION, DISCHARGE, EMBOSSER "PKG",47,20,0) ^9.402P^^ "PKG",47,22,0) ^9.49I^1^1 "PKG",47,22,1,0) 5.3^2930813^2960613 "PKG",47,22,1,"PAH",1,0) 976^3190502 "PKG",47,22,1,"PAH",1,1,0) ^^1^1^3190502 "PKG",47,22,1,"PAH",1,1,1,0) Please refer to the Patch Description in FORUM for patch DG*5.3*976 "QUES","XPF1",0) Y "QUES","XPF1","??") ^D REP^XPDH "QUES","XPF1","A") Shall I write over your |FLAG| File "QUES","XPF1","B") YES "QUES","XPF1","M") D XPF1^XPDIQ "QUES","XPF2",0) Y "QUES","XPF2","??") ^D DTA^XPDH "QUES","XPF2","A") Want my data |FLAG| yours "QUES","XPF2","B") YES "QUES","XPF2","M") D XPF2^XPDIQ "QUES","XPI1",0) YO "QUES","XPI1","??") ^D INHIBIT^XPDH "QUES","XPI1","A") Want KIDS to INHIBIT LOGONs during the install "QUES","XPI1","B") NO "QUES","XPI1","M") D XPI1^XPDIQ "QUES","XPM1",0) PO^VA(200,:EM "QUES","XPM1","??") ^D MG^XPDH "QUES","XPM1","A") Enter the Coordinator for Mail Group '|FLAG|' "QUES","XPM1","B") "QUES","XPM1","M") D XPM1^XPDIQ "QUES","XPO1",0) Y "QUES","XPO1","??") ^D MENU^XPDH "QUES","XPO1","A") Want KIDS to Rebuild Menu Trees Upon Completion of Install "QUES","XPO1","B") NO "QUES","XPO1","M") D XPO1^XPDIQ "QUES","XPZ1",0) Y "QUES","XPZ1","??") ^D OPT^XPDH "QUES","XPZ1","A") Want to DISABLE Scheduled Options, Menu Options, and Protocols "QUES","XPZ1","B") NO "QUES","XPZ1","M") D XPZ1^XPDIQ "QUES","XPZ2",0) Y "QUES","XPZ2","??") ^D RTN^XPDH "QUES","XPZ2","A") Want to MOVE routines to other CPUs "QUES","XPZ2","B") NO "QUES","XPZ2","M") D XPZ2^XPDIQ "RTN") 1 "RTN","DG53976P") 0^^B70401607^n/a "RTN","DG53976P",1,0) DG53976P ;ALB/JAM - DG*5.3*976 POST INSTALL TO UPDATE HEALTH BENEFIT PLANS FOR COMMUNITY CARE PROGRAM ;12/27/18 9:18pm "RTN","DG53976P",2,0) ;;5.3;Registration;**976**;Aug 13, 1993;Build 14 "RTN","DG53976P",3,0) ; "RTN","DG53976P",4,0) ; Integration Agreements: "RTN","DG53976P",5,0) ; 10141 : BMES^XPDUTL "RTN","DG53976P",6,0) ; : MES^XPDUTL "RTN","DG53976P",7,0) ; 10018 : UPDATE^DIE "RTN","DG53976P",8,0) Q "RTN","DG53976P",9,0) POST ; Entry point for post-install "RTN","DG53976P",10,0) ; "RTN","DG53976P",11,0) 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 "RTN","DG53976P",12,0) D BMES^XPDUTL(" Adding Entry in HEALTH BENEFIT PLAN (#25.11) File -") "RTN","DG53976P",13,0) D MES^XPDUTL(" Veteran Plan - CCP Grandfather ") "RTN","DG53976P",14,0) D UPDPS1 "RTN","DG53976P",15,0) D BMES^XPDUTL(" Adding Entry in HEALTH BENEFIT PLAN (#25.11) File -") "RTN","DG53976P",16,0) D MES^XPDUTL(" Veteran Plan - CCP State with no Full-Service Medical Facility ") "RTN","DG53976P",17,0) D UPDPS2 "RTN","DG53976P",18,0) D BMES^XPDUTL(" Adding Entry in HEALTH BENEFIT PLAN (#25.11) File - ") "RTN","DG53976P",19,0) D MES^XPDUTL(" Veteran Plan - CCP Urgent Care ") "RTN","DG53976P",20,0) D UPDPS3 "RTN","DG53976P",21,0) D BMES^XPDUTL(" Adding Entry in HEALTH BENEFIT PLAN (#25.11) File -") "RTN","DG53976P",22,0) D MES^XPDUTL(" Veteran Plan - CCP Basic ") "RTN","DG53976P",23,0) D UPDPS4 "RTN","DG53976P",24,0) D BMES^XPDUTL(" Adding Entry in HEALTH BENEFIT PLAN (#25.11) File -") "RTN","DG53976P",25,0) D MES^XPDUTL(" Veteran Plan - CCP Hardship Determination ") "RTN","DG53976P",26,0) D UPDPS5 "RTN","DG53976P",27,0) ; "RTN","DG53976P",28,0) L -^DGHBP(25.11,0) "RTN","DG53976P",29,0) Q "RTN","DG53976P",30,0) ; "RTN","DG53976P",31,0) UPDPS1 ;Setup new Health Benefit Plan - Veteran Plan - CCP Grandfather "RTN","DG53976P",32,0) ; "RTN","DG53976P",33,0) N DGFIELDS,DGERR "RTN","DG53976P",34,0) S DGERR="" "RTN","DG53976P",35,0) S DGFIELDS("NAME")="Veteran Plan - CCP Grandfather" "RTN","DG53976P",36,0) S DGFIELDS("PLANCODE")=211 "RTN","DG53976P",37,0) S DGFIELDS("COVERAGECODE")="CC01001" "RTN","DG53976P",38,0) S DGFIELDS("SD",1)="Veteran Plan - CCP Grandfather" "RTN","DG53976P",39,0) S DGFIELDS("LD",1)="Grandfathered Veterans have their eligibility extended from Veterans Choice" "RTN","DG53976P",40,0) S DGFIELDS("LD",2)="Program to the new Community Care Program established under the MISSION Act." "RTN","DG53976P",41,0) S DGFIELDS("LD",3)="There are two groups of Grandfathered Veterans: " "RTN","DG53976P",42,0) S DGFIELDS("LD",4)="'5 Lowest Population Density States'" "RTN","DG53976P",43,0) S DGFIELDS("LD",5)="or 'Received Title 38 Care'." "RTN","DG53976P",44,0) S DGFIELDS("LD",6)="Both groups require that the enrolled Veteran" "RTN","DG53976P",45,0) S DGFIELDS("LD",7)="(1) was distance-eligible on the day before the MISSION Act was signed (June 5, 2018), and" "RTN","DG53976P",46,0) S DGFIELDS("LD",8)="(2) live in a place that is still distance-eligible under Veterans Choice" "RTN","DG53976P",47,0) S DGFIELDS("LD",9)="rules as of the start of the MISSION Act on June 6, 2019." "RTN","DG53976P",48,0) D UPDREQ(.DGFIELDS,.DGERR) "RTN","DG53976P",49,0) I DGERR'="" D "RTN","DG53976P",50,0) . D BMES^XPDUTL(" *** An Error occurred during updating Plan:") "RTN","DG53976P",51,0) . D MES^XPDUTL(" *** "_DGERR_" ***") "RTN","DG53976P",52,0) . D MES^XPDUTL(" Please log YOUR IT Services ticket.") "RTN","DG53976P",53,0) Q "RTN","DG53976P",54,0) UPDPS2 ;Setup new Health Benefit Plan - Veteran Plan - CCP State with no Full-Service Medical Facility "RTN","DG53976P",55,0) ; "RTN","DG53976P",56,0) N DGFIELDS,DGERR "RTN","DG53976P",57,0) S DGERR="" "RTN","DG53976P",58,0) S DGFIELDS("NAME")="Veteran Plan - CCP State with no Full-Service Medical Facility" "RTN","DG53976P",59,0) S DGFIELDS("PLANCODE")=209 "RTN","DG53976P",60,0) S DGFIELDS("COVERAGECODE")="CC01002" "RTN","DG53976P",61,0) S DGFIELDS("SD",1)="Veteran Plan - CCP State with no Full-Service Medical Facility" "RTN","DG53976P",62,0) S DGFIELDS("LD",1)="Enrolled Veterans who reside in a state with no full-service " "RTN","DG53976P",63,0) S DGFIELDS("LD",2)="VA health care facility." "RTN","DG53976P",64,0) S DGFIELDS("LD",3)="This eligibility will be determined and assigned with the start of the MISSION Act on June 6, 2019." "RTN","DG53976P",65,0) D UPDREQ(.DGFIELDS,.DGERR) "RTN","DG53976P",66,0) I DGERR'="" D "RTN","DG53976P",67,0) . D BMES^XPDUTL(" *** An Error occurred during updating Plan:") "RTN","DG53976P",68,0) . D MES^XPDUTL(" *** "_DGERR_" ***") "RTN","DG53976P",69,0) . D MES^XPDUTL(" Please log YOUR IT Services ticket.") "RTN","DG53976P",70,0) Q "RTN","DG53976P",71,0) ; "RTN","DG53976P",72,0) UPDPS3 ;Setup new Health Benefit Plan - Veteran Plan - CCP Urgent Care "RTN","DG53976P",73,0) ; "RTN","DG53976P",74,0) N DGFIELDS,DGERR "RTN","DG53976P",75,0) S DGERR="" "RTN","DG53976P",76,0) S DGFIELDS("NAME")="Veteran Plan - CCP Urgent Care" "RTN","DG53976P",77,0) S DGFIELDS("PLANCODE")=210 "RTN","DG53976P",78,0) S DGFIELDS("COVERAGECODE")="CC01003" "RTN","DG53976P",79,0) S DGFIELDS("SD",1)="Veteran Plan - CCP Urgent Care" "RTN","DG53976P",80,0) 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." "RTN","DG53976P",81,0) S DGFIELDS("LD",2)="This eligibility will be determined and assigned with the start of the MISSION Act on June 6, 2019." "RTN","DG53976P",82,0) D UPDREQ(.DGFIELDS,.DGERR) "RTN","DG53976P",83,0) I DGERR'="" D "RTN","DG53976P",84,0) . D BMES^XPDUTL(" *** An Error occurred during updating Plan:") "RTN","DG53976P",85,0) . D MES^XPDUTL(" *** "_DGERR_" ***") "RTN","DG53976P",86,0) . D MES^XPDUTL(" Please log YOUR IT Services ticket.") "RTN","DG53976P",87,0) Q "RTN","DG53976P",88,0) ; "RTN","DG53976P",89,0) UPDPS4 ;Setup new Health Benefit Plan - Veteran Plan - CCP Basic "RTN","DG53976P",90,0) ; "RTN","DG53976P",91,0) N DGFIELDS,DGERR "RTN","DG53976P",92,0) S DGERR="" "RTN","DG53976P",93,0) S DGFIELDS("NAME")="Veteran Plan - CCP Basic" "RTN","DG53976P",94,0) S DGFIELDS("PLANCODE")=208 "RTN","DG53976P",95,0) S DGFIELDS("COVERAGECODE")="CC01006" "RTN","DG53976P",96,0) S DGFIELDS("SD",1)="Veteran Plan - CCP Basic" "RTN","DG53976P",97,0) S DGFIELDS("LD",1)="The Veteran must be enrolled in the VA healthcare system." "RTN","DG53976P",98,0) S DGFIELDS("LD",2)="Veteran is eligible for the Community Care Program but does not meet" "RTN","DG53976P",99,0) S DGFIELDS("LD",3)="the criteria for Community Care services." "RTN","DG53976P",100,0) D UPDREQ(.DGFIELDS,.DGERR) "RTN","DG53976P",101,0) I DGERR'="" D "RTN","DG53976P",102,0) . D BMES^XPDUTL(" *** An Error occurred during updating Plan:") "RTN","DG53976P",103,0) . D MES^XPDUTL(" *** "_DGERR_" ***") "RTN","DG53976P",104,0) . D MES^XPDUTL(" Please log YOUR IT Services ticket.") "RTN","DG53976P",105,0) Q "RTN","DG53976P",106,0) ; "RTN","DG53976P",107,0) UPDPS5 ;Setup new Health Benefit Plan - Veteran Plan - CCP Hardship Determination "RTN","DG53976P",108,0) ; "RTN","DG53976P",109,0) N DGFIELDS,DGERR "RTN","DG53976P",110,0) S DGERR="" "RTN","DG53976P",111,0) S DGFIELDS("NAME")="Veteran Plan - CCP Hardship Determination" "RTN","DG53976P",112,0) S DGFIELDS("OLDNAME")="Veteran Plan - CCP Admin VCCPE Consults" "RTN","DG53976P",113,0) S DGFIELDS("PLANCODE")=212 "RTN","DG53976P",114,0) S DGFIELDS("COVERAGECODE")="CC01007" "RTN","DG53976P",115,0) S DGFIELDS("SD",1)="Veteran Plan - CCP Hardship Determination" "RTN","DG53976P",116,0) S DGFIELDS("LD",1)="The Veteran must be enrolled in the VA health care system. The Veteran who may" "RTN","DG53976P",117,0) S DGFIELDS("LD",2)="meet new MISSION Act access standards (wait time and drive time) may still face" "RTN","DG53976P",118,0) S DGFIELDS("LD",3)="an unusual or excessive burden in accessing care at the VA based on:" "RTN","DG53976P",119,0) S DGFIELDS("LD",4)=". Geographical challenges" "RTN","DG53976P",120,0) S DGFIELDS("LD",5)=". Environmental factors such as:" "RTN","DG53976P",121,0) 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" "RTN","DG53976P",122,0) S DGFIELDS("LD",7)="o Traffic, or" "RTN","DG53976P",123,0) S DGFIELDS("LD",8)="o Hazardous weather conditions" "RTN","DG53976P",124,0) S DGFIELDS("LD",9)=". A medical condition that impacts the ability to travel" "RTN","DG53976P",125,0) S DGFIELDS("LD",10)="Or" "RTN","DG53976P",126,0) S DGFIELDS("LD",11)=". Meets MISSION Act access standard, but, must travel by air, boat, or ferry" "RTN","DG53976P",127,0) S DGFIELDS("LD",12)="And" "RTN","DG53976P",128,0) S DGFIELDS("LD",13)=". Veteran has received a ""COMMUNITY CARE-HARDSHIP DETERMINATION"" consult and" "RTN","DG53976P",129,0) S DGFIELDS("LD",14)=" the consult has not expired then the Veteran will be eligible for Hardship." "RTN","DG53976P",130,0) D UPDREQ(.DGFIELDS,.DGERR) "RTN","DG53976P",131,0) I DGERR'="" D "RTN","DG53976P",132,0) . D BMES^XPDUTL(" *** An Error occurred during updating Plan:") "RTN","DG53976P",133,0) . D MES^XPDUTL(" *** "_DGERR_" ***") "RTN","DG53976P",134,0) . D MES^XPDUTL(" Please log YOUR IT Services ticket.") "RTN","DG53976P",135,0) Q "RTN","DG53976P",136,0) ; "RTN","DG53976P",137,0) UPDREQ(DGFIELDS,DGERR) ; Update entries in the HEALTH BENEFIT PLAN File (25.11) "RTN","DG53976P",138,0) ; "RTN","DG53976P",139,0) ; Input: DGFIELDS - Array of Field Values "RTN","DG53976P",140,0) ; "RTN","DG53976P",141,0) ; Output: DGERR - Error Text "RTN","DG53976P",142,0) ; "RTN","DG53976P",143,0) N DGIEN,DGNAME,DGPCODE,DGCCODE,DGSD,DGLD,DGFDA,DGPFMSG,DGPFMS1,DGUPDATE,DGRENAME "RTN","DG53976P",144,0) K DGERR "RTN","DG53976P",145,0) S DGERR="" "RTN","DG53976P",146,0) S DGNAME=$G(DGFIELDS("NAME")) "RTN","DG53976P",147,0) S DGRENAME=$G(DGFIELDS("OLDNAME")) "RTN","DG53976P",148,0) S DGPCODE=$G(DGFIELDS("PLANCODE")) "RTN","DG53976P",149,0) M DGSD=DGFIELDS("SD") "RTN","DG53976P",150,0) M DGLD=DGFIELDS("LD") "RTN","DG53976P",151,0) S DGCCODE=$G(DGFIELDS("COVERAGECODE")) "RTN","DG53976P",152,0) I DGNAME="" S DGERR="Missing Health Benefit Plan Name" Q "RTN","DG53976P",153,0) D Q:DGERR'="" "RTN","DG53976P",154,0) . I DGPCODE="" S DGERR="Missing Plan Code" Q "RTN","DG53976P",155,0) . I '$D(DGSD) S DGERR="Missing Short Description" Q "RTN","DG53976P",156,0) . I '$D(DGLD) S DGERR="Missing Long Description" Q "RTN","DG53976P",157,0) . I DGCCODE="" S DGERR="Missing Coverage Code" Q "RTN","DG53976P",158,0) ; "RTN","DG53976P",159,0) ; Check if entry exists, use it if it does (and rename if a new name is specified) "RTN","DG53976P",160,0) S DGUPDATE=0,DGIEN="" "RTN","DG53976P",161,0) I DGRENAME'="" D "RTN","DG53976P",162,0) . S DGIEN=$O(^DGHBP(25.11,"B",DGRENAME,0)) "RTN","DG53976P",163,0) . I DGIEN D "RTN","DG53976P",164,0) . . S DGUPDATE=1 "RTN","DG53976P",165,0) . . D MES^XPDUTL(" Plan name "_DGRENAME) "RTN","DG53976P",166,0) . . D MES^XPDUTL(" will be renamed to "_DGNAME) "RTN","DG53976P",167,0) I DGIEN="" D "RTN","DG53976P",168,0) . S DGIEN=$O(^DGHBP(25.11,"B",DGNAME,0)) "RTN","DG53976P",169,0) . I DGIEN D "RTN","DG53976P",170,0) . . S DGUPDATE=1 "RTN","DG53976P",171,0) . . D MES^XPDUTL(" Plan already exists - it will be updated.") "RTN","DG53976P",172,0) I 'DGIEN S DGIEN="+1" "RTN","DG53976P",173,0) S DGIEN=DGIEN_"," "RTN","DG53976P",174,0) ; "RTN","DG53976P",175,0) S DGFDA(25.11,DGIEN,.01)=DGNAME "RTN","DG53976P",176,0) S:DGPCODE'="" DGFDA(25.11,DGIEN,.02)=DGPCODE "RTN","DG53976P",177,0) S:DGCCODE'="" DGFDA(25.11,DGIEN,.05)=DGCCODE "RTN","DG53976P",178,0) D UPDATE^DIE("E","DGFDA","","DGERR") "RTN","DG53976P",179,0) I $D(DGERR("DIERR")) S DGERR=$G(DGERR("DIERR",1,"TEXT",1)) Q "RTN","DG53976P",180,0) S DGIEN=$O(^DGHBP(25.11,"B",DGNAME,0)) "RTN","DG53976P",181,0) I 'DGIEN D BMES^XPDUTL(" "_DGIEN_" entry is not found to update Short and Long Description fields. ") Q "RTN","DG53976P",182,0) D WP^DIE(25.11,DGIEN_",",.03,"","DGSD","DGPFMSG") ; SHORT DESCRIPTION "RTN","DG53976P",183,0) I $D(DGPFMSG) S DGERR=$G(DGPFMSG("DIERR",1,"TEXT",1)) Q "RTN","DG53976P",184,0) D WP^DIE(25.11,DGIEN_",",.04,"","DGLD","DGPFMS1") ; LONG DESCRIPTION "RTN","DG53976P",185,0) I $D(DGPFMS1) S DGERR=$G(DGPFMS1("DIERR",1,"TEXT",1)) Q "RTN","DG53976P",186,0) D MES^XPDUTL(" Plan has been "_$S(DGUPDATE=1:"updated",1:"added")_".") "RTN","DG53976P",187,0) Q "RTN","DG53976P",188,0) ; "VER") 8.0^22.2 "BLD",10915,6) ^857 **END** **END**