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

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

initial load of FOIAVistA 6/30/08 version
File size: 8.3 KB
Line 
1DGENL1 ;ALB/RMO,ISA/KWP,Zoltan,ALB/BRM,LBD,ERC,EG,CKN - Patient Enrollment - Build List Area; 10/23/00 9:49am ;04/24/2006
2 ;;5.3;Registration;**121,147,232,266,343,564,672,659,653**;Aug 13,1993;Build 2
3 ;
4EN(DGARY,DFN,DGENRIEN,DGCNT) ;Entry point to build list area
5 ; for patient enrollment and patient enrollment history
6 ; Input -- DGARY Global array subscript
7 ; DFN Patient IEN
8 ; DGENRIEN Enrollment IEN
9 ; Output -- DGCNT Number of lines in the list
10 N DGENCAT,DGENR,DGLINE
11 I DGENRIEN,$$GET^DGENA(DGENRIEN,.DGENR) ;set-up enrollment array
12 S DGENCAT=$$CATEGORY^DGENA4(,$G(DGENR("STATUS"))) ;enrollment category
13 S DGENCAT=$$EXTERNAL^DILFD(27.15,.02,"",DGENCAT)
14 S DGLINE=1,DGCNT=0
15 D ENR(DGARY,DFN,.DGENR,.DGLINE,.DGCNT) ;enrollment
16 D PF(DGARY,DFN,.DGENR,.DGLINE,.DGCNT) ;priority factors
17 D HIS^DGENL2(DGARY,DFN,DGENRIEN,.DGLINE,.DGCNT) ;history
18 Q
19 ;
20ENR(DGARY,DFN,DGENR,DGLINE,DGCNT) ;Enrollment
21 ; Input -- DGARY Global array subscript
22 ; DFN Patient IEN
23 ; DGENR Enrollment array
24 ; DGLINE Line number
25 ; Output -- DGCNT Number of lines in the list
26 N DGSTART
27 ;
28 S DGSTART=DGLINE ; starting line number
29 D SET(DGARY,DGLINE,"Enrollment",31,IORVON,IORVOFF,,,,.DGCNT)
30 ;
31 ;Enrollment Date
32 S DGLINE=DGLINE+1
33 D SET(DGARY,DGLINE,"Enrollment Date: "_$S($G(DGENR("DATE")):$$EXT^DGENU("DATE",DGENR("DATE")),1:""),11,,,,,,.DGCNT)
34 ;
35 ;
36 ;Enrollment End Date
37 S DGLINE=DGLINE+1
38 D SET(DGARY,DGLINE,"Enrollment End Date: "_$S($G(DGENR("END")):$$EXT^DGENU("END",DGENR("END")),1:""),7,,,,,,.DGCNT)
39 ;
40 ;Enrollment Application Date
41 S DGLINE=DGLINE+1
42 D SET(DGARY,DGLINE,"Application Date: "_$S($G(DGENR("APP")):$$EXT^DGENU("APP",DGENR("APP")),1:""),10,,,,,,.DGCNT)
43 ;
44 ;Source
45 S DGLINE=DGLINE+1
46 D SET(DGARY,DGLINE,"Source of Enrollment: "_$S($G(DGENR("SOURCE")):$$EXT^DGENU("SOURCE",DGENR("SOURCE")),1:""),6,,,,,,.DGCNT)
47 ;
48 ;Category
49 S DGLINE=DGLINE+1
50 D SET(DGARY,DGLINE,"Enrollment Category: "_DGENCAT,7,IORVON,IORVOFF,,,,.DGCNT)
51 ;
52 ;Status
53 S DGLINE=DGLINE+1
54 D SET(DGARY,DGLINE,"Enrollment Status: "_$S($G(DGENR("STATUS")):$$EXT^DGENU("STATUS",DGENR("STATUS")),1:""),9,,,,,,.DGCNT)
55 ;
56 ;Priority
57 S DGLINE=DGLINE+1
58 D SET(DGARY,DGLINE,"Enrollment Priority: "_$S($G(DGENR("PRIORITY")):DGENR("PRIORITY"),1:"")_$S($G(DGENR("SUBGRP")):$$EXT^DGENU("SUBGRP",DGENR("SUBGRP")),1:""),7,,,,,,.DGCNT)
59 ;
60 ;
61 ;Effective date
62 S DGLINE=DGLINE+1
63 D SET(DGARY,DGLINE,"Effective Date: "_$S($G(DGENR("EFFDATE")):$$EXT^DGENU("EFFDATE",DGENR("EFFDATE")),1:""),12,,,,,,.DGCNT)
64 ;
65 ;Reason canceled/declined
66 S DGLINE=DGLINE+1
67 D SET(DGARY,DGLINE,"",1,,,,,,.DGCNT)
68 S DGLINE=DGLINE+1
69 D SET(DGARY,DGLINE,"Reason Canceled/Declined: "_$S($G(DGENR("REASON")):$$EXT^DGENU("REASON",DGENR("REASON")),1:""),2,,,,,,.DGCNT)
70 ;
71 ;Canceled/declined remarks
72 S DGLINE=DGLINE+1
73 D SET(DGARY,DGLINE,"Canceled/Declined Remarks: "_$S($G(DGENR("REASON"))'="":$$EXT^DGENU("REMARKS",DGENR("REMARKS")),1:""),1,,,,,,.DGCNT)
74 ;
75 ;Entered by
76 S DGLINE=DGLINE+1
77 D SET(DGARY,DGLINE,"",1,,,,,,.DGCNT)
78 S DGLINE=DGLINE+1
79 D SET(DGARY,DGLINE,"Entered By: "_$S($G(DGENR("USER")):$$EXT^DGENU("USER",DGENR("USER")),1:""),16,,,,,,.DGCNT)
80 ;
81 ;Date/time entered
82 S DGLINE=DGLINE+1
83 D SET(DGARY,DGLINE,"Date/Time Entered: "_$S($G(DGENR("DATETIME")):$$EXT^DGENU("DATETIME",DGENR("DATETIME")),1:""),9,,,,,,.DGCNT)
84 ;
85 ;Set line to start on next page
86 F DGLINE=DGLINE+1:1:DGSTART+VALM("LINES") D SET(DGARY,DGLINE,"",1,,,,,,.DGCNT)
87 Q
88 ;
89PF(DGARY,DFN,DGENR,DGLINE,DGCNT) ;Priority factors
90 ; Input -- DGARY Global array subscript
91 ; DFN Patient IEN
92 ; DGENR Enrollment array
93 ; DGLINE Line number
94 ; Output -- DGCNT Number of lines in the list
95 N DGSTART
96 ;
97 S DGSTART=DGLINE ; starting line number
98 D SET(DGARY,DGLINE,"Priority Factors",31,IORVON,IORVOFF,,,,.DGCNT)
99 ;
100 ;POW
101 S DGLINE=DGLINE+1
102 D SET(DGARY,DGLINE,"POW: "_$S($G(DGENR("ELIG","POW"))'="":$$EXT^DGENU("POW",DGENR("ELIG","POW")),1:""),19,,,,,,.DGCNT)
103 ;
104 ;Purple Heart - added for patch 343;brm;10/23/00
105 N PHDAT
106 S DGLINE=DGLINE+1
107 S PHDAT=$$PHEART(DFN,$G(DGENRIEN),$G(DGENR("DATETIME")))
108 D SET(DGARY,DGLINE,"Purple Hrt: "_$P(PHDAT,U),12,,,,,,.DGCNT)
109 D:$P(PHDAT,U)="YES" SET(DGARY,DGLINE,"Status: "_$P(PHDAT,U,2),32,,,,,,.DGCNT)
110 D:$P(PHDAT,U)="NO" SET(DGARY,DGLINE,"Remarks: "_$P(PHDAT,U,3),31,,,,,,.DGCNT)
111 ;
112 ;Agent orange
113 S DGLINE=DGLINE+1
114 D SET(DGARY,DGLINE,"A/O Exp.: "_$S($G(DGENR("ELIG","AO"))'="":$$EXT^DGENU("AO",DGENR("ELIG","AO")),1:""),14,,,,,,.DGCNT)
115 ;
116 ;Ionizing radiation
117 S DGLINE=DGLINE+1
118 D SET(DGARY,DGLINE,"ION Rad.: "_$S($G(DGENR("ELIG","IR"))'="":$$EXT^DGENU("IR",DGENR("ELIG","IR")),1:""),14,,,,,,.DGCNT)
119 ;
120 ;Radiation Exposure Method
121 S DGLINE=DGLINE+1
122 D SET(DGARY,DGLINE,"Rad Exp Method: "_$S($G(DGENR("ELIG","RADEXPM"))'="":$$EXT^DGENU("RADEXPM",DGENR("ELIG","RADEXPM")),1:""),8,,,,,,.DGCNT)
123 ;
124 ;Environmental contaminants
125 S DGLINE=DGLINE+1
126 D SET(DGARY,DGLINE,"Env Contam: "_$S($G(DGENR("ELIG","EC"))'="":$$EXT^DGENU("EC",DGENR("ELIG","EC")),1:""),12,,,,,,.DGCNT)
127 ;
128 ;Military retirement - new fields added with DG*5.3*672
129 S DGLINE=DGLINE+1
130 S DGRET=$G(DGENR("ELIG","DISRET"))
131 D SET(DGARY,DGLINE,"Mil Disab Retirement: "_$S($G(DGRET)=0:"NO",$G(DGRET)=1:"YES",$G(DGRET)=2:"YES",$G(DGRET)=3:"UNK",1:""),2,,,,,,.DGCNT)
132 D SET(DGARY,DGLINE,"Dischrg Due to Disab: "_$S($G(DGENR("ELIG","DISLOD"))'="":$$EXT^DGENU("DISLOD",DGENR("ELIG","DISLOD")),1:""),42,,,,,,.DGCNT)
133 ;
134 ;Combat Vet End Date (added for DG*5.3*564 - HVE Phase III)
135 S DGLINE=DGLINE+1
136 D SET(DGARY,DGLINE,"Combat Vet End Date: "_$S($G(DGENR("ELIG","CVELEDT"))'="":$$EXT^DGENU("CVELEDT",DGENR("ELIG","CVELEDT")),1:""),3,,,,,,.DGCNT)
137 ;
138 ;Eligible for medicaid
139 S DGLINE=DGLINE+1
140 D SET(DGARY,DGLINE,"Eligible for MEDICAID: "_$S($G(DGENR("ELIG","MEDICAID"))'="":$$EXT^DGENU("MEDICAID",DGENR("ELIG","MEDICAID")),1:""),1,,,,,,.DGCNT)
141 ;
142 ;Service connected and percentage
143 S DGLINE=DGLINE+1
144 D SET(DGARY,DGLINE,"",1,,,,,,.DGCNT)
145 S DGLINE=DGLINE+1
146 D SET(DGARY,DGLINE,"Svc Connected: "_$S($G(DGENR("ELIG","SC"))'="":$$EXT^DGENU("SC",DGENR("ELIG","SC")),1:""),9,,,,,,.DGCNT)
147 D SET(DGARY,DGLINE,"SC Percent: "_$S($G(DGENR("ELIG","SCPER"))'="":$$EXT^DGENU("SCPER",DGENR("ELIG","SCPER"))_"%",1:""),52,,,,,,.DGCNT)
148 ;
149 ;Aid & attendance and housebound
150 S DGLINE=DGLINE+1
151 D SET(DGARY,DGLINE,"Aid & Attendance: "_$S($G(DGENR("ELIG","A&A"))'="":$$EXT^DGENU("A&A",DGENR("ELIG","A&A")),1:""),6,,,,,,.DGCNT)
152 D SET(DGARY,DGLINE,"Housebound: "_$S($G(DGENR("ELIG","HB"))'="":$$EXT^DGENU("HB",DGENR("ELIG","HB")),1:""),52,,,,,,.DGCNT)
153 ;
154 ;VA Pension
155 ;Unemployable (added for DG*5.3*564 - HVE Phase III)
156 S DGLINE=DGLINE+1
157 D SET(DGARY,DGLINE,"VA Pension: "_$S($G(DGENR("ELIG","VAPEN"))'="":$$EXT^DGENU("VAPEN",DGENR("ELIG","VAPEN")),1:""),12,,,,,,.DGCNT)
158 D SET(DGARY,DGLINE,"Unemployable: "_$S($G(DGENR("ELIG","UNEMPLOY"))'="":$$EXT^DGENU("UNEMPLOY",DGENR("ELIG","UNEMPLOY")),1:""),50,,,,,,.DGCNT)
159 ;
160 ;Total check amount
161 S DGLINE=DGLINE+1
162 D SET(DGARY,DGLINE,"Total Check Amount: "_$S($G(DGENR("ELIG","VACKAMT"))'="":$$EXT^DGENU("VACKAMT",DGENR("ELIG","VACKAMT")),1:""),4,,,,,,.DGCNT)
163 ;
164 ;PROJ 112/SHAD - DG*5.3*653
165 I $G(DGENR("ELIG","SHAD"))=1 D
166 .D SET(DGARY,DGLINE,"Proj 112/SHAD: "_$$EXT^DGENU("SHAD",DGENR("ELIG","SHAD")),49,,,,,,.DGCNT)
167 ;
168 ;Eligibility code
169 S DGLINE=DGLINE+1
170 D SET(DGARY,DGLINE,"Eligibility Code: "_$S($G(DGENR("ELIG","CODE"))'="":$$EXT^DGENU("CODE",DGENR("ELIG","CODE")),1:""),6,,,,,,.DGCNT)
171 ;
172 ;Means test
173 S DGLINE=DGLINE+1
174 D SET(DGARY,DGLINE,"Means Test Status: "_$S($G(DGENR("ELIG","MTSTA"))'="":$$EXT^DGENU("MTSTA",DGENR("ELIG","MTSTA")),1:""),5,,,,,,.DGCNT)
175 ;
176 ;Veteran Catastrophically Disabled
177 S DGLINE=DGLINE+1
178 D SET(DGARY,DGLINE,"Veteran CD Status: "_$S($G(DGENR("ELIG","VCD"))'="":$$EXT^DGENU("VCD",DGENR("ELIG","VCD")),1:""),5,,,,,,.DGCNT)
179 ;
180 ;Set line to start on next page
181 F DGLINE=DGLINE+1:1:DGSTART+VALM("LINES") D SET(DGARY,DGLINE,"",1,,,,,,.DGCNT)
182 Q
183 ;
184SET(DGARY,DGLINE,DGTEXT,DGCOL,DGON,DGOFF,DGSUB,DGNUM,DGDATA,DGCNT) ; moved to
185 ;DGENL2 as DGENL1 was getting too big
186 I $G(DGCOL)']"" S DGCOL=""
187 I $G(DGON)']"" S DGON=""
188 I $G(DGOFF)']"" S DGOFF=""
189 I $G(DGSUB)']"" S DGSUB=""
190 I $G(DGNUM)']"" S DGNUM=""
191 I $G(DGDATA)']"" S DGDATA=""
192 D SET^DGENL2(DGARY,DGLINE,DGTEXT,DGCOL,DGON,DGOFF,DGSUB,DGNUM,DGDATA,.DGCNT)
193 Q
194PHEART(DFN,DGENRIEN,PHENRDT) ;move to DGENL2
195 S PHDAT=$$PHEART^DGENL2(DFN,$G(DGENRIEN),$G(DGENR("DATETIME")))
196 I ($G(PHI)]""!($G(PHST)]"")!($G(PHRR)]"")) Q $G(PHI)_"^"_$G(PHST)_"^"_$G(PHRR)
197 Q ""
Note: See TracBrowser for help on using the repository browser.