| [613] | 1 | DGCV ;ALB/DW,ERC,BRM,TMK - COMBAT VET ELIGIBILTY; 10/15/05 ; 3/24/08 7:28am
|
|---|
| 2 | ;;5.3;Registration;**528,576,564,673,778**; Aug 13, 1993;Build 9
|
|---|
| 3 | ;
|
|---|
| 4 | CVELIG(DFN) ;
|
|---|
| 5 | ;API will determine whether or not this veteran needs to have CV End
|
|---|
| 6 | ;Date set. If this determination cannot be done due to imprecise
|
|---|
| 7 | ;or missing dates, it returns which dates need editing.
|
|---|
| 8 | ;Input:
|
|---|
| 9 | ; DFN - Patient file IEN
|
|---|
| 10 | ;Output
|
|---|
| 11 | ; RESULT
|
|---|
| 12 | ; 0 - CV End Date should not be set
|
|---|
| 13 | ; 1 - CV End Date should be set
|
|---|
| 14 | ; If critical dates are imprecise return the following
|
|---|
| 15 | ; A - CV End Date should not be set, imprecise Service Sep date
|
|---|
| 16 | ; B - CV End Date should not be set, imprecise Combat To date
|
|---|
| 17 | ; C - CV End Date should not be set, imprecise Yugoslavia To date
|
|---|
| 18 | ; D - CV End Date should not be set, imprecise Somalia To date
|
|---|
| 19 | ; E - CV End Date should not be set, imprecise Pers Gulf To date
|
|---|
| 20 | ; If the Service Sep Date is missing, and there are no OEF/OIF/UNKNOWN
|
|---|
| 21 | ; OEF/OIF records on file, return the following so that it will
|
|---|
| 22 | ; appear on the Imprecise/Missing Date Report
|
|---|
| 23 | ; F - missing Service Sep Date & no OEF OIF or OEF/OIF Unknown dates
|
|---|
| 24 | ; If critical dates are missing but the corresponding indicator fields
|
|---|
| 25 | ; are set to 'YES' return the following
|
|---|
| 26 | ; G - missing Combat To Date, but Combat Indicated? = 'Yes'
|
|---|
| 27 | ; H - missing PG To Date, but PG Indicated? = 'Yes'
|
|---|
| 28 | ; I - missing Somalia To Date, but Somalia Indicator = 'Yes'
|
|---|
| 29 | ; J - missing Yugoslavia To Date, but Yugoslavia Indicator = 'Yes'
|
|---|
| 30 | ;
|
|---|
| 31 | N DG1,DG2,I,RESULT
|
|---|
| 32 | N DGCOM,DGCVDT,DGCVFLG,DGGULF,DGSOM,DGSRV,DGYUG,DGOEIF
|
|---|
| 33 | S (DG1,DG2,RESULT)=0
|
|---|
| 34 | I $G(DFN)']"" Q RESULT
|
|---|
| 35 | I '$D(^DPT(DFN)) Q RESULT
|
|---|
| 36 | ;
|
|---|
| 37 | ;get combat related data from top-level VistA fields
|
|---|
| 38 | N DGARR,DGERR
|
|---|
| 39 | D GETS^DIQ(2,DFN_",",".327;.322012;.322018;.322021;.5294;.5295","I","DGARR","DGERR")
|
|---|
| 40 | D PARSE
|
|---|
| 41 | ;
|
|---|
| 42 | S DG1=$$CHKSSD(DFN) ;check SSD for imprecise or missing
|
|---|
| 43 | S DGDATE=$G(DGCOM)_"^"_$G(DGYUG)_"^"_$G(DGSOM)_"^"_$G(DGGULF)_"^"_$G(DGOEIF)
|
|---|
| 44 | ;
|
|---|
| 45 | I $S(DG1="F":1,1:$P(DGDATE,U,5)>$G(DGSRV)) D
|
|---|
| 46 | . ; Use OIF/OEF/UNKNOWN OEF/OIF to dt only when SSD missing or SSD less
|
|---|
| 47 | . ; than OIF/OEF/UNKNOWN OEF/OIF to dt
|
|---|
| 48 | . N DGSRV,Z
|
|---|
| 49 | . S DGSRV=$P(DGDATE,U,5),Z=$$CHKSSD(DFN)
|
|---|
| 50 | . I Z=1 S DG1=Z
|
|---|
| 51 | ;
|
|---|
| 52 | S DG2=$$CHKREST(DGDATE,$G(DGSRV)) ;check other "TO" dates for imprecise, missing or invalid
|
|---|
| 53 | S RESULT=$$RES(DG1,$G(DG2))
|
|---|
| 54 | Q RESULT
|
|---|
| 55 | ;
|
|---|
| 56 | RES(DG1,DG2) ;determine the final RESULT code from DG1 & DG2
|
|---|
| 57 | ;if SSD evaluates to earlier than 11/11/98, can't set CV End Date
|
|---|
| 58 | I DG1=0!($G(DG2)=0) Q 0
|
|---|
| 59 | ;if SSD is 1
|
|---|
| 60 | I DG1=1,($G(DG2)=1!($G(DG2)']"")) Q 1
|
|---|
| 61 | I DG1=1,($G(DG2)=0) Q 0
|
|---|
| 62 | I DG1=1 Q DG2
|
|---|
| 63 | ;if SSD is imprecise or missing
|
|---|
| 64 | I DG1'=1,($G(DG2)=1) S DG2=""
|
|---|
| 65 | Q DG1_DG2
|
|---|
| 66 | ;
|
|---|
| 67 | CHKDATE(DGDATE,I,SSD) ;check to see if date is imprecise or missing
|
|---|
| 68 | ;if imprecise check to see if the imprecision prevents CV evaluation
|
|---|
| 69 | ;if not imprecise check to see if after 11/11/98
|
|---|
| 70 | ; Note that SSD doesn't appear to ever be used here (TMK)
|
|---|
| 71 | N RES
|
|---|
| 72 | S RES=0
|
|---|
| 73 | I $G(DGDATE)']"",I'=5 D Q RES
|
|---|
| 74 | . S RES=$S(I=0:"F",I=1:"G",I=2:"H",I=3:"I",I=4:"J",1:"")
|
|---|
| 75 | I $E(DGDATE,6,7)="00" D
|
|---|
| 76 | . I I=0 I DGDATE>2981111 S RES="A" Q
|
|---|
| 77 | . I DGDATE=2980000!(DGDATE=2981100) D Q
|
|---|
| 78 | .. ; Note OIF/OEF/UNKNOWN OEF/OIF will not get here as these dates by
|
|---|
| 79 | .. ; definition are after 11/11/98
|
|---|
| 80 | . . S RES=$S(I=0:"A",I=1:"B",I=2:"C",I=3:"D",I=4:"E",1:"")
|
|---|
| 81 | Q:RES="A" RES
|
|---|
| 82 | I DGDATE>2981111 S RES=1
|
|---|
| 83 | Q RES
|
|---|
| 84 | ;
|
|---|
| 85 | SETCV(DFN,DGSRV) ;calculate CV end date
|
|---|
| 86 | ; DGSRV is the most recent of the Service Separation Date
|
|---|
| 87 | ; or the OEF/OIF To Date, called from file #2 new style
|
|---|
| 88 | ; cross reference "ACVCOM"
|
|---|
| 89 | N DGCVEDT,DGFDA,DGNDAA,DGPLUS3,DGTMPDT,DGYRS
|
|---|
| 90 | S DGNDAA=3080128
|
|---|
| 91 | I $G(DFN)']""!($G(DGSRV)']"") Q
|
|---|
| 92 | I '$D(^DPT(DFN)) Q
|
|---|
| 93 | I $$GET1^DIQ(2,DFN_",",.5295,"I") Q
|
|---|
| 94 | D CVRULES(DFN,DGSRV,.DGYRS)
|
|---|
| 95 | Q:$G(DGYRS)'=3&($G(DGYRS)'=5)
|
|---|
| 96 | ;NDAA legislation, enacted 1/28/08, gives vets discharged
|
|---|
| 97 | ;on or after 1/28/03 (2 years previously) CV Eligibility
|
|---|
| 98 | ;for 5 years. Vets discharged before 1/28/03 get eligibility
|
|---|
| 99 | ;for 3 years after enactment (or until 1/27/2011) DG*5.3*778
|
|---|
| 100 | S DGTMPDT=$S(DGYRS=3:DGNDAA,1:DGSRV)
|
|---|
| 101 | S DGCVEDT=($E(DGTMPDT,1,3)+DGYRS)_$E(DGTMPDT,4,7)
|
|---|
| 102 | S DGCVEDT=$$FMADD^XLFDT(DGCVEDT,-1)
|
|---|
| 103 | S DGFDA(2,DFN_",",.5295)=DGCVEDT
|
|---|
| 104 | D FILE^DIE(,"DGFDA")
|
|---|
| 105 | Q
|
|---|
| 106 | ;
|
|---|
| 107 | CVRULES(DFN,DGSRV,DGYRS) ;apply rules for the CV End Date
|
|---|
| 108 | ;extension project - DG*5.3*778
|
|---|
| 109 | ;DGSRV - most recent of Service Sep Date or OEIUUF to date
|
|---|
| 110 | ; DGYRS = 3 years from NDAA or 1/27/2011
|
|---|
| 111 | ; = 5 years from SSD or Enrollment App Date
|
|---|
| 112 | ;determine how many years extra CV eligibility to give
|
|---|
| 113 | N DGCIEN,DGCUTOFF,DGENRDT,DGPIEN,DGPRI,DGQT,DGSTAT
|
|---|
| 114 | ;determine if veteran has an enrollment record prior
|
|---|
| 115 | ;to 1/28/2008 (the NDAA date) and no CV End Date for
|
|---|
| 116 | ;this enrollment
|
|---|
| 117 | S DGYRS=5
|
|---|
| 118 | S (DGPRI,DGQT)=0
|
|---|
| 119 | S DGCUTOFF=3030128
|
|---|
| 120 | S DGCIEN=$$FINDCUR^DGENA(DFN)
|
|---|
| 121 | I $G(DGCIEN),($D(^DGEN(27.11,DGCIEN,0)))]"" D
|
|---|
| 122 | . S DGENRDT=$$GET1^DIQ(27.11,DGCIEN_",",75.01,"I") Q:$G(DGENRDT)']""
|
|---|
| 123 | . I $P(DGENRDT,".",1)<DGNDAA S DGPRI=1 Q
|
|---|
| 124 | . I DGENRDT'<DGNDAA D
|
|---|
| 125 | . . S DGPIEN=DGCIEN
|
|---|
| 126 | . . F S DGPIEN=$$FINDPRI^DGENA(DGPIEN) Q:'DGPIEN D Q:DGQT
|
|---|
| 127 | . . . S DGENRDT=$$GET1^DIQ(27.11,DGPIEN_",",75.01,"I")
|
|---|
| 128 | . . . Q:$G(DGENRDT)']""
|
|---|
| 129 | . . . I $P(DGENRDT,".",1)<DGNDAA S (DGPRI,DGQT)=1
|
|---|
| 130 | ;if DGPRI=1, then there is an enrollment prior to 1/28/08
|
|---|
| 131 | I DGPRI=1 D Q
|
|---|
| 132 | . I $G(DGCIEN)]"" S DGSTAT=$$GET1^DIQ(27.11,DGCIEN_",",.04,"E")
|
|---|
| 133 | . I $G(DGSTAT)["INITIAL APPLICATION BY VAMC"!($G(DGSTAT)["BELOW ENROLLMENT GROUP THRESHOLD") D
|
|---|
| 134 | . . I DGSRV<DGCUTOFF S DGYRS=3
|
|---|
| 135 | ;
|
|---|
| 136 | ;if no enrollment prior to 1/28/08 (DGPRI=0) check service date
|
|---|
| 137 | ;against cutoff date - 1/28/03
|
|---|
| 138 | I DGSRV<DGCUTOFF S DGYRS=3
|
|---|
| 139 | Q
|
|---|
| 140 | ;
|
|---|
| 141 | CVEDT(DFN,DGDT) ;Provide Combat Vet Eligibility End Date, if eligible
|
|---|
| 142 | ;Supported DBIA #4156
|
|---|
| 143 | ;Input: DFN - Patient file IEN
|
|---|
| 144 | ; DGDT - Treatment date (optional),
|
|---|
| 145 | ; DT is default
|
|---|
| 146 | ;Output :RESULT=(1,0,-1)^End Date (if populated, otherwise null)^CV
|
|---|
| 147 | ; Eligible on DGDT(1,0)^is patient eligible on input date?
|
|---|
| 148 | ; (piece 1) 1 - qualifies as a CV
|
|---|
| 149 | ; 0 - does not qualify as a CV
|
|---|
| 150 | ; -1 - bad DFN or date
|
|---|
| 151 | ; (piece 3) 1 - vet was eligible on date specified (or DT)
|
|---|
| 152 | ; 0 - vet was not eligible on date specified (or DT)
|
|---|
| 153 | ;
|
|---|
| 154 | N RESULT
|
|---|
| 155 | S RESULT=""
|
|---|
| 156 | I $G(DFN)="" Q -1
|
|---|
| 157 | I '$D(^DPT(DFN)) Q -1
|
|---|
| 158 | ;if time sent in, drop time
|
|---|
| 159 | I $G(DGDT)']"" S DGDT=DT
|
|---|
| 160 | I DGDT?7N1"."1.6N S DGDT=$E(DGDT,1,7)
|
|---|
| 161 | I DGDT'?7N Q -1
|
|---|
| 162 | S RESULT=$$GET1^DIQ(2,DFN_",",.5295,"I")
|
|---|
| 163 | I $G(RESULT)']"" Q 0
|
|---|
| 164 | S RESULT=$S(DGDT'>RESULT:RESULT_"^1",1:RESULT_"^0") ; if treatment date is earlier or equal to end date, veteran is eligible
|
|---|
| 165 | S RESULT=$S($G(RESULT):1_"^"_RESULT,1:0)
|
|---|
| 166 | Q RESULT
|
|---|
| 167 | ;
|
|---|
| 168 | PARSE ;GETS^DIQ called in CVELIG - in this subroutine stuff results into array
|
|---|
| 169 | S DGSRV=$G(DGARR(2,DFN_",",.327,"I"))
|
|---|
| 170 | S DGCOM=$G(DGARR(2,DFN_",",.5294,"I")) ;Combat To Date
|
|---|
| 171 | S DGGULF=$G(DGARR(2,DFN_",",.322012,"I")) ;Persian Gulf To Date
|
|---|
| 172 | S DGSOM=$G(DGARR(2,DFN_",",.322018,"I")) ;Somalia To Date
|
|---|
| 173 | S DGYUG=$G(DGARR(2,DFN_",",.322021,"I")) ;Yugoslavia To Date
|
|---|
| 174 | S DGCVDT=$G(DGARR(2,DFN_",",.5295,"I")) ;CV End Date
|
|---|
| 175 | ; get last OIF/OEF/UNKNOWN OEF/OIF episode from multiple
|
|---|
| 176 | S DGOEIF=$P($$LAST^DGENOEIF(DFN),U)
|
|---|
| 177 | Q
|
|---|
| 178 | ;
|
|---|
| 179 | CHKSSD(DFN) ;check the Serv Sep Date [Last]
|
|---|
| 180 | ; DGSRV=last SSD
|
|---|
| 181 | ; Output - RESULT
|
|---|
| 182 | ; 1 - Date is present and after 11/11/1998
|
|---|
| 183 | ; 0 - Date is present but before 11/11/1998
|
|---|
| 184 | ; A - Date is imprecise & either is or potentially is after 11/11/98
|
|---|
| 185 | ; F - Date is missing
|
|---|
| 186 | N DG1
|
|---|
| 187 | I $G(DGSRV)']"" Q "F"
|
|---|
| 188 | S DG1=$$CHKDATE(DGSRV,0)
|
|---|
| 189 | I $G(DG1)']"" S DG1=0
|
|---|
| 190 | Q DG1
|
|---|
| 191 | ;
|
|---|
| 192 | CHKREST(DGDATE,SSD) ;
|
|---|
| 193 | ; SSD = optional, = to the last serv sep date
|
|---|
| 194 | N DG3,DG4,DGDT,DGFLG,DGLEN,DGQ,DGR,DGRES,DGX
|
|---|
| 195 | S (DG3,DG4,DGR,DGRES)=""
|
|---|
| 196 | S DGQ=0 ;loop terminator
|
|---|
| 197 | S DGFLG=0 ;flag to indicate that one of the dates is missing (no
|
|---|
| 198 | ; need to check this for OIF/OEF/UNKNOWN OEF/OIF since
|
|---|
| 199 | ; by definition, these must always be post 11/11/98)
|
|---|
| 200 | F DGX=1:1:5 D
|
|---|
| 201 | . S DGDT=$P(DGDATE,U,DGX) D
|
|---|
| 202 | . . I DGX'=5,$G(DGDT)']"" S DGFLG=1
|
|---|
| 203 | . . S DG4=$$CHKDATE(DGDT,DGX,$G(SSD))
|
|---|
| 204 | . . I $G(DG4)'=0 S DG3=$G(DG3)_$G(DG4)
|
|---|
| 205 | S DGLEN=$L(DG3)
|
|---|
| 206 | S DGQ=0
|
|---|
| 207 | F DGX=1:1:DGLEN S DGCHAR=$E(DG3,DGX) D Q:DGQ=1
|
|---|
| 208 | . I DGCHAR=1 S DG3=DGCHAR,DGQ=1 Q
|
|---|
| 209 | . I "BCDE"[DGCHAR S DGR=DGR_DGCHAR,DGQ=2
|
|---|
| 210 | I DGQ=1 Q 1
|
|---|
| 211 | I DGQ=2 Q $E(DGR)
|
|---|
| 212 | I DGFLG=1 S DGRES=$$MISS(DFN,DGLEN,DG3)
|
|---|
| 213 | Q DGRES
|
|---|
| 214 | ;
|
|---|
| 215 | MISS(DFN,DGLEN,DGRES) ;there is at least one missing date, and in order to
|
|---|
| 216 | ;return a RESULT of a missing date, need to check to see if the
|
|---|
| 217 | ;corresponding indicator field is set to 'YES'
|
|---|
| 218 | N DGARR,DGCHAR,DGERR,DGQ,DGR,DGX
|
|---|
| 219 | N DGCIND,DGPGIND,DGSIND,DGYIND
|
|---|
| 220 | S (DGCHAR,DGQ,DGR)=0
|
|---|
| 221 | D GETS^DIQ(2,DFN_",",".32201;.322019;.322016;.5291","I","DGARR","DGERR")
|
|---|
| 222 | S DGCIND=$G(DGARR(2,DFN_",",.5291,"I")) ;Combat Service Indicated
|
|---|
| 223 | S DGYIND=$G(DGARR(2,DFN_",",.322019,"I")) ;Yugo service indicated
|
|---|
| 224 | S DGSIND=$G(DGARR(2,DFN_",",.322016,"I")) ;Somalia service indicated
|
|---|
| 225 | S DGPGIND=$G(DGARR(2,DFN_",",.32201,"I")) ;Pers Gulf service indicated
|
|---|
| 226 | F DGX=1:1:DGLEN S DGCHAR=$E(DGRES,DGX) D Q:DGQ=1
|
|---|
| 227 | . I DGCHAR="G",($G(DGCIND)="Y") S DGR="G",DGQ=1 Q
|
|---|
| 228 | . I DGCHAR="H",($G(DGYIND)="Y") S DGR="H",DGQ=1 Q
|
|---|
| 229 | . I DGCHAR="I",($G(DGSIND)="Y") S DGR="I",DGQ=1 Q
|
|---|
| 230 | . I DGCHAR="J",($G(DGPGIND)="Y") S DGR="J"
|
|---|
| 231 | Q DGR
|
|---|
| 232 | DELCV(DFN) ;called by the Kill logic of the ACVCOM cross reference
|
|---|
| 233 | ;if $$CVELIG^DGCV returns a 0 the CV End Date should be deleted
|
|---|
| 234 | ;because this would indicate that fields have been changed and
|
|---|
| 235 | ;CV eligibility is no longer appropriate
|
|---|
| 236 | ;
|
|---|
| 237 | N DGCV,DGFDA
|
|---|
| 238 | K DGCVFLG
|
|---|
| 239 | S DGCVFLG=0
|
|---|
| 240 | I $G(DFN)']"" Q
|
|---|
| 241 | I '$D(^DPT(DFN)) Q
|
|---|
| 242 | S DGCV=$$GET1^DIQ(2,DFN_",",.5295,"I")
|
|---|
| 243 | I $G(DGCV)']"" Q
|
|---|
| 244 | S DGCVFLG=1
|
|---|
| 245 | S DGFDA(2,DFN_",",.5295)="@"
|
|---|
| 246 | D FILE^DIE(,"DGFDA")
|
|---|
| 247 | Q
|
|---|
