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

Last change on this file since 1259 was 623, checked in by George Lilly, 15 years ago

revised back to 6/30/08 version

File size: 7.5 KB
Line 
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 TracBrowser for help on using the repository browser.