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

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

initial load of FOIAVistA 6/30/08 version
File size: 6.5 KB
Line 
1DGENA ;ALB/CJM,ISA/KWP,Zoltan,LBD,CKN,EG - Enrollment API - Retrieve Data; 12/11/00 4:19pm ; 04/24/2006 8:51 AM
2 ;;5.3;Registration;**121,122,147,232,314,564,672,659,653**;Aug 13, 1993;Build 2
3 ;
4FINDCUR(DFN) ;
5 ;Description: Used to find a patients current enrollment.
6 ;Input :
7 ; DFN - Patient IEN
8 ;Output:
9 ; Function Value - returns the internal entry number of the patient's
10 ; current enrollment if there is one, NULL otherwise. Checks that
11 ; current enrollment actually belongs to the patient.
12 ;
13 Q:'$G(DFN) ""
14 ;
15 N CUR
16 S CUR=$P($G(^DPT(DFN,"ENR")),"^")
17 I CUR,$P($G(^DGEN(27.11,CUR,0)),"^",2)'=DFN S CUR=""
18 Q CUR
19 ;
20FINDPRI(DGENRIEN) ;
21 ;Description: Used to obtain a patient's enrollment record that was
22 ; prior to the enrollment identified by DGENRIEN.
23 ;Input :
24 ; DGENRIEN - this is the internal entry number of a PATIENT ENROLLMENT
25 ; record
26 ;Output:
27 ; Function Value - returns the internal entry number of the prior
28 ; enrollment for the patient if there is one, NULL otherwise.
29 ;
30 Q:'$G(DGENRIEN) ""
31 Q $P($G(^DGEN(27.11,DGENRIEN,0)),"^",9)
32 ;
33ENROLLED(DFN) ;
34 ;Description: Returns whether the patient is currently enrolled.
35 ;Input:
36 ; DFN - Patient IEN
37 ;Output:
38 ; Function Value - returns 1 if the patient is currently enrolled with
39 ; a status of VERIFIED, 0 otherwise
40 ;
41 N STATUS
42 S STATUS=$$STATUS($G(DFN))
43 I (STATUS=2) Q 1
44 Q 0
45 ;
46STATUS(DFN) ;
47 ;Description: Returns ENROLLMENT STATUS from the patient's current
48 ; enrollment.
49 ;Input:
50 ; DFN - Patient IEN
51 ;Output:
52 ; Function Value - If the patient has a current ENROLLMENT STATUS this
53 ; function will return its value, otherwise it returns NULL.
54 N DGENRIEN
55 S DGENRIEN=$$FINDCUR($G(DFN))
56 Q:'DGENRIEN ""
57 Q $P($G(^DGEN(27.11,DGENRIEN,0)),"^",4)
58 ;
59PRIORITY(DFN) ;
60 ;Description: Returns ENROLLMENT PRIORITY from the patient's current
61 ; enrollment.
62 ;Input:
63 ; DFN - Patient IEN
64 ;Output:
65 ; Function Value - If the patient has a current ENROLLMENT PRIORITY
66 ; this function will return its value, otherwise it returns NULL.
67 N DGENRIEN
68 S DGENRIEN=$$FINDCUR($G(DFN))
69 Q:'DGENRIEN ""
70 Q $P($G(^DGEN(27.11,DGENRIEN,0)),"^",7)
71 ;
72SOURCE(DFN) ;
73 ;Description: Returns SOURCE OF ENROLLMENT from the patient's current
74 ; enrollment.
75 ;Input:
76 ; DFN - Patient IEN
77 ;Output:
78 ; Function Value - If the patient has a current ENROLLMENT
79 ; this function will return the SOURCE OF ENROLLMENT, otherwise
80 ; it returns NULL.
81 ;
82 N DGENRIEN
83 S DGENRIEN=$$FINDCUR($G(DFN))
84 Q:'DGENRIEN ""
85 Q $P($G(^DGEN(27.11,DGENRIEN,0)),"^",3)
86 ;
87GET(DGENRIEN,DGENR) ;
88 ;Description: Used to obtain a record from the Patient Enrollment file
89 ; into the local DGENR array.
90 ;Input :
91 ; DGENRIEN - this is the internal entry number of a PATIENT ENROLLMENT record
92 ;Output:
93 ; Function Value - returns 1 on success, 0 on failure.
94 ; DGENR - this is the name of a local array, it should be passed by
95 ; reference. If the function is successful this array will
96 ; contain the enrollment.
97 ;
98 ; subscript field name
99 ; "APP" Enrollment Applicaiton Date
100 ; "DATE" Enrollment Date
101 ; "END" Enrollment End Date
102 ; "DFN" Patient IEN
103 ; "SOURCE" Enrollment Source
104 ; "STATUS" Enrollment Status
105 ; "REASON" Reason Canceled/Declined
106 ; "REMARKS" Canceled/Declined Remarks
107 ; "FACREC" Facility Received
108 ; "PRIORITY" Enrollment Priority
109 ; "SUBGRP" Enrollment Sub-Group
110 ; "EFFDATE" Effective Date
111 ; "PRIORREC" Prior Enrollment Record
112 ; "ELIG","CODE" Primary Eligibility Code
113 ; "ELIG","CODE",<code ien> Eligibility Codes
114 ; "ELIG","SC" Service Connected
115 ; "ELIG","SCPER" Service Connected Percentage
116 ; "ELIG","POW" POW Status Indicated
117 ; "ELIG","A&A" Receiving A&A Benefits
118 ; "ELIG","HB" Receiving Housebound Benefits
119 ; "ELIG","VAPEN" Receiving a VA Pension
120 ; "ELIG","VACKAMT" Total Annual VA Check Amount
121 ; "ELIG","DISRET" Military Disability Retirement
122 ; "ELIG","DISLOD" Discharged Due to Disability
123 ; "ELIG","MEDICAID" Medicaid
124 ; "ELIG","AO" Exposed to Agent Orange
125 ; "ELIG","IR" Radiation Exposure Indicated
126 ; "ELIG","RADEXPM" Radiation Exposure Method
127 ; "ELIG","EC" Environmental Contaminants
128 ; "ELIG","MTSTA" Means Test Status
129 ; "ELIG","VCD" Veteran Catastrophically Disabled?
130 ; "ELIG","PH" Purple Heart Indicated?
131 ; "ELIG","UNEMPLOY" Unemployable
132 ; "ELIG","CVELEDT" Combat Veteran End Date
133 ; "ELIG","SHAD" SHAD Indicated
134 ; "DATETIME" Date/Time Entered
135 ; "USER" Entered By
136 ;
137 N SUB,NODE
138 I '$G(DGENRIEN) Q 0
139 I '$D(^DGEN(27.11,DGENRIEN,0)) Q 0
140 K DGENR
141 S DGENR=""
142 S NODE=$G(^DGEN(27.11,DGENRIEN,0))
143 S DGENR("APP")=$P(NODE,"^")
144 S DGENR("DATE")=$P(NODE,"^",10)
145 S DGENR("END")=$P(NODE,"^",11)
146 S DGENR("DFN")=$P(NODE,"^",2)
147 S DGENR("SOURCE")=$P(NODE,"^",3)
148 S DGENR("STATUS")=$P(NODE,"^",4)
149 S DGENR("REASON")=$P(NODE,"^",5)
150 S DGENR("FACREC")=$P(NODE,"^",6)
151 S DGENR("PRIORITY")=$P(NODE,"^",7)
152 S DGENR("EFFDATE")=$P(NODE,"^",8)
153 S DGENR("PRIORREC")=$P(NODE,"^",9)
154 ;Phase II Get enrollment sub-grp (SRS 6.4)
155 S DGENR("SUBGRP")=$P(NODE,"^",12)
156 S NODE=$G(^DGEN(27.11,DGENRIEN,"R"))
157 S DGENR("REMARKS")=$P(NODE,"^")
158 S NODE=$G(^DGEN(27.11,DGENRIEN,"E"))
159 S DGENR("ELIG","CODE")=$P(NODE,"^")
160 S DGENR("ELIG","SC")=$P(NODE,"^",2)
161 S DGENR("ELIG","SCPER")=$P(NODE,"^",3)
162 S DGENR("ELIG","POW")=$P(NODE,"^",4)
163 S DGENR("ELIG","A&A")=$P(NODE,"^",5)
164 S DGENR("ELIG","HB")=$P(NODE,"^",6)
165 S DGENR("ELIG","VAPEN")=$P(NODE,"^",7)
166 S DGENR("ELIG","VACKAMT")=$P(NODE,"^",8)
167 S DGENR("ELIG","DISRET")=$P(NODE,"^",9)
168 S DGENR("ELIG","DISLOD")=$P(NODE,"^",20) ;added with DG*5.3*672
169 S DGENR("ELIG","MEDICAID")=$P(NODE,"^",10)
170 S DGENR("ELIG","AO")=$P(NODE,"^",11)
171 S DGENR("ELIG","IR")=$P(NODE,"^",12)
172 S DGENR("ELIG","EC")=$P(NODE,"^",13)
173 S DGENR("ELIG","MTSTA")=$P(NODE,"^",14)
174 S DGENR("ELIG","VCD")=$P(NODE,"^",15)
175 S DGENR("ELIG","PH")=$P(NODE,"^",16)
176 S DGENR("ELIG","UNEMPLOY")=$P(NODE,"^",17)
177 S DGENR("ELIG","CVELEDT")=$P(NODE,"^",18)
178 S DGENR("ELIG","SHAD")=$P(NODE,"^",19)
179 S DGENR("ELIG","RADEXPM")=$P(NODE,"^",21)
180 ;S DGENCDZZ=1 ; for CD Testing (disabled).
181 S NODE=$G(^DGEN(27.11,DGENRIEN,"U"))
182 S DGENR("DATETIME")=$P(NODE,"^")
183 S DGENR("USER")=$P(NODE,"^",2)
184 Q 1
185 ;
Note: See TracBrowser for help on using the repository browser.