| [613] | 1 | DGENEGT1 ;ALB/KCL,ISA/KWP,LBD,RGL,BRM - Enrollment Group Threshold API's ; 7/28/04 12:54pm
|
|---|
| 2 | ;;5.3;Registration;**232,417,454,491,513,451,564,672,717**;Aug 13, 1993
|
|---|
| 3 | ;
|
|---|
| 4 | ;
|
|---|
| 5 | NOTIFY(DGEGT,OLDEGT) ;
|
|---|
| 6 | ; Description: This is used to send a message to local mail group.
|
|---|
| 7 | ; The notification is used to communicate changes in the Enrollment
|
|---|
| 8 | ; Group Threshold (EGT) setting to users at the local site.
|
|---|
| 9 | ;
|
|---|
| 10 | ; Input:
|
|---|
| 11 | ; DGEGT - the new Enrollment Group Threshold array, passed by reference
|
|---|
| 12 | ; OLDEGT - the previous Enrollment Group Threshold array, passed by reference
|
|---|
| 13 | ;
|
|---|
| 14 | ; Output: None
|
|---|
| 15 | ;
|
|---|
| 16 | N TEXT,XMDUN,XMDUZ,XMTEXT,XMROU,XMSTRIP,XMSUB,XMY,XMZ,OLDPRI
|
|---|
| 17 | ;
|
|---|
| 18 | ; init subject and sender
|
|---|
| 19 | S XMSUB="Enrollment Group Threshold (EGT) Changed"
|
|---|
| 20 | S (XMDUN,XMDUZ)="Registration Enrollment Module"
|
|---|
| 21 | ;
|
|---|
| 22 | ; recipient
|
|---|
| 23 | S XMY("G.DGEN EGT UPDATES")=""
|
|---|
| 24 | ;
|
|---|
| 25 | ; get old EGT priority
|
|---|
| 26 | S OLDPRI=$G(OLDEGT("PRIORITY"))
|
|---|
| 27 | ;
|
|---|
| 28 | S XMTEXT="TEXT("
|
|---|
| 29 | S TEXT(1)="The Secretary of the VA has officially changed the enrollment priority"
|
|---|
| 30 | S TEXT(2)="grouping of veterans who shall receive care. This change may place"
|
|---|
| 31 | S TEXT(3)="veterans under your facilities care into a 'Not Enrolled' category."
|
|---|
| 32 | S TEXT(4)=""
|
|---|
| 33 | S TEXT(5)=""
|
|---|
| 34 | S TEXT(6)=" Prior EGT Priority: "_$S($G(OLDPRI):$$EXTERNAL^DILFD(27.16,.02,"F",OLDPRI),1:"N/A")_$S($G(OLDEGT("SUBGRP")):$$EXTERNAL^DILFD(27.16,.03,"F",OLDEGT("SUBGRP")),1:"")
|
|---|
| 35 | S TEXT(7)=""
|
|---|
| 36 | S TEXT(8)=""
|
|---|
| 37 | S TEXT(9)=" New Enrollment Group Threshold (EGT) Settings:"
|
|---|
| 38 | S TEXT(10)=""
|
|---|
| 39 | S TEXT(11)=" EGT Priority: "_$$EXTERNAL^DILFD(27.16,.02,"F",DGEGT("PRIORITY"))_$S($G(DGEGT("SUBGRP")):$$EXTERNAL^DILFD(27.16,.03,"F",DGEGT("SUBGRP")),1:"")
|
|---|
| 40 | S TEXT(12)=" EGT Type: "_$$EXTERNAL^DILFD(27.16,.04,"F",DGEGT("TYPE"))
|
|---|
| 41 | S TEXT(13)=" EGT Effective Date: "_$$EXTERNAL^DILFD(27.16,.01,"F",DGEGT("EFFDATE"))
|
|---|
| 42 | ;
|
|---|
| 43 | ; mailman deliverey
|
|---|
| 44 | D ^XMD
|
|---|
| 45 | ;
|
|---|
| 46 | Q
|
|---|
| 47 | ;
|
|---|
| 48 | ;
|
|---|
| 49 | DISPLAY() ;
|
|---|
| 50 | ; Description: Display Enrollment Group Threshold (EGT) settings.
|
|---|
| 51 | ;
|
|---|
| 52 | N DGEGT
|
|---|
| 53 | ;
|
|---|
| 54 | W !
|
|---|
| 55 | I '$$GET^DGENEGT($$FINDCUR^DGENEGT(),.DGEGT) W !,"Enrollment Group Threshold (EGT) settings not found."
|
|---|
| 56 | E D
|
|---|
| 57 | .W !,?3,"Enrollment Group Threshold (EGT) Settings"
|
|---|
| 58 | .W !,?3,"========================================="
|
|---|
| 59 | .W !
|
|---|
| 60 | .W !?5,"Date Entered",?25,": ",$S('$G(DGEGT("ENTERED")):"-none-",1:$$EXTERNAL^DILFD(27.16,.01,"F",DGEGT("ENTERED")))
|
|---|
| 61 | .W !?5,"EGT Priority",?25,": ",$S('$G(DGEGT("PRIORITY")):"-none-",1:$$EXTERNAL^DILFD(27.16,.02,"F",DGEGT("PRIORITY")))_$S($G(DGEGT("SUBGRP"))="":"",1:$$EXTERNAL^DILFD(27.16,.03,"F",DGEGT("SUBGRP")))
|
|---|
| 62 | .W !?5,"EGT Type",?25,": ",$S($G(DGEGT("TYPE"))="":"-none-",1:$$EXTERNAL^DILFD(27.16,.04,"F",DGEGT("TYPE")))
|
|---|
| 63 | .W !?5,"EGT Effective Date",?25,": ",$S('$G(DGEGT("EFFDATE")):"-none-",1:$$EXTERNAL^DILFD(27.16,.05,"F",DGEGT("EFFDATE")))
|
|---|
| 64 | ;
|
|---|
| 65 | Q
|
|---|
| 66 | ;
|
|---|
| 67 | ABOVE(DPTDFN,ENRPRI,ENRGRP,EGTPRI,EGTGRP,EGTFLG) ;
|
|---|
| 68 | ; Description: This function will determine if the enrollment is above
|
|---|
| 69 | ; the threshold.
|
|---|
| 70 | ;
|
|---|
| 71 | ;Input:
|
|---|
| 72 | ; DPTDFN - Patient File IEN
|
|---|
| 73 | ; ENRPRI - Enrollment Priority
|
|---|
| 74 | ; ENRGRP - Enrollment Sub-Group
|
|---|
| 75 | ; EGTPRI - EGT Priority (optional) - not used
|
|---|
| 76 | ; EGTGRP - EGT Sub-Group (optional) - not used
|
|---|
| 77 | ; EGTFLG - Flag to bypass additional EGT type 2 check (optional)
|
|---|
| 78 | ; It is used by $$ABOVE2 to prevent re-entering the
|
|---|
| 79 | ; sub-priority API ($$SUBPRI^DGENELA4)
|
|---|
| 80 | ; Output:
|
|---|
| 81 | ; Returns 1 if above 0 below.
|
|---|
| 82 | ;
|
|---|
| 83 | I $G(ENRGRP)="" S ENRGRP=""
|
|---|
| 84 | I $G(ENRPRI)="" S ENRPRI=""
|
|---|
| 85 | N ABOVE,EGT,TODAY,X
|
|---|
| 86 | I '$$GET^DGENEGT($$FINDCUR^DGENEGT(),.EGT) Q 1
|
|---|
| 87 | D NOW^%DTC S TODAY=X
|
|---|
| 88 | I TODAY<EGT("EFFDATE") Q 1
|
|---|
| 89 | ;
|
|---|
| 90 | ;EGT type 2 - Stop New Enrollments
|
|---|
| 91 | ; or EGT type 4 - Enrollment Decision (ESP DG*5.3*491)
|
|---|
| 92 | I EGT("TYPE")=2!(EGT("TYPE")=4) D Q ABOVE
|
|---|
| 93 | .S ABOVE=0
|
|---|
| 94 | .I ENRPRI<7 D Q
|
|---|
| 95 | ..I ENRPRI'>EGT("PRIORITY") S ABOVE=1 Q
|
|---|
| 96 | .;do check for priorities 7 and 8
|
|---|
| 97 | .I ENRPRI<EGT("PRIORITY") S ABOVE=1 Q
|
|---|
| 98 | .I ENRGRP'>EGT("SUBGRP") S ABOVE=1 Q
|
|---|
| 99 | .I $$OVRRIDE(.DPTDFN,.EGT) S ABOVE=1
|
|---|
| 100 | ;
|
|---|
| 101 | ;EGT types 1 & 3
|
|---|
| 102 | ;do check for priorities 7 and 8
|
|---|
| 103 | I ENRPRI>6&(ENRPRI=EGT("PRIORITY")) S ABOVE=0 D Q ABOVE
|
|---|
| 104 | .I ENRGRP'>(EGT("SUBGRP")) S ABOVE=1
|
|---|
| 105 | I ENRPRI'>(EGT("PRIORITY")) Q 1
|
|---|
| 106 | Q 0
|
|---|
| 107 | ;
|
|---|
| 108 | ABOVE2(DPTDFN,ENRDT,PRIORITY,SUBGRP) ;
|
|---|
| 109 | ;
|
|---|
| 110 | ; Input: DPTDFN - Patient File IEN
|
|---|
| 111 | ; ENRDT - enrollment effective date
|
|---|
| 112 | ; PRIORITY - enrollment priority
|
|---|
| 113 | ; SUBGRP - enrollment sub-priority (internal numeric value)
|
|---|
| 114 | ;
|
|---|
| 115 | ; Output: 1 or 0 for above or below EGT threshold
|
|---|
| 116 | ;
|
|---|
| 117 | N ABOVE,TODAY,X,EGT
|
|---|
| 118 | S ABOVE=1
|
|---|
| 119 | S:'$G(SUBGRP) SUBGRP=""
|
|---|
| 120 | S:'$G(PRIORITY) PRIORITY=""
|
|---|
| 121 | S:'$G(ENRDT) ENRDT=""
|
|---|
| 122 | D NOW^%DTC S TODAY=X
|
|---|
| 123 | Q:'$$GET^DGENEGT($$FINDCUR^DGENEGT(ENRDT),.EGT) 1
|
|---|
| 124 | Q:'$G(EGT("EFFDATE")) 1
|
|---|
| 125 | Q:TODAY<EGT("EFFDATE") 1
|
|---|
| 126 | Q:EGT("TYPE")#2 $$ABOVE(DPTDFN,PRIORITY,SUBGRP,"","",1) ;If EGT type 1 or 3
|
|---|
| 127 | I '$$ABOVE(DPTDFN,PRIORITY,SUBGRP,"","",1) Q 0
|
|---|
| 128 | Q ABOVE
|
|---|
| 129 | ;
|
|---|
| 130 | OVRRIDE(DPTDFN,EGT) ;check for previous EGT override by HEC and new rules
|
|---|
| 131 | N CVDT,ENRCAT,ENRDT,EGTENR,ENRIEN,DGPAT,STOP,CUR,CE
|
|---|
| 132 | S (STOP,CUR)=0
|
|---|
| 133 | I '$$GET^DGENELA(DPTDFN,.DGPAT) Q 0 ;Get current Patient file data
|
|---|
| 134 | ; Find most recent enrollment record
|
|---|
| 135 | S ENRIEN=$$FINDCUR^DGENA(.DPTDFN)
|
|---|
| 136 | F Q:STOP!CUR D
|
|---|
| 137 | .I 'ENRIEN S STOP=1 Q ;cannot check if no current enrollment
|
|---|
| 138 | .I '$$GET^DGENA(ENRIEN,.EGTENR) S STOP=1 Q ;need enr info to proceed
|
|---|
| 139 | .S ENRIEN=$$FINDPRI^DGENA(ENRIEN)
|
|---|
| 140 | .; If status is Pending, Deceased, Not Eligible, or Not Applicable
|
|---|
| 141 | .; ignore record and get previous
|
|---|
| 142 | .I "^6^15^16^17^18^19^20^21^23^"[(U_EGTENR("STATUS")_U) Q
|
|---|
| 143 | .S CUR=1
|
|---|
| 144 | I STOP Q 0
|
|---|
| 145 | S ENRDT=$$EDATE($G(EGTENR("APP")),$G(EGTENR("EFFDATE"))) S:'ENRDT ENRDT=DT
|
|---|
| 146 | S ENRCAT=$P($G(^DGEN(27.15,+EGTENR("STATUS"),0)),"^",2)
|
|---|
| 147 | ; If enrollment status was overridden at HEC, then cont. enroll.
|
|---|
| 148 | I EGTENR("SOURCE")=2,ENRDT'<EGT("EFFDATE"),ENRCAT="E" Q 1
|
|---|
| 149 | ; If status is Rejected or Cancelled/Declined, quit (no cont. enroll.)
|
|---|
| 150 | I "^4^7^11^12^13^22^"[(U_EGTENR("STATUS")_U) Q 0
|
|---|
| 151 | ; If Application Date or Effective Date of Change are prior to the
|
|---|
| 152 | ; EGT Effective Date then cont. enroll.
|
|---|
| 153 | I ENRDT<EGT("EFFDATE") Q 1
|
|---|
| 154 | ; If Enrollment Record is Verified, and meets one of the special CE
|
|---|
| 155 | ; rules, then cont. enroll.
|
|---|
| 156 | I ENRCAT="E" S CE=$$RULES(DPTDFN,.EGTENR,.EGT,.DGPAT) I CE Q CE>0
|
|---|
| 157 | ; Check previous enrollment records for Application Date/Effective
|
|---|
| 158 | ; Date and special CE rules
|
|---|
| 159 | S (STOP,CE)=0
|
|---|
| 160 | F Q:STOP D
|
|---|
| 161 | .I 'ENRIEN S STOP=1 Q ;cannot check if no current enrollment
|
|---|
| 162 | .I '$$GET^DGENA(ENRIEN,.EGTENR) S STOP=1 Q ;need enr info to proceed
|
|---|
| 163 | .S ENRIEN=$$FINDPRI^DGENA(ENRIEN)
|
|---|
| 164 | .; If status is Pending, Deceased, Not Eligible; Ineligible Date,
|
|---|
| 165 | .; or Not Applicable ignore record and get previous
|
|---|
| 166 | .I "^6^15^16^17^18^19^20^21^23^"[(U_EGTENR("STATUS")_U) Q
|
|---|
| 167 | .S ENRDT=$$EDATE($G(EGTENR("APP")),$G(EGTENR("EFFDATE"))) S:'ENRDT ENRDT=DT
|
|---|
| 168 | .S ENRCAT=$P($G(^DGEN(27.15,+EGTENR("STATUS"),0)),"^",2)
|
|---|
| 169 | .; If Application Date or Effective Date of Change are prior to the
|
|---|
| 170 | .; EGT Effective Date then cont. enroll.
|
|---|
| 171 | .I ENRDT<EGT("EFFDATE") S (STOP,CE)=1 Q
|
|---|
| 172 | .; If Enrollment Record is Verified, and meets one of the special CE
|
|---|
| 173 | .; rules, then cont. enroll.
|
|---|
| 174 | .I ENRCAT="E" S CE=$$RULES(DPTDFN,.EGTENR,.EGT,.DGPAT) I CE S STOP=1,CE=CE>0 Q
|
|---|
| 175 | Q CE
|
|---|
| 176 | ;
|
|---|
| 177 | RULES(DPTDFN,EGTENR,EGT,DGPAT) ;check for new cont enrollment rules (DG*5.3*672)
|
|---|
| 178 | N RTN
|
|---|
| 179 | ; If veteran ever had a verified enrollment with SC 10%+ and is now
|
|---|
| 180 | ; SC 0% non-compensable then cont. enroll
|
|---|
| 181 | I EGTENR("ELIG","VACKAMT")&(EGTENR("ELIG","SCPER")>9)&(DGPAT("SCPER")=0)&(DGPAT("VACKAMT")'>0) Q 1
|
|---|
| 182 | ; If veteran ever had a verified enrollment with one of these
|
|---|
| 183 | ; eligibilities then cont. enroll: AA, HB, VA Pension
|
|---|
| 184 | I EGTENR("ELIG","VACKAMT")&((EGTENR("ELIG","A&A")="Y")!(EGTENR("ELIG","HB")="Y")!(EGTENR("ELIG","VAPEN")="Y")) Q 1
|
|---|
| 185 | ; If AO Exposure Location = Korean DMZ prior to ESR implementation,
|
|---|
| 186 | ; then cont. enroll.
|
|---|
| 187 | ; **** NOTE: For patch DG*5.3*672 the ESR implementation date will
|
|---|
| 188 | ; be set to 12/29/2040. This will be changed to the actual ESR
|
|---|
| 189 | ; implementation date in a later patch.
|
|---|
| 190 | I DGPAT("AO")="Y" D I $G(RTN) Q RTN
|
|---|
| 191 | .I $S($D(EGTENR("ELIG","AOEXPLOC")):EGTENR("ELIG","AOEXPLOC"),1:DGPAT("AOEXPLOC"))="K",EGTENR("EFFDATE"),EGTENR("EFFDATE")<3401229 S RTN=1
|
|---|
| 192 | ; If combat vet end date is before application date, cont. enroll
|
|---|
| 193 | I $G(EGTENR("ELIG","CVELEDT"))'<ENRDT Q 1
|
|---|
| 194 | ; If veteran is enrolled due to MT status or Medicaid, cont. enroll
|
|---|
| 195 | ; UNLESS first verified enrollment record is due to MT status or
|
|---|
| 196 | ; Medicaid and the primary MT of that income year was changed to a
|
|---|
| 197 | ; status that would not enroll (e.g. due to IVM converted test,
|
|---|
| 198 | ; Hardship removal, or Medicaid removal).
|
|---|
| 199 | I ((EGTENR("PRIORITY")=7)&("^2^16^"[(U_EGTENR("ELIG","MTSTA")_U)))!((EGTENR("PRIORITY")=5)&((EGTENR("ELIG","MTSTA")=4)!(EGTENR("ELIG","MEDICAID")=1))) S RTN=1 D Q RTN
|
|---|
| 200 | .N ENIEN,ENR,MTDT,MTIEN
|
|---|
| 201 | .S ENIEN=0 F S ENIEN=$O(^DGEN(27.11,"C",+DPTDFN,ENIEN)) Q:'ENIEN I $P($G(^DGEN(27.11,+ENIEN,0)),U,4)=2 D Q
|
|---|
| 202 | ..I '$$GET^DGENA(ENIEN,.ENR) Q
|
|---|
| 203 | ..I ((ENR("PRIORITY")=7)&("^2^16^"[(U_ENR("ELIG","MTSTA")_U)))!((ENR("PRIORITY")=5)&(ENR("ELIG","VAPEN")'="Y")&((ENR("ELIG","MTSTA")=4)!(ENR("ELIG","MEDICAID")=1))) D
|
|---|
| 204 | ...S MTDT=$E(ENR("APP"),1,3)_"1231",MTIEN=$$LST^DGMTU(MTDT) Q:'MTIEN
|
|---|
| 205 | ...I $P($G(^DGMT(408.31,MTIEN,0)),U,3)=6 S RTN=-1
|
|---|
| 206 | Q 0
|
|---|
| 207 | ;
|
|---|
| 208 | EDATE(APP,EFF) ; Compare the Application Date and Effective Date and
|
|---|
| 209 | ; return the earlier date
|
|---|
| 210 | N EDT
|
|---|
| 211 | S APP=$G(APP),EFF=$G(EFF)
|
|---|
| 212 | S EDT=APP I 'EDT S EDT=EFF Q EDT
|
|---|
| 213 | I EFF S:EFF<EDT EDT=EFF
|
|---|
| 214 | Q EDT
|
|---|
