source: FOIAVistA/trunk/r/ENROLLMENT_APPLICATION_SYSTEM-EAS/EASEZPDG.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.7 KB
Line 
1EASEZPDG ;ALB/AMA/GTS/CMF - PRINT 10-10EZ OR EZR FROM DG OPTIONS
2 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**57**;Mar 15, 2001
3 ;
4 Q
5 ;
6ENEZR(EASDFN,EASMTIEN) ;DBIA 4600 - PRINT THE 10-10EZR FROM DG OPTIONS
7 ; INPUT:
8 ; EASDFN - POINTER TO THE PATIENT FILE (#2) - required
9 ; EASMTIEN - POINTER TO MEANS TEST FILE (#408.31) - optional
10 ; (+ien, "", or 0)
11 ; OUTPUT:
12 ; (+ien or ""):ZTSK - TASKMAN JOB NUMBER
13 ; (0):mt ien (forces test lookup only)
14 ;
15 N EASFLAG,X
16 S EASFLAG="EZR"
17 S EASDFN=$G(EASDFN)
18 S EASMTIEN=$G(EASMTIEN)
19 ;
20 S X=$$ENEZ(EASDFN,EASMTIEN)
21 Q X
22 ;
23ENEZ(EASDFN,EASMTIEN) ;DBIA 4600 - PRINT THE 10-10EZ FROM DG OPTIONS
24 ; INPUT:
25 ; EASDFN - POINTER TO THE PATIENT FILE (#2) - required
26 ; EASMTIEN - POINTER TO MEANS TEST FILE (#408.31) - optional
27 ; (+ien, "", or 0)
28 ; OUTPUT:
29 ; (+ien or ""):ZTSK - TASKMAN JOB NUMBER
30 ; (0):mt ien (forces test lookup only)
31 ;
32 S EASDFN=$G(EASDFN)
33 S EASMTIEN=$G(EASMTIEN)
34 I EASMTIEN=0 Q $$PICK^EASEZPVU(EASDFN,0)
35 E S EASMTIEN=$$PICK^EASEZPVU(EASDFN,EASMTIEN)
36 ;
37 ;If any EAS applications exist, ensure they're all filed
38 N X,INPROG
39 S X=0,INPROG=0 F S X=$O(^EAS(712,"AC",EASDFN,X)) Q:'X!INPROG D
40 . I $$GET1^DIQ(712,X,7.1)="" D
41 . . N IX,DATE F IX="REV","PRT","SIG" Q:INPROG D
42 . . . S DATE=0 F S DATE=$O(^EAS(712,IX,DATE)) Q:'DATE!INPROG D
43 . . . . I $D(^EAS(712,IX,DATE,X)) S INPROG=1
44 I INPROG D Q 0
45 . N DIR
46 . W !!,"No data have been found for the selected patient, or"
47 . W !,"the patient may have an on-line 10-10EZ application"
48 . W !,"in progress. The 10-10EZ"_$S($G(EASFLAG)="EZR":"R",1:"")_" form shall not be printed."
49 . S DIR(0)="E" D ^DIR
50 ;
51 N %ZIS,ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK,ZUSR,POP,ERR
52 ;
53 W !!?5,*7,"Do not select a slave device for output."
54 W !?5,"This output requires a 132 column output printer."
55 W !?5,"Output to SCREEN will be unreadable.",!
56 ;
57 ;
58DEV S %ZIS="QM"
59 S %ZIS("S")="I $P($G(^(1)),U)'[""SLAVE""&($P($G(^(0)),U)'[""SLAVE"")"
60 S %ZIS("B")=""
61 ;S IOP="Q"
62 D ^%ZIS
63 ;
64 I POP D G EXIT
65 . I $D(IO("Q")) K IO("Q")
66 . W !,"Print request cancelled!"
67 . Q
68 I IO=IO(0),$E(IOST,1,2)="C-" D G DEV
69 . W !,*7,"CANNOT QUEUE TO HOME DEVICE!",!
70 . Q
71 ;
72 I $G(EASFLAG)="EZR" S ZTDESC="1010EZR PRINT"
73 E S ZTDESC="1010EZ PRINT"
74 S ZUSR=DUZ,ZTRTN="EN^EASEZPDG"
75 ;
76 F X="ZUSR","EASDFN","EASMTIEN","EASFLAG" S ZTSAVE(X)=""
77 D ^%ZTLOAD
78 D HOME^%ZIS
79 ;
80EXIT Q +$G(ZTSK)
81 ;
82EN ;BACKGROUND JOB ENTRY POINT TO PRINT EZ/EZR FROM DG OPTIONS
83 ;
84 N EASAPP,C2711
85 S EASAPP=0
86 I '$G(EASVRSN) S EASVRSN=6
87 ;
88 ;SET UP ^TMP("EZDATA" AND ^TMP("EZINDEX" FROM ^EAS(711,"A","A"
89 D LOCAL711^EASEZU2
90 ;
91 S C2711=+$$KEY711^EASEZU1("TYPE OF BENEFIT-ENROLLMENT")
92 D VISTA^EASEZPVD(EASDFN,EASMTIEN)
93 ;
94 ;SET UP ^TMP("EZTEMP" AND ^TMP("EZDISP" GLOBALS
95 D SORT^EASEZC3(0)
96 ;
97 ;SET UP PRINT VARIABLES
98 N EALNE,EAINFO,EAABRT,EAADL,EAMULT,EAAD,EACNT,KEY
99 D SETUP^EASEZPDU(.EALNE,.EAINFO)
100 ;
101 ;DETERMINE WHICH FORM TO PRINT
102 I $G(EASFLAG)="EZR" D EZR I 1
103 E D EZ
104 ;
105 K ^TMP("EASEZ",$J),^TMP("EASEZR",$J)
106 K ^TMP("EZDATA",$J),^TMP("EZRDATA",$J)
107 K ^TMP("EZINDEX",$J),^TMP("EZRINDEX",$J)
108 K ^TMP("EZTEMP",$J),^TMP("EZRTEMP",$J)
109 K ^TMP("EZDISP",$J),^TMP("EZRDISP",$J)
110 Q
111 ;
112EZR ; Entry point to print 1010EZR
113 ;
114 N EASDG,EAADL,EAAD,EACNT
115 M ^TMP("EASEZR",$J)=^TMP("EASEZ",$J) K ^TMP("EASEZ",$J)
116 M ^TMP("EZRDATA",$J)=^TMP("EZDATA",$J) K ^TMP("EZDATA",$J)
117 M ^TMP("EZRINDEX",$J)=^TMP("EZINDEX",$J) K ^TMP("EZINDEX",$J)
118 M ^TMP("EZRTEMP",$J)=^TMP("EZTEMP",$J) K ^TMP("EZTEMP",$J)
119 M ^TMP("EZRDISP",$J)=^TMP("EZDISP",$J) K ^TMP("EZDISP",$J)
120 ;
121 D PAGE1^EASEZRPU
122 D EN^EASEZRP1(.EALNE,.EAINFO)
123 ;
124 D PAGE2^EASEZRPP
125 S EASDG=1 ;FLAG VARIABLE TO SIGNIFY PRINTING FROM DG
126 D EN^EASEZRP2(.EALNE,.EAINFO,EASDG)
127 ;
128 D NETEZR^EASEZPDU(.EALNE,.EAINFO)
129 ;
130 ;Print additional insurance pages if more than 1 insurance company
131 F EAADL=1:1 Q:'$D(^TMP("EZRTEMP",$J,"IA",EAADL)) D
132 . S EAAD=1
133 . D PAGEI^EASEZRPU(EAADL)
134 I $G(EAAD) D EN^EASEZRPI(.EALNE,.EAINFO)
135 ;
136 ;Print additional dependent pages if more than 1 dependent
137 S EAAD=0 F EAADL=1:1 Q:'$D(^TMP("EZRTEMP",$J,"IIB",EAADL)) D
138 . S EAAD=1 ;FLAG THAT THERE ARE ADDITIONAL DEPENDENTS
139 . D PAGEN^EASEZRPU(EAADL)
140 I EAAD D EN^EASEZRPD(.EALNE,.EAINFO)
141 ;
142 ;;RESORT DEPENDENT SUBSCRIPTS TO ENSURE PROPER NUMERICAL ORDER
143 ;K ^TMP("EZRSORT",$J)
144 ;M ^TMP("EZRSORT",$J,"IIF")=^TMP("EZRTEMP",$J,"IIF")
145 ;K ^TMP("EZRTEMP",$J,"IIF")
146 ;S EAADL=0,EACNT=1 F S EAADL=$O(^TMP("EZRSORT",$J,"IIF",EAADL)) Q:'EAADL D
147 ;. N EAQUES
148 ;. S EACNT=EACNT+1
149 ;. S EAQUES="" F S EAQUES=$O(^TMP("EZRSORT",$J,"IIF",EAADL,EAQUES)) Q:EAQUES="" D
150 ;. . S ^TMP("EZRTEMP",$J,"IIF",EACNT,EAQUES)=^TMP("EZRSORT",$J,"IIF",EAADL,EAQUES)
151 ;K ^TMP("EZRSORT",$J)
152 ;
153 ;Print additional dependent financial pages if more
154 ;than 1 dependent, starting with the 2nd one
155 ;(since Child 1 info already displayed on pages 2 & 3)
156 S EAAD=0,EAADL=1 F S EAADL=$O(^TMP("EZRTEMP",$J,"IIF",EAADL)) Q:'EAADL D
157 . S EAAD=1,KEY=+$$KEY711^EASEZU1("CHILD(N) CHILD #")
158 . S ^TMP("EZRTEMP",$J,"IIF",EAADL,"7.")=KEY_"^CHILD "_EAADL_"^1"
159 . D PAGEDFF^EASEZRPP(EAADL)
160 ;
161 ;SINCE ANY ADDITIONAL DEPENDENTS' NET WORTH AMOUNTS (SECTION IIG)
162 ;ARE INCLUDED IN THE VET'S AMOUNT, DISPLAY A MESSAGE ON THE FORM
163 I EAAD D
164 . N TEMP,HDR,FTR,BEGF,BEGG,ADFF,FNP,GNP
165 . S TEMP="EASEZR",HDR="HDR^EASEZRPF(.EALNE,.EAINFO)"
166 . S FTR="FT^EASEZRPF(.EALNE,.EAINFO)",BEGF="BEGINF^EASEZRPM"
167 . S BEGG="BEGING^EASEZRPM",ADFF="ADFF^EASEZRPM"
168 . S FNP=9,GNP=7
169 . D NETMSG
170 ;
171 Q
172 ;
173EZ ;PRINT THE 10-10EZ FORM (copied from EASEZP6F)
174 ;
175 N EASDG,EAADL,EAAD,EACNT
176 D PAGE1^EASEZP6U
177 D PAGE1^EASEZPU3
178 D EN^EASEZP61(.EALNE,.EAINFO)
179 ;
180 D PAGE2^EASEZPU2
181 D EN^EASEZP62(.EALNE,.EAINFO)
182 ;
183 S EASDG=1 ;FLAG VARIABLE TO SIGNIFY PRINTING FROM DG
184 D EN^EASEZP63(.EALNE,.EAINFO,EASDG)
185 D NETEZ^EASEZPDU(.EALNE,.EAINFO)
186 ;
187 ;Print additional insurance pages if more than 1 insurance company
188 F EAADL=1:1 Q:'$D(^TMP("EZTEMP",$J,"IA",EAADL)) D
189 . S EAAD=1
190 . D PAGEI^EASEZPU3(EAADL)
191 I $G(EAAD) D EN^EASEZP6I(.EALNE,.EAINFO)
192 ;
193 ;Print additional dependent pages if more than 1 dependent
194 S EAAD=0 F EAADL=1:1 Q:'$D(^TMP("EZTEMP",$J,"IIB",EAADL)) D
195 . S EAAD=1 ;FLAG THAT THERE ARE ADDITIONAL DEPENDENTS
196 . D PAGEN^EASEZPU3(EAADL)
197 I EAAD D EN^EASEZP6D(.EALNE,.EAINFO)
198 ;
199 K ^AMAB("EASEZ"),^AMAB("EZDATA"),^AMAB("EZINDEX"),^AMAB("EZTEMP"),^AMAB("EZDISP")
200 M ^AMAB("EASEZ",$J)=^TMP("EASEZ",$J)
201 M ^AMAB("EZDATA",$J)=^TMP("EZDATA",$J)
202 M ^AMAB("EZINDEX",$J)=^TMP("EZINDEX",$J)
203 M ^AMAB("EZTEMP",$J)=^TMP("EZTEMP",$J)
204 M ^AMAB("EZDISP",$J)=^TMP("EZDISP",$J)
205 ;
206 ;;RESORT DEPENDENT SUBSCRIPTS TO ENSURE PROPER NUMERICAL ORDER
207 ;K ^TMP("EZSORT",$J)
208 ;M ^TMP("EZSORT",$J,"IIF")=^TMP("EZTEMP",$J,"IIF")
209 ;K ^TMP("EZTEMP",$J,"IIF")
210 ;S (EAADL,EACNT)=1 F S EAADL=$O(^TMP("EZSORT",$J,"IIF",EAADL)) Q:'EAADL D
211 ;. N EAQUES
212 ;. S EACNT=EACNT+1
213 ;. S EAQUES="" F S EAQUES=$O(^TMP("EZSORT",$J,"IIF",EAADL,EAQUES)) Q:EAQUES="" D
214 ;. . S ^TMP("EZTEMP",$J,"IIF",EACNT,EAQUES)=^TMP("EZSORT",$J,"IIF",EAADL,EAQUES)
215 ;K ^TMP("EZSORT",$J)
216 ;
217 ;Print additional dependent financial pages if more
218 ;than 1 dependent, starting with the 2nd one
219 ;(since Child 1 info already displayed on pages 2 & 3)
220 S EAAD=0,EAADL=1 F S EAADL=$O(^TMP("EZTEMP",$J,"IIF",EAADL)) Q:'EAADL D
221 . S EAAD=1,KEY=+$$KEY711^EASEZU1("CHILD(N) CHILD #")
222 . S ^TMP("EZTEMP",$J,"IIF",EAADL,"7.")=KEY_"^CHILD "_EAADL_"^1"
223 . D PAGEDFF^EASEZPU2(EAADL)
224 ;
225 ;SINCE ANY ADDITIONAL DEPENDENTS' NET WORTH AMOUNTS (SECTION IIG)
226 ;ARE INCLUDED IN THE VET'S AMOUNT, DISPLAY A MESSAGE ON THE FORM
227 I EAAD D
228 . ;PRINT IIF AND IIG SECTIONS
229 . N TEMP,HDR,FTR,BEGF,BEGG,ADFF,FNP,GNP
230 . S TEMP="EASEZ",HDR="HDR^EASEZP6F(.EALNE,.EAINFO)"
231 . S FTR="FT^EASEZP6F(.EALNE,.EAINFO)",BEGF="BEGINF^EASEZP6M"
232 . S BEGG="BEGING^EASEZP6M",ADFF="ADFF^EASEZP6M"
233 . S FNP=9,GNP=7
234 . D NETMSG
235 ;
236 Q
237 ;
238NETMSG ;PRINT THE MESSAGE FOR THE NET WORTH SECTION
239 ;
240 N EASF,DEPF,DFCNT,NEWPG
241 ;
242 S EASF=$NA(^TMP(TEMP,$J,"DFF"))
243 I $O(@EASF@(1)) D @BEGF
244 ;
245 ;Start printing with 2nd dependent
246 S DEPF=1,DFCNT=0 F S DEPF=$O(@EASF@(DEPF)) Q:'DEPF D
247 . S DFCNT=DFCNT+1
248 . ;Check to see if a new page is needed
249 . I (DFCNT>1),'((DFCNT-1)#FNP) D
250 . . D @FTR
251 . . D @BEGF
252 . I (DFCNT#FNP)'=1 W !?131,$C(13) W:EALNE("ULC")="-" ! W EALNE("UL")
253 . D @ADFF
254 ;
255 ;PRINT NET WORTH MESSAGE IF THERE ARE *any* ADDITIONAL DEPENDENTS
256 I ((DFCNT#FNP)'=0),((DFCNT#FNP)'=GNP) W !!,?131,$C(13) W:EALNE("ULC")="-" ! W EALNE("UL")
257 ;At the end of IIF, to find when to jump to the next page,
258 ;55 print lines, minus 3 lines for Section IIG title header,
259 ;minus the number of lines already used on current page,
260 ;divided by the number of lines for a Section IIG entry
261 S NEWPG=(52-((DFCNT#FNP)*6))\7
262 I '(DFCNT#FNP)!'NEWPG!(NEWPG=GNP) S NEWPG=GNP D @FTR
263 D @BEGG
264 W !!?23,"ANY PREVIOUS CALENDAR YEAR NET WORTH AMOUNTS FROM ANY ADDITIONAL DEPENDENT CHILD(REN)"
265 W !!?29,"WILL BE INCLUDED IN THE VETERAN'S PREVIOUS CALENDAR YEAR NET WORTH AMOUNTS.",!
266 D @FTR
267 ;
268 Q
Note: See TracBrowser for help on using the repository browser.