Ignore:
Timestamp:
Dec 4, 2009, 12:11:15 AM (14 years ago)
Author:
George Lilly
Message:

revised back to 6/30/08 version

File:
1 edited

Legend:

Unmodified
Added
Removed

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

    r613 r623  
    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
     1DGCV ;ALB/DW,ERC,BRM,TMK - COMBAT VET ELIGIBILTY; 10/15/05
     2 ;;5.3;Registration;**528,576,564,673**; Aug 13, 1993
     3 ;
     4CVELIG(DFN) ;
     5 ;API will determine whether or not this vetearn 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 updated
     13 ;    1 - CV End Date should be updated
     14 ;  If critical dates are imprecise return the following
     15 ;    A - CV End Date should not be updated, imprecise Service Sep date
     16 ;    B - CV End Date should not be updated, imprecise Combat To date
     17 ;    C - CV End Date should not be updated, imprecise Yugoslavia To date
     18 ;    D - CV End Date should not be updated, imprecise Somalia To date
     19 ;    E - CV End Date should not be updated, 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 ;
     56RES(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 ;
     67CHKDATE(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 ;
     85SETCV(DFN,DGSRV) ;calculate CV end date
     86 K DGCVEDT
     87 N DGFDA
     88 I $G(DFN)']""!($G(DGSRV)']"") Q
     89 I '$D(^DPT(DFN)) Q
     90 S DGCVEDT=$P($$SCH^XLFDT("24M",DGSRV),".")
     91 I DGCVEDT=$G(DGCVDT) Q
     92 I $$GET1^DIQ(2,DFN_",",.5295,"I") Q
     93 S DGFDA(2,DFN_",",.5295)=DGCVEDT
     94 D FILE^DIE(,"DGFDA")
     95 Q
     96 ;
     97CVEDT(DFN,DGDT) ;Provide Combat Vet Eligibility End Date, if eligible
     98 ;Supported DBIA #4156
     99 ;Input:  DFN - Patient file IEN
     100 ;        DGDT - Treatment date (optional),
     101 ;               DT is default
     102 ;Output :RESULT=(1,0,-1)^End Date (if populated, otherwise null)^CV
     103 ;               Eligible on DGDT(1,0)^is patient eligible on input date?
     104 ;      (piece 1)  1 - qualifies as a CV
     105 ;                 0 - does not qualify as a CV
     106 ;                -1 - bad DFN or date
     107 ;      (piece 3)  1 - vet was eligible on date specified (or DT)     
     108 ;                 0 - vet was not eligible on date specified (or DT)
     109 ;
     110 N RESULT
     111 S RESULT=""
     112 I $G(DFN)="" Q -1
     113 I '$D(^DPT(DFN)) Q -1
     114 ;if time sent in, drop time
     115 I $G(DGDT)']"" S DGDT=DT
     116 I DGDT?7N1"."1.6N S DGDT=$E(DGDT,1,7)
     117 I DGDT'?7N Q -1
     118 S RESULT=$$GET1^DIQ(2,DFN_",",.5295,"I")
     119 I $G(RESULT)']"" Q 0
     120 S RESULT=$S(DGDT'>RESULT:RESULT_"^1",1:RESULT_"^0") ; if treatment date is earlier or equal to end date, veteran is eligible
     121 S RESULT=$S($G(RESULT):1_"^"_RESULT,1:0)
     122 Q RESULT
     123 ;
     124PARSE ;GETS^DIQ called in CVELIG - in this subroutine stuff results into array
     125 S DGSRV=$G(DGARR(2,DFN_",",.327,"I"))
     126 S DGCOM=$G(DGARR(2,DFN_",",.5294,"I")) ;Combat To Date
     127 S DGGULF=$G(DGARR(2,DFN_",",.322012,"I")) ;Persian Gulf To Date
     128 S DGSOM=$G(DGARR(2,DFN_",",.322018,"I")) ;Somalia To Date
     129 S DGYUG=$G(DGARR(2,DFN_",",.322021,"I")) ;Yugoslavia To Date
     130 S DGCVDT=$G(DGARR(2,DFN_",",.5295,"I")) ;CV End Date
     131 ; get last OIF/OEF/UNKNOWN OEF/OIF episode from multiple
     132 S DGOEIF=$P($$LAST^DGENOEIF(DFN),U)
     133 Q
     134 ;
     135CHKSSD(DFN) ;check the Serv Sep Date [Last]
     136 ; DGSRV=last SSD
     137 ;  Output - RESULT
     138 ;    1 - Date is present and after 11/11/1998
     139 ;    0 - Date is present but before 11/11/1998
     140 ;    A - Date is imprecise & either is or potentially is after 11/11/98
     141 ;    F - Date is missing
     142 N DG1
     143 I $G(DGSRV)']"" Q "F"
     144 S DG1=$$CHKDATE(DGSRV,0)
     145 I $G(DG1)']"" S DG1=0
     146 Q DG1
     147 ;
     148CHKREST(DGDATE,SSD) ;
     149 ; SSD = optional, = to the last serv sep date
     150 N DG3,DG4,DGDT,DGFLG,DGLEN,DGQ,DGR,DGRES,DGX
     151 S (DG3,DG4,DGR,DGRES)=""
     152 S DGQ=0 ;loop terminator
     153 S DGFLG=0 ;flag to indicate that one of the dates is missing (no
     154 ;          need to check this for OIF/OEF/UNKNOWN OEF/OIF since
     155 ;          by definition, these must always be post 11/11/98)
     156 F DGX=1:1:5 D
     157 . S DGDT=$P(DGDATE,U,DGX) D
     158 . . I DGX'=5,$G(DGDT)']"" S DGFLG=1
     159 . . S DG4=$$CHKDATE(DGDT,DGX,$G(SSD))
     160 . . I $G(DG4)'=0 S DG3=$G(DG3)_$G(DG4)
     161 S DGLEN=$L(DG3)
     162 S DGQ=0
     163 F DGX=1:1:DGLEN S DGCHAR=$E(DG3,DGX) D  Q:DGQ=1
     164 . I DGCHAR=1 S DG3=DGCHAR,DGQ=1 Q
     165 . I "BCDE"[DGCHAR S DGR=DGR_DGCHAR,DGQ=2
     166 I DGQ=1 Q 1
     167 I DGQ=2 Q $E(DGR)
     168 I DGFLG=1 S DGRES=$$MISS(DFN,DGLEN,DG3)
     169 Q DGRES
     170 ;
     171MISS(DFN,DGLEN,DGRES) ;there is at least one missing date, and in order to
     172 ;return a RESULT of a missing date, need to check to see if the
     173 ;corresponding indicator field is set to 'YES'
     174 N DGARR,DGCHAR,DGERR,DGQ,DGR,DGX
     175 N DGCIND,DGPGIND,DGSIND,DGYIND
     176 S (DGCHAR,DGQ,DGR)=0
     177 D GETS^DIQ(2,DFN_",",".32201;.322019;.322016;.5291","I","DGARR","DGERR")
     178 S DGCIND=$G(DGARR(2,DFN_",",.5291,"I")) ;Combat Service Indicated
     179 S DGYIND=$G(DGARR(2,DFN_",",.322019,"I")) ;Yugo service indicated
     180 S DGSIND=$G(DGARR(2,DFN_",",.322016,"I")) ;Somalia service indicated
     181 S DGPGIND=$G(DGARR(2,DFN_",",.32201,"I")) ;Pers Gulf service indicated
     182 F DGX=1:1:DGLEN S DGCHAR=$E(DGRES,DGX) D  Q:DGQ=1
     183 . I DGCHAR="G",($G(DGCIND)="Y") S DGR="G",DGQ=1 Q
     184 . I DGCHAR="H",($G(DGYIND)="Y") S DGR="H",DGQ=1 Q
     185 . I DGCHAR="I",($G(DGSIND)="Y") S DGR="I",DGQ=1 Q
     186 . I DGCHAR="J",($G(DGPGIND)="Y") S DGR="J"
     187 Q DGR
     188DELCV(DFN) ;called by the Kill logic of the ACVCOM cross reference
     189 ;if $$CVELIG^DGCV returns a 0 the CV End Date should be deleted
     190 ;because this would indicate that fields have been changed and
     191 ;CV eligibility is no longer appropriate
     192 ;
     193 N DGCV,DGFDA
     194 K DGCVFLG
     195 S DGCVFLG=0
     196 I $G(DFN)']"" Q
     197 I '$D(^DPT(DFN)) Q
     198 S DGCV=$$GET1^DIQ(2,DFN_",",.5295,"I")
     199 I $G(DGCV)']"" Q
     200 S DGCVFLG=1
     201 S DGFDA(2,DFN_",",.5295)="@"
     202 D FILE^DIE(,"DGFDA")
     203 Q
Note: See TracChangeset for help on using the changeset viewer.