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

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

initial load of WorldVistAEHR
File size: 7.0 KB
Line 
1DGQEUT2 ;ALB/RPM - VIC REPLACEMENT UTILITIES #2 ; 3/13/06 11:12am
2 ;;5.3;Registration;**571,641,679**;Aug 13, 1993
3 ;
4 ; This routine contains the following VIC Redesign API's:
5 ; CPRSTAT - determine Card Print Release Status
6 ; $$PENDDT - checks for pending requests and returns request date
7 ; $$REQFLD - checks for required fields
8 ; $$HOLD - checks for pending ICN and/or Enrollment
9 ; $$VICELIG - determines applicant's VIC eligibility
10 ;
11 Q ;no direct entry
12 ;
13 ;
14CPRSTAT(DGVIC) ;determine card print release status
15 ; This procedure is used to determine Card Print Release Status from
16 ; the data contained in the input array (DGVIC). Once determined, the
17 ; status and remarks are placed into the VIC data array.
18 ;
19 ; Input:
20 ; DGVIC - VIC data array (pass by reference)
21 ;
22 ; Output: None
23 ;
24 N DGERR
25 ;
26 D ;drop out of DO block when DGVIC("STAT") is known
27 . ;
28 . ;check if DFN is valid
29 . ;set card print release status="C"ancel if not valid
30 . I '$D(^DPT(+$G(DGVIC("DFN")),0)) D
31 . . S DGVIC("STAT")="C"
32 . . S DGVIC("REMARKS")="Unable to find veteran in the database"
33 . Q:DGVIC("STAT")]""
34 . ;
35 . ;check for required fields
36 . ;set card print release status="C"ancel if req field is missing
37 . I '$$REQFLD(.DGVIC,.DGERR) D
38 . . S DGVIC("STAT")="C"
39 . . S DGVIC("REMARKS")=$G(DGERR)
40 . Q:DGVIC("STAT")]""
41 . ;
42 . ;check for pending conditions
43 . ;set card print release status="H"old if pending conditions exist
44 . I $$HOLD(.DGVIC,.DGERR) D
45 . . S DGVIC("STAT")="H"
46 . . S DGVIC("REMARKS")=$G(DGERR)
47 . Q:DGVIC("STAT")]""
48 . ;
49 . ;check if pt is eligible for VIC
50 . ;set card print release status="P"rint if eligible, else "I"neligible
51 . I $$VICELIG(.DGVIC) S DGVIC("STAT")="P"
52 . E D
53 . . S DGVIC("STAT")="I"
54 . . S DGVIC("REMARKS")="Veteran does not meet VIC eligibility requirements."
55 ;
56 Q
57 ;
58 ;
59PENDDT(DGDFN) ;check for pending request date
60 ;
61 ; Input:
62 ; DGDFN - pointer to patient in PATIENT (#2) file
63 ;
64 ; Output:
65 ; Function value - FM format request date on success, 0 on failure
66 ;
67 N DGDAT ;function value
68 N DGRIEN ;VIC REQUEST pointer
69 N DGREQ ;array of request data
70 ;
71 S DGDAT=0
72 ;
73 ;get last request
74 S DGRIEN=$$FINDLST^DGQEREQ(DGDFN)
75 I DGRIEN D
76 . Q:'$$GETREQ^DGQEREQ(DGRIEN,.DGREQ)
77 . ;
78 . ;check Card Print Release Status
79 . I $G(DGREQ("CPRSTAT"))="H" S DGDAT=+$G(DGREQ("REQDT"))
80 ;
81 Q DGDAT
82 ;
83 ;
84REQFLD(DGVIC,DGERR) ;required field check
85 ; This function is used to check for required fields in the VIC data
86 ; array.
87 ;
88 ; Input:
89 ; DGVIC - VIC data array (pass by reference)
90 ;
91 ; Output:
92 ; Function value - returns 1 on success, 0 on failure.
93 ; DGERR - error msg returned on failure
94 ;
95 N DGTYPE ;mailing address type
96 N DGSUB ;array subscript
97 ;
98 D ;quit DO block on first error
99 . ;
100 . ;check for required SSN
101 . I $G(DGVIC("SSN"))="" S DGERR="Unable to determine veteran's Social Security Number"
102 . Q:$D(DGERR)
103 . ;
104 . ;check for required DOB to include month and day
105 . I +$G(DGVIC("DOB"))>0 D
106 . . I +$E(DGVIC("DOB"),1,2)<1!(+$E(DGVIC("DOB"),3,4)<1) S DGERR="Unable to determine veteran's complete Date of Birth"
107 . E S DGERR="Unable to determine veteran's Date of Birth"
108 . Q:$D(DGERR)
109 . ;
110 . ;check for required name components
111 . F DGSUB="NAME","LAST" D Q:$D(DGERR)
112 . . I $G(DGVIC(DGSUB))="" S DGERR="Unable to determine veteran's Name"
113 . . ;
114 . . ;prevent submission of incomplete patient merges
115 . . I DGSUB="NAME",DGVIC(DGSUB)["MERGING INTO" S DGERR="Incomplete patient record merge"
116 . Q:$D(DGERR)
117 . ;
118 . ;check for address selection type
119 . I '$G(DGVIC("ADRTYPE")) S DGERR="Unable to determine a mailing address"
120 . Q:$D(DGERR)
121 . ;
122 . ;check for required pt address components
123 . F DGSUB="STREET1","CITY","STATE","ZIP" D Q:$D(DGERR)
124 . . I $G(DGVIC(DGSUB))="" D
125 . . . S DGTYPE=$S(DGVIC("ADRTYPE")=1:"permanent",DGVIC("ADRTYPE")=2:"temporary",DGVIC("ADRTYPE")=3:"confidential",1:"facility")
126 . . . S DGERR="Unable to determine the "_DGSUB_" field of the "_DGTYPE_" mailing address"
127 . Q:$D(DGERR)
128 . ;
129 . ;check for required VIC eligibility factors
130 . F DGSUB="SC" D Q:$D(DGERR)
131 . . I $G(DGVIC(DGSUB))="" S DGERR="Unable to determine veteran's Service Connected Indicator"
132 . Q:$D(DGERR)
133 . ;
134 . ;check for required facility data elements
135 . F DGSUB="FACNUM","FACNAME","VISN" D Q:$D(DGERR)
136 . . I $G(DGVIC(DGSUB))="" S DGERR="Unable to determine a source facility"
137 ;
138 Q $S($D(DGERR):0,1:1)
139 ;
140 ;
141HOLD(DGVIC,DGMSG) ;check for pending ICN, Enrollment Status, Purple Heart
142 ; This function checks for a pending ICN, Enrollment Status, and/or
143 ; Purple Heart confirmation and builds the appropriate message text
144 ; when a pending condition exists.
145 ;
146 ; Input:
147 ; DGVIC - VIC data array, pass by reference
148 ; Array subscripts are:
149 ; "ICN" - integration control number
150 ; Note: Must be in format returned by $$GETICN^DGQEDEMO
151 ; "ENRSTAT" - enrollment status
152 ; Note: Must be in format returned by $$STATUS^DGENA
153 ; "PH" - purple heart status
154 ; Note: Must be in format returned by $$GETPH^DGQEUT1
155 ;
156 ; Output:
157 ; Function value - returns 1 when a pending condition exists;
158 ; otherwise, returns 0
159 ;
160 ; DGMSG - Message text returned when function value=1 listing
161 ; pending data items; pass by reference
162 ;
163 N DGI ;generic index
164 N DGENRST ;enrollment status value
165 N DGCNT ;pending item count
166 N DGRSLT ;function value
167 ;
168 S DGRSLT=0
169 S DGCNT=0
170 S DGENRST=+$G(DGVIC("ENRSTAT"))
171 ;
172 ;is national ICN missing
173 I '+$G(DGVIC("ICN")) D
174 . S DGRSLT=1
175 . S DGCNT=DGCNT+1
176 . S DGMSG(DGCNT)="Veteran does not have a National ICN"
177 ;
178 ;is enrollment status
179 I $$ISENRPND^DGQEUT1(DGENRST) D
180 . S DGRSLT=1
181 . S DGCNT=DGCNT+1
182 . S DGMSG(DGCNT)="Veteran is pending verification"
183 ;
184 ;is purple heart pending
185 I $G(DGVIC("PH"))="P" D
186 . S DGRSLT=1
187 . S DGCNT=DGCNT+1
188 . S DGMSG(DGCNT)="Veteran's Purple Heart status is pending confirmation"
189 ;
190 ;format message text
191 I DGCNT D
192 . S DGMSG=""
193 . F DGI=1:1:DGCNT S DGMSG=DGMSG_$S(DGI>1&(DGI<DGCNT):", ",DGI>1&(DGI=DGCNT):" and ",1:"")_DGMSG(DGI)
194 . S DGMSG=DGMSG_"."
195 ;
196 Q DGRSLT
197 ;
198 ;
199VICELIG(DGELG) ;is applicant eligible for a Veteran ID Card?
200 ; This function determines if an applicant is eligible for a Veteran
201 ; Identification Card (VIC).
202 ;
203 ; Input:
204 ; DGELG - eligibility data object array
205 ;
206 ; Output:
207 ; Function Value - returns 1 if the applicant is eligible for VIC,
208 ; 0 if not eligible
209 ;
210 N DGRSLT ;function result
211 ;
212 ;set default, not eligible
213 S DGRSLT=0
214 ;
215 D ;apply VIC eligibilty rules
216 . I (DGELG("ENRSTAT")=2)!(DGELG("ENRSTAT")=21) S DGRSLT=1 Q
217 . ;
218 . I (DGELG("ENRSTAT")=7)!(DGELG("ENRSTAT")=19)!(DGELG("ENRSTAT")=20) D Q:DGRSLT
219 . . Q:DGELG("ELIGSTAT")'="V"
220 . . I DGELG("MST")="Y" S DGRSLT=1 Q
221 . . I DGELG("SC")=1 S DGRSLT=1 Q
222 . ;
223 . I (DGELG("ENRSTAT")=11)!(DGELG("ENRSTAT")=12)!(DGELG("ENRSTAT")=13)!(DGELG("ENRSTAT")=14)!(DGELG("ENRSTAT")=22) D Q:DGRSLT
224 . . Q:DGELG("ELIGSTAT")'="V"
225 . . I DGELG("COMBVET")=1 S DGRSLT=1 Q
226 . . I DGELG("SC")=1 S DGRSLT=1 Q
227 . . I DGELG("MST")="Y" S DGRSLT=1 Q
228 ;
229 Q DGRSLT
Note: See TracBrowser for help on using the repository browser.