Produced by Araxis Merge on 11/9/2018 12:33:42 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 | CHCMLRPT.m | Mon Nov 5 16:43:32 2018 UTC |
2 | CPEE_Build9_Sprint27.zip\HAC_CPE_CH | CHCMLRPT.m | Tue Nov 6 22:06:22 2018 UTC |
Description | Between Files 1 and 2 |
|
---|---|---|
Text Blocks | Lines | |
Unchanged | 10 | 1246 |
Changed | 9 | 22 |
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 | CHCMLRPT ; HAC/SKD - CML REPORT - 2-12-08 | |
2 | ;;1.0;CHA MPVA SYSTE M;;JULY 4, 1990;Buil d 1 | |
3 | ;NEW ROUT INE per DE V000276-02 ,DEV007033 : Benie Ma iling List | |
4 | ;Last mod ified by S KD, 4-24-0 9/DEV00703 3, 5-29-09 /DEV002408 | |
5 | ;TLH 09/2 2/09 DEV00 7959 CORRE CTION FOR BENES THAT WERE INEL IGIBLE ON MAILING LI ST | |
6 | ;TLH 09/2 9/09 DEV00 7520 CORRE CTION FOR ** WITHIN REMIT TO A DDRESS/PHY SICAL ADDR ESS | |
7 | ;YJK 02/2 5/10 DEV00 9056-02 SK IP "ELIGIB LE" STATUS CHECK FOR "SB" AND "CWVV" | |
8 | ;SBB 11/2 5/13 DEF01 6554 Modif ied Writin g to a fil e as per V HA standar d. | |
9 | ; Conv ersion fro m DECNET t o FTP | |
10 | ;SBB 07/3 0/15 DEF01 6554 Addin g changes for DECNET | |
11 | ; | |
12 | ;Bene mai ling list | |
13 | BENE(Z1,Z2 ,Z3,Z4,Z5, Z6,Z7,Z8,Z 9,Z10,Z11, Z12) | |
14 | ; CHCML.C SP call wi th Z1(CHPR OG),Z2(CHU NIQ),Z3(CH ALLMAIL),Z 4(CHCTY),Z 5(CHST),Z6 (DUZ),Z7(C HBENE),Z8( CHSBIDDT), Z9(CHZFG), Z10(CHDOB) ,Z11(CHSEX ),Z12(CHOH I) argumen ts ;SKD,D EV007033 | |
15 | Q:Z7'=1 ;1=bene l ist, 0=pro v list | |
16 | I Z1="" S Z1="CHAMP VA" | |
17 | NEW CHPRO G,CHUNIQ,C HALLMAIL,C HCTY,CHST, DUZ,CHBENE ,CHSBIDDT, CHZIPFG,CH DOB,CHSEX, CHOHI ;SKD,DEV0 07033 | |
18 | S CHPROG= Z1,CHUNIQ= Z2,CHALLMA IL=Z3,CHCT Y=$$UPPER^ CHTFLIB(Z4 ),CHST=Z5, DUZ=Z6,CHB ENE=Z7,CHS BIDDT=Z8,C HZIPFG=Z9, CHDOB=Z10, CHSEX=Z11, CHOHI=Z12 ;SKD,DEV 007033,DEV 002408 | |
19 | BQUE ;S IO P="Q",%ZIS ="Q" W !! D ^%ZIS G: POP QEND | |
20 | S CHFIO=" " | |
21 | S ZTDTH=$ H | |
22 | S ZTRTN=" BENELIST^C HCMLRPT",Z TDESC="CML Beneficia ry Mailing List" | |
23 | S ZTIO="" ,ZTSAVE("C HFIO")="", ZTSAVE("CH PROG")="", ZTSAVE("CH UNIQ")="", ZTSAVE("CH ALLMAIL")= "",ZTSAVE( "CHCTY")=" ",ZTSAVE(" CHST")="", ZTSAVE("DU Z")="" | |
24 | S ZTSAVE( "CHFORNFG" )="",ZTSAV E("CHBPFG" )="",ZTSAV E("CHDFN") ="",ZTSAVE ("CHBFN")= "",ZTSAVE( "CHSBIDDT" )="",ZTSAV E("CH*")=" " | |
25 | S ZTSAVE( "^CHMZHOLD (""CML""," )="",ZTSAV E("CHDOB") ="",ZTSAVE ("CHSEX")= "",ZTSAVE( "CHOHI")=" " | |
26 | D ^%ZTLOA D | |
27 | Q | |
28 | ; | |
29 | BENELIST ; | |
30 | K ^CHMZHO LD("CML",D UZ),^CHMZH OLD("CML", "FINAL",DU Z),^CHMZHO LD("CML"," DUPADDR",D UZ),^CHMZH OLD("CML", "ALLMAILIN G",DUZ),^C HMZHOLD("C ML","ONEMA ILING",DUZ ) | |
31 | S CHBPFG= "BENE" | |
32 | ;SBB; DEF 016554-11/ 25/13 - us ing POP fo r OPEN^%ZI SH. | |
33 | N POP | |
34 | D INIT | |
35 | I 'CHUNIQ D ALLELIG ;get all elig bene s | |
36 | E D UNQB ENE ;filed a claim wit hin last 1 2 or 18 mo nths (CHAM PVA) | |
37 | D BENECT | |
38 | D BFILEIO | |
39 | D KILLVAR | |
40 | Q | |
41 | ; | |
42 | ALLELIG | |
43 | I CHPROG= "CHAMPVA" D Q ;get all CHAMP VA EA bene s | |
44 | .S CHDFN= 0 F S CHD FN=$O(^AHC HVA(CHDFN) ) Q:'CHDFN D | |
45 | ..S CHBFN =0 F S CH BFN=$O(^AH CHVA(CHDFN ,100,CHBFN )) Q:'CHBF N D | |
46 | ...Q:$D(^ AHCHVA("SB ",CHDFN,CH BFN)) ;S B bene | |
47 | ...Q:$D(^ AHCHVA("FM P",CHDFN)) ;FMP ben e | |
48 | ...Q:$D(^ AHCHVA("WV ",CHDFN,CH BFN)) ;C WVV bene | |
49 | ...S CHQF LAG=0 D QU ITCHK(CHDF N,CHBFN) Q :CHQFLAG | |
50 | ...D GETB ADDR | |
51 | I CHPROG= "SB" D Q | |
52 | .S CHDFN= 0 F S CHD FN=$O(^AHC HVA("SB",C HDFN)) Q:' CHDFN D | |
53 | ..S CHBFN =0 F S CH BFN=$O(^AH CHVA("SB", CHDFN,CHBF N)) Q:'CHB FN D | |
54 | ...S CHQF LAG=0 D QU ITCHK(CHDF N,CHBFN) Q :CHQFLAG | |
55 | ...D GETB ADDR | |
56 | I CHPROG= "CWVV" D Q | |
57 | .S CHDFN= 0 F S CHD FN=$O(^AHC HVA("WV",C HDFN)) Q:' CHDFN D | |
58 | ..S CHBFN =0 F S CH BFN=$O(^AH CHVA("WV", CHDFN,CHBF N)) Q:'CHB FN D | |
59 | ...S CHQF LAG=0 D QU ITCHK(CHDF N,CHBFN) Q :CHQFLAG | |
60 | ...D GETB ADDR | |
61 | I CHPROG= "FMP" D Q | |
62 | .S CHDFN= 0 F S CHD FN=$O(^AHC HVA("FMP", CHDFN)) Q: 'CHDFN D | |
63 | ..I '$D(^ AHCHVA(CHD FN,0)) Q | |
64 | ..S CHNM= "",CHNM=$P ($G(^AHCHV A(CHDFN,0) ),"^",1) Q :CHNM="" | |
65 | ..Q:CHNM[ "(SN)" | |
66 | ..Q:$D(^A HADIC(5548 04.07,"B", CHNM,CHDFN )) | |
67 | ..D GFMPA DDR | |
68 | I CHPROG= "CMOP" D Q | |
69 | .S CHDFN= 0 F S CHD FN=$O(^AHC HVA(CHDFN) ) Q:'CHDFN D | |
70 | ..S CHBFN =0 F S CH BFN=$O(^AH CHVA(CHDFN ,100,CHBFN )) Q:'CHBF N D | |
71 | ...S CHQF LAG=0 D QU ITCHK(CHDF N,CHBFN) Q :CHQFLAG | |
72 | ...S CHMD FNI=0,CHMD FNI=$O(^CH MDFN("B",C HDFN,CHMDF NI)) Q:'CH MDFNI | |
73 | ...S CHMD FNJ=0,CHMD FNJ=$O(^CH MDFN(CHMDF NI,100,"B" ,CHBFN,CHM DFNJ)) Q:' CHMDFNJ | |
74 | ...Q:'$D( ^CHMDFN(CH MDFNI,100, CHMDFNJ,5) ) | |
75 | ...S CHMD FNK="A" S CHMDFNK=$O (^CHMDFN(C HMDFNI,100 ,CHMDFNJ,5 ,CHMDFNK), -1) Q:'CHM DFNK D | |
76 | ....S CHC MOPEA=$P($ G(^CHMDFN( CHMDFNI,10 0,CHMDFNJ, 5,CHMDFNK, 0)),"^",3) | |
77 | ....Q:CHC MOPEA'=1 ;NOT CMOP EA | |
78 | ....D GET BADDR | |
79 | Q | |
80 | ; | |
81 | UNQBENE2 ; | |
82 | Q:'$G(CHY R) | |
83 | I CHPROG= "CHAMPVA"! (CHPROG="C MOP") Q:'$ G(CHJUL548 ) | |
84 | E Q:'$G( CHJUL365) | |
85 | S CHPDI=$ S(CHPROG=" CHAMPVA":C HYR_$E(CHJ UL548,3,5) _"00000000 ",CHPROG=" CMOP":CHYR _$E(CHJUL5 48,3,5)_"0 0000000",1 :CHYR_$E(C HJUL365,3, 5)_"000000 00") | |
86 | ; | |
87 | F S CHPD I=$O(^CHMP AY("C",CHP DI)) Q:'CH PDI D | |
88 | .S CHCLI= 0 F S CHC LI=$O(^CHM PAY("C",CH PDI,CHCLI) ) Q:'CHCLI D | |
89 | ..Q:$P($G (^CHMPAY(C HCLI,0))," ^",2)=10 ;skip if a deleted claim | |
90 | ..S CHPRG =$P($G(^CH MPAY(CHCLI ,0)),"^",2 7) Q:'CHPR G | |
91 | ..I CHPRO G="CHAMPVA " Q:CHPRG' =1&(CHPRG' =2) | |
92 | ..I CHPRO G="FMP" Q: CHPRG'=3 | |
93 | ..I CHPRO G="SB" Q:C HPRG'=6 | |
94 | ..I CHPRO G="CWVV" Q :CHPRG'=7 | |
95 | ..I CHPRO G="CMOP" Q :'$D(^CHMP AY(CHCLI," ZEMC","CMO P")) | |
96 | ..S CHDFN =$P($G(^CH MPAY(CHCLI ,0)),"^",2 1) | |
97 | ..S CHBFN =$P($G(^CH MPAY(CHCLI ,0)),"^",2 2) | |
98 | ..D GETBA DDR | |
99 | Q | |
100 | ; | |
101 | UNQBENE ; | |
102 | I CHPROG= "CHAMPVA"! (CHPROG="C MOP") Q:'$ G(CH548) | |
103 | E Q:'$G( CH365) | |
104 | I CHPROG= "CHAMPVA"! (CHPROG="C MOP") S CH DONEDT=CH5 48 | |
105 | E S CHDO NEDT=CH365 | |
106 | I CHPROG= "FMP" D UN IQFMP Q | |
107 | S CHCLI=" A",CHDONE= 0 | |
108 | F S CHCL I=$O(^CHMP AY(CHCLI), -1) Q:'CHC LI Q:CHDO NE D | |
109 | .Q:'$D(^C HMPAY(CHCL I,0)) | |
110 | .Q:$P($G( ^CHMPAY(CH CLI,0)),"^ ",2)=10 ;skip if a deleted c laim | |
111 | .S CHCRED T="",CHCRE DT=$P($G(^ CHMPAY(CHC LI,0)),"^" ,25) Q:CHC REDT="" | |
112 | .I CHCRED T<CHDONEDT S CHDONE= 1 | |
113 | .S CHPRG= $P($G(^CHM PAY(CHCLI, 0)),"^",27 ) Q:'CHPRG | |
114 | .I CHPROG ="CHAMPVA" Q:CHPRG'= 1&(CHPRG'= 2) | |
115 | .;I CHPRO G="FMP" Q: CHPRG'=3 | |
116 | .I CHPROG ="SB" Q:CH PRG'=6 | |
117 | .I CHPROG ="CWVV" Q: CHPRG'=7 | |
118 | .I CHPROG ="CMOP" Q: '$D(^CHMPA Y(CHCLI,"Z EMC","CMOP ")) | |
119 | .S CHDFN= $P($G(^CHM PAY(CHCLI, 0)),"^",21 ) | |
120 | .S CHBFN= $P($G(^CHM PAY(CHCLI, 0)),"^",22 ) | |
121 | .D GETBAD DR | |
122 | Q | |
123 | ; | |
124 | GETBADDR ; bene remit -to addres s, domesti c and fore ign | |
125 | S (CHNAME ,CHADDR1,C HADDR2,CHA DDR3,CHCIT Y,CHSTI,CH STATE,CHZI P9,CHZIP5, CHFORNFG)= "" | |
126 | S CHNAME= $P($G(^AHC HVA(CHDFN, 100,CHBFN, 0)),"^",1) Q:CHNAME= "" | |
127 | ;S CHSTAT =$P($G(^AH CHVA(CHDFN ,100,CHBFN ,0)),"^",5 ) Q:CHSTAT '="EA" ;T LH 9/22/09 ;YJK 2/25/ 2010 DEV00 9056-02 | |
128 | S CHSTAT= $P($G(^AHC HVA(CHDFN, 100,CHBFN, 0)),"^",5) ;YJK 2/ 25/2010 DE V009056-02 | |
129 | Q:CHSTAT' ="EA"&(CHP ROG'="SB") &(CHPROG'= "CWVV") ;YJK 2/ 25/2010 DE V009056-02 | |
130 | Q:CHNAME[ "(SN)" ;don't in clude SN b ene | |
131 | ;adding d eleted ben e/sponsor check to e nsure that persons a re not del eted prior to creati ng mailing list | |
132 | S CHSNAME =$P(^AHCHV A(CHDFN,0) ,"^",1) ; TLH DEV007 959 | |
133 | S DELFLG= $$DELCHK^C HTFLIB(CHS NAME,CHDFN ,CHNAME,CH BFN) Q:DEL FLG=1 ;T LH DEV0079 59 | |
134 | ;S CHSNAM E="",CHNAM E=$P(^AHCH VA(CHDFN,1 00,CHBFN,0 ),"^",1) ;Y JK 2/25/20 10 DEV0090 56-02 TYPO correctio n | |
135 | S CHNAME= "",CHNAME= $P(^AHCHVA (CHDFN,100 ,CHBFN,0), "^",1) ;Y JK 2/25/20 10 DEV0090 56-02 | |
136 | S DELFLG= $$DELCHK^C HTFLIB(CHS NAME,CHDFN ,CHNAME,CH BFN) Q:DEL FLG=1 ;T LH DEV0079 59 | |
137 | I CHPROG= "CHAMPVA" Q:$P($G(^A HCHVA(CHDF N,100,CHBF N,1)),"^", 10)'=1 ;b ad address | |
138 | I CHPROG= "CMOP" Q:$ P($G(^AHCH VA(CHDFN,1 00,CHBFN,1 )),"^",10) '=1 ;bad address | |
139 | Q:$P($G(^ AHCHVA(CHD FN,100,CHB FN,0)),"^" ,6)'="" ; deceased ;TLH chang ed to look at 0 node piece 6 f or DOD | |
140 | I CHPROG= "FMP" Q:$P ($G(^AHCHV A(CHDFN,6) ),"^",14)= "" ;no ac ceptance l tr sent | |
141 | S CHNAME= $$CNVTNAME (CHNAME) | |
142 | S CHADDR1 =$P($G(^AH CHVA(CHDFN ,100,CHBFN ,1)),"^",1 ) Q:CHADDR 1="" | |
143 | S CHADDR2 =$P($G(^AH CHVA(CHDFN ,100,CHBFN ,1)),"^",2 ) | |
144 | S CHADDR3 =$P($G(^AH CHVA(CHDFN ,100,CHBFN ,1)),"^",1 2) | |
145 | S CHCITY= $P($G(^AHC HVA(CHDFN, 100,CHBFN, 1)),"^",3) Q:CHCITY= "" | |
146 | I CHCTY'= "" Q:CHCIT Y'=CHCTY | |
147 | S CHFORNF G=$S($P($G (^AHCHVA(C HDFN,100,C HBFN,1))," ^",11)=1:" F",1:"D") ;D-Domes tic F-Fore ign | |
148 | S CHQFG=0 | |
149 | I CHFORNF G="D" D Q :$G(CHQFG) | |
150 | .S CHSTI= $P($G(^AHC HVA(CHDFN, 100,CHBFN, 1)),"^",4) I 'CHSTI S CHQFG=1 Q | |
151 | .S CHSTAT E=$P($G(^D IC(5,CHSTI ,0)),"^",2 ) I CHSTAT E="" S CHQ FG=1 Q | |
152 | .I CHST'= "" I CHSTA TE'=CHST S CHQFG=1 Q | |
153 | .S CHZIP9 =$P($G(^AH CHVA(CHDFN ,100,CHBFN ,1)),"^",5 ) I 'CHZIP 9 S CHQFG= 1 Q | |
154 | .S CHZIP5 =$E(CHZIP9 ,1,5) I 'C HZIP5 S CH QFG=1 Q | |
155 | E D Q:$ G(CHQFG) | |
156 | .S CHSTI= $P($G(^AHC HVA(CHDFN, 100,CHBFN, 1)),"^",13 ) I 'CHSTI S CHQFG=1 Q | |
157 | .S CHSTAT E=$P($G(^D IC(5,CHSTI ,0)),"^",1 ) I CHSTAT E="" S CHQ FG=1 Q ; Country | |
158 | .S (CHZIP 5,CHZIP9)= "1" | |
159 | I $G(CHZI PFG) Q:'$D (^CHMZHOLD ("CML",DUZ ,"CHZIPS", CHZIP5)) ;SKD,5-2 9,09,DEV00 2408 | |
160 | I CHADDR2 ="" S CHAD DR2="NOADD R2" | |
161 | I CHADDR3 ="" S CHAD DR3="NOADD R3" | |
162 | S CHOHITO C=0 | |
163 | I '$G(CHO HI) S ^CHM ZHOLD("CML ",DUZ,CHBP FG,CHFORNF G,CHZIP5,C HSTATE,CHC ITY,CHADDR 1,CHADDR2, CHADDR3,CH DFN,CHBFN) =$G(CHNAME )_"^"_$G(C HZIP9) ;SKD,5-29, 09,DEV0024 08 | |
164 | E D | |
165 | .I $G(CHO HI)=1 D | |
166 | ..S ^CHMZ HOLD("CML" ,DUZ,CHBPF G,CHFORNFG ,CHZIP5,CH STATE,CHCI TY,CHADDR1 ,CHADDR2,C HADDR3,CHD FN,CHBFN)= $G(CHNAME) _"^"_$G(CH ZIP9) ; SKD,5-29,0 9,DEV00240 8 ;if OHI | |
167 | .I $G(CHO HI)=2 D | |
168 | ..I CHOHI TOC S ^CHM ZHOLD("CML ",DUZ,CHBP FG,CHFORNF G,CHZIP5,C HSTATE,CHC ITY,CHADDR 1,CHADDR2, CHADDR3,CH DFN,CHBFN) =$G(CHNAME )_"^"_$G(C HZIP9) ;SKD,5-29, 09,DEV0024 08 ;i f OHI | |
169 | .I $G(CHO HI)=3 D | |
170 | ..I 'CHOH ITOC S ^CH MZHOLD("CM L",DUZ,CHB PFG,CHFORN FG,CHZIP5, CHSTATE,CH CITY,CHADD R1,CHADDR2 ,CHADDR3,C HDFN,CHBFN )=$G(CHNAM E)_"^"_$G( CHZIP9) ;SKD,5-29, 09,DEV0024 08 ;i f no OHI | |
171 | ;I CHPROG ="SB",$G(C HSBIDDT)=1 D ; SKD,DEV007 033 | |
172 | ;.S CHIDD T="",CHIDD T=$$CONVDT 5($P($G(^A HCHVA(CHDF N,100,CHBF N,10)),"^" ,3)) | |
173 | ;.S $P(^C HMZHOLD("C ML",DUZ,CH BPFG,CHFOR NFG,CHZIP5 ,CHSTATE,C HCITY,CHAD DR1,CHADDR 2,CHADDR3, CHDFN,CHBF N),"^",3)= $G(CHIDDT) | |
174 | ;I $G(CHD OB) D ;SKD,DEV 002408,5-2 9-09 | |
175 | ;.S CHBDO B="",CHBDO B=$$CONVDT 5($P($G(^A HCHVA(CHDF N,100,CHBF N,0)),"^", 3)) | |
176 | ;.S $P(^C HMZHOLD("C ML",DUZ,CH BPFG,CHFOR NFG,CHZIP5 ,CHSTATE,C HCITY,CHAD DR1,CHADDR 2,CHADDR3, CHDFN,CHBF N),"^",4)= $G(CHBDOB) | |
177 | ;I $G(CHS EX) D ;SKD,DEV 002408,5-2 9-09 | |
178 | ;.S CHBSE X="",CHBSE X=$P($G(^A HCHVA(CHDF N,100,CHBF N,0)),"^", 2) | |
179 | ;.S $P(^C HMZHOLD("C ML",DUZ,CH BPFG,CHFOR NFG,CHZIP5 ,CHSTATE,C HCITY,CHAD DR1,CHADDR 2,CHADDR3, CHDFN,CHBF N),"^",5)= $G(CHBSEX) | |
180 | Q | |
181 | ; | |
182 | UNIQFMP ; | |
183 | Q:CHPROG' ="FMP" | |
184 | S CHCLI=" A",CHDONE= 0 | |
185 | F S CHCL I=$O(^CHFM PCL(CHCLI) ,-1) Q:'CH CLI Q:CHD ONE D | |
186 | .Q:'$D(^C HFMPCL(CHC LI,0)) | |
187 | .S CHCLJ= 0 | |
188 | .F S CHC LJ=$O(^CHF MPCL(CHCLI ,100,CHCLJ )) Q:'CHCL J D | |
189 | ..Q:'$D(^ CHFMPCL(CH CLI,100,CH CLJ,0)) | |
190 | ..S CHCRE DT="",CHCR EDT=$P($G( ^CHFMPCL(C HCLI,100,C HCLJ,0))," ^",7) Q:CH CREDT="" | |
191 | ..I CHCRE DT<CHDONED T S CHDONE =1 | |
192 | ..S CHDFN =$P($G(^CH FMPCL(CHCL I,0)),"^", 2) | |
193 | ..D GFMPA DDR | |
194 | Q | |
195 | ; | |
196 | GFMPADDR ; FMP remit- to address , domestic and forei gn | |
197 | S (CHNAME ,CHADDR1,C HADDR2,CHA DDR3,CHCIT Y,CHSTI,CH STATE,CHZI P9,CHZIP5, CHFORNFG)= "" | |
198 | S CHNAME= $P($G(^AHC HVA(CHDFN, 0)),"^",1) Q:CHNAME= "" | |
199 | Q:CHNAME[ "(SN)" ;don't in clude SN b ene | |
200 | Q:$P($G(^ AHCHVA(CHD FN,1)),"^" ,10)'=1 ; bad addres s | |
201 | Q:$P($G(^ AHCHVA(CHD FN,0)),"^" ,4)'="" ; deceased | |
202 | Q:$P($G(^ AHCHVA(CHD FN,6)),"^" ,14)="" ; no accepta nce ltr se nt | |
203 | S CHNAME= $$CNVTNAME (CHNAME) | |
204 | S CHADDR1 =$P($G(^AH CHVA(CHDFN ,1)),"^",1 ) Q:CHADDR 1="" | |
205 | S CHADDR2 =$P($G(^AH CHVA(CHDFN ,1)),"^",2 ) | |
206 | S CHADDR3 =$P($G(^AH CHVA(CHDFN ,1)),"^",1 2) | |
207 | S CHCITY= $P($G(^AHC HVA(CHDFN, 1)),"^",3) Q:CHCITY= "" | |
208 | I CHCTY'= "" Q:CHCIT Y'=CHCTY | |
209 | S CHFORNF G=$S($P($G (^AHCHVA(C HDFN,1))," ^",11)=1:" F",1:"D") ;D-Domes tic F-Fore ign | |
210 | S CHQFG=0 | |
211 | I CHFORNF G="D" D Q :$G(CHQFG) | |
212 | .S CHSTI= $P($G(^AHC HVA(CHDFN, 1)),"^",4) I 'CHSTI S CHQFG=1 Q | |
213 | .S CHSTAT E=$P($G(^D IC(5,CHSTI ,0)),"^",2 ) I CHSTAT E="" S CHQ FG=1 Q | |
214 | .I CHST'= "" I CHSTA TE'=CHST S CHQFG=1 Q | |
215 | .S CHZIP9 =$P($G(^AH CHVA(CHDFN ,1)),"^",5 ) I 'CHZIP 9 S CHQFG= 1 Q | |
216 | .S CHZIP5 =$E(CHZIP9 ,1,5) I 'C HZIP5 S CH QFG=1 Q | |
217 | E D Q:$ G(CHQFG) | |
218 | .S CHSTI= $P($G(^AHC HVA(CHDFN, 1)),"^",13 ) I 'CHSTI S CHQFG=1 Q | |
219 | .S CHSTAT E=$P($G(^D IC(5,CHSTI ,0)),"^",1 ) I CHSTAT E="" S CHQ FG=1 Q ; Country | |
220 | .S (CHZIP 5,CHZIP9)= "1" | |
221 | I CHADDR2 ="" S CHAD DR2="NOADD R2" | |
222 | I CHADDR3 ="" S CHAD DR3="NOADD R3" | |
223 | S CHBFN=1 | |
224 | S ^CHMZHO LD("CML",D UZ,CHBPFG, CHFORNFG,C HZIP5,CHST ATE,CHCITY ,CHADDR1,C HADDR2,CHA DDR3,CHDFN ,CHBFN)=$G (CHNAME)_" ^"_$G(CHZI P9) | |
225 | Q | |
226 | ; | |
227 | BENECT ; | |
228 | F CHFORNF G="D","F" D | |
229 | .S CHZIP5 =0 F S CH ZIP5=$O(^C HMZHOLD("C ML",DUZ,CH BPFG,CHFOR NFG,CHZIP5 )) Q:'CHZI P5 D | |
230 | ..S CHSTA TE="" F S CHSTATE=$ O(^CHMZHOL D("CML",DU Z,CHBPFG,C HFORNFG,CH ZIP5,CHSTA TE)) Q:CHS TATE="" D | |
231 | ...S CHCI TY="" F S CHCITY=$O (^CHMZHOLD ("CML",DUZ ,CHBPFG,CH FORNFG,CHZ IP5,CHSTAT E,CHCITY)) Q:CHCITY= "" D | |
232 | ....S CHA DDR1="" F S CHADDR1 =$O(^CHMZH OLD("CML", DUZ,CHBPFG ,CHFORNFG, CHZIP5,CHS TATE,CHCIT Y,CHADDR1) ) Q:CHADDR 1="" D | |
233 | .....S CH ADDR2="" S CHADDR2=$ O(^CHMZHOL D("CML",DU Z,CHBPFG,C HFORNFG,CH ZIP5,CHSTA TE,CHCITY, CHADDR1,CH ADDR2)) Q: CHADDR2="" D | |
234 | ......S C HADDR3="" F S CHADD R3=$O(^CHM ZHOLD("CML ",DUZ,CHBP FG,CHFORNF G,CHZIP5,C HSTATE,CHC ITY,CHADDR 1,CHADDR2, CHADDR3)) Q:CHADDR3= "" D | |
235 | .......S CHDFN=0 F S CHDFN=$ O(^CHMZHOL D("CML",DU Z,CHBPFG,C HFORNFG,CH ZIP5,CHSTA TE,CHCITY, CHADDR1,CH ADDR2,CHAD DR3,CHDFN) ) Q:'CHDFN D | |
236 | ........S CHBFN=0 F S CHBFN= $O(^CHMZHO LD("CML",D UZ,CHBPFG, CHFORNFG,C HZIP5,CHST ATE,CHCITY ,CHADDR1,C HADDR2,CHA DDR3,CHDFN ,CHBFN)) Q :'CHBFN D | |
237 | ......... S CHNAME=" ",CHNAME=$ P(^CHMZHOL D("CML",DU Z,CHBPFG,C HFORNFG,CH ZIP5,CHSTA TE,CHCITY, CHADDR1,CH ADDR2,CHAD DR3,CHDFN, CHBFN),"^" ,1) | |
238 | ......... S CHZIP9=" ",CHZIP9=$ P(^CHMZHOL D("CML",DU Z,CHBPFG,C HFORNFG,CH ZIP5,CHSTA TE,CHCITY, CHADDR1,CH ADDR2,CHAD DR3,CHDFN, CHBFN),"^" ,2) | |
239 | ......... S ^CHMZHOL D("CML",DU Z,CHBPFG," CT","TOTCT ",CHFORNFG )=$G(^CHMZ HOLD("CML" ,DUZ,CHBPF G,"CT","TO TCT",CHFOR NFG))+1 | |
240 | ......... I CHALLMAI L D | |
241 | ......... .S ^CHMZHO LD("CML"," ALLMAILING ",DUZ,CHBP FG,CHFORNF G,CHZIP5,C HSTATE,CHC ITY,CHADDR 1,CHADDR2, CHDFN,CHBF N)=CHNAME_ "^"_CHZIP9 _"^"_CHADD R3 | |
242 | ......... .I $G(CHSB IDDT)=1 D ;SKD,DE V007033 | |
243 | ......... ..S CHIDDT ="",CHIDDT =$$CONVDT5 ($P($G(^AH CHVA(CHDFN ,100,CHBFN ,10)),"^", 3)) | |
244 | ......... .I $G(CHDO B) D ;SKD,DEV0 02408,5-29 -09 | |
245 | ......... ..S CHBDOB ="",CHBDOB =$$CONVDT5 ($P($G(^AH CHVA(CHDFN ,100,CHBFN ,0)),"^",3 )) | |
246 | ......... ..S $P(^CH MZHOLD("CM L",DUZ,CHB PFG,CHFORN FG,CHZIP5, CHSTATE,CH CITY,CHADD R1,CHADDR2 ,CHADDR3,C HDFN,CHBFN ),"^",4)=$ G(CHBDOB) | |
247 | ......... .I $G(CHSE X) D ;SKD,DEV0 02408,5-29 -09 | |
248 | ......... ..S CHBSEX ="",CHBSEX =$P($G(^AH CHVA(CHDFN ,100,CHBFN ,0)),"^",2 ) | |
249 | ......... ..S ^CHMZH OLD("CML", "ALLMAILIN G",DUZ,CHB PFG,CHFORN FG,CHZIP5, CHSTATE,CH CITY,CHADD R1,CHADDR2 ,CHDFN,CHB FN)=CHNAME _"^"_CHZIP 9_"^"_CHAD DR3_"^"_$G (CHIDDT)_" ^"_$G(CHBD OB)_"^"_$G (CHBSEX) | |
250 | ......... E S ^CHMZ HOLD("CML" ,"ONEMAILI NG",DUZ,CH BPFG,CHFOR NFG,CHZIP5 ,CHSTATE,C HCITY,CHAD DR1,CHADDR 2)=CHNAME_ "^"_CHZIP9 ;*** | |
251 | ......... I '$D(^CHM ZHOLD("CML ","FINAL", DUZ,CHBPFG ,CHFORNFG, CHZIP5,CHS TATE,CHCIT Y,CHADDR1, CHADDR2)) D | |
252 | ......... .S ^CHMZHO LD("CML",D UZ,CHBPFG, "CT","UNQC T",CHFORNF G)=$G(^CHM ZHOLD("CML ",DUZ,CHBP FG,"CT","U NQCT",CHFO RNFG))+1 | |
253 | ......... .I CHALLMA IL D ;SKD,DEV 007033 | |
254 | ......... ..I CHPROG ="SB",$G(C HSBIDDT)=1 S CHIDDT= "",CHIDDT= $$CONVDT5( $P($G(^AHC HVA(CHDFN, 100,CHBFN, 10)),"^",3 )) | |
255 | ......... ..I $G(CHD OB) D ;SKD,DEV 002408,5-2 9-09 | |
256 | ......... ...S CHBDO B="",CHBDO B=$$CONVDT 5($P($G(^A HCHVA(CHDF N,100,CHBF N,0)),"^", 3)) | |
257 | ......... ...S $P(^C HMZHOLD("C ML",DUZ,CH BPFG,CHFOR NFG,CHZIP5 ,CHSTATE,C HCITY,CHAD DR1,CHADDR 2,CHADDR3, CHDFN,CHBF N),"^",4)= $G(CHBDOB) | |
258 | ......... ..I $G(CHS EX) D ;SKD,DEV 002408,5-2 9-09 | |
259 | ......... ...S CHBSE X="",CHBSE X=$P($G(^A HCHVA(CHDF N,100,CHBF N,0)),"^", 2) | |
260 | ......... ..I $G(CHO HI) D ;SKD,DEV 002408,5-2 9-09 | |
261 | ......... ... | |
262 | ......... ..S ^CHMZH OLD("CML", "FINAL",DU Z,CHBPFG,C HFORNFG,CH ZIP5,CHSTA TE,CHCITY, CHADDR1,CH ADDR2,CHDF N,CHBFN)=C HNAME_"^"_ CHZIP9_"^" _CHADDR3_" ^"_$G(CHID DT)_"^"_$G (CHBDOB)_" ^"_$G(CHBS EX) | |
263 | ......... .E S ^CHM ZHOLD("CML ","FINAL", DUZ,CHBPFG ,CHFORNFG, CHZIP5,CHS TATE,CHCIT Y,CHADDR1, CHADDR2)=C HNAME_"^"_ CHZIP9 | |
264 | ......... E D | |
265 | ......... .I 'CHALLM AIL D ;SPLIT L ONG LINES FOR MIGRAT ION CJM 20 170718 | |
266 | ......... .. S CHTMP ="Attentio n "_$S(CHP ROG="SB":" Spina Bifi da",CHPROG ="CWVV":"C hildren of Women Vie tnam Veter an",CHPROG ="FMP":"Fo reign Medi cal Progra m",CHPROG= "CMOP":"CM OP",1:"CHA MPVA")_" B eneficiari es" | |
267 | ......... .. S $P(^C HMZHOLD("C ML","FINAL ",DUZ,CHBP FG,CHFORNF G,CHZIP5,C HSTATE,CHC ITY,CHADDR 1,CHADDR2) ,"^",1)=CH TMP | |
268 | ......... .S ^CHMZHO LD("CML",D UZ,CHBPFG, "CT","DUPC T",CHFORNF G)=$G(^CHM ZHOLD("CML ",DUZ,CHBP FG,"CT","D UPCT",CHFO RNFG))+1 | |
269 | ......... .S CHTMP=" Attention "_$S(CHPRO G="SB":"Sp ina Bifida ",CHPROG=" CWVV":"Chi ldren of W omen Vietn am Veteran ",CHPROG=" FMP":"Fore ign Medica l Program" ,CHPROG="C MOP":"CMOP ",1:"CHAMP VA")_" Ben eficiaries " | |
270 | ......... .S ^CHMZHO LD("CML"," DUPADDR",D UZ,CHBPFG, CHFORNFG,C HZIP5,CHST ATE,CHCITY ,CHADDR1,C HADDR2)=CH TMP | |
271 | Q | |
272 | ; | |
273 | BFILEIO ; | |
274 | X ^%ZOSF( "UCI") S U CI=$P(Y,", ",1) | |
275 | ;DEF01655 4 SBB 11/2 5/13 - Co nverting f rom DECNET to FTP. | |
276 | ;S FILELO C="HACFS3" "
|
|
277 | ;I UCI'=" HAC" S FIL ELOC="HACF S3""
|
|
278 | S FILELOC ="HAC_HFS$ :[SCR.TEMP _FILES]" | |
279 | I UCI'="H AC" S FILE LOC="HAC_H FS$:[DSMMA NAG.CHAMPV A]TEST_" | |
280 | I CHALLMA IL=1 S CHF ILEBDOM=FI LELOC_DUZ_ "_CML_BENE _ALL_D.TXT ",CHFILEBF OR=FILELOC _DUZ_"_CML _BENE_ALL_ F.TXT" | |
281 | E S CHFI LEBDOM=FIL ELOC_DUZ_" _CML_BENE_ ONE_D.TXT" ,CHFILEBFO R=FILELOC_ DUZ_"_CML_ BENE_ONE_F .TXT" | |
282 | ;DEF01655 4-11/25/13 -SBB use O PEN^%ZISH to open fi le | |
283 | ;O CHFILE BDOM:"NWS" :5 Q:'$T | |
284 | ;O CHFILE BFOR:"NWS" :5 Q:'$T | |
285 | ;SBB 07/3 0/15 DEF01 6554 | |
286 | X "D $SYS TEM.Proces s.SetZEOF( 1)" | |
287 | I '$$OPEN FIWR^CHTFL IB9(.CHFIL EBDOM,"CHF ILEBDOM") X "D $SYST EM.Process .SetZEOF(0 )" Q | |
288 | I '$$OPEN FIWR^CHTFL IB9(.CHFIL EBFOR,"CHF ILEBFOR") X "D $SYST EM.Process .SetZEOF(0 )" Q | |
289 | D BSUMMAR Y | |
290 | D PRTBENE | |
291 | ;DEF01655 4-11/25/13 -SBB use C LOSE^%ZISH to close file | |
292 | ;C FILE,C HFILEBDOM, CHFILEBFOR | |
293 | D CLOSEF^ CHTFLIB9(F ILE,"FILE" ) | |
294 | D CLOSEF^ CHTFLIB9(C HFILEBDOM, "CHFILEBDO M") | |
295 | D CLOSEF^ CHTFLIB9(C HFILEBFOR, "CHFILEBFO R") | |
296 | D CLOSEF^ CHTFLIB9(F IO,"FIO") | |
297 | ;SBB 07/3 0/15 DEF01 6554 | |
298 | X "D $SYS TEM.Proces s.SetZEOF( 0)" | |
299 | D FTPFILE ^CHTFLIB9( CHFILEBDOM ," DNS . DNS ","/CML"," PUT") | |
300 | H 3 | |
301 | D FTPFILE ^CHTFLIB9( CHFILEBFOR ," DNS . DNS ","/CML"," PUT") | |
302 | H 3 | |
303 | D FTPFILE ^CHTFLIB9( FIO," DNS . DNS ","/FS3BIG ","PUT") | |
304 | Q | |
305 | ; | |
306 | BSUMMARY ; | |
307 | F CHFORNF G="D","F" D | |
308 | .S FILE=$ S(CHFORNFG ="D":CHFIL EBDOM,1:CH FILEBFOR) | |
309 | .D PRINTT OT | |
310 | Q | |
311 | ; | |
312 | PRTBENE ; | |
313 | F CHFORNF G="D","F" D | |
314 | .S FILE=$ S(CHFORNFG ="D":CHFIL EBDOM,1:CH FILEBFOR) | |
315 | .I CHALLM AIL D BALL MAIL | |
316 | .E D ONE MAIL | |
317 | Q | |
318 | ; | |
319 | BALLMAIL ; | |
320 | S CHZIP5= 0 F S CHZ IP5=$O(^CH MZHOLD("CM L","ALLMAI LING",DUZ, CHBPFG,CHF ORNFG,CHZI P5)) Q:'CH ZIP5 D | |
321 | .S CHSTAT E="" F S CHSTATE=$O (^CHMZHOLD ("CML","AL LMAILING", DUZ,CHBPFG ,CHFORNFG, CHZIP5,CHS TATE)) Q:C HSTATE="" D | |
322 | ..S CHCIT Y="" F S CHCITY=$O( ^CHMZHOLD( "CML","ALL MAILING",D UZ,CHBPFG, CHFORNFG,C HZIP5,CHST ATE,CHCITY )) Q:CHCIT Y="" D | |
323 | ...S CHAD DR1="" F S CHADDR1= $O(^CHMZHO LD("CML"," ALLMAILING ",DUZ,CHBP FG,CHFORNF G,CHZIP5,C HSTATE,CHC ITY,CHADDR 1)) Q:CHAD DR1="" D | |
324 | ....S CHA DDR2="" S CHADDR2=$O (^CHMZHOLD ("CML","AL LMAILING", DUZ,CHBPFG ,CHFORNFG, CHZIP5,CHS TATE,CHCIT Y,CHADDR1, CHADDR2)) Q:CHADDR2= "" D | |
325 | .....S CH DFN=0 F S CHDFN=$O( ^CHMZHOLD( "CML","ALL MAILING",D UZ,CHBPFG, CHFORNFG,C HZIP5,CHST ATE,CHCITY ,CHADDR1,C HADDR2,CHD FN)) Q:'CH DFN D | |
326 | ......S C HBFN=0 F S CHBFN=$O (^CHMZHOLD ("CML","AL LMAILING", DUZ,CHBPFG ,CHFORNFG, CHZIP5,CHS TATE,CHCIT Y,CHADDR1, CHADDR2,CH DFN,CHBFN) ) Q:'CHBFN D | |
327 | .......S CHNAME="", CHNAME=$P( ^CHMZHOLD( "CML","ALL MAILING",D UZ,CHBPFG, CHFORNFG,C HZIP5,CHST ATE,CHCITY ,CHADDR1,C HADDR2,CHD FN,CHBFN), "^",1) | |
328 | .......S CHZIP9="", CHZIP9=$P( ^CHMZHOLD( "CML","ALL MAILING",D UZ,CHBPFG, CHFORNFG,C HZIP5,CHST ATE,CHCITY ,CHADDR1,C HADDR2,CHD FN,CHBFN), "^",2) | |
329 | .......I CHFORNFG=" F" S CHZIP 9="" | |
330 | .......S CHADDR3="" ,CHADDR3=$ P(^CHMZHOL D("CML","A LLMAILING" ,DUZ,CHBPF G,CHFORNFG ,CHZIP5,CH STATE,CHCI TY,CHADDR1 ,CHADDR2,C HDFN,CHBFN ),"^",3) | |
331 | .......I CHPROG="SB ",$G(CHSBI DDT)=1 S C HIDDT="",C HIDDT=$$CO NVDT5($P($ G(^AHCHVA( CHDFN,100, CHBFN,10)) ,"^",3)) | |
332 | .......I $G(CHDOB) D ;S KD,DEV0024 08,5-29-09 | |
333 | ........S CHBDOB="" ,CHBDOB=$$ CONVDT5($P ($G(^AHCHV A(CHDFN,10 0,CHBFN,0) ),"^",3)) | |
334 | ........S $P(^CHMZH OLD("CML", DUZ,CHBPFG ,CHFORNFG, CHZIP5,CHS TATE,CHCIT Y,CHADDR1, CHADDR2,CH ADDR3,CHDF N,CHBFN)," ^",4)=$G(C HBDOB) | |
335 | .......I $G(CHSEX) D ;S KD,DEV0024 08,5-29-09 | |
336 | ........S CHBSEX="" ,CHBSEX=$P ($G(^AHCHV A(CHDFN,10 0,CHBFN,0) ),"^",2) | |
337 | .......I $G(CHOHI) S CHOHDSP= $$GETOHI(C HDFN,CHBFN ) | |
338 | .......U FILE W !,C HNAME_T_CH ADDR1_T_$S (CHADDR2=" NOADDR2":" ",1:CHADDR 2)_T_$S(CH ADDR3="NOA DDR3":"",1 :CHADDR3)_ T_CHCITY_T _CHSTATE_T _T_$$CNVZI P9(CHZIP9) _T_$G(CHID DT)_T_$G(C HBDOB)_T_$ G(CHBSEX)_ T_$G(CHOHD SP) ;SK D,DEV00703 3,DEV00240 8 | |
339 | Q | |
340 | ; | |
341 | CNVZIP9(ZI P) ; | |
342 | Q $S($L(Z IP)>5:$E(Z IP,1,5)_"- "_$E(ZIP,6 ,9),1:ZIP) | |
343 | ; | |
344 | CNVTNAME(N 1) ;conver t name to the last M I first fo rmat | |
345 | Q:N1="" | |
346 | S NM=N1 | |
347 | S NML=$P( NM,",",1), NMF=$P($P( NM,",",2), " ",1),NMM =$P($P(NM, ",",2)," " ,2) | |
348 | ;I NMM'=" " S NMM=NM M_"." | |
349 | Q NMF_" " _$S(NMM'=" ":NMM_" ", 1:"")_NML | |
350 | ; | |
351 | ;*******p rovider ma iling list ********** ********** ********** ******** | |
352 | ; | |
353 | PROV(Z3,Z4 ,Z5,Z6,Z7, Z9) ;CML.C SP call wi th Z3(CHAL LMAIL),Z4( CHCTY),Z5( CHST),Z6(D UZ),Z7(CHB ENE),Z9(CH ZFG) argum ents | |
354 | Q:Z7'=0 ;1=bene l ist, 0=pro v list | |
355 | Q:Z6="" ;NO DUZ | |
356 | NEW CHALL MAIL,CHCTY ,CHST,CHBE NE,CHJUL36 5,CHYR,CHZ IPFG | |
357 | S CHALLMA IL=Z3,CHCT Y=$$UPPER^ CHTFLIB(Z4 ),CHST=Z5, DUZ=Z6,CHB ENE=Z7,CHZ IPFG=CHZFG | |
358 | ; | |
359 | VQUE ;S IO P="Q",%ZIS ="Q" W !! D ^%ZIS G: POP QEND | |
360 | S CHFIO=" " | |
361 | S ZTDTH=$ H | |
362 | S ZTRTN=" PROVLIST^C HCMLRPT",Z TDESC="CML Provider Mailing Li st" | |
363 | S ZTIO="" ,ZTSAVE("C HFIO")="", ZTSAVE("CH ALLMAIL")= "",ZTSAVE( "CHCTY")=" ",ZTSAVE(" CHST")="", ZTSAVE("DU Z")="" | |
364 | S ZTSAVE( "CH*")="" | |
365 | D ^%ZTLOA D | |
366 | Q | |
367 | ; | |
368 | PROVLIST ; | |
369 | K ^CHMZHO LD("CML",D UZ),^CHMZH OLD("CML", "FINAL",DU Z),^CHMZHO LD("CML"," DUPADDR",D UZ),^CHMZH OLD("CML", "ALLMAILIN G",DUZ),^C HMZHOLD("C ML","ONEMA ILING",DUZ ) | |
370 | S CHBPFG= "PROV" | |
371 | D PROV1,P ROV2,VFILE IO | |
372 | D KILLVAR | |
373 | Q | |
374 | ; | |
375 | PROV1 ; | |
376 | D INIT | |
377 | Q:'$G(CHJ UL365) Q: '$G(CHYR) | |
378 | S CHPDI=C HYR_$E(CHJ UL365,3,5) _"00000000 " | |
379 | F S CHPD I=$O(^CHMP AY("C",CHP DI)) Q:'CH PDI D | |
380 | .S CHCLI= 0 | |
381 | .F S CHC LI=$O(^CHM PAY("C",CH PDI,CHCLI) ) Q:'CHCLI D | |
382 | ..Q:$P($G (^CHMPAY(C HCLI,0))," ^",2)=10 ;skip if a deleted claim | |
383 | ..S CHVP= $P($G(^CHM PAY(CHCLI, 0)),"^",3) Q:'$G(CHV P) | |
384 | ..Q:$P($G (^CHMVEN(C HVP,1)),"^ ",7)=45 ;skip i f a pharma cy vendor | |
385 | ..Q:$P($G (^CHMVEN(C HVP,0)),"^ ",8)'=0 ;skip i f not in a n active s tatus | |
386 | ..S (CHNA ME,CHADDR1 ,CHADDR2,C HCITY,CHST ATE,CHZIP9 ,CHZIP5,CH FORNFG)="" | |
387 | ..;;tlh 9 /28/09 cha nged all n odes from 2 to 1 to pull remit to addres s not phys ical locat ion addres s | |
388 | ..;;prior to 9/28/0 9 all the nodes were pulling ^ CHMVEN(CHV P,2) now c hanged to ^CHMVEN(CH VP,1) | |
389 | ..;;chang e chname t o pull rem it to name not physi cal name. | |
390 | ..S CHNAM E=$P($G(^C HMVEN(CHVP ,0)),"^",1 ) Q:CHNAME ="" ;rem it name an d address only | |
391 | ..S CHADD R1=$P($G(^ CHMVEN(CHV P,1)),"^", 1) Q:CHADD R1="" | |
392 | ..S CHADD R2=$P($G(^ CHMVEN(CHV P,1)),"^", 2) | |
393 | ..S CHCIT Y=$P($G(^C HMVEN(CHVP ,1)),"^",3 ) Q:CHCITY ="" | |
394 | ..S CHCIT Y=$$UPPER^ CHTFLIB(CH CITY) | |
395 | ..I CHCTY '="" Q:CHC ITY'=CHCTY | |
396 | ..S CHFOR NFG=$S($P( $G(^CHMVEN (CHVP,1)), "^",18):"F ",1:"D") ;Domestic ,Foreign | |
397 | ..S CHQFG =0 | |
398 | ..I CHFOR NFG="D" D Q:$G(CHQF G) | |
399 | ...S CHST I=$P($G(^C HMVEN(CHVP ,1)),"^",4 ) I 'CHSTI S CHQFG=1 Q | |
400 | ...S CHST ATE=$P($G( ^DIC(5,CHS TI,0)),"^" ,2) I CHST ATE="" S C HQFG=1 Q | |
401 | ...I CHST '="" I CHS TATE'=CHST S CHQFG=1 Q | |
402 | ...S CHZI P9=$P($G(^ CHMVEN(CHV P,1)),"^", 5) I CHZIP 9="" S CHQ FG=1 Q | |
403 | ...S CHZI P5=$E(CHZI P9,1,5) I CHZIP5="" S CHQFG=1 Q | |
404 | ..E D Q :$G(CHQFG) | |
405 | ...S CHST I=$P($G(^C HMVEN(CHVP ,1)),"^",1 7) I 'CHST I S CHQFG= 1 Q | |
406 | ...S CHST ATE=$P($G( ^DIC(5,CHS TI,0)),"^" ,1) I CHST ATE="" S C HQFG=1 Q ;Country | |
407 | ...S (CHZ IP5,CHZIP9 )="1" | |
408 | ..I $G(CH ZIPFG) Q:' $D(^CHMZHO LD("CML",D UZ,"CHZIPS ",CHZIP5)) ;SKD,5 -29,09,DEV 002408 | |
409 | ..I CHADD R2="" S CH ADDR2="NOA DDR2" | |
410 | ..I ((CHA DDR1["*")! (CHADDR2[ "*")) U FI O W !,CHNA ME_T_CHADD R1_T_CHADD R2_T_CHCIT Y_T_CHSTAT E_T_T_CHZI P9 Q ;TL H 9/29/09 | |
411 | ..S ^CHMZ HOLD("CML" ,DUZ,CHBPF G,CHFORNFG ,CHZIP5,CH STATE,CHCI TY,CHADDR1 ,CHADDR2,C HVP)=CHNAM E_"^"_CHZI P9 | |
412 | Q | |
413 | ; | |
414 | PROV2 ; | |
415 | F CHFORNF G="D","F" D | |
416 | .S CHZIP5 =0 F S CH ZIP5=$O(^C HMZHOLD("C ML",DUZ,CH BPFG,CHFOR NFG,CHZIP5 )) Q:'CHZI P5 D | |
417 | ..S CHSTA TE="" F S CHSTATE=$ O(^CHMZHOL D("CML",DU Z,CHBPFG,C HFORNFG,CH ZIP5,CHSTA TE)) Q:CHS TATE="" D | |
418 | ...S CHCI TY="" F S CHCITY=$O (^CHMZHOLD ("CML",DUZ ,CHBPFG,CH FORNFG,CHZ IP5,CHSTAT E,CHCITY)) Q:CHCITY= "" D | |
419 | ....S CHA DDR1="" F S CHADDR1 =$O(^CHMZH OLD("CML", DUZ,CHBPFG ,CHFORNFG, CHZIP5,CHS TATE,CHCIT Y,CHADDR1) ) Q:CHADDR 1="" D | |
420 | .....S CH ADDR2="" S CHADDR2=$ O(^CHMZHOL D("CML",DU Z,CHBPFG,C HFORNFG,CH ZIP5,CHSTA TE,CHCITY, CHADDR1,CH ADDR2)) Q: CHADDR2="" D | |
421 | ......S C HVP=0 F S CHVP=$O(^ CHMZHOLD(" CML",DUZ,C HBPFG,CHFO RNFG,CHZIP 5,CHSTATE, CHCITY,CHA DDR1,CHADD R2,CHVP)) Q:'CHVP D | |
422 | .......S CHNAME=$P( ^CHMZHOLD( "CML",DUZ, CHBPFG,CHF ORNFG,CHZI P5,CHSTATE ,CHCITY,CH ADDR1,CHAD DR2,CHVP), "^",1) | |
423 | .......S CHZIP9=$P( ^CHMZHOLD( "CML",DUZ, CHBPFG,CHF ORNFG,CHZI P5,CHSTATE ,CHCITY,CH ADDR1,CHAD DR2,CHVP), "^",2) | |
424 | .......S ^CHMZHOLD( "CML",DUZ, CHBPFG,"CT ","TOTCT", CHFORNFG)= $G(^CHMZHO LD("CML",D UZ,CHBPFG, "CT","TOTC T",CHFORNF G))+1 | |
425 | .......I CHALLMAIL S ^CHMZHOL D("CML","A LLMAILING" ,DUZ,CHBPF G,CHFORNFG ,CHZIP5,CH STATE,CHCI TY,CHADDR1 ,CHADDR2,C HVP)=CHNAM E_"^"_CHZI P9 | |
426 | .......E S ^CHMZHO LD("CML"," ONEMAILING ",DUZ,CHBP FG,CHFORNF G,CHZIP5,C HSTATE,CHC ITY,CHADDR 1,CHADDR2) =CHNAME_"^ "_CHZIP9 | |
427 | .......I '$D(^CHMZH OLD("CML", "FINAL",DU Z,CHBPFG,C HFORNFG,CH ZIP5,CHSTA TE,CHCITY, CHADDR1,CH ADDR2)) D | |
428 | ........S ^CHMZHOLD ("CML",DUZ ,CHBPFG,"C T","UNQCT" ,CHFORNFG) =$G(^CHMZH OLD("CML", DUZ,CHBPFG ,"CT","UNQ CT",CHFORN FG))+1 | |
429 | ........I CHALLMAIL S ^CHMZHO LD("CML"," FINAL",DUZ ,CHBPFG,CH FORNFG,CHZ IP5,CHSTAT E,CHCITY,C HADDR1,CHA DDR2,CHVP) =CHNAME_"^ "_CHZIP9 | |
430 | ........E S ^CHMZH OLD("CML", "FINAL",DU Z,CHBPFG,C HFORNFG,CH ZIP5,CHSTA TE,CHCITY, CHADDR1,CH ADDR2)=CHN AME_"^"_CH ZIP9 | |
431 | .......E D | |
432 | ........I 'CHALLMAI L S $P(^CH MZHOLD("CM L","FINAL" ,DUZ,CHBPF G,CHFORNFG ,CHZIP5,CH STATE,CHCI TY,CHADDR1 ,CHADDR2), "^",1)="At tention CH AMPVA Prov ider" | |
433 | ........S ^CHMZHOLD ("CML",DUZ ,CHBPFG,"C T","DUPCT" ,CHFORNFG) =$G(^CHMZH OLD("CML", DUZ,CHBPFG ,"CT","DUP CT",CHFORN FG))+1 | |
434 | ........S ^CHMZHOLD ("CML","DU PADDR",DUZ ,CHBPFG,CH FORNFG,CHZ IP5,CHSTAT E,CHCITY,C HADDR1,CHA DDR2)="Att ention CHA MPVA Provi der" | |
435 | Q | |
436 | ;open ven dor output files | |
437 | VFILEIO ; | |
438 | X ^%ZOSF( "UCI") S U CI=$P(Y,", ",1) | |
439 | ;DEF01655 4 SBB 11/2 5/13 - Co nverting f rom DECNET to FTP. | |
440 | ;S FILELO C="HACFS3" "
|
|
441 | ;I UCI'=" HAC" S FIL ELOC="HACF S3""
|
|
442 | S FILELOC ="HAC_HFS$ :[SCR.TEMP _FILES]" | |
443 | I UCI'="H AC" S FILE LOC="HAC_H FS$:[DSMMA NAG.CHAMPV A]TEST_" | |
444 | I CHALLMA IL=1 S CHF ILEVDOM=FI LELOC_DUZ_ "_CML_PROV _ALL_D.TXT ",CHFILEVF OR=FILELOC _DUZ_"_CML _PROV_ALL_ F.TXT" | |
445 | E S CHFI LEVDOM=FIL ELOC_DUZ_" _CML_PROV_ ONE_D.TXT" ,CHFILEVFO R=FILELOC_ DUZ_"_CML_ PROV_ONE_F .TXT" | |
446 | ;DEF01655 4-11/25/13 -SBB use O PEN^%ZISH to open fi le | |
447 | ;O CHFILE VDOM:"NWS" :5 Q:'$T | |
448 | ;O CHFILE VFOR:"NWS" :5 Q:'$T | |
449 | ;SBB 07/3 0/15 DEF01 6554 | |
450 | X "D $SYS TEM.Proces s.SetZEOF( 1)" | |
451 | I '$$OPEN FIWR^CHTFL IB9(.CHFIL EVDOM,"CHF ILEVDOM") X "D $SYST EM.Process .SetZEOF(0 )" Q | |
452 | I '$$OPEN FIWR^CHTFL IB9(.CHFIL EVFOR,"CHF ILEVFOR") X "D $SYST EM.Process .SetZEOF(0 )" Q | |
453 | D PSUMMAR Y | |
454 | D PRTPROV | |
455 | ; | |
456 | ;C FILE,C HFILEVDOM, CHFILEVFOR ,FIO ;TLH 9/29/09 | |
457 | D CLOSEF^ CHTFLIB9(F ILE,"FILE" ) | |
458 | D CLOSEF^ CHTFLIB9(C HFILEBDOM, "CHFILEBDO M") | |
459 | D CLOSEF^ CHTFLIB9(C HFILEBFOR, "CHFILEBFO R") | |
460 | D CLOSEF^ CHTFLIB9(F IO,"FIO") | |
461 | ;SBB 07/3 0/15 DEF01 6554 | |
462 | X "D $SYS TEM.Proces s.SetZEOF( 0)" | |
463 | D FTPFILE ^CHTFLIB9( CHFILEBDOM ," DNS . DNS ","/CML"," PUT") | |
464 | H 3 | |
465 | D FTPFILE ^CHTFLIB9( CHFILEBFOR ," DNS . DNS ","/CML"," PUT") | |
466 | H 3 | |
467 | D FTPFILE ^CHTFLIB9( FIO," DNS . DNS ","/FS3BIG ","PUT") | |
468 | Q | |
469 | ; | |
470 | PSUMMARY ; | |
471 | F CHFORNF G="D","F" D | |
472 | .S FILE=$ S(CHFORNFG ="D":CHFIL EVDOM,1:CH FILEVFOR) | |
473 | .D PRINTT OT | |
474 | Q | |
475 | ; | |
476 | PRTPROV ; | |
477 | F CHFORNF G="D","F" D | |
478 | .S FILE=$ S(CHFORNFG ="D":CHFIL EVDOM,1:CH FILEVFOR) | |
479 | .I CHALLM AIL D VALL MAIL | |
480 | .E D ONE MAIL | |
481 | Q | |
482 | ; | |
483 | VALLMAIL ; | |
484 | S CHZIP5= 0 F S CHZ IP5=$O(^CH MZHOLD("CM L","ALLMAI LING",DUZ, CHBPFG,CHF ORNFG,CHZI P5)) Q:'CH ZIP5 D | |
485 | .S CHSTAT E="" F S CHSTATE=$O (^CHMZHOLD ("CML","AL LMAILING", DUZ,CHBPFG ,CHFORNFG, CHZIP5,CHS TATE)) Q:C HSTATE="" D | |
486 | ..S CHCIT Y="" F S CHCITY=$O( ^CHMZHOLD( "CML","ALL MAILING",D UZ,CHBPFG, CHFORNFG,C HZIP5,CHST ATE,CHCITY )) Q:CHCIT Y="" D | |
487 | ...S CHAD DR1="" F S CHADDR1= $O(^CHMZHO LD("CML"," ALLMAILING ",DUZ,CHBP FG,CHFORNF G,CHZIP5,C HSTATE,CHC ITY,CHADDR 1)) Q:CHAD DR1="" D | |
488 | ....S CHA DDR2="" S CHADDR2=$O (^CHMZHOLD ("CML","AL LMAILING", DUZ,CHBPFG ,CHFORNFG, CHZIP5,CHS TATE,CHCIT Y,CHADDR1, CHADDR2)) Q:CHADDR2= "" D | |
489 | .....S CH VP=0 F S CHVP=$O(^C HMZHOLD("C ML","ALLMA ILING",DUZ ,CHBPFG,CH FORNFG,CHZ IP5,CHSTAT E,CHCITY,C HADDR1,CHA DDR2,CHVP) ) Q:'CHVP D | |
490 | ......S C HNAME=$P(^ CHMZHOLD(" CML","ALLM AILING",DU Z,CHBPFG,C HFORNFG,CH ZIP5,CHSTA TE,CHCITY, CHADDR1,CH ADDR2,CHVP ),"^",1) | |
491 | ......S C HZIP9=$P(^ CHMZHOLD(" CML","ALLM AILING",DU Z,CHBPFG,C HFORNFG,CH ZIP5,CHSTA TE,CHCITY, CHADDR1,CH ADDR2,CHVP ),"^",2) | |
492 | ......I C HFORNFG="F " S CHZIP9 ="" | |
493 | ......U F ILE W !,CH NAME_T_CHA DDR1_T_$S( CHADDR2="N OADDR2":"" ,1:CHADDR2 )_T_CHCITY _T_CHSTATE _T_T_$$CNV ZIP9(CHZIP 9) | |
494 | Q | |
495 | ; | |
496 | ONEMAIL ; | |
497 | S CHZIP5= 0 F S CHZ IP5=$O(^CH MZHOLD("CM L","ONEMAI LING",DUZ, CHBPFG,CHF ORNFG,CHZI P5)) Q:'CH ZIP5 D | |
498 | .S CHSTAT E="" F S CHSTATE=$O (^CHMZHOLD ("CML","ON EMAILING", DUZ,CHBPFG ,CHFORNFG, CHZIP5,CHS TATE)) Q:C HSTATE="" D | |
499 | ..S CHCIT Y="" F S CHCITY=$O( ^CHMZHOLD( "CML","ONE MAILING",D UZ,CHBPFG, CHFORNFG,C HZIP5,CHST ATE,CHCITY )) Q:CHCIT Y="" D | |
500 | ...S CHAD DR1="" F S CHADDR1= $O(^CHMZHO LD("CML"," ONEMAILING ",DUZ,CHBP FG,CHFORNF G,CHZIP5,C HSTATE,CHC ITY,CHADDR 1)) Q:CHAD DR1="" D | |
501 | ....S CHA DDR2="" S CHADDR2=$O (^CHMZHOLD ("CML","ON EMAILING", DUZ,CHBPFG ,CHFORNFG, CHZIP5,CHS TATE,CHCIT Y,CHADDR1, CHADDR2)) Q:CHADDR2= "" D | |
502 | .....S CH NAME="",CH NAME=$P(^C HMZHOLD("C ML","ONEMA ILING",DUZ ,CHBPFG,CH FORNFG,CHZ IP5,CHSTAT E,CHCITY,C HADDR1,CHA DDR2),"^", 1) | |
503 | .....I $D (^CHMZHOLD ("CML","DU PADDR",DUZ ,CHBPFG,CH FORNFG,CHZ IP5,CHSTAT E,CHCITY,C HADDR1,CHA DDR2)) S C HNAME=^CHM ZHOLD("CML ","DUPADDR ",DUZ,CHBP FG,CHFORNF G,CHZIP5,C HSTATE,CHC ITY,CHADDR 1,CHADDR2) ;*** | |
504 | .....S CH ZIP9="",CH ZIP9=$P(^C HMZHOLD("C ML","ONEMA ILING",DUZ ,CHBPFG,CH FORNFG,CHZ IP5,CHSTAT E,CHCITY,C HADDR1,CHA DDR2),"^", 2) | |
505 | .....I CH FORNFG="F" S CHZIP9= "" | |
506 | .....U FI LE W !,CHN AME_T_CHAD DR1_T_$S(C HADDR2="NO ADDR2":"", 1:CHADDR2) _T_CHCITY_ T_CHSTATE_ T_T_$$CNVZ IP9(CHZIP9 ) | |
507 | Q | |
508 | ; | |
509 | PRINTTOT ; | |
510 | I '$G(DUZ ) S DUZ=1 | |
511 | U FILE W !! | |
512 | S TITLE=" Health Adm inistratio n Center" S TAB=((80 -$L(TITLE) )/2) | |
513 | D NOW^%DT C S CHDATE =$$FMTE^XL FDT(X,"5D" ) | |
514 | U FILE W "DUZ: ",DU Z,?TAB,TIT LE,?68,CHD ATE,! K TA B,TITLE | |
515 | S RPTTITL E="Communi cations "_ $S(CHBPFG= "BENE":CHP ROG,1:"")_ " "_$S(CHB PFG="BENE" :"Benefici ary",1:"Pr ovider")_" Mailing L ist "_$S(C HFORNFG="D ":"Domesti c",1:"Fore ign") | |
516 | U FILE W !,RPTTITLE | |
517 | U FILE W ! | |
518 | U FILE W !,$S(CHBPF G="BENE":" ",1: " ")_"Total "_$S(CHBPF G="BENE":" Beneficiar y",1:"Prov ider")_" C ount: "_$ G(^CHMZHOL D("CML",DU Z,CHBPFG," CT","TOTCT ",CHFORNFG )) | |
519 | U FILE W !," Numb er of Uniq ue Address es: "_$G( ^CHMZHOLD( "CML",DUZ, CHBPFG,"CT ","UNQCT", CHFORNFG)) | |
520 | U FILE W !,"Number of Duplica te Address es: "_$G( ^CHMZHOLD( "CML",DUZ, CHBPFG,"CT ","DUPCT", CHFORNFG)) ,!! | |
521 | I CHBPFG= "BENE"&(CH ALLMAIL) U FILE W !, "OUTPUT FO RMAT: NAME _TAB_ADDR1 _TAB_ADDR2 _TAB_ADDR3 _TAB_CITY_ TAB_STATE_ TAB_TAB_ZI P9_TAB_SBI DCDDT_TAB_ DOB_TAB_SE X_TAB_OHIT OC" | |
522 | E U FILE W !,"OUTP UT FORMAT: NAME_TAB_ ADDR1_TAB_ ADDR2_TAB_ CITY_TAB_S TATE_TAB_T AB_ZIP9" | |
523 | U FILE W ! | |
524 | Q | |
525 | ; | |
526 | KILLVAR ; | |
527 | K ^CHMZHO LD("CML",D UZ),^CHMZH OLD("CML", "FINAL",DU Z),^CHMZHO LD("CML"," DUPADDR",D UZ) | |
528 | K ^CHMZHO LD("CML"," ALLMAILING ",DUZ),^CH MZHOLD("CM L","ONEMAI LING",DUZ) ,^CHMZHOLD ("CML","ZI P",DUZ) | |
529 | K Z1,Z2,Z 3,Z4,Z5,Z6 ,CHPROG,CH UNIQ,CHALL MAIL,CHCTY ,CHST,CHBE NE,X,X2,X2 ,CHJUL365, CHJUL548,C HYR,CHPDI, CHCLI | |
530 | K CHSTI,C HNAME,CHAD DR1,CHADDR 2,CHADDR3, CHCITY,CHS TATE,CHZIP 9,CHZIP5,C HFORNFG | |
531 | K CHDFN,C HBFN,CHMDF NI,CHMDFNJ ,CHMDFNK,C HCMOPEA | |
532 | K FILE,CH FILEVDOM,C HFILEVFOR, CHFILEBDOM ,CHFILEBFO R,CHQFLAG, CH365,CH54 8,CHCREDT, CHDONE,CHD ONEDT | |
533 | K CHZIPS, CHZIPFG | |
534 | Q | |
535 | ; | |
536 | INIT ; | |
537 | S T=$C(9) ;TAB DEL IMITER | |
538 | I '$D(DT) D NOW^%DT C S DT=X ;TLH 9/29/ 09 DEV0075 20 | |
539 | I DT="" D NOW^%DTC S DT=X ;T LH9/29/09 DEV007520 | |
540 | S CHDATE= $$STRIP^XL FSTR($$FMT E^XLFDT(DT ,"5D"),"/" ) ;TLH 9/ 29/09 DEV0 07520 | |
541 | X ^%ZOSF( "UCI") S U CI=$P(Y,", ",1) | |
542 | S FIO="HA C_HFS$:[SC R.TEMP_FIL ES]VENDORS _WITH_ASTE RICK_IN_RE MITADD_"_C HDATE | |
543 | I UCI'="H AC" S FIO= "HAC_HFS$: [DSMMANAG. CHAMPVA]VE NDORS_WITH _ASTERICK_ IN_REMITAD D_"_CHDATE _"_"_UCI | |
544 | ;S FIO="H ACFS3""
|
|
545 | ;O FIO ; TLH 9/29/0 9 | |
546 | ;C FIO="D " O FIO:"N WS" ;TLH 9/29/09 | |
547 | ;SBB 07/3 0/15 DEF01 6554 | |
548 | X "D $SYS TEM.Proces s.SetZEOF( 1)" | |
549 | I '$$OPEN FIWR^CHTFL IB9(.FIO," FIO") X "D $SYSTEM.P rocess.Set ZEOF(0)" Q | |
550 | K ^CHMZHO LD("CML",D UZ,CHBPFG) ,^CHMZHOLD ("CML","FI NAL",DUZ,C HBPFG) | |
551 | I CHZIPFG =1,$G(^CHM ZHOLD("CML ","ZIP",DU Z))'="" D ;SKD,5- 29,09,DEV0 02408 | |
552 | .S XX="", XX=^CHMZHO LD("CML"," ZIP",DUZ) | |
553 | .F I=1:1: $L(XX,$c(1 3,10)) D | |
554 | ..S (CHZI P1,CHZIP2) ="" | |
555 | ..S CHZIP 1=$P($P(XX ,$c(13,10) ,I),"-",1) ,CHZIP1=$$ TRIM^CHTFL IB($$LTRIM ^CHTFLIB(C HZIP1)),CH ZIP1=$E(CH ZIP1,1,5) | |
556 | ..S CHZIP 2=$P($P(XX ,$c(13,10) ,I),"-",2) ,CHZIP2=$$ TRIM^CHTFL IB($$LTRIM ^CHTFLIB(C HZIP2)) I $L(CHZIP2) S CHZIP2= $E(CHZIP2, 1,5) | |
557 | ..Q:'CHZI P1 | |
558 | ..S ^CHMZ HOLD("CML" ,DUZ,"CHZI PS",CHZIP1 )="" | |
559 | ..F J=CHZ IP1:1:CHZI P2 S ^CHMZ HOLD("CML" ,DUZ,"CHZI PS",J)="" | |
560 | F CHFORNF G="D","F" D | |
561 | .S ^CHMZH OLD("CML", DUZ,CHBPFG ,"CT","TOT CT",CHFORN FG)=0 | |
562 | .S ^CHMZH OLD("CML", DUZ,CHBPFG ,"CT","UNQ CT",CHFORN FG)=0 | |
563 | .S ^CHMZH OLD("CML", DUZ,CHBPFG ,"CT","DUP CT",CHFORN FG)=0 | |
564 | D UCI^%ZO SV S UCI=$ P(Y,",",1) | |
565 | I UCI="DE V" D | |
566 | .D NOW^%D TC S X1=X, X2=-365 D C^%DTC S C HJUL365=$$ FMJUL^CHTF LIB(X),CHY R=$$FMYR^C HTFLIB(X), CH365=X K X | |
567 | .D NOW^%D TC S X1=X, X2=-548 D C^%DTC S C HJUL548=$$ FMJUL^CHTF LIB(X),CHY R=$$FMYR^C HTFLIB(X), CH548=X K X | |
568 | E D | |
569 | .D NOW^%D TC S X1=X, X2=-365 D C^%DTC S C HJUL365=$$ FMJUL^CHTF LIB(X),CHY R=$$FMYR^C HTFLIB(X), CH365=X K X | |
570 | .D NOW^%D TC S X1=X, X2=-548 D C^%DTC S C HJUL548=$$ FMJUL^CHTF LIB(X),CHY R=$$FMYR^C HTFLIB(X), CH548=X K X | |
571 | Q | |
572 | ; | |
573 | QUITCHK(DN ,BN) ;QUI T check no t to add t o the mail ing list | |
574 | S CHQFLAG =0 | |
575 | S CHDN=DN ,CHBN=BN | |
576 | Q:(CHDN=" "!CHBN="") | |
577 | I '$D(^AH CHVA(CHDN, 100,CHBN,0 )) S CHQFL AG=1 Q | |
578 | I CHPROG= "CHAMPVA" I $P($G(^A HCHVA(CHDN ,100,CHBN, 0)),"^",5) '="EA" S C HQFLAG=1 Q | |
579 | I CHPROG= "CMOP" I $ P($G(^AHCH VA(CHDN,10 0,CHBN,0)) ,"^",5)'=" EA" S CHQF LAG=1 Q | |
580 | S CHNM="" ,CHNM=$P($ G(^AHCHVA( CHDN,100,C HBN,0)),"^ ",1) | |
581 | I CHNM="" S CHQFLAG =1 Q | |
582 | I CHNM["( SN)" S CHQ FLAG=1 Q | |
583 | I $P($G(^ AHCHVA(CHD N,100,CHBN ,0)),"^",6 )'="" I $L ($P(^AHCHV A(CHDN,100 ,CHBN,0)," ^",6))=7 S CHQFLAG=1 Q ;SKD , 5-14-09, DEV007250 | |
584 | I $D(^AHA DIC(554804 .07,"B",CH NM)) D | |
585 | .S CHI=0 | |
586 | .F S CHI =$O(^AHADI C(554804.0 7,"B",CHNM ,CHI)) Q:' CHI D | |
587 | ..S (CHDE LDN,CHDELB N)=0 | |
588 | ..S CHDEL DN=$P($G(^ AHADIC(554 804.07,CHI ,0)),"^",3 ) Q:'CHDEL DN | |
589 | ..S CHDEL BN=$P($G(^ AHADIC(554 804.07,CHI ,0)),"^",4 ) Q:'CHDEL BN | |
590 | ..I CHDEL DN=CHDN,CH DELBN=CHBN S CHQFLAG =1 Q | |
591 | Q | |
592 | ; | |
593 | CONVDT5(D) ;convert FileMan da te to mm/d d/yyyy | |
594 | NEW D1,M1 | |
595 | I D="" Q "" | |
596 | S D=$$FMT E^XLFDT(D, "5D") | |
597 | S D1=$P(D ,"/",1) | |
598 | I D1="" Q "" | |
599 | I $L(D1)= 1 S D1="0" _D1 | |
600 | S M1=$P(D ,"/",2) | |
601 | I M1="" Q "" | |
602 | I $L(M1)= 1 S M1="0" _M1 | |
603 | Q D1_"/"_ M1_"/"_$P( D,"/",3) | |
604 | ; | |
605 | OHITOC(IVA L,JVAL) ; | |
606 | Q:IVAL="" | |
607 | Q:JVAL="" | |
608 | I '$G(DT) S X="NOW" D ^%DT S DT=Y | |
609 | S QFLG=0, U="^" | |
610 | S CHOHLOG =1 | |
611 | S K="A" | |
612 | F S K=$O (^CHMDFN(I VAL,100,JV AL,2,K),-1 ) G:'K OHI END G:QFLG OHIEND D | |
613 | .Q:'$D(^C HMDFN(IVAL ,100,JVAL, 2,K,0)) | |
614 | .S REC=^( 0) | |
615 | .S (CHOHI B,CHOHIE,C HOH)="" | |
616 | .S CHOHIB =$P(REC,U, 1),CHOHIE= $P(REC,U,2 ),CHOH=$P( REC,U,3) | |
617 | .I CHOH=" " S CHOH=1 | |
618 | .S:$D(^CH MDIC(74100 2.76,CHOH, 0)) CHOHLO G=$P(^(0), U,4) | |
619 | .I CHOHLO G="" S CHO HLOG=1 | |
620 | .S:CHOHIE ="" CHOHIE =9999999 | |
621 | .I CHOHIB '>DT,DT<CH OHIE S QFL G=1 | |
622 | OHIEND K I VAL,JVAL,Y ,K,QFLG,CH OHIB,CHOHI E,CHOH | |
623 | Q CHOHLOG | |
624 | ; | |
625 | GETOHI(OHI DFN,OHIBFN ) ; | |
626 | S CHOH="" | |
627 | S CHMDFNI =0,CHMDFNI =$O(^CHMDF N("B",OHID FN,CHMDFNI )) | |
628 | I CHMDFNI S CHMDFNJ =0,CHMDFNJ =$O(^CHMDF N(CHMDFNI, 100,"B",OH IBFN,CHMDF NJ)) | |
629 | S CHOHITO C=0 | |
630 | I CHMDFNI ,CHMDFNJ S CHOHITOC= $$OHITOC(C HMDFNI,CHM DFNJ) | |
631 | I CHOHITO C D | |
632 | .S:$D(^CH MDIC(74100 2.78,CHOHI TOC,0)) CH OH=$P(^CHM DIC(741002 .78,CHOHIT OC,0),"^", 1),CHOH=$E (CHOH,5,15 ) | |
633 | Q CHOH | |
634 | Q |
Araxis Merge (but not the data content of this report) is Copyright © 1993-2016 Araxis Ltd (www.araxis.com). All rights reserved.