Produced by Araxis Merge on 11/9/2018 12:34:06 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 | CHMLRR1.m | Mon Nov 5 16:41:55 2018 UTC |
2 | CPEE_Build9_Sprint27.zip\HAC_CPE_CH | CHMLRR1.m | Fri Nov 9 03:17:44 2018 UTC |
Description | Between Files 1 and 2 |
|
---|---|---|
Text Blocks | Lines | |
Unchanged | 6 | 718 |
Changed | 5 | 10 |
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 | CHMLRR1 ;J EH/CHV;DAT A LOAD FOR RES/RET;0 6/24/15 8 :40 AM | |
2 | ;;1.0;CHA MPVA SYSTE M;;JULY 4, 1990;Buil d 1 | |
3 | ; | |
4 | ;ENC22734 - ENHANCE MENT OF CA CHE SYSTEM S TO SUPPO RT RESERVI STS RETIRE D FUNCTION ALITY | |
5 | ; | |
6 | ;To load data file from VADIR /Austin: STRTA | |
7 | ;To creat e data to send to VA DIR/Austin : STRTB | |
8 | ; | |
9 | ;File lay out: | |
10 | ; Name Null Typ e | |
11 | ; ------- ---------- - ---- --- --------- | |
12 | ; CHAMPVA _FIRST_NAM E VAR CHAR2(50) | |
13 | ; CHAMPVA _LAST_NAME VAR CHAR2(26) | |
14 | ; CHAMPVA _SSN VAR CHAR2(9) | |
15 | ; CHAMPVA _DOB VAR CHAR2(10) | |
16 | ; VA_ID NUM BER(10) | |
17 | ; MATCHIN G_DATE VAR CHAR2(20) | |
18 | ; DEATH_I ND VAR CHAR2(1) | |
19 | ; | |
20 | ; VA_ID: an interna l value us ed in VADI R and othe r VA and D oD systems (equivale nt to an E DI PI, | |
21 | ; if you've come acro ss that te rm before) to unique ly identif y a servic e member. | |
22 | ; | |
23 | ; Matchin g Date: th e date we matched an d processe d this per son in VAD IR for you r group. | |
24 | ; ( I think yo u're holdi ng on to t his value to know wh en we last processed that | |
25 | ; particular service m ember.) | |
26 | ; | |
27 | ; Death I ndicator ( Y or N): i ndicates w hether the service m ember is a live (N) o r deceased (Y). | |
28 | ; | |
29 | ;SPECIAL NOTE FROM VADIR DEVE LOPER (7/1 /15): | |
30 | ; So te chnically, they're e ither Reti red or Gra y-Area Ret irees. | |
31 | ; It's more a lis t of poten tial TRICA RE-eligibl e sponsors than anyt hing else. | |
32 | ; | |
33 | STRTA ;L OAD VADIR/ AUSTIN FIL E INTO CHA MPVA BENE FILE | |
34 | D INIT | |
35 | Q:$D(DUOU T) | |
36 | G:FNAME=" "!(EFFDATE ="^") END | |
37 | D GTRR | |
38 | I $D(^CHM ZHOLD("CHM LRR1",$J)) D | |
39 | .S DIR(0) ="Y",DIR(" A")="OK TO UPDATE RE S/RET DATA ",DIR("B") ="NO" D ^D IR K DIR | |
40 | .Q:Y=-1 | |
41 | .S ANS=Y | |
42 | .I ANS=1 D | |
43 | ..D LDRR^ CHMLRR1 | |
44 | ..D MMSGA 1 | |
45 | .I ANS=0 D | |
46 | ..W !,"Yo u can Queu e update b y doing: D QUEA^CHML RR1" | |
47 | .I ANS="" W !,"YOU TIMED OUT. PLEASE TR Y AGAIN." | |
48 | D END | |
49 | Q | |
50 | GTRR ;GATH ERING RES/ RET DATA | |
51 | U 0 W !!, "Reading i n RES/RET Data...",! | |
52 | X ^%ZOSF( "UCI") S U CI=$P(Y,", ",1) | |
53 | S FOLDER= "HAC_HFS$: [SCR.TEMP_ FILES]" | |
54 | I UCI'="L IVE" S FOL DER="HAC_H FS$:[DSMMA NAG.CHAMPV A]" | |
55 | S CHIO=FN AME | |
56 | S CHIO=FO LDER_CHIO | |
57 | S FLDR="/ FS3BIG/SSD /VADIR_Dat a_Files" | |
58 | D FTPFILE ^CHTFLIB9( CHIO," DNS fs3. DNS ",FLDR,"GE T") | |
59 | H 5 | |
60 | S POP=0,C NTR=0 | |
61 | K:$D(CTR) CTR | |
62 | S CTR=0 | |
63 | S POP=$$O PENFIRD^CH TFLIB9(.CH IO,"CHIO") | |
64 | Q:'POP | |
65 | X "D $SYS TEM.Proces s.SetZEOF( 1)" | |
66 | F U CHIO R REC:5 Q :$$STATUS^ %ZISH S C TR=CTR+1,^ CHMZHOLD(" CHMLRR1",$ J,CTR)=EFF DATE_"^"_$ TR(REC,"|" ,"^") | |
67 | D CLOSEF^ CHTFLIB9(C HIO,"CHIO" ) | |
68 | W !,"FILE "_FNAME_" HAS BEEN CLOSED" | |
69 | Q | |
70 | LDRR ;UPDA TE BENE GL OBAL USING FM | |
71 | Q:'$D(^CH MZHOLD("CH MLRR1",CHD LRJ)) | |
72 | U 0 W !," Processing data...Pl ease stand by." | |
73 | N EFFDATE ,FNAME,LNA ME,SSN,HST DT | |
74 | S CTR=0 F S CTR=$O (^CHMZHOLD ("CHMLRR1" ,CHDLRJ,CT R)) Q:'CTR D | |
75 | .S (EFFDA TE,FNAME,L NAME,SSN)= "" | |
76 | .S EFFDAT E=$P(^CHMZ HOLD("CHML RR1",CHDLR J,CTR),"^" ,1) | |
77 | .S SSN=$P (^CHMZHOLD ("CHMLRR1" ,CHDLRJ,CT R),"^",4) | |
78 | .I $D(^AH CHVA("C",S SN)) D | |
79 | ..S I=0 F S I=$O(^ AHCHVA("C" ,SSN,I)) Q :'I D | |
80 | ...Q:$P(^ AHCHVA(I,0 ),"^",5)'= "E" | |
81 | ...Q:$P($ G(^AHCHVA( I,30)),"^" ,4)=1 ;C HECK OF RE T/RES BEIN G SET BY E LIG QUE | |
82 | ...S ORRF LG=$P(^AHC HVA(I,0)," ^",25) ;C URRENT RES /RET FLAG | |
83 | ...I ORRF LG'="" D | |
84 | ....D NOW ^%DTC S HS TDT=% | |
85 | ....S $P( ^AHCHVA(I, 101,HSTDT, 0),"^",25) =ORRFLG ;UPDATE HI STORY NODE | |
86 | ....S:$D( ^AHCHVA(I, 30)) ^AHCH VA(I,101,H STDT,30)=^ AHCHVA(I,3 0) ;UPDA TE HISTORY NODE | |
87 | ...S DR=" .25////1;1 3////1;14/ ///"_EFFDA TE_";15/// /"_DUZ_";1 6////0",DI E="^AHCHVA (",DA=I D ^DIE ;UP DATE BENE FILE | |
88 | ...S TMPA RY(I)="" | |
89 | D LDRPT ; CREATE REP ORT OF RES /RET BENES UPDATED I N AHCHVA | |
90 | Q | |
91 | INIT ;INIT ILIZING VA RIABLES | |
92 | S (EFFDAT E,Y,CHFLDT ,CHIO,CTR, REC,RC1,RC 2,ANS,CHDL RJ)="" | |
93 | K ^CHMZHO LD("CHMLRR 1",$J) | |
94 | D NOW^%DT C S CHFLDT =% ;FILE LOAD DATE | |
95 | S:'$D(DUZ ) DUZ=1 | |
96 | S CTR=0 | |
97 | S EFFDATE ="" | |
98 | S CHDLRJ= $J | |
99 | K FNAME | |
100 | ;DISPLAY MENU TITLE | |
101 | S TITLE=" RES/RET Da ta Load" | |
102 | W ?(39-($ L(TITLE)/2 )),TITLE,! !! | |
103 | ;SET RES/ RET FILE | |
104 | A1 ; | |
105 | S DIR(0)= "F^3:50" | |
106 | S DIR("A" )="Enter R ES/RET fil e name {in cl .txt}" | |
107 | D ^DIR K DIR | |
108 | Q:$D(DUOU T) | |
109 | Q:Y="^"!( Y="") | |
110 | G:Y'[".tx t" A1 | |
111 | S FNAME=Y | |
112 | K ^CHMZHO LD("CHMLRR 1",$J) | |
113 | ;SET EFFE CTIVE DATE | |
114 | S EFFDATE ="" K DIR | |
115 | S DIR(0)= "D",DIR("A ")="Enter Effective date (mm/d d/yy)",DIR ("B")="TOD AY" D ^DIR K DIR | |
116 | Q:$D(DUOU T) | |
117 | S EFFDATE =Y | |
118 | Q | |
119 | END ;END O F ROUTINE | |
120 | K EFFDATE ,Y,CHFLDT, CHIO,CTR,R EC,CHDLRJ | |
121 | K DIC,PGC TR,FLDR | |
122 | W !!,"UPD ATE HAS BE EN TASKED. MM WILL B E SENT WHE N DONE." | |
123 | Q | |
124 | QUEA ;QUE OR RUN THI S ROUTINE MANUALLY. | |
125 | I '$D(DUZ ) S DUZ=1, DUZ(0)="@" | |
126 | D NOW^%DT C S DT=X | |
127 | I '$D(CHF LDT) S CHF LDT=% | |
128 | S CHFIO=" ",ZTSAVE(" DUZ")="",Z TSAVE("CHF LDT")="",Z TSAVE("CHD LRJ")="" | |
129 | S ZTRTN=" LDRR^CHMLR R1",ZTDESC ="PROCESS RES/RET FE E FILE" | |
130 | S ZTIO="" | |
131 | D ^%ZTLO AD | |
132 | ;D @ZTRTN ; USE I F RUNNING HOT | |
133 | Q | |
134 | MMSGA1 ;GE NERATE MM MESSAGE | |
135 | S CNT=1,^ TMP($J,"CH MLRR1",CNT )="",CNT=C NT+1 | |
136 | S ^TMP($J ,"CHMLRR1" ,CNT)="RET IRED RESER VIST UPDAT E.",CNT=CN T+1 | |
137 | S ^TMP($J ,"CHMLRR1" ,CNT)="",C NT=CNT+1 | |
138 | S ^TMP($J ,"CHMLRR1" ,CNT)="CHA MPVA BENE GLOBAL, HA S BEEN UPD ATED.",CNT =CNT+1 | |
139 | S ^TMP($J ,"CHMLRR1" ,CNT)="",C NT=CNT+1 | |
140 | S ^TMP($J ,"CHMLRR1" ,CNT)="PLE ASE CHECK: ",CNT=CNT+ 1 | |
141 | S ^TMP($J ,"CHMLRR1" ,CNT)="",C NT=CNT+1 | |
142 | S ^TMP($J ,"CHMLRR1" ,CNT)=" /FS3BIG/SS D/VADIR_Re ports/"_FI LE,CNT=CNT +1 | |
143 | S ^TMP($J ,"CHMLRR1" ,CNT)="",C NT=CNT+1 | |
144 | S XMTEXT= "^TMP("_$J _",""CHMLR R1""," | |
145 | S XMDUZ=. 5 | |
146 | S XMY(DUZ )="" | |
147 | S XMY("G. RES/RET")= "" ;RETI RED RESERV IST MAIL G ROUP | |
148 | S XMSUB=" VADIR RR U PDT-CMPLTD " D ^XMD | |
149 | Q | |
150 | LDRPT ;CRE ATE REPORT OF RES/RE T BENES UP DATED IN A HCHVA | |
151 | Q:'$D(TMP ARY) | |
152 | N RWCTR,R PTDT | |
153 | S RWCTR=0 | |
154 | D NOW^%DT C S RPTDT= $$FMTE^XLF DT(%,"1Z") | |
155 | S DATE=$P (RPTDT,"@" ,1) | |
156 | S TIME=$P (RPTDT,"@" ,2) | |
157 | X ^%ZOSF( "UCI") S U CI=$P(Y,", ",1) | |
158 | D NOW^%DT C S RPTDT= $TR($$FMTE ^XLFDT(%," 7DZ"),"/") | |
159 | S FOLDER= "HAC_HFS$: [SCR.TEMP_ FILES]" | |
160 | I UCI'="L IVE" S FOL DER="HAC_H FS$:[DSMMA NAG.CHAMPV A]" | |
161 | S FILE="V ADIR_Uptd_ Ben_Rpt_"_ RPTDT_".TX T" | |
162 | I $$ENVIR ^CHTFLIB'= "LIVE" D | |
163 | .S FILE=" VADIR_Uptd _Ben_Rpt_" _RPTDT_"_" _$$ENVIR^C HTFLIB_".T XT" | |
164 | S CHIO=FO LDER_FILE | |
165 | S FLDR="/ FS3BIG/SSD /VADIR_Rep orts" | |
166 | S POP=0,C NTR=0 | |
167 | S POP=$$O PENFIWR^CH TFLIB9(.CH IO,"CHIO") | |
168 | Q:'POP | |
169 | X "D $SYS TEM.Proces s.SetZEOF( 1)" | |
170 | U CHIO | |
171 | D HEADER, HD1 | |
172 | S I=0 F S I=$O(TMP ARY(I)) Q: 'I D | |
173 | .S SNAME= $P(^AHCHVA (I,0),"^", 1) ;SPN NAME | |
174 | .S SSN=$E ($P(^AHCHV A(I,0),"^" ,9),1,3)_" -"_$E($P(^ AHCHVA(I,0 ),"^",9),4 ,5)_"-"_$E ($P(^AHCHV A(I,0),"^" ,9),6,9) ;SPN SSN | |
175 | .S RRSTAT =$P(TMPARY (I),"^",25 ) ;SPN R ES/RET FLA G | |
176 | .S RWCTR= RWCTR+1 | |
177 | .W !,RWCT R,")",?10, I,?26,SNAM E,?57,SSN | |
178 | D CLOSEF^ CHTFLIB9(C HIO,"CHIO" ) | |
179 | W !,"FILE "_FILE_" HAS BEEN C LOSED" | |
180 | D FTPFILE ^CHTFLIB9( CHIO," DNS fs3. DNS ",FLDR,"PU T") | |
181 | H 5 | |
182 | W !,"FILE "_FILE_" HAS BEEN P UT ON /FS3 BIG/SSD/VA DIR_Report s" | |
183 | Q | |
184 | HEADER ;PR INTS OUT T HE HEADER INFORMATIO N OF SPONS ORS BEING UPDATED | |
185 | S HTL1="H EALTH ADMI NISTRATION CENTER" | |
186 | S HTL2="R ES/RET SPO NSORS UPDA TED REPORT " | |
187 | S:'$D(PGC TR) PGCTR= 0 | |
188 | S PGCTR=P GCTR+1 | |
189 | S HPG="Pa ge :"_PGCT R | |
190 | W !,DUZ,? +(80-$L(HT L1)/2),HTL 1,?+(80-$L (HPG)),HPG | |
191 | W !,DATE, ?+(80-$L(H TL2)/2),HT L2 | |
192 | W !,TIME | |
193 | Q | |
194 | HD1 ; | |
195 | W !!,?10, "EIN",?26, "SPONSOR N AME",?57," SSN" | |
196 | W !,?10," ---------- --",?26,"- ---------" ,?57,"---- ----" | |
197 | Q | |
198 | ;-------- ---------- ---------- ---------- ---------- -; | |
199 | ; GENER ATE BI-YEA RLY VADIR FILE - STA RTS HERE ; SEE T T MTN02250 8 / GETSPO NS^ZZSBBUT L1 | |
200 | ;-------- ---------- ---------- ---------- ---------- -; | |
201 | STRTB ;STA RT GATHERI NG DATA | |
202 | D GTLIST | |
203 | D CRTFILE | |
204 | D MMSGB1 | |
205 | D END2 | |
206 | Q | |
207 | END2 ; | |
208 | K FILE,CT R,DFN,CHKF LG,HCGDT,H STAT,ELGFL G,BFN,SSN, X1 | |
209 | K NAME,LN AME,FNAME, DOB,HSTAT, CNTR,CHIO, CURYRBG,FL DR | |
210 | K FLNM,MA XCNT,YY,BE GDT,MMYY,Y Y,SLNAME,S FNAME,SVBF N | |
211 | Q | |
212 | GTLIST ;GE T LIST OF ELEG SPN | |
213 | N BEGDTRN G,ENDDTRNG | |
214 | D NOW^%DT C | |
215 | S %DT="", X="T" D ^% DT S (DT,E NDDTRNG)=Y ;ENDING DATE RANG E | |
216 | S X1=DT,X 2=-365 D C ^%DTC S BE GDTRNG=X ;BEGINING DATE RANG E | |
217 | N BEGELGD T,ENDELGDT ,ELGFLG | |
218 | N NAME,FN AME,LNAME, SSN,DOB | |
219 | N CTR | |
220 | K ^CHMZHO LD("CHMLRR 1",$J,"OUT ") | |
221 | S CTR=0 | |
222 | S DFN=0 F S DFN=$O (^AHCHVA(D FN)) Q:'DF N D | |
223 | .Q:'$D(^A HCHVA(DFN, 0)) | |
224 | .S CHKFLG =0 | |
225 | .I $P(^AH CHVA(DFN,0 ),"^",5)'= "E" D Q:C HKFLG=0 | |
226 | ..S J=0 F S J=$O(^ AHCHVA(DFN ,101,J)) Q :'J D | |
227 | ...Q:'$D( ^AHCHVA(DF N,101,J,0) ) | |
228 | ...S HSTA T=$P(^AHCH VA(DFN,101 ,J,0),"^", 5) Q:HSTAT ="" | |
229 | ...S HCGD T=$P(^AHCH VA(DFN,101 ,J,0),"^", 11) | |
230 | ...I HSTA T="E" I BE GDTRNG<HCG DT&(HCGDT< ENDDTRNG) S CHKFLG=1 | |
231 | .S ELGFLG =1 | |
232 | .S SVBFN= "" | |
233 | .S BFN=0 F S BFN=$ O(^AHCHVA( DFN,100,BF N)) Q:'BFN D | |
234 | ..I '$D(^ AHCHVA(DFN ,100,BFN,1 09)) S ELG FLG=1 Q | |
235 | ..S BEGEL GDT=0 S BE GELGDT=$O( ^AHCHVA(DF N,100,BFN, 109,BEGELG DT)) Q:'BE GELGDT ; BEG ELIG D ATE | |
236 | ..S ENDEL GDT=0 S EN DELGDT=$O( ^AHCHVA(DF N,100,BFN, 109,BEGELG DT,ENDELGD T)) Q:'END ELGDT ;E ND ELIG DA TE | |
237 | ..I ENDEL GDT>BEGDTR NG S SVBFN =BFN S ELG FLG=0 | |
238 | .Q:ELGFLG =1 | |
239 | .S (NAME, FNAME,LNAM E,SSN,DOB) ="" | |
240 | .S NAME=$ P(^AHCHVA( DFN,0),"^" ,1) | |
241 | .S LNAME= $P(NAME,", ",1) | |
242 | .S FNAME= $P(NAME,", ",2) | |
243 | .S DOB=$P (^AHCHVA(D FN,0),"^", 3) Q:DOB'? 7N Q:$E(D OB,4,5)="0 0" Q:$E(D OB,6,7)="0 0" | |
244 | .S DOB=$$ FMTE^XLFDT (DOB,"5Z") ;DATE F ORMAT MM/D D/YYYY | |
245 | .S SSN=$P (^AHCHVA(D FN,0),"^", 9) Q:SSN=" "!($L(SSN) '=9) | |
246 | .S ^CHMZH OLD("CHMLR R1",$J,"OU T",DFN)=FN AME_"|"_LN AME_"|"_SS N_"|"_DOB | |
247 | Q | |
248 | CRTFILE ;C REATE FILE FOR FS3BI G/SSD | |
249 | N CTR | |
250 | X ^%ZOSF( "UCI") S U CI=$P(Y,", ",1) | |
251 | S FLDR="/ FS3BIG/SSD /VADIR_Dat a_Files" | |
252 | S POP=0,C NTR=0 | |
253 | K:$D(CTR) CTR | |
254 | S FILE="V ADIR_SRC_D ATA.TXT" | |
255 | I $$ENVIR ^CHTFLIB'= "LIVE" D | |
256 | .S FILE=" VADIR_SRC_ DATA_"_$$E NVIR^CHTFL IB_".TXT" | |
257 | S CHIO="H AC_HFS$:[D SMMANAG.CH AMPVA]"_FI LE | |
258 | S POP=$$O PENFIWR^CH TFLIB9(.CH IO,"CHIO") | |
259 | Q:'POP | |
260 | X "D $SYS TEM.Proces s.SetZEOF( 1)" | |
261 | U CHIO | |
262 | S CTR=0 F S CTR=$O (^CHMZHOLD ("CHMLRR1" ,$J,"OUT", CTR)) Q:'C TR W !,^C HMZHOLD("C HMLRR1",$J ,"OUT",CTR ) | |
263 | D CLOSEF^ CHTFLIB9(C HIO,"CHIO" ) | |
264 | W !,"FILE "_CHIO_" HAS BEEN C LOSED" | |
265 | D FTPFILE ^CHTFLIB9( CHIO," DNS fs3. DNS ",FLDR,"PU T") | |
266 | H 5 | |
267 | Q | |
268 | MMSGB1 ;GE NERATE VAD IR OUTGOIN G FILE MM MESSAGE | |
269 | S CNT=1,^ TMP($J,"CH MLRR2",CNT )="",CNT=C NT+1 | |
270 | S ^TMP($J ,"CHMLRR2" ,CNT)="RET IRED RESER VIST VADIR /CBOPC FIL E EXCHANGE .",CNT=CNT +1 | |
271 | S ^TMP($J ,"CHMLRR2" ,CNT)="",C NT=CNT+1 | |
272 | S ^TMP($J ,"CHMLRR2" ,CNT)="THI S FILE IS SCHEDULE T O BE TRANS FERRED TO VADIR.",CN T=CNT+1 | |
273 | S ^TMP($J ,"CHMLRR2" ,CNT)="",C NT=CNT+1 | |
274 | S ^TMP($J ,"CHMLRR2" ,CNT)="PLE ASE REVIEW FILE:",CN T=CNT+1 | |
275 | S ^TMP($J ,"CHMLRR2" ,CNT)="",C NT=CNT+1 | |
276 | S ^TMP($J ,"CHMLRR2" ,CNT)=" /FS3BIG/SS D/VADIR_Da ta_Files/" _FILE,CNT= CNT+1 | |
277 | S ^TMP($J ,"CHMLRR2" ,CNT)="",C NT=CNT+1 | |
278 | S XMTEXT= "^TMP("_$J _",""CHMLR R2""," | |
279 | S XMDUZ=. 5 | |
280 | S XMY(DUZ )="" | |
281 | S XMY(" PII ")="" ;PST MAILB OX GROUP | |
282 | S XMY("G. VADIR AUST IN")="" ;VADIR GRO UP IN AUST IN | |
283 | S XMSUB=" VADIR RR V ADIR/CBOPC FILE EXCH ANGE" D ^X MD | |
284 | Q | |
285 | GETSPONS ; | |
286 | ;set MMYY . | |
287 | N MAXCNT, YY,BEGDT | |
288 | S MAXCNT= 500 | |
289 | D NOW^%DT C | |
290 | S MMYY=$E (X,4,5)_$E (X,2,3),YY =$E(X,1,3) | |
291 | S CURYRBG =YY_"0000" | |
292 | S CURYRBG =+CURYRBG | |
293 | S U="^",C NT=0 | |
294 | S FILENM= "SPONFILE_ "_MMYY_".D AT" | |
295 | S IOF="#, *27,*91,*5 0,*74,*27, *91,*72" | |
296 | X ^%ZOSF( "UCI") S U CI=$P(Y,", ",1) | |
297 | S FILE="H AC_HFS$:[S RC.TEMP_FI LES]"_FILE NM | |
298 | I UCI'="L IVE" S FIL E="HAC_HFS $:[DSMMANA G.CHAMPVA] "_$P(FILEN M,".")_UCI _"."_$P(FI LENM,".",2 ) | |
299 | I '$$OPEN FIWR^CHTFL IB9(.FILE, "FILE") Q | |
300 | ; | |
301 | S DFN=0 F S DFN=$O (^AHCHVA(D FN)) Q:('D FN) D | |
302 | .Q:'$D(^A HCHVA(DFN, 0)) ;Qui t if no 0 node | |
303 | .Q:($P(^A HCHVA(DFN, 0),U,5)'=" E") ;Qui t for non eligible s ponsors | |
304 | .I $D(^AH CHVA(X,15) ),$P(^AHCH VA(X,15),U ) Q ;Qui t for Spin a Bifida s ponsors | |
305 | .S (SNAME ,SLNAME,SF NAME,SSSN, SDOB,ERR)= "" | |
306 | .S RES=$$ GETVALS(.S NAME,.SSSN ,.SDOB) | |
307 | .Q:'RES | |
308 | .S SLNAME =$P(SNAME, ",") | |
309 | .S SFNAME =$P(SNAME, ",",2) | |
310 | .U FILE W SFNAME_"| "_SLNAME_" |"_SSSN_"| "_SDOB | |
311 | .U FILE W ! | |
312 | .S CNT=CN T+1 | |
313 | .Q | |
314 | D CLOSEF^ CHTFLIB9(F ILE,"FILE" ) | |
315 | D FTPFILE ^CHTFLIB9( FILE," DNS fs3. DNS ","FS3BIG" ,"PUT") | |
316 | W !,"Tota l Records Found : ", CNT | |
317 | Q | |
318 | ; | |
319 | GETVALS(SN AME,SSSN,S DOB) ; | |
320 | N RESULT | |
321 | S RESULT= 0 | |
322 | S RESULT= $$SPONELIG () | |
323 | ; | |
324 | I RESULT S RESULT=0 D | |
325 | .S SNAME= $P(^AHCHVA (DFN,0),U) Q:SNAME=" " | |
326 | .; | |
327 | .S SSSN=$ P(^AHCHVA( DFN,0),U,9 ) | |
328 | .S SSSN=$ $LTRIM^CHT FLIB(SSSN) | |
329 | .S SSSN=$ $TRIM^CHTF LIB(SSSN) | |
330 | .I SSSN'? 9N S ^CHMZ HOLD("ZSPO NFILE","EX CEPTION",S NAME,"SSN" )="SSN = " _SSSN S ER R=1 | |
331 | .Q:ERR | |
332 | .; | |
333 | .S SDOB=$ P(^AHCHVA( DFN,0),U,3 ) | |
334 | .I SDOB'? 7N S ^CHMZ HOLD("ZSPO NFILE","EX CEPTION",S NAME,"DOB" )="DOB = " _SDOB S ER R=1 | |
335 | .I SDOB=" " S ^CHMZH OLD("ZSPON FILE","EXC EPTION",SN AME,"DOB") ="DOB = "_ SDOB S ERR =1 | |
336 | .Q:ERR | |
337 | .S SDOB=$ $FMTE^XLFD T(SDOB,"5D ") ;m/d/ yyyy forma t | |
338 | .S SDOB=$ $CONVDT5^C HCMSFFI(SD OB) ;mm/d d/yyyy for mat | |
339 | .; | |
340 | .S RESULT =1 | |
341 | .Q | |
342 | Q RESULT | |
343 | ; | |
344 | SPONELIG() ; | |
345 | ; | |
346 | N RESULT, BFN,ELIG,B EBDATE,BEE DATE | |
347 | S (RESULT ,BFN)=0 | |
348 | S (ELIG,B EBDATE,BEE DATE)="" | |
349 | ; | |
350 | F S BFN= $O(^AHCHVA (DFN,100,B FN)) Q:('B FN)!RESULT D | |
351 | .Q:$P(^AH CHVA(DFN,1 00,BFN,0), U,5)'="EA" | |
352 | .I ($P(^A HCHVA(DFN, 100,BFN,0) ,U,11)<CUR YRBG) S RE SULT=1 Q | |
353 | .Q | |
354 | ; | |
355 | Q RESULT | |
356 | QUEB ; | |
357 | I '$G(DUZ ) S DUZ=1 | |
358 | S MMYY="I NITIAL" | |
359 | S CHFIO=" ",ZTDTH=$H | |
360 | S ZTRTN=" STRTB^CHML RR1",ZTDES C="VADIR/C BOPC file exchange" | |
361 | S ZTIO="" ,ZTSAVE("C HFIO")="", ZTSAVE("MM YY")="" | |
362 | D ^%ZTLOA D | |
363 | Q | |
364 |
Araxis Merge (but not the data content of this report) is Copyright © 1993-2016 Araxis Ltd (www.araxis.com). All rights reserved.