Produced by Araxis Merge on 11/9/2018 12:33:52 AM Central Standard Time. See www.araxis.com for information about Merge. This report uses XHTML and CSS2, and is best viewed with a modern standards-compliant browser. For optimum results when printing this report, use landscape orientation and enable printing of background images and colours in your browser.
# | Location | File | Last Modified |
---|---|---|---|
1 | CPEE_Build9_Sprint27.zip\HAC_CPE_CH | CHMBLACA.m | Mon Nov 5 16:41:17 2018 UTC |
2 | CPEE_Build9_Sprint27.zip\HAC_CPE_CH | CHMBLACA.m | Mon Nov 5 17:42:18 2018 UTC |
Description | Between Files 1 and 2 |
|
---|---|---|
Text Blocks | Lines | |
Unchanged | 3 | 748 |
Changed | 2 | 4 |
Inserted | 0 | 0 |
Removed | 0 | 0 |
Whitespace | |
---|---|
Character case | Differences in character case are significant |
Line endings | Differences in line endings (CR and LF characters) are ignored |
CR/LF characters | Not shown in the comparison detail |
No regular expressions were active.
1 | CHMBLACA ; HAC/JSG;FO RM REQUEST QUEUE IVR PROCESS ( SCAN);10/2 4/08 10:10 AM | |
2 | ;;1.0;CHA MPVA SYSTE M;;JULY 4, 1990;Buil d 54 | |
3 | ;SBB 01/1 3/2016 Cre ating new routine fo r ACA IRS FORM 1095- B re-issue menu prom pt. | |
4 | MENU() ; | |
5 | ; | |
6 | N SMENU,A NS,ISSYR,I SSNM,ISDFN ,ISBFN,Y1, DAY,DTADD | |
7 | S DAY=$$S ETDAY() | |
8 | S MENUF=1 ,ANS=0,DTA DD=0 | |
9 | D RUNNXTW ED | |
10 | F FORMNUM =1:1 S S=$ P($T(SMENU +FORMNUM), ";",2) Q:S ="END" S SMENU(FORM NUM)=S | |
11 | S FORMNUM =FORMNUM-1 ,CHTYPE="" ,Y1="" | |
12 | F D Q:Y 1="" | |
13 | . S Y1=$$ PROMPT I ' CHTYPE Q | |
14 | . Q:Y1="" | |
15 | . S ANS=Y 1 | |
16 | . I ANS=1 D ISSLTR | |
17 | . I ANS=2 D DISPLST | |
18 | . ;I ANS= 3 D DISPHL P | |
19 | . ;I ANS= 4 D SENDLT R | |
20 | . D INIT | |
21 | . Q | |
22 | ; | |
23 | I DTADD D | |
24 | . N NWD | |
25 | . S NWD=$ $SETNXTWD( ) | |
26 | . S Y=NWD D DD^%DT S NWD=Y | |
27 | . W $$TIT LE,$$CLEAR () | |
28 | . S DX=1, DY=5 X XY W !!,"A pr int batch has been c reated for the IRS F orm 1095-B ." | |
29 | . S DX=1, DY=7 X XY W !,"This batch will automatic ally be re leased to the print vendor," | |
30 | . S DX=1, DY=8 X XY W !," on n ext wednes day, ",NWD ," @00:30a m." | |
31 | . R X:5 | |
32 | . Q | |
33 | ; | |
34 | Q 1 | |
35 | ; | |
36 | PROMPT() ; | |
37 | W $$TITLE ,$$CLEAR | |
38 | F CT=1:1: FORMNUM S DX=3,DY=4+ CT X XY W CT,".",$S( CT<10:" ",1:" " ),SMENU(CT ) | |
39 | S DX=3,DY =16 X XY W "Select O ne: " D CS BRS^CHSC2 | |
40 | I $D(DFOU T)!($D(DTO UT))!($D(D UOUT)) S Y ="" Q "" ; | |
41 | I $D(DQOU T) D S Y= 0 Q 1 ; | |
42 | . W !!,"S elect an o ption from above." | |
43 | . R X:5 | |
44 | I Y="" Q "" | |
45 | I '$D(SME NU(Y)) D Q 1 ; | |
46 | . W *7,!! ,"Invalid selection. Please t ry again." | |
47 | . R X:10 | |
48 | S CHTYPE= Y | |
49 | S (ANS,TY PE)=Y | |
50 | Q Y | |
51 | ; | |
52 | INIT() ; I NITIALIZE | |
53 | D ^CHMFSE T K CHQUIT ,CHRTN,CHR T,CHFLAG,A 3FLG,ISSYR ,ISSNM | |
54 | S DTM=5,D BM=23,MENU F="" X CHM AR | |
55 | S (CHDT,A NS,TYPE,CH TYPE,DFN,B FN,VEN,ISS YR,ISSNM)= "",U="^" | |
56 | Q | |
57 | ; | |
58 | ISSLTR ; | |
59 | ; | |
60 | W $$TITLE ,$$CLEAR | |
61 | ; | |
62 | ISSYRG ; | |
63 | S ISSYR=" " D IYEAR Q:ISSYR="" | |
64 | ISSNMG ; | |
65 | S ISSNM=" " D INAME G:ISSNM="" ISSYRG | |
66 | ISSLTRQ ; | |
67 | Q | |
68 | IYEAR ; | |
69 | ; | |
70 | W $$TITLE ,$$CLEAR | |
71 | S DX=3,DY =4 X XY W "Enter Yea r (eg: 201 5): " D CS BRS^CHSC2 | |
72 | I $D(DFOU T)!($D(DTO UT))!($D(D UOUT)) S Y ="" Q ; | |
73 | I Y="" Q | |
74 | I Y<2015 D S Y=0 G IYEAR ; | |
75 | . W !!,"S elect a ye ar after 2 014. eg: 2 015 etc" | |
76 | . R X:5 | |
77 | I '+Y D G IYEAR ; | |
78 | . W *7,!! ,"Invalid year. Ple ase try ag ain." | |
79 | . R X:5 | |
80 | I Y'?4N D G IYEAR ; | |
81 | . W *7,!! ,"Enter a 4 digit ye ar. Please try again ." | |
82 | . R X:5 | |
83 | S ISSYR=Y | |
84 | Q | |
85 | ; | |
86 | INAME ; | |
87 | ; | |
88 | W $$TITLE ,$$CLEAR | |
89 | N FRMLACA | |
90 | S FRMLACA =1,Y="" | |
91 | D ^CHMBLA B1 | |
92 | ;w !,Y | |
93 | I Y=-1 D G INAME | |
94 | . W !,"NO MATCHES F OUND in th e CHAMPVA Database." | |
95 | . W !!,"N o Print/Re print for IRS FORM 1 095-B can be generat ed" | |
96 | . W ! | |
97 | . R X:15 | |
98 | . Q | |
99 | Q | |
100 | ; | |
101 | RELT(STR) ; | |
102 | ; | |
103 | N RTN,TMP | |
104 | S TMP=$P( STR,U,4),R TN=$S(TMP= "C":"CHILD ",TMP="S": "SPOUSE",T MP="XS":"E X-SPOUSE", TMP="CG":" CAREGIVER" ,1:"") | |
105 | Q RTN | |
106 | ; | |
107 | STAT(STR) ; | |
108 | ; | |
109 | N RTN,TMP | |
110 | S TMP=$P( STR,U,5) | |
111 | I TMP'="" D | |
112 | . S TMP=$ S(TMP="EA" :"ELIGIBLE -ACTIVE",T MP="D":"IN ELIGIBLE", 1:TMP) | |
113 | . S TMP=$ S(TMP="PS" :"PENDING- REVIEW",TM P="PR":"PE NDING DEER S ACCEPTAN CE",1:TMP) | |
114 | . S TMP=$ S(TMP="PC" :"PENDING DEERS-DATA CONFLICT" ,TMP="T":" SENT TO DE ERS-UNEDIT ABLE",1:TM P) | |
115 | . S TMP=$ S(TMP="U": "UNKNOWN", TMP="SF":" SELF",1:TM P) | |
116 | . S TMP=$ S(TMP="PW" :"PENDING HAC VALIDA TION",TMP= "SF":"SELF ",1:TMP) | |
117 | . S TMP=$ S(TMP="REN ":"RE-ENRO LLED",TMP= "DIS":"DIS ENROLLED", 1:TMP) | |
118 | . S TMP=$ S(TMP="DL" :"DELETED" ,1:TMP) | |
119 | . Q | |
120 | S RTN=TMP | |
121 | Q RTN | |
122 | ; | |
123 | SETGLBL ; | |
124 | ; | |
125 | N CNTNM,R TNS | |
126 | S DAY=$$S ETDAY() | |
127 | S CNTNM=0 ,CNTNM=^CH MZHOLD("RE ISU-1095-B ",DAY) | |
128 | ;Q:'+ZPSI | |
129 | ;Q:'+ZPSJ | |
130 | I ADDCHK= 0 D Q | |
131 | . W !!," UNABLE TO PRINT/REPR INT THE IR S FORM 109 5-B," | |
132 | . W !," BENEFIC IARY HAS B AD ADDRESS FLAG" | |
133 | . H 5 | |
134 | . Q | |
135 | I '+ZPSI! '+ZPSJ D Q | |
136 | . W !,"NO MATCHES F OUND in th e CHAMPVA Database." | |
137 | . W !!,"B eneficiari es must me et the spe cified yea r requirem ents " | |
138 | . W !," for IRS 10 95-B. No b ene name a dded." | |
139 | . H 5 | |
140 | . Q | |
141 | S ISDFN=Z PSI,(ISBFN ,Y)=ZPSJ | |
142 | S ISSNM=$ P(^AHCHVA( ISDFN,100, ISBFN,0),U ) | |
143 | ;Finding duplicates | |
144 | N DSP14DT | |
145 | S DY14=$$ GET14DA,DU P=0,DSP14D T=0 F I=DY 14:1:DAY Q :DUP D | |
146 | . I $D(^C HMZHOLD("R EISU-1095- B",I,ISSYR ,ISSNM)) D | |
147 | . . S DUP =1 S Y=I D DD^%DT S DSP14DT=Y | |
148 | . . W !," FORM 1095- B already requested for this n ame in pas t 14 days on ",DSP14 DT | |
149 | . . W !," request 14 days a fter this day:",DSP1 4DT | |
150 | . . H 5 | |
151 | . . Q | |
152 | . Q | |
153 | ; | |
154 | Q:DUP | |
155 | ; | |
156 | S RTNS="" D INITRP^ CHMEAI01(I SDFN,ISBFN ,ISSYR,.RT NS) | |
157 | I RTNS="" D Q | |
158 | . W !,"UN ABLE TO PR INT/REPRIN T THE IRS FORM 1095- B, " | |
159 | . W !," B ENEFICIARY IS NOT EL IGIBLE FOR SELECTED YEAR" | |
160 | . H 5 | |
161 | . Q | |
162 | ; | |
163 | S ^CHMZHO LD("REISU- 1095-B",DA Y,ISSYR,IS SNM)=RTNS, CNTNM=CNTN M+1 | |
164 | S ^CHMZHO LD("REISU- 1095-B",DA Y)=CNTNM | |
165 | S CCLNUM= 347 | |
166 | D SETCCL2 B(ISDFN,IS BFN,CCLNUM ) | |
167 | D INCCCLC T(CCLNUM) | |
168 | S DTADD=1 | |
169 | ; | |
170 | Q | |
171 | SETDAY() ; | |
172 | ; | |
173 | N RTN | |
174 | D NOW^%DT C S RTN=X | |
175 | I '$D(^CH MZHOLD("RE ISU-1095-B ",RTN)) S ^CHMZHOLD( "REISU-109 5-B",RTN)= 0 Q RTN | |
176 | Q RTN | |
177 | ; | |
178 | SETCCL2B(D FNN,BFNN,C CLN) ; | |
179 | ; | |
180 | N TMP,CNT | |
181 | D NOW^%DT C S TMP=$E (%,1,$L(%) -2) | |
182 | S CNT=0 | |
183 | ;^AHCHVA( 550014,100 ,1,500,1,0 )="3001201 .1014^170^ 0^^^1" | |
184 | I '$D(^AH CHVA(DFNN, 100,BFNN,5 00)) S CNT =1 D Q | |
185 | . S ^AHCH VA(DFNN,10 0,BFNN,500 ,CNT,0)=TM P_U_CCLN_U _"0"_U_U_U _"1" | |
186 | . Q | |
187 | S CNT=$O( ^AHCHVA(DF NN,100,BFN N,500,""), -1),CNT=CN T+1 | |
188 | S ^AHCHVA (DFNN,100, BFNN,500,C NT,0)=TMP_ U_CCLN_U_" 0"_U_U_U_" 1" | |
189 | Q | |
190 | ; | |
191 | INCCCLCT(C CLN) ; | |
192 | ; | |
193 | N CT | |
194 | S CT=0,CT =$P(^AHADI C(554801.1 ,CCLN,0),U ,5),CT=CT+ 1,$P(^AHAD IC(554801. 1,CCLN,0), U,5)=CT | |
195 | Q | |
196 | ; | |
197 | DISPLST ; | |
198 | ; | |
199 | N RECNT,L STWD,DSPDT | |
200 | K CHQUIT | |
201 | S DAY=$$S ETDAY(),RE CNT=1,CHQU IT=0,DSPDT =DAY | |
202 | D DISPLST 1 | |
203 | S CT=0,CT 1=0 | |
204 | S LSTWD=^ CHMZHOLD(" REISU-1095 -B")-1 F S LSTWD=$O (^CHMZHOLD ("REISU-10 95-B",LSTW D)) Q:'+LS TWD!CHQUIT D | |
205 | . S Y=LST WD D DD^%D T S DSPDT= Y | |
206 | . S DX=3, DY=LN+CT1 X XY W ?10 ,DSPDT S C T=CT+1,CT1 =CT1+1 | |
207 | . I DY=20 D DISPLST 2 I 'CHQUI T D DISPLS T1 | |
208 | . S IYR=0 F S IYR= $O(^CHMZHO LD("REISU- 1095-B",LS TWD,IYR)) Q:'+IYR!CH QUIT D | |
209 | . . S DX= 3,DY=LN+CT 1 X XY W ? 40,IYR S C T=CT+1,CT1 =CT1+1 | |
210 | . . I DY= 20 D DISPL ST2 I 'CHQ UIT D DISP LST1 | |
211 | . . S INM ="" F S I NM=$O(^CHM ZHOLD("REI SU-1095-B" ,LSTWD,IYR ,INM)) Q:( INM="")!CH QUIT D | |
212 | . . . S D X=3,DY=LN+ CT1 X XY W RECNT," " ,INM S CT= CT+1,CT1=C T1+1,RECNT =RECNT+1 | |
213 | . . . I D Y=20 D DIS PLST2 I 'C HQUIT D DI SPLST1 | |
214 | . . . Q | |
215 | . . Q | |
216 | . Q | |
217 | R !,X:10 | |
218 | Q | |
219 | ; | |
220 | DISPLST1 ; | |
221 | ; | |
222 | W $$TITLE ,$$CLEAR | |
223 | S DX=3,DY =4 X XY W $ZDATE($H, 1) | |
224 | S DX=3,DY =5 X XY W "Name ",? 40,"Year " | |
225 | S DX=3,DY =6 X XY W "---- ",? 40,"---- " | |
226 | S LN=7,CT 1=0 | |
227 | Q | |
228 | ; | |
229 | DISPLST2 ; | |
230 | ; | |
231 | W !,"Pres s Enter to continue or '^' to stop: " D CSBRS^CHSC 2 W ! | |
232 | I $D(DFOU T)!($D(DTO UT)) S CHQ UIT=1 Q | |
233 | I $D(DUOU T) S CHQUI T=1 Q | |
234 | Q | |
235 | ; | |
236 | DISPHLP ; | |
237 | W $$TITLE ,$$CLEAR | |
238 | S DX=3,DY =4 X XY W "Option 1: " | |
239 | S DX=3,DY =5 X XY W " Select a bene by Na me or SSN" | |
240 | S DX=3,DY =6 X XY W " Enter the year for which " | |
241 | S DX=3,DY =7 X XY W " the IRS F orm 1095-B is needed ." | |
242 | S DX=3,DY =8 X XY W " " | |
243 | S DX=3,DY =9 X XY W "Option 2: " | |
244 | S DX=3,DY =10 X XY W " Displays the Bene names " | |
245 | S DX=3,DY =11 X XY W " that wil l get the Form 1095- B " | |
246 | S DX=3,DY =12 X XY W " at the e nd of this month." | |
247 | S DX=3,DY =13 X XY W " " | |
248 | S DX=3,DY =14 X XY W "Option 3 :" | |
249 | S DX=3,DY =15 X XY W " Displays this help text." | |
250 | S DX=3,DY =16 X XY W " " | |
251 | S DX=3,DY =17 X XY W "Option 4 :" | |
252 | S DX=3,DY =18 X XY W " Send the last mont h's list" | |
253 | S DX=3,DY =19 X XY W " to stagi ng area." | |
254 | R X:10 | |
255 | Q | |
256 | ; | |
257 | SENDLTR ; | |
258 | ; | |
259 | W $$TITLE ,$$CLEAR | |
260 | S DX=3,DY =4 X XY W "All the n ames for t he current week are sent to a file" | |
261 | S DX=3,DY =5 X XY W "on wednes day to \\ DNS fs3\FS3BIG \TEMP_FILE S\IRS_LETT ERS" | |
262 | S DX=3,DY =6 X XY W " " | |
263 | S DX=3,DY =7 X XY W "MoveIt ta sk needs t o be creat ed to pick this one exclusivel y," | |
264 | S DX=3,DY =8 X XY W "the curre nt task pi cks the fi le only on ce a week. " | |
265 | ; | |
266 | S CHFIO=" " | |
267 | S ZTRTN=" IRSLTRFQ^C HMBLACA",Z TDESC="IRS 1095-B Re issue File creation. " | |
268 | S ZTIO="" ,ZTSAVE("C HFIO")="" | |
269 | D ^%ZTLOA D | |
270 | ; | |
271 | K CHFIO,% ZIS,%DT,%D T(0),%DT(" A"),DIC,DI C(0),DIC(" A") | |
272 | W @IOF | |
273 | Q | |
274 | ; | |
275 | RUNNXTWED ; | |
276 | ; | |
277 | S DAY=$$S ETDAY() | |
278 | S NXTWD=$ $SETNXTWD( ) | |
279 | I $D(^CHM ZHOLD("REI SU-1095-B" ,NXTWD,"EN D")) Q | |
280 | ; | |
281 | S CHFIO=" " | |
282 | S X=NXTWD D H^%DTC | |
283 | S ZTDTH=% H_",1800" ; Submit f or wednesd y end at 0 030 hrs 30 *60 = 1800 | |
284 | S ZTRTN=" IRSLTRFQ^C HMBLACA",Z TDESC="IRS 1095-B Re issue File creation. " | |
285 | S ZTIO="" ,ZTSAVE("C HFIO")="" | |
286 | D ^%ZTLOA D | |
287 | ; | |
288 | S ^CHMZHO LD("REISU- 1095-B",NX TWD)=0 | |
289 | S ^CHMZHO LD("REISU- 1095-B",NX TWD,"END") =1 | |
290 | K CHFIO,% ZIS,%DT,%D T(0),%DT(" A"),DIC,DI C(0),DIC(" A") | |
291 | W @IOF | |
292 | Q | |
293 | ; | |
294 | SETNXTWD() ; sets th e next wed nesday | |
295 | ; | |
296 | N RTN,DAY ,DAYC,X,AX | |
297 | S DAY=$$S ETDAY() | |
298 | S X=DAY D DW^%DTC S DAYC=X | |
299 | S AX=$S(D AYC="WEDNE SDAY":7,DA YC="TUESDA Y":1,DAYC= "MONDAY":2 ,DAYC="SUN DAY":3,DAY C="SATURDA Y":4,DAYC= "FRIDAY":5 ,DAYC="THU RSDAY":6,1 :0) | |
300 | S X1=DAY, X2=AX | |
301 | D C^%DTC | |
302 | S RTN=X | |
303 | Q RTN | |
304 | ; | |
305 | GET14DA() ; get 14 d ays ago | |
306 | ; | |
307 | N RTN,DAY | |
308 | S DAY=$$S ETDAY() | |
309 | S X1=DAY, X2=-14 | |
310 | D C^%DTC | |
311 | S RTN=X | |
312 | Q RTN | |
313 | ; | |
314 | IRSLTRFQ ; | |
315 | ; | |
316 | ; CEP/JAH /AEB MODIF IED TO ALL OW FOR MUL TIPLES OF AN IDENTIC AL NAME ON A GIVEN | |
317 | ; QUEUE P ERIOD FOR A GIVEN FO RM YEAR | |
318 | N LSTWD | |
319 | S LSTWD=^ CHMZHOLD(" REISU-1095 -B") | |
320 | S DAY=$$S ETDAY^CHMB LACA() | |
321 | S ^CHMZHO LD("REISU- 1095-B")=D AY | |
322 | S DIR="HA C_HFS$:[SC R.TEMP_FIL ES]" | |
323 | X ^%ZOSF( "UCI") S U CI=$P(Y,", ",1) | |
324 | I UCI'="H AC" S DIR= "HAC_HFS$: [DSMMANAG. CHAMPVA]" | |
325 | ; | |
326 | K ^ZTMPYR ($J) | |
327 | S LSTWD=L STWD-1 F S LSTWD=$O (^CHMZHOLD ("REISU-10 95-B",LSTW D)) Q:(LST WD=DAY)!(' +LSTWD) D | |
328 | . S IYR=0 F S IYR= $O(^CHMZHO LD("REISU- 1095-B",LS TWD,IYR)) Q:'+IYR D | |
329 | . . S ^ZT MPYR($J,IY R)=0 | |
330 | . . S INM ="" F S I NM=$O(^CHM ZHOLD("REI SU-1095-B" ,LSTWD,IYR ,INM)) Q:I NM="" D | |
331 | . . . S ^ ZTMPYR($J, IYR,LSTWD, INM)=^CHMZ HOLD("REIS U-1095-B", LSTWD,IYR, INM) | |
332 | . . . Q | |
333 | . . Q | |
334 | . Q | |
335 | ; | |
336 | S IYR=0 F S IYR=$O (^ZTMPYR($ J,IYR)) Q: '+IYR D | |
337 | . S DT=$Z DATE($H,1) ,DTYR=$P(D T,"/",3),D TYR1=DTYR_ $P(DT,"/") _$P(DT,"/" ,2) | |
338 | . D NOW^% DTC S TM=$ P(%,".",2) | |
339 | . S FNAME ="MEC_Data Extract_O_ "_IYR_"_B_ "_DTYR1_TM _".TXT" | |
340 | . S CHFIO =DIR_FNAME | |
341 | . I '$$OP ENFIWR^CHT FLIB9(.CHF IO,"CHFIO" ) Q | |
342 | . I UCI'= "HAC" U CH FIO W UCI, !! | |
343 | . ; | |
344 | . S LSTWD ="" F S L STWD=$O(^Z TMPYR($J,I YR,LSTWD)) Q:LSTWD=" " D | |
345 | . . S INM ="" F S I NM=$O(^ZTM PYR($J,IYR ,LSTWD,INM )) Q:INM=" " D | |
346 | . . . U C HFIO W ^ZT MPYR($J,IY R,LSTWD,IN M),! | |
347 | . . . Q | |
348 | . ; | |
349 | . D CLOSE F^CHTFLIB9 (CHFIO,"CH FIO") | |
350 | . H 5 | |
351 | . D FTPFI LE^CHTFLIB 9(CHFIO," DNS fs3. DNS ","/FS3BIG /IRS_LETTE RS","PUT") | |
352 | . H 5 | |
353 | . Q | |
354 | ;D KILLRG BL(DAY) | |
355 | K ^ZTMPYR ($J) | |
356 | Q | |
357 | ; | |
358 | KILLRGBL(D AY) ; | |
359 | ; | |
360 | K ^CHMZHO LD("REISU- 1095-B",DA Y) | |
361 | K ^ZTMPYR ($J) | |
362 | Q | |
363 | ; | |
364 | TITLE() ;m enu type | |
365 | ; | |
366 | W @IOF,!, ?21,"Famil y Member I RS Form 10 95-B" | |
367 | Q "" ;TIT LE | |
368 | ; | |
369 | CLEAR() ;C LEAR SCREE N | |
370 | D RNGECLR ^CHSC1(3,2 4,XY,CHEOL ) | |
371 | Q "" ;CLE AR | |
372 | ; | |
373 | SMENU ;Men u options | |
374 | ;Request IRS Form 1 095-B by y ear | |
375 | ;View the Weekly Li st | |
376 | ;END |
Araxis Merge (but not the data content of this report) is Copyright © 1993-2016 Araxis Ltd (www.araxis.com). All rights reserved.