Changeset 636 for FOIAVistA/tag/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGCV.m

Timestamp:

Dec 4, 2009, 8:26:01 PM (14 years ago)

Author:

George Lilly

Message:

WorldVistAEHR overlayed on FOIAVistA

Location:

FOIAVistA/tag/r

Files:

• . (copied) (copied from FOIAVistA/trunk/r )
• REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGCV.m (modified) (3 diffs)

FOIAVistA/tag/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGCV.m

@@ -1 @@
-DGCV ;ALB/DW,ERC,BRM,TMK - COMBAT VET ELIGIBILTY; 10/15/05 ; 3/24/08 7:28am
- ;;5.3;Registration;**528,576,564,673,778**; Aug 13, 1993;Build 9
+DGCV ;ALB/DW,ERC,BRM,TMK - COMBAT VET ELIGIBILTY; 10/15/05
+ ;;5.3;Registration;**528,576,564,673**; Aug 13, 1993
  ;
 CVELIG(DFN) ;
- ;API will determine whether or not this veteran needs to have CV End
+ ;API will determine whether or not this vetearn needs to have CV End
  ;Date set.  If this determination cannot be done due to imprecise
  ;or missing dates, it returns which dates need editing.
@@ -10 +10 @@
  ;Output
  ;  RESULT
- ;    0 - CV End Date should not be set
- ;    1 - CV End Date should be set
+ ;    0 - CV End Date should not be updated
+ ;    1 - CV End Date should be updated
  ;  If critical dates are imprecise return the following
- ;    A - CV End Date should not be set, imprecise Service Sep date
- ;    B - CV End Date should not be set, imprecise Combat To date
- ;    C - CV End Date should not be set, imprecise Yugoslavia To date
- ;    D - CV End Date should not be set, imprecise Somalia To date
- ;    E - CV End Date should not be set, imprecise Pers Gulf To date
+ ;    A - CV End Date should not be updated, imprecise Service Sep date
+ ;    B - CV End Date should not be updated, imprecise Combat To date
+ ;    C - CV End Date should not be updated, imprecise Yugoslavia To date
+ ;    D - CV End Date should not be updated, imprecise Somalia To date
+ ;    E - CV End Date should not be updated, imprecise Pers Gulf To date
  ;  If the Service Sep Date is missing, and there are no OEF/OIF/UNKNOWN
  ;    OEF/OIF records on file, return the following so that it  will
@@ -84 +84 @@
  ;
 SETCV(DFN,DGSRV) ;calculate CV end date
- ;    DGSRV is the most recent of the Service Separation Date 
- ;    or the OEF/OIF To Date, called from file #2 new style 
- ;    cross reference "ACVCOM"
- N DGCVEDT,DGFDA,DGNDAA,DGPLUS3,DGTMPDT,DGYRS
- S DGNDAA=3080128
+ K DGCVEDT
+ N DGFDA
  I $G(DFN)']""!($G(DGSRV)']"") Q
  I '$D(^DPT(DFN)) Q
+ S DGCVEDT=$P($$SCH^XLFDT("24M",DGSRV),".")
+ I DGCVEDT=$G(DGCVDT) Q
  I $$GET1^DIQ(2,DFN_",",.5295,"I") Q
- D CVRULES(DFN,DGSRV,.DGYRS)
- Q:$G(DGYRS)'=3&($G(DGYRS)'=5)
- ;NDAA legislation, enacted 1/28/08, gives vets discharged
- ;on or after 1/28/03 (2 years previously) CV Eligibility 
- ;for 5 years.  Vets discharged before 1/28/03 get eligibility 
- ;for 3 years after enactment (or until 1/27/2011) DG*5.3*778
- S DGTMPDT=$S(DGYRS=3:DGNDAA,1:DGSRV)
- S DGCVEDT=($E(DGTMPDT,1,3)+DGYRS)_$E(DGTMPDT,4,7)
- S DGCVEDT=$$FMADD^XLFDT(DGCVEDT,-1)
  S DGFDA(2,DFN_",",.5295)=DGCVEDT
  D FILE^DIE(,"DGFDA")
- Q
- ;
-CVRULES(DFN,DGSRV,DGYRS) ;apply rules for the CV End Date
- ;extension project - DG*5.3*778
- ;DGSRV - most recent of Service Sep Date or OEIUUF to date
- ;   DGYRS = 3 years from NDAA or 1/27/2011
- ;         = 5 years from SSD or Enrollment App Date
- ;determine how many years extra CV eligibility to give
- N DGCIEN,DGCUTOFF,DGENRDT,DGPIEN,DGPRI,DGQT,DGSTAT
- ;determine if veteran has an enrollment record prior
- ;to 1/28/2008 (the NDAA date) and no CV End Date for
- ;this enrollment
- S DGYRS=5
- S (DGPRI,DGQT)=0
- S DGCUTOFF=3030128
- S DGCIEN=$$FINDCUR^DGENA(DFN)
- I $G(DGCIEN),($D(^DGEN(27.11,DGCIEN,0)))]"" D
- . S DGENRDT=$$GET1^DIQ(27.11,DGCIEN_",",75.01,"I") Q:$G(DGENRDT)']""
- . I $P(DGENRDT,".",1)<DGNDAA S DGPRI=1 Q
- . I DGENRDT'<DGNDAA D
- . . S DGPIEN=DGCIEN
- . . F  S DGPIEN=$$FINDPRI^DGENA(DGPIEN) Q:'DGPIEN  D  Q:DGQT
- . . . S DGENRDT=$$GET1^DIQ(27.11,DGPIEN_",",75.01,"I")
- . . . Q:$G(DGENRDT)']""
- . . . I $P(DGENRDT,".",1)<DGNDAA S (DGPRI,DGQT)=1
- ;if DGPRI=1, then there is an enrollment prior to 1/28/08
- I DGPRI=1 D  Q
- . I $G(DGCIEN)]"" S DGSTAT=$$GET1^DIQ(27.11,DGCIEN_",",.04,"E")
- . I $G(DGSTAT)["INITIAL APPLICATION BY VAMC"!($G(DGSTAT)["BELOW ENROLLMENT GROUP THRESHOLD") D
- . . I DGSRV<DGCUTOFF S DGYRS=3
- ;
- ;if no enrollment prior to 1/28/08 (DGPRI=0) check service date
- ;against cutoff date - 1/28/03
- I DGSRV<DGCUTOFF S DGYRS=3
  Q
  ;