Produced by Araxis Merge on 11/9/2018 12:33:54 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 | CHMEDRQT.m | Mon Nov 5 16:43:29 2018 UTC |
2 | CPEE_Build9_Sprint27.zip\HAC_CPE_CH | CHMEDRQT.m | Mon Nov 5 17:44:06 2018 UTC |
Description | Between Files 1 and 2 |
|
---|---|---|
Text Blocks | Lines | |
Unchanged | 5 | 774 |
Changed | 4 | 8 |
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 | CHMEDRQT ; HAC/AEB;QU ARTERLY UP DATE DEERS WITH CHAM PVA BENE'S ;11/01/99 10:30 AM | |
2 | ;;;1.0;CH AMPVA SYST EM;;JULY 4 , 1990;V1 | |
3 | ;PC DUO 5 8191 JEH 8 /3/10 - UP DATE ROUTI NE TO MATC H WEEKLY | |
4 | ;DPT 7/11 /11 - CORR ECT SSNTYP TO SSSNTY P | |
5 | ;DPT 9/7/ 11 - MODIF IED EDIT O F BDOB FOR BENE | |
6 | ;DPT 9/13 /11- CORRE CT FIELD N AME | |
7 | ;DPT 10/1 8/11 - ADD EDIT TO E XCLUDE SB BENES,SET BREL TO "Z " IF NOT P RESENT | |
8 | ;DPT 1/5/ 12- OMIT B ENE WHO AR E CARE GIV ERS | |
9 | ;DEV01393 6 DPT 2/9/ 12 - OMIT BENE WHO A RE INELIBI BLE AND TR ICARE ELIG IBLE | |
10 | ;DPT 5/4/ 12 - OMIT BENE WITH REL "SF" , CHNG NOTIF Y TO MATCH WEEKLY | |
11 | ;DPT 10/0 9/12 - add notify to include P ST group. | |
12 | ;DPT 10/2 9/12 MTN01 6594 - EMA IL CHANGE | |
13 | ;DPT 3/5/ 13 MTN0174 59 - omit bene witho ut eligibi lity dates (no 105 no de) | |
14 | ;MTN02307 3 DPT 4/8/ 15 - CHANG E POC AT D EERS | |
15 | ;ENC02077 DPT INCLU DE PSUEDO SSN INDICA TOR WEEKLY ,QUARTERLY FILES TO DEERS | |
16 | ;MTN02610 4 ADD CONT ACT FOR DE ERS | |
17 | ;;TEST DP T 9/3/15 S ET RELATIO NSHIP TO " G" IS UNMA RRIED WIDO W CR NUMBE R COMING J AN2016 | |
18 | ||
19 | START ; | |
20 | W !,"This will send the Quart erly DEERS update fi le",! | |
21 | W !,"Do y ou wish to continue ? " D CSBR S^CHSC2 | |
22 | G END:$D( DFOUT) G E ND:$D(DUOU T) | |
23 | I $D(DQOU T) W !,"En ter 'Y' to send file to DEERS 'N' to exi t" G START | |
24 | G:Y="" EN D S ANS=$E (Y) S ANS= $$UP^XLFST R(ANS) | |
25 | I ANS="Y" D QUEA^CH MEDRQT | |
26 | Q | |
27 | CFILE ;CRE ATE FILE | |
28 | S U="^",F ILEIO="HAC _HFS$:[DSM MANAG]DEER S_SEND.DAT " | |
29 | ;O FILEIO C FILEIO: "D" O FILE IO ;REMOV ES OLD FIL E AND CREA TES NEW | |
30 | O FILEIO C FILEIO:" D" O FILEI O:"NWU" ; REMOVES OL D FILE AND CREATES N EW ; JEH 8/11/05 | |
31 | K ^CHMZHO LD("EA") ;DELETES L AST RUN LI ST | |
32 | I '$D(DT) D NOW^%DT C S DT=X | |
33 | I DT="" D NOW^%DTC S DT=X | |
34 | S DFN=0,S FLG=0,CT=1 | |
35 | C1 S DFN=$ O(^AHCHVA( "EA",DFN)) G:'DFN CE ND | |
36 | G:'$D(^AH CHVA(DFN,0 )) C1 | |
37 | G:$D(^AH CHVA(DFN,1 5)) C1 ;DP T 10/18/11 | |
38 | ||
39 | S BFN=0 | |
40 | C2 S BFN=$ O(^AHCHVA( "EA",DFN,B FN)) G:'BF N C1 | |
41 | G:'$D(^AH CHVA(DFN,1 00,BFN,0)) C2 | |
42 | I $P(^AHC HVA(DFN,10 0,BFN,0)," ^",4)="CG" K ^AHCHVA ("EA",DFN, BFN) G C2 ;DPT 1/5/ 12 | |
43 | I $P(^AHC HVA(DFN,10 0,BFN,0)," ^",4)="SF" K ^AHCHVA ("EA",DFN, BFN) G C2 ;DPT 5/4/ 12 | |
44 | I $P(^AHC HVA(DFN,10 0,BFN,0)," ^",5)="D" I $P(^AHCH VA(DFN,100 ,BFN,0),"^ ",12)="CHE " K ^AHCH VA("EA",DF N,BFN) G C 2 ;DEV013 936 DPT 2/ 9/12 | |
45 | D SPN ;C REATE SPON DATA | |
46 | D BENE ;C RETE BENE DATA | |
47 | S SFLG=1 | |
48 | S ^CHMZHO LD("EA",DF N,BFN)="" ;SETS UP LIST FOR R ESEND | |
49 | S CT=CT+1 | |
50 | G C2 | |
51 | CEND C FIL EIO | |
52 | D ZWCLOSE ^CHMSNUTL( FILEIO,263 ,512) ; JEH 8/11/0 5 | |
53 | I SFLG=1 D SEND | |
54 | K FILEIO, DFN,BFN,SR EC,BREC | |
55 | Q | |
56 | SEND ;SEND FILE | |
57 | I '$D(DT) D NOW^%DT C S DT=X | |
58 | K CHFTPTI M,CHFTPWT | |
59 | ; | |
60 | S CHFILE= "DROHAC.DA T " | |
61 | S CHFILE= $P(FILEIO, ":",2)_" " | |
62 | ;S CHFTPM SG=0 | |
63 | ;S X=$ZF( -1,"SUBMIT HAC_HFS$: [DSMMANAG] NEW_DEERS_ MU_FTP_OUT .COM","/NA ME=DEERS_M U_FTP_OUT_ JOB/NOPRIN TER/USER=H ACCACHEMGR ",CHFILE,D T) ; SUBMI T FTP JOB IN LIVE | |
64 | S X=$ZF(- 1,"SUBMIT HAC_HFS$:[ DSMMANAG]N EW_DEERS_M U_FTP_OUT. COM/NAME=D EERS_MU_FT P_OUT_JOB/ NOPRINTER/ USER=HACCA CHEMGR/PAR AM=("_CHFI LE_","_DT_ ")") ;SUB MIT FTP JO B IN LIVE ; JEH 8/ 11/05 | |
65 | D NOTIFY ;DPT 5/4/1 2 | |
66 | ; | |
67 | ;FFTPCK S RRD="HAC_ HFS$:[DSMM ANAG]DEERS _MU_FTP_OU T_JOB.LOG" ;LIVE | |
68 | ; C RRD | |
69 | ; K CHFTP TIM,CHFTPW T S ZE="", QFLAG=0,CH FTPWT=$P(^ CHMDIC(741 002.17,1,2 ),U,10) | |
70 | ; F CHFTP TIM=1:1:CH FTPWT H 60 O RRD:"R ":10 D Q :(QFLAG=1) | |
71 | ; .I '$T C RRD Q | |
72 | ; .F U R RD R RRDLI NE D Q:( QFLAG=1)!( $ZE["ENDOF FILE") | |
73 | ; ..I (RR DLINE["250 Transfer completed" ) S CHFTPM SG=1,QFLAG =1 Q | |
74 | ; ..I (RR DLINE["Cha rged CPU t ime:") S Q FLAG=1 Q | |
75 | ; ; | |
76 | ;FTPERR C RRD | |
77 | ;S CCHNB= 2 | |
78 | ;S ZML(CC HNB)="" | |
79 | ;S ZML(CC HNB)="FILE :HAC_HFS$: [DSMMANAG] "_"DEERS_S END_"_DT_" .DAT" | |
80 | ;S CCHNB= CCHNB+1 | |
81 | ;S ZML(CC HNB)="" | |
82 | ;S CCHNB= CCHNB+1 | |
83 | ;I (CHFTP MSG=0) D | |
84 | ;.S ZML(C CHNB)="FTP UNSUCCESS FUL..Quart erly..OUT. .FTP DEERS _SEND_"_DT _".DAT fil e" | |
85 | ;.S CCHNB =CCHNB+1 | |
86 | ;.S ZML(C CHNB)="Num ber of rec ords sent "_CT_"." | |
87 | ;.Q | |
88 | ;I (CHFTP MSG=1) D | |
89 | ;.S ZML(C CHNB)="FTP successfu l..Quarter ly..OUT..F TP DEERS_S END_"_DT_" .DAT file" | |
90 | ;.Q | |
91 | ;S XMDUZ= .5 | |
92 | ;S XMY(98 87)="" | |
93 | ;S XMY(" PII ")="" | |
94 | ;S XMTEXT ="ZML(" | |
95 | ;I (CHFTP MSG=1) D | |
96 | ;.S XMSUB ="SUCC M O OUT DEER S File"_DT | |
97 | ;I (CHFTP MSG=0) D | |
98 | ;.S XMSUB ="UNSUC MO OUT DEERS File"_DT | |
99 | ;D ^XMD | |
100 | ;D:CHFTPM SG=1 NOTIF Y ;SEN D EMAILS V IA MS-EXCH G | |
101 | ; | |
102 | END K CHFT PMSG,RRD,R RDLINE,CHF ILE,FMDATE ,CCHNB,QFL AG | |
103 | Q | |
104 | NOTIFY ;SE ND MS-EXCH ANGE EMAIL S FROM VIS TA | |
105 | ; | |
106 | D UCI^%ZO SV I $P(Y, ",",1)'="H AC" Q | |
107 | S XMDUZ=D UZ | |
108 | S XMY(232 49)="" | |
109 | S XMY(" PII ")="" ;DPT 10/09 /12 | |
110 | S XMY("'v eronica.t. parker4.ct r@mail.mil '")="" ; DPT 4/8/15 MTN023073 | |
111 | S XMY("'r ichard.m.b urton.ctr@ mail.mil'" )="" ;DPT 4/27/16 MT N026104 | |
112 | S XMY(" PII ")="" | |
113 | S TEXT(1) ="DMDC," ;DPT 4/8/ 15 MTN0230 73 | |
114 | S TEXT(2) =" " | |
115 | S TEXT(3) ="The Quar terly file is availa ble on you r site for processin g." | |
116 | S TEXT(4) ="Please l et us know via this message wh en you are finished. " | |
117 | S TEXT(5) ="Number o f records sent "_CT_ "." | |
118 | S TEXT(6) ="Thank Yo u" | |
119 | S XMTEXT= "TEXT(" | |
120 | S XMSUB=" Quarterly File" ;DP T 5/4/12 | |
121 | D ^XMD | |
122 | K XMY,XMD UZ,TEXT,XM TEXT,XMSUB | |
123 | I '$D(DT) D NOW^%DT C S DT=X | |
124 | S XMY(" PII ")="" | |
125 | S XMDUZ=D UZ,XMSUB=" DEERS Outg oing file for "_$$FM TE^XLFDT(D T,"5D") | |
126 | S TEXT(1) ="The DEER S FTP was successful ly complet ed and sen t on " | |
127 | S TEXT(1) =TEXT(1)_$ $DOW^XLFDT (DT)_", "_ $$FMTE^XLF DT(DT,"8D" )_"." | |
128 | ||
129 | ;S RDT=$$ FMADD^XLFD T(DT,2,0,0 ,0) | |
130 | ;S TEXT(2 )=" " | |
131 | ;S TEXT(3 )="The ret urn should be no lat er then "_ $$DOW^XLFD T(RDT)_", "_$$FMTE^X LFDT(RDT," 8D")_"." | |
132 | D ^XMD | |
133 | K XMY,XMD UZ,TEXT,XM TEXT,XMSUB | |
134 | Q | |
135 | SPN ;GET A LL SPONSOR DATA | |
136 | ;SSSN - S PONSORS SS N | |
137 | ;SSSNTYP - S:ACTUAL SSN,P:PSU DO | |
138 | ;SLNAME - SPONSOR L AST NAME | |
139 | ;SFNAME - SPONSOR F IRST NAME | |
140 | ;SMNAME - SPONSOR M IDDLE NAME | |
141 | ;SDOB - S PONSOR DAT OF BIRTH | |
142 | ;PTDATE - SPONSORS P&T DATE | |
143 | ;SDOD - S PONSOR DAT E OF DEATH | |
144 | ;SPSVC - SPONSORS B RANCH OF S ERVICE (Z FOR UNKNOW N) | |
145 | ;SPSTAT - SPONSORS STATUS( D: 100% FOR D AV) | |
146 | ;SPNLBDT - BEGIN SP ONSOR'S ST ATUS DATE | |
147 | ;SPNLEDT - END SPON SOR'S STAT US DATE | |
148 | S SPEC(". ")="" ; A DD CHARACT ERS HERE I F THEY ARE TO BE REM OVED FROM THE NAME | |
149 | Q:'$G(DFN ) ;PC DU O 58191 JE H 8/3/10 | |
150 | Q:'$D(^AH CHVA(DFN,0 )) ;PC D UO 58191 J EH 8/3/10 | |
151 | S (SSSN,S SSNTYP,SSN TYP1,SLNAM E,SFNAME,S MNAME,SDOB ,PTDATE,SD OD,SPSVC,S PSTAT,SPNL BDT,SPNLED T)="" ;TL H 2/4/09 F IX UNDEFIN ED ERROR ;PC DUO 58191 JEH 8/3/10 | |
152 | S SREC=^A HCHVA(DFN, 0) | |
153 | S SSSN=$P (SREC,U,9) ,NAME=$P(S REC,U,1) | |
154 | S SSNTYP1 =$P(SREC,U ,10) S:SSN TYP1="" SS SNTYP="S" | |
155 | S:SSNTYP1 '="P" SSSN TYP="S" S: SSNTYP1="P " SSSNTYP= "S" ;ENC02 777 DPT CH ANGE SSNTY P TO SSSNT YP | |
156 | S SFNAME1 =$P(NAME," ,",2),CHBD AT="000000 00" | |
157 | S SFNAME= $P(SFNAME1 ," ",1) S SFNAME=$$ REPLACE^XL FSTR(SFNAM E,.SPEC) ; DPT 9/13/1 1 | |
158 | S SLNAME= $E($P(NAME ,",",1),1, 26) S SLNA ME=$$REPLA CE^XLFSTR( SLNAME,.SP EC) | |
159 | S SMNAME= $P(SFNAME1 ," ",2) S SMNAME=$$R EPLACE^XLF STR(SMNAME ,.SPEC) | |
160 | S SDOB=$P (SREC,U,3) I SDOB'=" " S X=SDOB D ^%DT S: Y=-1 SDOB= CHBDAT | |
161 | I SDOB'=" " I SDOB'= CHBDAT S S DOB=$$FMTE ^XLFDT(SDO B,"7D") | |
162 | I SDOB="" S SDOB="0 0000000" | |
163 | D | |
164 | .S PTDATE =9999999 | |
165 | .S PTDATE =$O(^AHCHV A(DFN,102, PTDATE),-1 ) | |
166 | .I PTDATE '="" S X=P TDATE D ^% DT S:Y=-1 PTDATE=CHB DAT | |
167 | I PTDATE' ="" I PTDA TE'=CHBDAT S PTDATE= $$FMTE^XLF DT(PTDATE, "7D") | |
168 | I PTDATE= "" S PTDAT E=CHBDAT | |
169 | S SDOD=$P (SREC,U,4) I SDOD'=" " S X=SDOD D ^%DT S: Y=-1 SDOD= CHBDAT | |
170 | I SDOD'=" " I SDOD'= CHBDAT S S DOD=$$FMTE ^XLFDT(SDO D,"7D") | |
171 | I SDOD="" S SDOD=CH BDAT | |
172 | S SPSVC=" Z" ;SPEC ITEM #9 | |
173 | S SPSTAT= "Z" ;SPEC ITEM #10 | |
174 | S SPNLBDT =CHBDAT | |
175 | S SPNLEDT =CHBDAT | |
176 | ;CHECK FO RMATING TO ENSURE IT S CORRECT | |
177 | S SSSN=$$ FXLGTH^CHT FLIB(SSSN, "L",9) | |
178 | S SFNAME= $$FXLGTH^C HTFLIB(SFN AME,"L",20 ) S SFNAME =$$REPLACE ^XLFSTR(SF NAME,.SPEC ) | |
179 | S SLNAME= $$FXLGTH^C HTFLIB(SLN AME,"L",26 ) S SLNAME =$$REPLACE ^XLFSTR(SL NAME,.SPEC ) | |
180 | S SMNAME= $$FXLGTH^C HTFLIB(SMN AME,"L",20 ) S SMNAME =$$REPLACE ^XLFSTR(SM NAME,.SPEC ) | |
181 | I PTDATE' =CHBDAT D | |
182 | .I $L($P( PTDATE,"/" ,2))'=2 S $P(PTDATE, "/",2)="0" _$P(PTDATE ,"/",2) | |
183 | .I $L($P( PTDATE,"/" ,3))'=2 S $P(PTDATE, "/",3)="0" _$P(PTDATE ,"/",3) | |
184 | .S PTDATE =$$STRIP^X LFSTR(PTDA TE,"/") | |
185 | .Q | |
186 | I SDOB'=C HBDAT D | |
187 | .I $L($P( SDOB,"/",2 ))'=2 S $P (SDOB,"/", 2)="0"_$P( SDOB,"/",2 ) | |
188 | .I $L($P( SDOB,"/",3 ))'=2 S $P (SDOB,"/", 3)="0"_$P( SDOB,"/",3 ) | |
189 | .S SDOB=$ $STRIP^XLF STR(SDOB," /") | |
190 | .Q | |
191 | I SDOD'=C HBDAT D | |
192 | .I $L($P( SDOD,"/",2 ))'=2 S $P (SDOD,"/", 2)="0"_$P( SDOD,"/",2 ) | |
193 | .I $L($P( SDOD,"/",3 ))'=2 S $P (SDOD,"/", 3)="0"_$P( SDOD,"/",3 ) | |
194 | .S SDOD=$ $STRIP^XLF STR(SDOD," /") | |
195 | .Q | |
196 | I SPNLBDT '=CHBDAT D | |
197 | .I $L($P( SPNLBDT,"/ ",2))'=2 S $P(SPNLBD T,"/",2)=" 0"_$P(SPNL BDT,"/",2) | |
198 | .I $L($P( SPNLBDT,"/ ",3))'=2 S $P(SPNLBD T,"/",3)=" 0"_$P(SPNL BDT,"/",3) | |
199 | .S SPNLBD T=$$STRIP^ XLFSTR(SPN LBDT,"/") | |
200 | .Q | |
201 | I SPNLEDT '=CHBDAT D | |
202 | .I $L($P( SPNLEDT,"/ ",2))'=2 S $P(SPNLED T,"/",2)=" 0"_$P(SPNL EDT,"/",2) | |
203 | .I $L($P( SPNLEDT,"/ ",3))'=2 S $P(SPNLED T,"/",3)=" 0"_$P(SPNL EDT,"/",3) | |
204 | .S SPNLED T=$$STRIP^ XLFSTR(SPN LEDT,"/") | |
205 | .Q | |
206 | ;U FILEIO W SSSN,SS SNTYP,SLNA ME,SFNAME, SMNAME,SDO B,PTDATE,S DOD,SPSVC, SPSTAT,SPN LBDT,SPNLE DT ; JEH 8/11/05 | |
207 | S REC=SSS N_SSSNTYP_ SLNAME_SFN AME_SMNAME _SDOB_PTDA TE_SDOD_SP SVC_SPSTAT _SPNLBDT_S PNLEDT ; JEH 8/11/ 05 | |
208 | Q | |
209 | BENE ;GET ALL BENE D ATA | |
210 | ;BLNAME - BENE LAST NAME 13 | |
211 | ;BFNAME - BENE FIRS T NAME 14 | |
212 | ;BMNAME - BENE MIDD ILE NAME 1 5 | |
213 | ;BDOB - B ENE DATE O F BIRTH 16 | |
214 | ;BDOD - B ENE DATE O F DEATH 17 | |
215 | ;BSEX - B ENE GENDER 18 | |
216 | ;BREL - B ENE RELATI ONSHIP WIT H SPONSOR 19 | |
217 | ;BPNABDT - DATE BEN E BECAME A SSOCIATED WITH SPONS OR 20 | |
218 | ;BPNAEDT - DATE BEN E BECAME U NASSOCIATE D WITH SPO NSOR 21 | |
219 | ;BPNATRSN - REASON CODE FOR B ENE TO BEC OME UNASSO CIATED WIT H SPONSOR | |
220 | ;BPNECTYP - CODE TO REPRESENT ASSOCIATI ON TERMINA TION 23 | |
221 | ;BPNECBDT - BEGIN D ATE THAT A FFECTED BE NE ELIG PE RIOD 24 | |
222 | ;BPNECEDT - END DAT E THAT AFF ECTED BENE ELIG PERI OD 25 | |
223 | ;BBEGDT - CHAMPVA B EG ELIG DA TE 26 | |
224 | ;BENDDT - CHAMPVA E ND ELIG DA TE 27 | |
225 | ;BSSN - B ENE SSN 28 | |
226 | ;CHFILL - FILLER OF LENGTH 1 29 | |
227 | Q:'$G(DFN ) Q:'$G(B FN) ;PC DUO 58191 JEH 8/3/10 | |
228 | Q:'$D(^AH CHVA(DFN,1 00,BFN,0)) ;PC DUO 58191 JEH 8/3/10 | |
229 | Q:'$D(^AH CHVA(DFN,1 00,BFN,105 )) ;DPT 3/ 5/13 | |
230 | S (BLNAME ,BFNAME,BM NAME,BDOB, BDOD,BSEX, BREL,BPNAB DT,BPNAEDT ,BPNATRSN, BPNECTYP,B PNECBDT,BP NECEDT,BSS N,CHFILL)= "" ;TLH 2 /4/09 FIX UNDEFINED ERROR ;PC DUO 58 191 JEH 8/ 3/10 | |
231 | S (BBEGDT ,BENDDT)=" 00000000" ;PC DUO 58191 JEH 8/3/10 | |
232 | S BREC=^A HCHVA(DFN, 100,BFN,0) | |
233 | S NAME=$P (^AHCHVA(D FN,100,BFN ,0),U,1) | |
234 | S BSSN=$P (BREC,U,9) | |
235 | ; compa re sponsor ssn type and bene s sn type | |
236 | ;S BSTYPE 1=$P(BREC, U,36) D ;ENC020777 DPT | |
237 | ; .I (SS NTYP1=""&B STYPE1="") !(SSNTYP1= ""&BSTYPE= "A")!(SSNT YP1="A"&BS TYPE="A") S SSNTYP1= "S" ;ENC02 0777 DPT | |
238 | ; .I SSN TYP1="A"&B STYPE="P" S SSNTYP1= "U" ;ENC02 0777 DPT | |
239 | ; .I (SS NTYP1="P"& BSTYPE="A" )!(SSNTYP1 ="P"&BSTYP E="") S S SNTYP1="V" ;ENC02077 7 DPT | |
240 | ; .I SSN TYP1="P"&B STYPE="P" S SSNTYP1= "P" ;ENC02 0777 DPT | |
241 | S BDOB=$P (BREC,"^", 3) I BDOB' ="" S X=BD OB D ^%DT S:Y=-1 BDO B=CHBDAT ; DPT 9/7/11 | |
242 | I BDOB="" S BDOB=CH BDAT ;DP T 9/7/11 | |
243 | S:BDOB'=C HBDAT BDOB =$$FMTE^XL FDT(BDOB," 7D") ;DPT 9/7/11 | |
244 | S BDOD=$P (BREC,"^", 6) I BDOD' ="" S X=BD OD D ^%DT S:Y=-1 BDO D=CHBDAT | |
245 | I BDOD="" S BDOD=CH BDAT | |
246 | S:BDOD'=C HBDAT BDOD =$$FMTE^XL FDT(BDOD," 7D") | |
247 | S BSEX=$P (BREC,"^", 2) I BSEX' ="M" I BSE X'="F" S B SEX="Z" | |
248 | S BREL=$P (BREC,"^", 4) ;NEED TO REFINE TO DEERS C ODE SET | |
249 | I BREL="" S BREL="Z " ; DPT 10 /18/11 | |
250 | I BREL="X S" S BREL= "S" ;DEER S UNABLE T O ACCEPT E X SPOUSE S TATUS ; PC DUO 581 91 JEH 8/3 /10 | |
251 | I BREL="C " D | |
252 | .S:$P(BRE C,"^",26)= "S" BREL=" V" | |
253 | ;I BREL=" S" I $P(BR EC,"^",5)= "EA" I $P( BREC,"^",1 3)="WMT" S BREL="G" ;TEST DPT 9/3/15 ACT IVATE IN J AN 2016 | |
254 | ||
255 | S BFNAME1 =$P(NAME," ,",2) | |
256 | S BFNAME= $E($P(BFNA ME1," ",1) ,1,20),BFN AME=$$REPL ACE^XLFSTR (BFNAME,.S PEC) | |
257 | S BMNAME= $E($P(BFNA ME1," ",2) ,1,20),BMN AME=$$REPL ACE^XLFSTR (BMNAME,.S PEC) | |
258 | S BLNAME= $E($P(NAME ,",",1),1, 26),BLNAME =$$REPLACE ^XLFSTR(BL NAME,.SPEC ) | |
259 | D | |
260 | .S IDT=0 | |
261 | .S IDT=$O (^AHCHVA(D FN,100,BFN ,105,IDT)) I 'IDT S (IDT,FDT)= CHBDAT Q | |
262 | .S FDT=0 | |
263 | .S FDT=$O (^AHCHVA(D FN,100,BFN ,105,IDT,F DT)) I 'FD T S FDT=CH BDAT Q | |
264 | .Q | |
265 | I IDT'=CH BDAT S BBE GDT=$$FMTE ^XLFDT(IDT ,"7D") | |
266 | I FDT'=CH BDAT S BEN DDT=$$FMTE ^XLFDT(FDT ,"7D") | |
267 | S BPNABDT =CHBDAT D | |
268 | .I BREL=" C" S BPNAB DT=BDOB D | |
269 | ..S:$P(BR EC,"^",26) ="A" BPNAB DT=$P(BREC ,"^",27) ;ADOPTION DT FOR ADO PTED CHILD | |
270 | ..S:$P(BR EC,"^",26) ="S" BPNAB DT=$P(^AHC HVA(DFN,10 0,BFN,3)," ^",3) ;DT OF MARRIA GE FOR STE P CHILD | |
271 | ..S:$P(BR EC,"^",26) ="I" BPNAB DT=$P(BREC ,"^",10) ;QE DT FOR ILLIG. CH ILD | |
272 | .I BREL=" V" S BPNAB DT=$P(BREC ,"^",8) | |
273 | .I BREL=" S" S BPNAB DT="000000 00" Q | |
274 | .S X=BPNA BDT D ^%DT I Y=-1 S BPNABDT=CH BDAT Q | |
275 | .S BPNABD T=$$FMTE^X LFDT(BPNAB DT,"7D") | |
276 | .I $L($P( BPNABDT,"/ ",2))'=2 S $P(BPNABD T,"/",2)=" 0"_$P(BPNA BDT,"/",2) | |
277 | .I $L($P( BPNABDT,"/ ",3))'=2 S $P(BPNABD T,"/",3)=" 0"_$P(BPNA BDT,"/",3) | |
278 | .S BPNABD T=$$STRIP^ XLFSTR(BPN ABDT,"/") | |
279 | .Q | |
280 | S BPNAEDT =CHBDAT D | |
281 | .I BREL=" S" S BPNAE DT="000000 00" | |
282 | .I BREL=" C" S BPNAE DT="000000 00" D | |
283 | ..I $P(BR EC,"^",19) =1 I $P(BR EC,"^",31) '="" S BPN AEDT=$P(BR EC,"^",31) Q ;ALWAY S SET END DATE TO CH ILD MARRIA GE DT DPT 9/13/11 | |
284 | ..S:$P(BR EC,"^",26) ="S" BPNAE DT=$P(BREC ,"^",7) ; DATE OD MA RRIAGE TER M FOR STEP CHILD. | |
285 | ..I $P(BR EC,"^",26) ="A" I $P( BREC,"^",6 )'="" S BP NAEDT=$P(B REC,"^",6) ;ADOPTED CHILD END DATE = DT OF DEATH DPT 9/13/1 1 | |
286 | .S X=BPNA EDT D ^%DT I Y=-1 S BPNAEDT="0 0000000" Q | |
287 | .S BPNAED T=$$FMTE^X LFDT(BPNAE DT,"7D") | |
288 | .I $L($P( BPNAEDT,"/ ",2))'=2 S $P(BPNAED T,"/",2)=" 0"_$P(BPNA EDT,"/",2) | |
289 | .I $L($P( BPNAEDT,"/ ",3))'=2 S $P(BPNAED T,"/",3)=" 0"_$P(BPNA EDT,"/",3) | |
290 | .S BPNAED T=$$STRIP^ XLFSTR(BPN AEDT,"/") | |
291 | .Q | |
292 | S BPNATRS N="Z" | |
293 | ;I BPNAED T'=CHBDAT D | |
294 | ;.I BREL= "C" I $P(B REC,"^",31 )'="" S BP NATRSN="H" Q | |
295 | ;.I BREL= "V" I $P(B REC,"^",31 )'="" S BP NATRSN="H" Q | |
296 | ;.I BREL= "S" I $P(B REC,"^",16 )=1 S BPNA TRSN="T" Q | |
297 | S BPNECTY P=" " I $ P(BREC,"^" ,22)=1 S B PNECTYP="0 1" | |
298 | S BPNECED T="0000000 0" | |
299 | S BPNECBD T="0000000 0" D | |
300 | .Q:$P(BRE C,"^",22)' =1 ;ONLY SET FOR S CHOOL DATE S | |
301 | .S I=99,I =$O(^AHCHV A(DFN,100, BFN,104,I) ,-1) Q:'I Q:'$D(^AH CHVA(DFN,1 00,BFN,104 ,I,0)) | |
302 | .S BPNECB DT=$P(^AHC HVA(DFN,10 0,BFN,104, I,0),"^",1 ) | |
303 | .S BPNECE DT=$P(^AHC HVA(DFN,10 0,BFN,104, I,0),"^",2 ) | |
304 | .S X=BPNE CBDT D ^%D T I Y=-1 S (BPNECBDT ,BPNECEDT) =CHBDAT Q | |
305 | .S X=BPNE CEDT D ^%D T I Y=-1 S (BPNECBDT ,BPNECEDT) =CHBDAT Q | |
306 | .S BPNECB DT=$$FMTE^ XLFDT(BPNE CBDT,"7D") | |
307 | .S BPNECE DT=$$FMTE^ XLFDT(BPNE CEDT,"7D") | |
308 | .I $L($P( BPNECBDT," /",2))'=2 S $P(BPNEC BDT,"/",2) ="0"_$P(BP NECBDT,"/" ,2) | |
309 | .I $L($P( BPNECBDT," /",3))'=2 S $P(BPNEC BDT,"/",3) ="0"_$P(BP NECBDT,"/" ,3) | |
310 | .I $L($P( BPNECEDT," /",2))'=2 S $P(BPNEC EDT,"/",2) ="0"_$P(BP NECEDT,"/" ,2) | |
311 | .I $L($P( BPNECEDT," /",3))'=2 S $P(BPNEC EDT,"/",3) ="0"_$P(BP NECEDT,"/" ,3) | |
312 | .S BPNECB DT=$$STRIP ^XLFSTR(BP NECBDT,"/" ) | |
313 | .S BPNECE DT=$$STRIP ^XLFSTR(BP NECEDT,"/" ) | |
314 | .Q | |
315 | S BSSN=$$ FXLGTH^CHT FLIB(BSSN, "L",9) | |
316 | S BFNAME= $$FXLGTH^C HTFLIB(BFN AME,"L",20 ) | |
317 | S BLNAME= $$FXLGTH^C HTFLIB(BLN AME,"L",26 ) | |
318 | S BMNAME= $$FXLGTH^C HTFLIB(BMN AME,"L",20 ) | |
319 | I BDOB'=C HBDAT D ;D PT CHECK F OR ZEROS 9 /9/11 | |
320 | .I $L($P( BDOB,"/",2 ))'=2 S $P (BDOB,"/", 2)="0"_$P( BDOB,"/",2 ) | |
321 | .I $L($P( BDOB,"/",3 ))'=2 S $P (BDOB,"/", 3)="0"_$P( BDOB,"/",3 ) | |
322 | .S BDOB=$ $STRIP^XLF STR(BDOB," /") ;DPT 9/13/11 | |
323 | I BDOD'=C HBDAT D | |
324 | .I $L($P( BDOD,"/",2 ))'=2 S $P (BDOD,"/", 2)="0"_$P( BDOD,"/",2 ) | |
325 | .I $L($P( BDOD,"/",3 ))'=2 S $P (BDOD,"/", 3)="0"_$P( BDOD,"/",3 ) | |
326 | .S BDOD=$ $STRIP^XLF STR(BDOD," /") ;DPT 9 /9/11 | |
327 | .Q | |
328 | I IDT'=CH BDAT D | |
329 | .I $L($P( BBEGDT,"/" ,2))'=2 S $P(BBEGDT, "/",2)="0" _$P(BBEGDT ,"/",2) | |
330 | .I $L($P( BBEGDT,"/" ,3))'=2 S $P(BBEGDT, "/",3)="0" _$P(BBEGDT ,"/",3) | |
331 | .S BBEGDT =$$STRIP^X LFSTR(BBEG DT,"/") | |
332 | .Q | |
333 | I FDT'=CH BDAT D | |
334 | .I $L($P( BENDDT,"/" ,2))'=2 S $P(BENDDT, "/",2)="0" _$P(BENDDT ,"/",2) | |
335 | .I $L($P( BENDDT,"/" ,3))'=2 S $P(BENDDT, "/",3)="0" _$P(BENDDT ,"/",3) | |
336 | .S BENDDT =$$STRIP^X LFSTR(BEND DT,"/") | |
337 | .Q | |
338 | ;I BPNAED T'=CHBDAT D D PT 9/13/11 | |
339 | ;.I $L($P (BPNAEDT," /",2))'=2 S $P(BPNAE DT,"/",2)= "0"_$P(BPN AEDT,"/",2 ) | |
340 | ;.I $L($P (BPNAEDT," /",3))'=2 S $P(BPNAE DT,"/",3)= "0"_$P(BPN AEDT,"/",3 ) | |
341 | ;.S BPNAE DT=$$STRIP ^XLFSTR(BP NAEDT,"/") | |
342 | ;.Q | |
343 | ;;I BPNEC BDT'=CHBDA T I BPNECE DT["/" D | |
344 | ;.I $L($P (BPNECBDT, "/",2))'=2 S $P(BPNE CBDT,"/",2 )="0"_$P(B PNECBDT,"/ ",2) | |
345 | ;.I $L($P (BPNECBDT, "/",3))'=2 S $P(BPNE CBDT,"/",3 )="0"_$P(B PNECBDT,"/ ",3) | |
346 | ;.S BPNEC BDT=$$STRI P^XLFSTR(B PNECBDT,"/ ") | |
347 | ;.Q | |
348 | ;;I BPNEC EDT'=CHBDA T I BPNECE DT["/" D | |
349 | ;.I $L($P (BPNECEDT, "/",2))'=2 S $P(BPNE CEDT,"/",2 )="0"_$P(B PNECEDT,"/ ",2) | |
350 | ;.I $L($P (BPNECEDT, "/",3))'=2 S $P(BPNE CEDT,"/",3 )="0"_$P(B PNECEDT,"/ ",3) | |
351 | ;.S BPNEC EDT=$$STRI P^XLFSTR(B PNECEDT,"/ ") | |
352 | ;.Q | |
353 | S CHFILL= " " | |
354 | S CHFILL= $$FXLGTH^C HTFLIB(CHF ILL,"L",1) | |
355 | ;U FILEIO W BLNAME, BFNAME,BMN AME,BDOB,B DOD,BSEX,B REL,BPNABD T,BPNAEDT, BPNATRSN,B PNECTYP,BP NECBDT,BPN ECEDT,BBEG DT,BENDDT, BSSN,CHFIL L,! ;TLH 12/14/06 M ODIFIED TO MATCH WEE KLY DEERS PROCESS | |
356 | ; FOR ENC 020777 NE ED TO REPL ACE SECOND POSITION OF REC BEF ORE NEXT S TEP | |
357 | S REC=REC _BLNAME_BF NAME_BMNAM E_BDOB_BDO D_BSEX_BRE L_BPNABDT_ BPNAEDT_BP NATRSN_BPN ECTYP_BPNE CBDT_BPNEC EDT_BBEGDT _BENDDT_BS SN_CHFILL ;TLH 12/1 4/06 MODIF ED TO MATC H WEEKLY D EERS PROCE SS | |
358 | D ZWCHAR^ CHMSNUTL(F ILEIO,REC) | |
359 | Q | |
360 | QUEA ;QUE THIS ROUTI NE MANUALL Y. | |
361 | I '$D(DUZ ) S DUZ=1, DUZ(0)="@" | |
362 | D NOW^%DT C S DT=X | |
363 | S:'$D(DTI ME) DTIME= 300 | |
364 | S U="^" | |
365 | S CHFIO=" " | |
366 | S ZTRTN=" CFILE^CHME DRQT",ZTDE SC="SEND Q UARTERLY D ATA FILE T O DEERS" | |
367 | S ZTIO="" ,ZTSAVE("C HFIO")="" | |
368 | D ^%ZTLOA D | |
369 | Q | |
370 | RFILE ;RES END FILE | |
371 | S U="^",F ILEIO="HAC _HFS$:[DSM MANAG]DEER S_SEND.DAT " | |
372 | ;O FILEIO C FILEIO: "D" O FILE IO | |
373 | O FILEIO C FILEIO:" D" O FILEI O:"NWU" ; JEH 8/11 /05 | |
374 | I '$D(DT) D NOW^%DT C S DT=X | |
375 | I DT="" D NOW^%DTC S DT=X | |
376 | S DFN=0,S FLG=0,CT=1 | |
377 | R1 S DFN=$ O(^CHMZHOL D("EA",DFN )) G:'DFN REND | |
378 | G:'$D(^AH CHVA(DFN,0 )) R1 | |
379 | S BFN=0 | |
380 | R2 S BFN=$ O(^CHMZHOL D("EA",DFN ,BFN)) G:' BFN R1 | |
381 | G:'$D(^AH CHVA(DFN,1 00,BFN,0)) R2 | |
382 | D SPN ;C REATE BENE DATA | |
383 | D BENE ;C RETE BENE DATA | |
384 | S SFLG=1 | |
385 | S CT=CT+1 | |
386 | G R2 | |
387 | REND C FIL EIO | |
388 | D ZWCLOSE ^CHMSNUTL( FILEIO,263 ,512) ; JEH 8/11/0 5 | |
389 | I SFLG=1 D SEND | |
390 | K FILEIO, DFN,BFN,SR EC,BREC | |
391 | Q |
Araxis Merge (but not the data content of this report) is Copyright © 1993-2016 Araxis Ltd (www.araxis.com). All rights reserved.