Produced by Araxis Merge on 11/9/2018 12:33:55 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 | CHMEDRSD.m | Mon Nov 5 16:38:52 2018 UTC |
2 | CPEE_Build9_Sprint27.zip\HAC_CPE_CH | CHMEDRSD.m | Mon Nov 5 17:44:10 2018 UTC |
Description | Between Files 1 and 2 |
|
---|---|---|
Text Blocks | Lines | |
Unchanged | 2 | 672 |
Changed | 1 | 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 | CHMEDRSD ; HAC/AEB;UP DATE DEERS WITH CHAM PVA BENE'S ;11/01/99 10:30 AM | |
2 | ;V1 | |
3 | ;DPT 9/7/ 11 - INITI ALIZED BBE GDT & BEND DT, MODIFI ED EDIT OF BDOB FOR BENE | |
4 | ;DPT 9/13 /11- CORRE CT FIELD N AME | |
5 | ;DPT 10/1 8/11 - ADD EDIT TO E XCLUDE SB BENES,SET BREL TO "Z " IF NOT P RESENT | |
6 | ;DPT 1/5/ 12- OMIT B ENE WHO AR E CARE GIV ERS | |
7 | ;DEV01393 6 DPT 2/9/ 12 - OMIT BENE WHO A RE INELIBI BLE AND TR ICARE ELIG IBLE | |
8 | ;MTN01509 3 DPT 5/4/ 12 - OMIT BENE WITH REL "SF" | |
9 | ;MTN01659 4 DPT 10/2 9/12 - CHA NGE EMAIL ADDRESS FO R DEERS | |
10 | ;DPT 1/30 /13 - EXCL UDE ALL WI TH NO ELIG IBILITY DA TES NO 105 NODE | |
11 | ;MTN02307 3 DPT 4/8/ 15 - CHANG E POC AT D EERS | |
12 | ;MTN02610 4 ADD CONT ACT FOR DE ERS | |
13 | ; TEST DP T 9/3/15 SET RELATI ONSHIP TO "G" IF UNM ARRIED WID OW CR NUMB ER COMING activiate later | |
14 | ;ENC0207 7 DPT INCL UDE PSUEDO SSN INDIC ATOR WEEKL Y,QUARTERL Y FILES TO DEERS NOT YET APPRO VED | |
15 | ||
16 | D QUEA^CH MEDRSD | |
17 | Q | |
18 | CFILE ;CRE ATE FILE | |
19 | S U="^",F ILEIO="HAC _HFS$:[DSM MANAG]DEER S_SEND.DAT " | |
20 | ;O FILEIO C FILEIO: "D" O FILE IO:("NWU": 263) ;SKD , 7-15-05, REMOVES O LD FILE AN D CREATES NEW | |
21 | O FILEIO C FILEIO:" D" O FILEI O:"NWU" ; JEH | |
22 | K ^CHMZHO LD("AF","P R") ;DELE TES LAST R UN LIST | |
23 | I '$D(DT) D NOW^%DT C S DT=X | |
24 | I DT="" D NOW^%DTC S DT=X | |
25 | S DFN=0,S FLG=0,CT=1 | |
26 | C1 S DFN=$ O(^AHCHVA( "AF","PR", DFN)) G:'D FN CEND | |
27 | G:'$D(^AH CHVA(DFN,0 )) C1 | |
28 | G:$D(^AHC HVA(DFN,15 )) C1 ;DPT 10/18/11 | |
29 | S BFN=0 | |
30 | C2 S BFN=$ O(^AHCHVA( "AF","PR", DFN,BFN)) G:'BFN C1 | |
31 | G:'$D(^AH CHVA(DFN,1 00,BFN,0)) C2 | |
32 | ;;;CHECK STATUS OF BENE PRIOR TO SENDIN G FILE TO DEERS;;;;; ; | |
33 | I $P(^AHC HVA(DFN,10 0,BFN,0)," ^",4)="CG" K ^AHCHV A("AF","PR ",DFN,BFN) G C2 ;DP T 1/5/12 | |
34 | I $P(^AHC HVA(DFN,10 0,BFN,0)," ^",4)="SF" K ^AHCHV A("AF","PR ",DFN,BFN) G C2 ;DP T 5/4/12 | |
35 | I $P(^AHC HVA(DFN,10 0,BFN,0)," ^",5)="D" I $P(^AHC HVA(DFN,10 0,BFN,0)," ^",12)="CH E" K ^AHC HVA("AF"," PR",DFN,BF N) G C2 ; DEV013936 DPT 2/9/12 | |
36 | I $P(^AHC HVA(DFN,10 0,BFN,0)," ^",5)="PS" K ^AHCHVA ("AF","PR" ,DFN,BFN) G C2 ;TLH 5/5/09 DE V006491 | |
37 | D SPN ;C REATE BENE DATA | |
38 | D BENE ;C RETE BENE DATA | |
39 | S SFLG=1 | |
40 | K ^AHCHVA ("AF","PR" ,DFN,BFN) ;SKD | |
41 | S ^CHMZHO LD("AF","P R",DFN,BFN )="" ;SET S UP LIST FOR RESEND | |
42 | S CT=CT+1 | |
43 | G C2 | |
44 | CEND ; | |
45 | C FILEIO | |
46 | D ZWCLOSE ^CHMSNUTL( FILEIO,263 ,512) | |
47 | I SFLG=1 D SEND | |
48 | K FILEIO, DFN,BFN,SR EC,BREC | |
49 | Q | |
50 | SEND ;SEND FILE | |
51 | I '$D(DT) D NOW^%DT C S DT=X | |
52 | K CHFTPTI M,CHFTPWT | |
53 | S CHFILE= "DROHAC.DA T " | |
54 | ;S CHFILE =$P(FILEIO ,":",2)_" " | |
55 | S CHFILE= $P(FILEIO, "]",2)_" " ;DPT AUG 30 2017 | |
56 | 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 | |
57 | D NOTIFY | |
58 | ; | |
59 | END K CHFT PMSG,RRD,R RDLINE,CHF ILE,FMDATE ,CCHNB,QFL AG | |
60 | Q | |
61 | NOTIFY ;SE ND MS-EXCH ANGE EMAIL S FROM VIS TA | |
62 | ; | |
63 | S XMSUB=" WEEKLY DEE RS FILE RE ADY TO SEN D "_$$FMT E^XLFDT(DT ,"5D") | |
64 | S XMDUZ=. 5 | |
65 | S XMY(988 7)="" S XM Y(23249)=" " ;CHANGE NOTIFY DPT 7/8/12 | |
66 | D UCI^%ZO SV I $P(Y, ",",1)="HA C" S XMY(" PII ")="" | |
67 | S XMY(" PII ")="" | |
68 | D UCI^%ZO SV I $P(Y, ",",1)="HA C" S XMY(" 'veronica. t.parker4. ctr@mail.m il'")="" ; DPT 4/27/1 6 MTN02610 4 | |
69 | D UCI^%ZO SV I $P(Y, ",",1)="HA C" S XMY(" 'richard.m .burton.ct r@mail.mil '")="" ;DP T 4/27/16 MTN026104 | |
70 | S TEXT(1) ="DMDC," ; DPT 4/8/15 MTN023073 | |
71 | S TEXT(2) =" " | |
72 | S TEXT(3) ="The week ly file is available on your s ite for pr ocessing." | |
73 | S TEXT(4) ="Please l et us know via this message wh en you are finished. " | |
74 | S TEXT(5) ="Number o f records sent "_CT_ "." | |
75 | S TEXT(6) ="Thank Yo u" | |
76 | S XMTEXT= "TEXT(" | |
77 | D ^XMD | |
78 | K XMY,XMD UZ,TEXT,XM TEXT,XMSUB | |
79 | Q | |
80 | SPN ;GET A LL SPONSOR DATA | |
81 | ;SSSN - S PONSORS SS N | |
82 | ;SSSNTYP - S:ACTUAL SSN,P:PSU DO | |
83 | ;SLNAME - SPONSOR L AST NAME | |
84 | ;SFNAME - SPONSOR F IRST NAME | |
85 | ;SMNAME - SPONSOR M IDDLE NAME | |
86 | ;SDOB - S PONSOR DAT OF BIRTH | |
87 | ;PTDATE - SPONSORS P&T DATE | |
88 | ;SDOD - S PONSOR DAT E OF DEATH Q | |
89 | ;SPSVC - SPONSORS B RANCH OF S ERVICE (Z FOR UNKNOW N) | |
90 | ;SPSTAT - SPONSORS STATUS( D: 100% FOR D AV) | |
91 | ;SPNLBDT - BEGIN SP ONSOR'S ST ATUS DATE | |
92 | ;SPNLEDT - END SPON SOR'S STAT US DATE | |
93 | S SPEC(". ")="" ; A DD CHARACT ERS HERE I F THEY ARE TO BE REM OVED FROM THE NAME | |
94 | Q:'$G(DFN ) | |
95 | Q:'$D(^AH CHVA(DFN,0 )) | |
96 | 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 | |
97 | S SREC=^A HCHVA(DFN, 0) | |
98 | S SSSN=$P (SREC,U,9) ,NAME=$P(S REC,U,1) | |
99 | ;S SSNTYP 1=$P(SREC, U,10) ;dDP T 11/3/15 ENC020777 | |
100 | ; S SSSNT YP=SSNTTYP 1 | |
101 | S SSNTYP1 =$P(SREC,U ,10) S:SSN TYP1="" SS SNTYP="S" | |
102 | S:SSNTYP1 '="P" SSSN TYP="S" S: SSNTYP1="P " SSSNTYP= "S" ;TLH 8/22/07 AD DED ADDITI ONAL "S" T O REFLECT "SSSNTYP" | |
103 | S SFNAME1 =$P(NAME," ,",2),CHBD AT="000000 00" | |
104 | S SFNAME= $P(SFNAME1 ," ",1) S SFNAME=$$ REPLACE^XL FSTR(SFNAM E,.SPEC) ; DPT 9/13/1 1 | |
105 | S SLNAME= $E($P(NAME ,",",1),1, 26) S SLNA ME=$$REPLA CE^XLFSTR( SLNAME,.SP EC) | |
106 | S SMNAME= $P(SFNAME1 ," ",2) I SMNAME="" S $P(SMNA ME," ",21- $L(SMNAME) )="" ;DPT 9/9/11 | |
107 | S SMNAME= $$REPLACE^ XLFSTR(SMN AME,.SPEC) ;DPT 9/9/ 11 | |
108 | S SDOB=$P (SREC,U,3) I SDOB'=" " S X=SDOB D ^%DT S: Y=-1 SDOB= CHBDAT | |
109 | I SDOB'=" " I SDOB'= CHBDAT S S DOB=$$FMTE ^XLFDT(SDO B,"7D") | |
110 | I SDOB="" S SDOB="0 0000000" | |
111 | D | |
112 | .S PTDATE =9999999 | |
113 | .S PTDATE =$O(^AHCHV A(DFN,102, PTDATE),-1 ) | |
114 | .I PTDATE '="" S X=P TDATE D ^% DT S:Y=-1 PTDATE=CHB DAT | |
115 | I PTDATE' ="" I PTDA TE'=CHBDAT S PTDATE= $$FMTE^XLF DT(PTDATE, "7D") | |
116 | I PTDATE= "" S PTDAT E=CHBDAT | |
117 | S SDOD=$P (SREC,U,4) I SDOD'=" " S X=SDOD D ^%DT S: Y=-1 SDOD= CHBDAT | |
118 | I SDOD'=" " I SDOD'= CHBDAT S S DOD=$$FMTE ^XLFDT(SDO D,"7D") | |
119 | I SDOD="" S SDOD=CH BDAT | |
120 | S SPSVC=" Z" ;SPEC ITEM #9 | |
121 | S SPSTAT= "Z" ;SPEC ITEM #10 | |
122 | S SPNLBDT =CHBDAT | |
123 | S SPNLEDT =CHBDAT | |
124 | ;CHECK FO RMATING TO ENSURE IT S CORRECT | |
125 | S SSSN=$$ FXLGTH^CHT FLIB(SSSN, "L",9) | |
126 | S SFNAME= $$FXLGTH^C HTFLIB(SFN AME,"L",20 ) S SFNAME =$$REPLACE ^XLFSTR(SF NAME,.SPEC ) | |
127 | S SLNAME= $$FXLGTH^C HTFLIB(SLN AME,"L",26 ) S SLNAME =$$REPLACE ^XLFSTR(SL NAME,.SPEC ) | |
128 | S SMNAME= $$FXLGTH^C HTFLIB(SMN AME,"L",20 ) S SMNAME =$$REPLACE ^XLFSTR(SM NAME,.SPEC ) | |
129 | I PTDATE' =CHBDAT D | |
130 | .I $L($P( PTDATE,"/" ,2))'=2 S $P(PTDATE, "/",2)="0" _$P(PTDATE ,"/",2) | |
131 | .I $L($P( PTDATE,"/" ,3))'=2 S $P(PTDATE, "/",3)="0" _$P(PTDATE ,"/",3) | |
132 | .S PTDATE =$$STRIP^X LFSTR(PTDA TE,"/") | |
133 | .Q | |
134 | I SDOB'=C HBDAT D | |
135 | .I $L($P( SDOB,"/",2 ))'=2 S $P (SDOB,"/", 2)="0"_$P( SDOB,"/",2 ) | |
136 | .I $L($P( SDOB,"/",3 ))'=2 S $P (SDOB,"/", 3)="0"_$P( SDOB,"/",3 ) | |
137 | .S SDOB=$ $STRIP^XLF STR(SDOB," /") | |
138 | .Q | |
139 | I SDOD'=C HBDAT D | |
140 | .I $L($P( SDOD,"/",2 ))'=2 S $P (SDOD,"/", 2)="0"_$P( SDOD,"/",2 ) | |
141 | .I $L($P( SDOD,"/",3 ))'=2 S $P (SDOD,"/", 3)="0"_$P( SDOD,"/",3 ) | |
142 | .S SDOD=$ $STRIP^XLF STR(SDOD," /") | |
143 | .Q | |
144 | I SPNLBDT '=CHBDAT D | |
145 | .I $L($P( SPNLBDT,"/ ",2))'=2 S $P(SPNLBD T,"/",2)=" 0"_$P(SPNL BDT,"/",2) | |
146 | .I $L($P( SPNLBDT,"/ ",3))'=2 S $P(SPNLBD T,"/",3)=" 0"_$P(SPNL BDT,"/",3) | |
147 | .S SPNLBD T=$$STRIP^ XLFSTR(SPN LBDT,"/") | |
148 | .Q | |
149 | I SPNLEDT '=CHBDAT D | |
150 | .I $L($P( SPNLEDT,"/ ",2))'=2 S $P(SPNLED T,"/",2)=" 0"_$P(SPNL EDT,"/",2) | |
151 | .I $L($P( SPNLEDT,"/ ",3))'=2 S $P(SPNLED T,"/",3)=" 0"_$P(SPNL EDT,"/",3) | |
152 | .S SPNLED T=$$STRIP^ XLFSTR(SPN LEDT,"/") | |
153 | .Q | |
154 | ;;U FILEI O W SSSN,S SSNTYP,SLN AME,SFNAME ,SMNAME,SD OB,PTDATE, SDOD,SPSVC ,SPSTAT,SP NLBDT,SPNL EDT ;SKD | |
155 | S REC=SSS N_SSSNTYP_ SLNAME_SFN AME_SMNAME _SDOB_PTDA TE_SDOD_SP SVC_SPSTAT _SPNLBDT_S PNLEDT ; J EH | |
156 | ;S ^TMP(" ZSKDDEER", REC)="" ; JEH <-- ---------- ---------- DO NOT RE MOVE ";" | |
157 | Q | |
158 | BENE ;GET ALL BENE D ATA | |
159 | ;BLNAME - BENE LAST NAME 13 | |
160 | ;BFNAME - BENE FIRS T NAME 14 | |
161 | ;BMNAME - BENE MIDD ILE NAME 1 5 | |
162 | ;BDOB - B ENE DATE O F BIRTH 16 | |
163 | ;BDOD - B ENE DATE O F DEATH 17 | |
164 | ;BSEX - B ENE GENDER 18 | |
165 | ;BREL - B ENE RELATI ONSHIP WIT H SPONSOR 19 | |
166 | ;BPNABDT - DATE BEN E BECAME A SSOCIATED WITH SPONS OR 20 | |
167 | ;BPNAEDT - DATE BEN E BECAME U NASSOCIATE D WITH SPO NSOR 21 | |
168 | ;BPNATRSN - REASON CODE FOR B ENE TO BEC OME UNASSO CIATED WIT H SPONSOR | |
169 | ;BPNECTYP - CODE TO REPRESENT ASSOCIATI ON TERMINA TION 23 | |
170 | ;BPNECBDT - BEGIN D ATE THAT A FFECTED BE NE ELIG PE RIOD 24 | |
171 | ;BPNECEDT - END DAT E THAT AFF ECTED BENE ELIG PERI OD 25 | |
172 | ;BBEGDT - CHAMPVA B EG ELIG DA TE 26 | |
173 | ;BENDDT - CHAMPVA E ND ELIG DA TE 27 | |
174 | ;BSSN - B ENE SSN 28 | |
175 | ;CHFILL - FILLER OF LENGTH 1 29 | |
176 | Q:'$G(DFN ) Q:'$G(B FN) | |
177 | Q:'$D(^AH CHVA(DFN,1 00,BFN,0)) | |
178 | Q:'$D(^AH CHVA(DFN,1 00,BFN,105 )) ;DPT 1/ 30/13 | |
179 | S (BLNAME ,BFNAME,BM NAME,BDOB, BDOD,BSEX, BREL,BPNAB DT,BPNAEDT ,BPNATRSN, BPNECTYP,B SSNTYPE1,B PNECBDT,BP NECEDT,BBE GDT,BENDDT ,BSSN,CHFI LL)="" ;T LH 2/4/09 FIX UNDEFI NED ERROR | |
180 | S (BBEGDT ,BENDDT)=" 00000000" ;DPT 9/7/ 11 | |
181 | S BREC=^A HCHVA(DFN, 100,BFN,0) | |
182 | S NAME=$P (^AHCHVA(D FN,100,BFN ,0),U,1) | |
183 | S BSSN=$P (BREC,U,9) | |
184 | ; compa re sponsor ssn type and bene s sn type | |
185 | ;S BSSNTY PE1=$P(BRE C,U,36) D ;ENC0207 77 DPT | |
186 | ; .I (SS NTYP1=""&B SSNTYPE1=" ")!(SSNTYP 1=""&BSSNT YPE1="A")! (SSNTYP1=" A"&BSSNTYP E1="A") S SSNTYP1="S " ;ENC0270 77 DPT | |
187 | ; .I SSN TYP1="A"&B SSNTYPE1=" P" S SSNTY P1="U" ;EN C02077 DPT | |
188 | ; .I (SS NTYP1="P"& BSSNTYPE1= "A")!(SSNT YP1="P"&BS SNTYPE1="" ) S SSNTY P1="V" ;EN C020777 DP T | |
189 | ; .I SSN TYP1="P"&B SSNTYPE1=" P" S SSNTY P1="P" ;EN C020777 DP T | |
190 | S BDOB=$P (BREC,"^", 3) S X=BDO B D ^%DT S :Y=-1 BDOB =CHBDAT ;D PT 9/7/11 | |
191 | I BDOB'=" " I BDOB'= CHBDAT S:B DOB'=CHBDA T BDOB=$$F MTE^XLFDT( BDOB,"7D") ;DPT 9/7/ 11 | |
192 | S BDOD=$P (BREC,"^", 6) S X=BDO D D ^%DT S :Y=-1 BDOD =CHBDAT | |
193 | I BDOD'=" " I BDOD'= CHBDAT S:B DOD'=CHBDA T BDOD=$$F MTE^XLFDT( BDOD,"7D") | |
194 | S BSEX=$P (BREC,"^", 2) I BSEX' ="M" I BSE X'="F" S B SEX="Z" | |
195 | S BREL=$P (BREC,"^", 4) ;NEED TO REFINE TO DEERS C ODE SET | |
196 | I BREL="" S BREL="Z " ;DPT 10/ 18/11 | |
197 | I BREL="X S" S BREL= "S" ;DEER S UNABLE T O ACCEPT E X SPOUSE S TATUS | |
198 | I BREL="C " D | |
199 | .S:$P(BRE C,"^",26)= "S" BREL=" V" | |
200 | ;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 | |
201 | S BFNAME1 =$P(NAME," ,",2) | |
202 | S BFNAME= $E($P(BFNA ME1," ",1) ,1,20),BFN AME=$$REPL ACE^XLFSTR (BFNAME,.S PEC) | |
203 | S BMNAME= $E($P(BFNA ME1," ",2) ,1,20),BMN AME=$$REPL ACE^XLFSTR (BMNAME,.S PEC) | |
204 | S BLNAME= $E($P(NAME ,",",1),1, 26),BLNAME =$$REPLACE ^XLFSTR(BL NAME,.SPEC ) | |
205 | D | |
206 | .S IDT=0 | |
207 | .S IDT=$O (^AHCHVA(D FN,100,BFN ,105,IDT)) I 'IDT S (IDT,FDT)= CHBDAT Q | |
208 | .S FDT=0 | |
209 | .S FDT=$O (^AHCHVA(D FN,100,BFN ,105,IDT,F DT)) I 'FD T S FDT=CH BDAT Q | |
210 | .Q | |
211 | I IDT'=CH BDAT S BBE GDT=$$FMTE ^XLFDT(IDT ,"7D") | |
212 | I FDT'=CH BDAT S BEN DDT=$$FMTE ^XLFDT(FDT ,"7D") | |
213 | S BPNABDT =CHBDAT D | |
214 | .I BREL=" C" S BPNAB DT=BDOB D | |
215 | ..S:$P(BR EC,"^",26) ="A" BPNAB DT=$P(BREC ,"^",27) ;ADOPTION DT FOR ADO PTED CHILD | |
216 | ..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 | |
217 | ..S:$P(BR EC,"^",26) ="I" BPNAB DT=$P(BREC ,"^",10) ;QE DT FOR ILLIG. CH ILD | |
218 | .I BREL=" V" S BPNAB DT=$P(BREC ,"^",8) | |
219 | .I BREL=" S" S BPNAB DT="000000 00" Q | |
220 | .S X=BPNA BDT D ^%DT I Y=-1 S BPNABDT=CH BDAT Q | |
221 | .S BPNABD T=$$FMTE^X LFDT(BPNAB DT,"7D") | |
222 | .I $L($P( BPNABDT,"/ ",2))'=2 S $P(BPNABD T,"/",2)=" 0"_$P(BPNA BDT,"/",2) | |
223 | .I $L($P( BPNABDT,"/ ",3))'=2 S $P(BPNABD T,"/",3)=" 0"_$P(BPNA BDT,"/",3) | |
224 | .S BPNABD T=$$STRIP^ XLFSTR(BPN ABDT,"/") | |
225 | .Q | |
226 | S BPNAEDT =CHBDAT D | |
227 | .I BREL=" S" S BPNAE DT="000000 00" | |
228 | .I BREL=" C" S BPNAE DT="000000 00" D | |
229 | ..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 | |
230 | ..S:$P(BR EC,"^",26) ="S" BPNAE DT=$P(BREC ,"^",7) ; DATE OD MA RRIAGE TER M FOR STEP CHILD. | |
231 | ..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 | |
232 | .S X=BPNA EDT D ^%DT I Y=-1 S BPNAEDT="0 0000000" Q | |
233 | .S BPNAED T=$$FMTE^X LFDT(BPNAE DT,"7D") | |
234 | .I $L($P( BPNAEDT,"/ ",2))'=2 S $P(BPNAED T,"/",2)=" 0"_$P(BPNA EDT,"/",2) | |
235 | .I $L($P( BPNAEDT,"/ ",3))'=2 S $P(BPNAED T,"/",3)=" 0"_$P(BPNA EDT,"/",3) | |
236 | .S BPNAED T=$$STRIP^ XLFSTR(BPN AEDT,"/") | |
237 | .Q | |
238 | S BPNATRS N="Z" | |
239 | ;I BPNAED T'=CHBDAT D | |
240 | ;.I BREL= "C" I $P(B REC,"^",31 )'="" S BP NATRSN="H" Q | |
241 | ;.I BREL= "V" I $P(B REC,"^",31 )'="" S BP NATRSN="H" Q | |
242 | ;.I BREL= "S" I $P(B REC,"^",16 )=1 S BPNA TRSN="T" Q | |
243 | S BPNECTY P=" " I $ P(BREC,"^" ,22)=1 S B PNECTYP="0 1" | |
244 | S BPNECED T="0000000 0" | |
245 | S BPNECBD T="0000000 0" D | |
246 | .Q:$P(BRE C,"^",22)' =1 ;ONLY SET FOR S CHOOL DATE S | |
247 | .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)) | |
248 | .S BPNECB DT=$P(^AHC HVA(DFN,10 0,BFN,104, I,0),"^",1 ) | |
249 | .S BPNECE DT=$P(^AHC HVA(DFN,10 0,BFN,104, I,0),"^",2 ) | |
250 | .S X=BPNE CBDT D ^%D T I Y=-1 S (BPNECBDT ,BPNECEDT) =CHBDAT Q | |
251 | .S X=BPNE CEDT D ^%D T I Y=-1 S (BPNECBDT ,BPNECEDT) =CHBDAT Q | |
252 | .S BPNECB DT=$$FMTE^ XLFDT(BPNE CBDT,"7D") | |
253 | .S BPNECE DT=$$FMTE^ XLFDT(BPNE CEDT,"7D") | |
254 | .I $L($P( BPNECBDT," /",2))'=2 S $P(BPNEC BDT,"/",2) ="0"_$P(BP NECBDT,"/" ,2) | |
255 | .I $L($P( BPNECBDT," /",3))'=2 S $P(BPNEC BDT,"/",3) ="0"_$P(BP NECBDT,"/" ,3) | |
256 | .I $L($P( BPNECEDT," /",2))'=2 S $P(BPNEC EDT,"/",2) ="0"_$P(BP NECEDT,"/" ,2) | |
257 | .I $L($P( BPNECEDT," /",3))'=2 S $P(BPNEC EDT,"/",3) ="0"_$P(BP NECEDT,"/" ,3) | |
258 | .S BPNECB DT=$$STRIP ^XLFSTR(BP NECBDT,"/" ) | |
259 | .S BPNECE DT=$$STRIP ^XLFSTR(BP NECEDT,"/" ) | |
260 | .Q | |
261 | S BSSN=$$ FXLGTH^CHT FLIB(BSSN, "L",9) | |
262 | S BFNAME= $$FXLGTH^C HTFLIB(BFN AME,"L",20 ) | |
263 | S BLNAME= $$FXLGTH^C HTFLIB(BLN AME,"L",26 ) | |
264 | S BMNAME= $$FXLGTH^C HTFLIB(BMN AME,"L",20 ) | |
265 | I BDOB'=C HBDAT D ;D PT 9/9/11 ADD CHECK FOR ZEROS | |
266 | .I $L($P( BDOB,"/",2 ))'=2 S $P (BDOB,"/", 2)="0"_$P( BDOB,"/",2 ) ;DPT 9/9 /11 | |
267 | .I $L($P( BDOB,"/",3 ))'=2 S $P (BDOB,"/", 3)="0"_$P( BDOB,"/",3 ) ;DPT 9/9 /11 | |
268 | .S BDOB=$ $STRIP^XLF STR(BDOB," /") ;DPT 9 /9/11 | |
269 | .Q | |
270 | I BDOD'=C HBDAT D | |
271 | .I $L($P( BDOD,"/",2 ))'=2 S $P (BDOD,"/", 2)="0"_$P( BDOD,"/",2 ) | |
272 | .I $L($P( BDOD,"/",3 ))'=2 S $P (BDOD,"/", 3)="0"_$P( BDOD,"/",3 ) | |
273 | .S BDOD=$ $STRIP^XLF STR(BDOD," /") ;DPT 9 /9/11 | |
274 | .Q | |
275 | I IDT'=CH BDAT D | |
276 | .I $L($P( BBEGDT,"/" ,2))'=2 S $P(BBEGDT, "/",2)="0" _$P(BBEGDT ,"/",2) | |
277 | .I $L($P( BBEGDT,"/" ,3))'=2 S $P(BBEGDT, "/",3)="0" _$P(BBEGDT ,"/",3) | |
278 | .S BBEGDT =$$STRIP^X LFSTR(BBEG DT,"/") | |
279 | .Q | |
280 | I FDT'=CH BDAT D | |
281 | .I $L($P( BENDDT,"/" ,2))'=2 S $P(BENDDT, "/",2)="0" _$P(BENDDT ,"/",2) | |
282 | .I $L($P( BENDDT,"/" ,3))'=2 S $P(BENDDT, "/",3)="0" _$P(BENDDT ,"/",3) | |
283 | .S BENDDT =$$STRIP^X LFSTR(BEND DT,"/") | |
284 | .Q | |
285 | ;I BPNAED T'=CHBDAT D DPT 9/13/11 DE ACTIVE IF STATMENT | |
286 | ;.I $L($P (BPNAEDT," /",2))'=2 S $P(BPNAE DT,"/",2)= "0"_$P(BPN AEDT,"/",2 ) | |
287 | ;.I $L($P (BPNAEDT," /",3))'=2 S $P(BPNAE DT,"/",3)= "0"_$P(BPN AEDT,"/",3 ) | |
288 | ;.S BPNAE DT=$$STRIP ^XLFSTR(BP NAEDT,"/") | |
289 | ;.Q | |
290 | ;;I BPNEC BDT'=CHBDA T I BPNECE DT["/" D | |
291 | ;.I $L($P (BPNECBDT, "/",2))'=2 S $P(BPNE CBDT,"/",2 )="0"_$P(B PNECBDT,"/ ",2) | |
292 | ;.I $L($P (BPNECBDT, "/",3))'=2 S $P(BPNE CBDT,"/",3 )="0"_$P(B PNECBDT,"/ ",3) | |
293 | ;.S BPNEC BDT=$$STRI P^XLFSTR(B PNECBDT,"/ ") | |
294 | ;.Q | |
295 | ;;I BPNEC EDT'=CHBDA T I BPNECE DT["/" D | |
296 | ;.I $L($P (BPNECEDT, "/",2))'=2 S $P(BPNE CEDT,"/",2 )="0"_$P(B PNECEDT,"/ ",2) | |
297 | ;.I $L($P (BPNECEDT, "/",3))'=2 S $P(BPNE CEDT,"/",3 )="0"_$P(B PNECEDT,"/ ",3) | |
298 | ;.S BPNEC EDT=$$STRI P^XLFSTR(B PNECEDT,"/ ") | |
299 | ;.Q | |
300 | S CHFILL= " " | |
301 | S CHFILL= $$FXLGTH^C HTFLIB(CHF ILL,"L",1) | |
302 | ;;U FILEI O W BLNAME ,BFNAME,BM NAME,BDOB, BDOD,BSEX, BREL,BPNAB DT,BPNAEDT ,BPNATRSN, BPNECTYP,B PNECBDT,BP NECEDT,BBE GDT,BENDDT ,BSSN,CHFI LL,! | |
303 | ; S REC=R EC_BLNAME_ BFNAME_BMN AME_BDOB_B DOD_BSEX_B REL_BPNABD T_BPNAEDT_ BPNATRSN_B STYPE1_BPN ECBDT_BPNE CEDT_BBEGD T_BENDDT_B SSN_CHFILL | |
304 | ; FOR ENC 020777 NE ED TO REPL ACE SECOND POSITION OF REC BEF ORE NEXT S TEP | |
305 | 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 | |
306 | D ZWCHAR^ CHMSNUTL(F ILEIO,REC) | |
307 | Q | |
308 | QUEA ;QUE THIS ROUTI NE MANUALL Y. | |
309 | I '$D(DUZ ) S DUZ=1, DUZ(0)="@" | |
310 | D NOW^%DT C S DT=X | |
311 | S:'$D(DTI ME) DTIME= 300 ;CH ANGE BACK TO DTIME=1 00 | |
312 | S U="^" | |
313 | S CHFIO=" " | |
314 | S ZTRTN=" CFILE^CHME DRSD",ZTDE SC="SEND D ATA FILE T O DEERS" | |
315 | S ZTIO="" ,ZTSAVE("C HFIO")="", ZTSAVE("FI LEIO")="", ZTSAVE("RE C")="" | |
316 | D ^%ZTLOA D | |
317 | Q | |
318 | RFILE ;RES END FILE | |
319 | S U="^",F ILEIO="HAC _HFS$:[DSM MANAG]DEER S_SEND.DAT " | |
320 | ;O FILEIO C FILEIO: "D" O FILE IO:("NWU": 263) | |
321 | O FILEIO C FILEIO:" D" O FILEI O:"NWU" ; JEH | |
322 | I '$D(DT) D NOW^%DT C S DT=X | |
323 | I DT="" D NOW^%DTC S DT=X | |
324 | S DFN=0,S FLG=0,CT=1 | |
325 | R1 S DFN=$ O(^CHMZHOL D("AF","PR ",DFN)) G: 'DFN REND | |
326 | G:'$D(^AH CHVA(DFN,0 )) R1 | |
327 | S BFN=0 | |
328 | R2 S BFN=$ O(^CHMZHOL D("AF","PR ",DFN,BFN) ) G:'BFN R 1 | |
329 | G:'$D(^AH CHVA(DFN,1 00,BFN,0)) R2 | |
330 | D SPN ;C REATE BENE DATA | |
331 | D BENE ;C RETE BENE DATA | |
332 | S SFLG=1 | |
333 | S CT=CT+1 | |
334 | G R2 | |
335 | REND C FIL EIO D ZWCL OSE^CHMSNU TL(FILEIO, 263,512) | |
336 | I SFLG=1 D SEND | |
337 | K FILEIO, DFN,BFN,SR EC,BREC | |
338 | Q |
Araxis Merge (but not the data content of this report) is Copyright © 1993-2016 Araxis Ltd (www.araxis.com). All rights reserved.