Produced by Araxis Merge on 11/9/2018 12:34:00 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 | CHMKSMLO.m | Mon Nov 5 16:44:13 2018 UTC |
2 | CPEE_Build9_Sprint27.zip\HAC_CPE_CH | CHMKSMLO.m | Mon Nov 5 17:49:27 2018 UTC |
Description | Between Files 1 and 2 |
|
---|---|---|
Text Blocks | Lines | |
Unchanged | 3 | 614 |
Changed | 2 | 14 |
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 | CHMKSMLO ; HAC/JEH; C HAMPVA CHA MPVA Surve y Mailing Option ;12 /19/08 | |
2 | ;;V1.0 | |
3 | ; | |
4 | D:$$INIT( )=1 QUEA^C HMKSMLO ;QUE TO RU N IN BACKG ROUND | |
5 | ;D:$$INIT ()=1 START ;USE T O RUN HOT | |
6 | Q | |
7 | START ; | |
8 | D CONST | |
9 | D DTRNG ;GET TODA Y'S DATE A ND 90 DAY DATE | |
10 | D GTCLMS ; CREATING L IST IF CLA IMS | |
11 | I $$OFILES() =1 D ;CR EATE LISTI NG ON FS3B IG | |
12 | .D CRFILES | |
13 | E W !,"ERRO R CREATING REPORTS. CONTACT OC IO HELPDES K, 7777" | |
14 | D END | |
15 | Q | |
16 | GTCLMS ;GE TTING LIST OF CLAIMS | |
17 | S PDI=STR PDI F S P DI=$O(^CHM IMAGE("B", PDI)) Q:'P DI!(PDI>TD YPDI) D | |
18 | .S I=0 S I=$O(^CHMP AY("C",PDI ,I)) Q:'I | |
19 | .Q:'$D(^C HMPAY(I,0) ) | |
20 | .I $P(^CH MPAY(I,0), "^",2)=4 D | |
21 | ..S CMPLT DT=$P(^CHM PAY(I,0)," ^",10) | |
22 | ..I (STRD T<=CMPLTDT )&(CMPLTDT <=TODAY) D | |
23 | ...S DFN= $P(^CHMPAY (I,0),"^", 21) | |
24 | ...S BFN= $P(^CHMPAY (I,0),"^", 22) | |
25 | ...Q:$$DB DUPCK(DFN, BFN)=1 ; CHECK FOR DUPLICATE BENES | |
26 | ...S DOB= $P(^AHCHVA (DFN,100,B FN,0),"^", 3) | |
27 | ...I $$AG E^CHTFLIB( DOB,TODAY) >18 D | |
28 | ....I $P( ^CHMPAY(I, 0),"^",7)= 1&(CTRIN<C TRMAX) D ;INPATIEN T | |
29 | .....I $$ EOBSNT(I) D | |
30 | ......S C TRIN=CTRIN +1 | |
31 | ......I $ $CHKBENE(D FN,BFN)=1 D | |
32 | .......I $$OHICHK(D FN,BFN,CMP LTDT)=1 D | |
33 | ........S CTRINO=CT RINO+1 | |
34 | ........S ^CHMZHOLD ("SML",FNA ME,"INP"," OHI",CTRIN O)=I_"^"_D FN_"^"_BFN | |
35 | .......E D | |
36 | ........S CTRINN=CT RINN+1 | |
37 | ........S ^CHMZHOLD ("SML",FNA ME,"INP"," NOHI",CTRI NN)=I_"^"_ DFN_"^"_BF N | |
38 | ....I $P( ^CHMPAY(I, 0),"^",7)= 2&(CTROUT< CTRMAX) D ;OUTPATI ENT | |
39 | .....I $$ EOBSNT(I) D | |
40 | ......S C TROUT=CTRO UT+1 | |
41 | ......I $ $CHKBENE(D FN,BFN)=1 D | |
42 | .......I $$OHICHK(D FN,BFN,CMP LTDT)=1 D | |
43 | ........S CTROUTO=C TROUTO+1 | |
44 | ........S ^CHMZHOLD ("SML",FNA ME,"OUT"," OHI",CTROU TO)=I_"^"_ DFN_"^"_BF N | |
45 | .......E D | |
46 | ........S CTROUTN=C TROUTN+1 | |
47 | ........S ^CHMZHOLD ("SML",FNA ME,"OUT"," NOHI",CTRO UTN)=I_"^" _DFN_"^"_B FN | |
48 | .S CTRTOT =CTRIN+CTR OUT | |
49 | Q | |
50 | INIT() ;IN ITIALIZATI ON | |
51 | N IFLG | |
52 | S IFLG=0 ;0=QUIT/1 =CONTINUE | |
53 | W @IOF | |
54 | S TITLE=" CHAMPVA SU RVEY MAILI NG LIST" | |
55 | W ?(80-$L (TITLE)/2) ,TITLE,! | |
56 | ;SET FILE NAME | |
57 | S DIR(0)= "F^3:50" | |
58 | S DIR("A" )="Enter S urvey Mail ing file n ame" D ^DI R K DIR | |
59 | Q:$D(DUOU T) IFLG | |
60 | Q:Y="^"!( Y="") IFLG | |
61 | S FNAME=Y | |
62 | W ! | |
63 | ;SET TOTA L NUMBER O F BENES TO CAPTURE | |
64 | S DIR(0)= "N" | |
65 | S DIR("B" )=600 | |
66 | S DIR("A" )="Enter t otal numbe r of benef iciaries t o capture" D ^DIR K DIR | |
67 | Q:$D(DUOU T) IFLG | |
68 | Q:Y="^"!( Y="")!(Y=0 ) IFLG | |
69 | S TOTBENE =Y | |
70 | W ! | |
71 | ;SET NUMB ER OF DAYS IN THE PA ST TO GET DATA FROM | |
72 | S DIR(0)= "N" | |
73 | S DIR("B" )=90 | |
74 | S DIR("A" )="Enter t he past nu mber of da ys to gath er claims from" D ^D IR K DIR | |
75 | Q:$D(DUOU T) IFLG | |
76 | Q:Y="^"!( Y="") IFLG | |
77 | S TOTDAYS =Y | |
78 | W ! | |
79 | INT2 ;SET OUTLOOK EM AIL ADDRES S | |
80 | S DIR(0)= "F^3:50" | |
81 | S DIR("A" ,1)="To re ceive repo rt complet ed notific ation." | |
82 | S DIR("A" )="Enter E mail Addre ss PII )" D ^DIR K DIR | |
83 | Q:$D(DUOU T) IFLG | |
84 | Q:Y="^" I FLG | |
85 | G:Y'["@" INT2 | |
86 | S EMAILNM ="" S:Y'=" " EMAILNM= Y | |
87 | W ! | |
88 | D INOTE | |
89 | S IFLG=1 | |
90 | Q IFLG | |
91 | INOTE ;NOT IFICATION | |
92 | W !,"This will take some time to gather and proce ss the dat a." | |
93 | W !,"A Ma ilman mess age will b e sent whe n the SML reports ar e ready.", !! | |
94 | K:$D(^CHM ZHOLD("SML ",FNAME)) ^CHMZHOLD( "SML",FNAM E) | |
95 | Q | |
96 | CONST ;SET TING CONST ANT VARIAB LES | |
97 | S (STRDT, TODAY)=0 | |
98 | S (CTRTOT ,CTRIN,CTR OUT,CTRMAX T)=0 | |
99 | S (CTRINO ,CTRINN,CT ROUTO,CTRO UTN)=0 ; OHI/NO OHI /INPATIENT /OUTPATIEN T COUNTERS | |
100 | S CTRMAX= 15000*TOTD AYS ;MAX NUMBER OF CLAIMS TO COLLECT F OR RANDUM DATA GATHE RING | |
101 | S CTRMXOU T=$FN(TOTB ENE/4,"",0 ) ;MAX N UMBER OF C LAIMS USED FOR EACH INP/OUT/OH I/NOHI FIL E | |
102 | S CTRMAXT =CTRMAX*2 | |
103 | Q | |
104 | DTRNG ;GET TODAYS DA TE AND PAS T 90 DAYS DATE | |
105 | D NOW^%DT C S TODAY= X | |
106 | S X1=X S X2=-TOTDAY S D C^%DTC S STRDT=X ; COMPUTE PA ST 90 DAYS DATE | |
107 | S TDYPDI= "20"_$$FMJ UL^CHTFLIB (TODAY)_"9 9999999" ;PDI DATE FORMAT | |
108 | S STRPDI= "20"_$$FMJ UL^CHTFLIB (STRDT)_"0 0000000" ;PDI DATE FORMAT | |
109 | Q | |
110 | DBDUPCK(DD FN,DBFN) ;CHECK FOR DUPULICAT E BENES | |
111 | ;1=DUPS F OUND/0=NOT FOUND | |
112 | Q:$D(^CHM ZHOLD("SML ",FNAME,"B ENE_DUP",D DFN,DBFN)) 1 | |
113 | S ^CHMZHO LD("SML",F NAME,"BENE _DUP",DDFN ,DBFN)="" | |
114 | Q 0 | |
115 | EOBSNT(CLM PTR) ;CHEC K IF EOB W AS SENT TO AUSTIN AN D COMPLETE | |
116 | N SENT,EO BST,EOBRS, EOBQPTR | |
117 | S SENT=0 ;0=NOT SENT/1=SEN T | |
118 | Q:'$D(CLM PTR) SENT | |
119 | S EOBQPTR =0 S EOBQP TR=$O(^CHM EOBQ("D",C LMPTR,EOBQ PTR)) Q:'E OBQPTR SEN T | |
120 | S EOBST=$ P(^CHMEOBQ (EOBQPTR,0 ),"^",3) ;STATUS 1=COMPLET ED | |
121 | S EOBRS=$ P(^CHMEOBQ (EOBQPTR,0 ),"^",4) ;REASON PAY=PAID | |
122 | S:EOBST=1 &(EOBRS="P AY") SENT= 1 | |
123 | Q SENT | |
124 | CHKPHM(CST RDAT,CDFN, CBFN) ;CHE CKS BENE F OR ONLY PH ARMACY CLA IMS ;Q: $$CHKPHM(S TRDT,DFN,B FN)=1 | |
125 | N PHMFLG | |
126 | S PHMFLG= 1 ;0=NO PHARMACY C LAIMS/1=PH R CLAIMS | |
127 | S CHKI=0 S CHKI=$O( ^CHMDFN("B ",CDFN,CHK I)) Q:'CHK I PHMFLG | |
128 | S CHKJ=0 S CHKJ=$O( ^CHMDFN(CH KI,100,"B" ,CBFN,CHKJ )) Q:'CHKJ PHMFLG | |
129 | S CHKK=0 F S CHKK= $O(^CHMDFN (CHKI,100, CHKJ,100,C HKK)) Q:'C HKK D | |
130 | .S CHKCLM PT=$P(^CHM DFN(CHKI,1 00,CHKJ,10 0,CHKK,0), "^",1) | |
131 | .Q:'$D(^C HMPAY(CHKC LMPT,0)) | |
132 | .S CCLMCD T=$P($P(^C HMPAY(CHKC LMPT,0),"^ ",10),".", 1) ;GET CLAIM COMP LETED DATE | |
133 | .I CSTRDA T<=CCLMCDT D | |
134 | ..I $P(^C HMPAY(CHKC LMPT,0),"^ ",7)'=3 D ;CHECK FOR PHARMA CY CLAIMS | |
135 | ...S PHMF LG=0 | |
136 | Q PHMFLG | |
137 | OHICHK(ODF N,OBFN,OCM PLTDT) ;CH ECK FOR OH I | |
138 | N CHKVAL, HASOHI,OHI BEG,OHIEND ,DFNI,BFNJ | |
139 | S OCMPLTD T=$P(OCMPL TDT,".",1) | |
140 | S HASOHI= 0 ;1=H AS OHI/0=N O OHI | |
141 | S DFNI=0 S DFNI=$O( ^CHMDFN("B ",ODFN,DFN I)) Q:'DFN I HASOHI | |
142 | S BFNJ=0 S BFNJ=$O( ^CHMDFN(DF NI,100,"B" ,OBFN,BFNJ )) Q:'BFNJ HASOHI | |
143 | S CHKVAL= 99 S CHKVA L=$O(^CHMD FN(DFNI,10 0,BFNJ,2,C HKVAL),-1) | |
144 | Q:'$D(^CH MDFN(DFNI, 100,BFNJ,2 ,CHKVAL,0) ) HASOHI | |
145 | S OHIBEG= $P(^CHMDFN (DFNI,100, BFNJ,2,CHK VAL,0),"^" ,1) | |
146 | S OHIEND= $P(^CHMDFN (DFNI,100, BFNJ,2,CHK VAL,0),"^" ,2) | |
147 | S:OHIEND= "" OHIEND= 9999999 | |
148 | S OHICODE =$P(^CHMDF N(DFNI,100 ,BFNJ,2,CH KVAL,0),"^ ",3) | |
149 | I OHIBEG< =OCMPLTDT& (OCMPLTDT< =OHIEND) S HASOHI=1 | |
150 | I OHICODE =1 S HASOH I=0 | |
151 | I OHICODE =8 S HASOH I=0 | |
152 | Q HASOHI | |
153 | CHKBENE(CD FN,CBFN) ; CHECK OF B ENE ADDRES S AND DOD FUNCTION | |
154 | N CBFLG,D OD,ADR | |
155 | S CBFLG=0 ;0=BAD ADDRESS AN D/OR DOD, 1=GOOD ADD RESS AND N O DOD | |
156 | Q:'$D(^AH CHVA(DFN,1 00,BFN,0)) CBFLG | |
157 | S DOD=$P( ^AHCHVA(DF N,100,BFN, 0),"^",6) ;DATE O F DEATH | |
158 | Q:DOD'="" CBFLG | |
159 | Q:'$D(^AH CHVA(DFN,1 00,BFN,1)) CBFLG ;CHECK FOR CORRECT A DDRESS | |
160 | S ADR=$P( ^AHCHVA(DF N,100,BFN, 1),"^",10) | |
161 | Q:ADR'=1 CBFLG ;1= CORRECT AD DRESS | |
162 | S CBFLG=1 | |
163 | Q CBFLG | |
164 | MMMSG ;GEN ERATE MM M ESSAGE | |
165 | S CNT=1,^ TMP($J,"SM L",CNT)="" ,CNT=CNT+1 | |
166 | S ^TMP($J ,"SML",CNT )="YOUR SM L INFORMAT ION CAN BE FOUND HER E:",CNT=CN T+1 | |
167 | S ^TMP($J ,"SML",CNT )="",CNT=C NT+1 | |
168 | S ^TMP($J ,"SML",CNT )=" DIREC TORY: FS3B IG\COMMO_R PTS\SML",C NT=CNT+1 | |
169 | S ^TMP($J ,"SML",CNT )="",CNT=C NT+1 | |
170 | S ^TMP($J ,"SML",CNT )=" REPOR T NAMES:", CNT=CNT+1 | |
171 | S ^TMP($J ,"SML",CNT )="",CNT=C NT+1 | |
172 | S ^TMP($J ,"SML",CNT )=" "_F NAME_"_OHI _INFO.TXT (OHI rep ort)",CNT= CNT+1 | |
173 | S ^TMP($J ,"SML",CNT )=" "_F NAME_"_OHI _MLNG.TXT (OHI lab el list)", CNT=CNT+1 | |
174 | S ^TMP($J ,"SML",CNT )=" "_F NAME_"_NOH I_INFO.TXT (NO OHI report)",C NT=CNT+1 | |
175 | S ^TMP($J ,"SML",CNT )=" "_F NAME_"_NOH I_MLNG.TXT (NO OHI label list )",CNT=CNT +1 | |
176 | S ^TMP($J ,"SML",CNT )="" | |
177 | S XMTEXT= "^TMP($J," "SML""," | |
178 | S XMDUZ=. 5 | |
179 | S XMY(EMA ILNM)="" | |
180 | S XMY(DUZ )="" | |
181 | S XMSUB=" SURVEY MAI LING LIST HAS COMPLE TED" D ^XM D | |
182 | Q | |
183 | OFILES() ; OUTPUT IS GENERATED HERE | |
184 | N OFLG | |
185 | S $ZE="", $ZT="OFEND ^CHMKSMLO" | |
186 | S OFLG=0 ;0=FILE CLOSED/1=F ILE OPENED | |
187 | S FIOOI=" HACFS3"" DNS decnet HAC dec741!"": :D:[FS3BIG .COMMO_RPT S.SML]"_FN AME_"_OHI_ INFO.TXT" ; NAME OF OPT INFO F ILE | |
188 | S FIOOM=" HACFS3"" DNS decnet HAC dec741!"": :D:[FS3BIG .COMMO_RPT S.SML]"_FN AME_"_OHI_ MLNG.TXT" ; NAME OF OPT MAILIN G LIST FIL E | |
189 | S FIOII=" HACFS3"" DNS decnet HAC dec741!"": :D:[FS3BIG .COMMO_RPT S.SML]"_FN AME_"_NOHI _INFO.TXT" ; NAME OF INP INFO F ILE | |
190 | S FIOIM=" HACFS3"" DNS decnet HAC dec741!"": :D:[FS3BIG .COMMO_RPT S.SML]"_FN AME_"_NOHI _MLNG.TXT" ; NAME OF INP MAILIN G LIST FIL E | |
191 | S FITLI=" HACFS3"" DNS decnet HAC dec741!"": :D:[FS3BIG .COMMO_RPT S.SML]"_FN AME_"_TOTA L_INFO.TXT " ; NAME OF TOTAL INFO FILE | |
192 | S FITLM=" HACFS3"" DNS decnet HAC dec741!"": :D:[FS3BIG .COMMO_RPT S.SML]"_FN AME_"_TOTA L_MLNG.TXT " ; NAME OF TOTAL MAIL ING LIST F ILE | |
193 | O FIOOI:" WRNS":5 Q: $T=0 OFLG | |
194 | O FIOOM:" WRNS":5 Q: $T=0 OFLG | |
195 | O FIOII:" WRNS":5 Q: $T=0 OFLG | |
196 | O FIOIM:" WRNS":5 Q: $T=0 OFLG | |
197 | O FITLI:" WRNS":5 Q: $T=0 OFLG | |
198 | O FITLM:" WRNS":5 Q: $T=0 OFLG | |
199 | S OFLG=1 | |
200 | Q OFLG | |
201 | OFEND ; | |
202 | Q | |
203 | CRFILES ;P OPULATING FILES WITH DATA | |
204 | N REC | |
205 | S CFCTR=0 | |
206 | S RECNUM= 0 | |
207 | S CTRLP=0 | |
208 | F FLTYPE= 1:1:4 D | |
209 | .;S (CTRI NO,CTRINN, CTROUTO,CT ROUTN)=150 | |
210 | .S CTRRND =$S(FLTYPE =1:CTRINO, FLTYPE=2:C TRINN,FLTY PE=3:CTROU TO,FLTYPE= 4:CTROUTN) | |
211 | .D RNDGEN (CTRRND) | |
212 | .S CTRMAX =CTRMXOUT+ CTRLP | |
213 | .I CTRMAX >CTRRND S CTRMAX=CTR RND | |
214 | .S CTRLP= 0 ;LOOPI NG COUNTER | |
215 | .S CTR=0 F S CTR=$ O(^CHMZHOL D("SML",FN AME,"RANDU M",CTR)) Q :'CTR!(CTR LP>=CTRMAX ) D | |
216 | ..S RECNU M=^CHMZHOL D("SML",FN AME,"RANDU M",CTR) | |
217 | ..I FLTYP E=1 S DATA =^CHMZHOLD ("SML",FNA ME,"INP"," OHI",RECNU M) | |
218 | ..I FLTYP E=2 S DATA =^CHMZHOLD ("SML",FNA ME,"INP"," NOHI",RECN UM) | |
219 | ..I FLTYP E=3 S DATA =^CHMZHOLD ("SML",FNA ME,"OUT"," OHI",RECNU M) | |
220 | ..I FLTYP E=4 S DATA =^CHMZHOLD ("SML",FNA ME,"OUT"," NOHI",RECN UM) | |
221 | ..S DFN=$ P(DATA,"^" ,2) | |
222 | ..S BFN=$ P(DATA,"^" ,3) | |
223 | ..Q:$$CHK PHM(STRDT, DFN,BFN)=1 ;CHECK FOR PHARMA CY CLAIMS | |
224 | ..Q:$$GTD ATA()=0 ;GETTING B ENE INFO | |
225 | ..I CTRLP <CTRMAX D | |
226 | ...S CTRL P=CTRLP+1 | |
227 | ...S T=$C (9) ;TAB | |
228 | ...S TMPR EC=NAME_T_ ADRLN1_T_A DRLN2_T_AD RCTY_T_ADR ST_T_ADRZI P_T_TELENO _T_AGE_T_G ENDR_T_OHI CODE_T_SSN ;BENE D ATA | |
229 | ...S TMPR ECM=NAME_T _ADRLN1_T_ ADRLN2_T_A DRCTY_T_AD RST_T_ADRZ IP | |
230 | ...I FLTY PE=1!(FLTY PE=3) D ;OHI DAT A | |
231 | ....U FIO OI W TMPRE C,! | |
232 | ....U FIO OM W TMPRE CM,! | |
233 | ...I FLTY PE=2!(FLTY PE=4) D ;NO OHI DATA | |
234 | ....U FIO II W TMPRE C,! | |
235 | ....U FIO IM W TMPRE CM,! | |
236 | ..U FITLI W TMPREC, ! | |
237 | ..U FITLM W TMPRECM ,! | |
238 | .I CTRLP< CTRMAX S C TRLP=CTRLP -CTRMAX | |
239 | .E S CTR LP=0 | |
240 | Q | |
241 | RNDGEN(MAX ) ;RANDUM GENERATOR | |
242 | F N=1:1:M AX S ^GLOV AR("SML",F NAME,N)="" | |
243 | F I=MAX:- 1:1 D | |
244 | .S R=$R(I )+1 | |
245 | .S N="" F K=1:1:R S N=$O(^GLO VAR("SML", FNAME,N)) | |
246 | .K ^GLOVA R("SML",FN AME,N) | |
247 | .S ^CHMZH OLD("SML", FNAME,"RAN DUM",(MAX- I+1))=N | |
248 | Q | |
249 | GTDATA() ; GETTING BE NE DATA | |
250 | N GTFLG | |
251 | S GTFLG=1 ;0=BAD DATA/1=GOO D DATA | |
252 | S NAMLAB= ^AHCHVA(DF N,100,BFN, 0) ;NAME INFORMATI ON | |
253 | S NAME=$P (NAMLAB,"^ ",1) | |
254 | ;GET DATE OF BIRTH | |
255 | S DOB=$P( NAMLAB,"^" ,3) | |
256 | S BRTHDAY =DOB | |
257 | S AGE=$$A GE^CHTFLIB (BRTHDAY,T ODAY) | |
258 | ;GET GEND ER | |
259 | S GENDR=$ P(NAMLAB," ^",2) | |
260 | ;FORMAT S OC SEC NUM BER | |
261 | S SSN=$P( NAMLAB,U,9 ) | |
262 | S SSN3=$E (SSN,1,3) | |
263 | S SSN2=$E (SSN,4,5) | |
264 | S SSN4=$E (SSN,6,9) | |
265 | S SSN=SSN 3_"-"_SSN2 _"-"_SSN4 | |
266 | ;ADDRESS INFORMATIO N | |
267 | S ADDRLAB =^AHCHVA(D FN,100,BFN ,1) | |
268 | S ADRLN1= $P(ADDRLAB ,"^",1) | |
269 | S ADRLN2= $P(ADDRLAB ,"^",2) | |
270 | S ADRCTY= $P(ADDRLAB ,"^",3) | |
271 | S ADRST=$ P(ADDRLAB, "^",4) | |
272 | I ADRST'= "" I $D(^D IC(5,ADRST ,0)) S ADR ST=$P(^DIC (5,ADRST,0 ),U,2) | |
273 | S (ADRZIP ,ADRZIPZ,A DRZIP1,ADR ZIP2)="" | |
274 | S ADRZIP= $P(ADDRLAB ,"^",5) | |
275 | I $L(ADRZ IP)>5 S AD RZIP1=$E(A DRZIP,1,5) S ADRZIP2 =$E(ADRZIP ,6,9) S AD RZIP=ADRZI P1_"-"_ADR ZIP2 | |
276 | ;SAVE TEL EPHONE NUM BER | |
277 | S PHONE=$ P(ADDRLAB, "^",6) | |
278 | I $E(PHON E,4,4)="-" S TELENO= PHONE | |
279 | I $E(PHON E,1,1)="(" S TELENO= PHONE | |
280 | I $E(PHON E,4,4)=" " S TELENO= PHONE | |
281 | I PHONE'= "" I $L(PH ONE)<9 I $ E(PHONE,4, 4)'=("")!( "-") S PPH ONE=$E(PHO NE,1,3)_"- "_$E(PHONE ,4,6)_"-"_ $E(PHONE,7 ,10) | |
282 | I PHONE'= "" I $E(PH ONE,1,1)'= "(" S PPHO NE=$E(PHON E,1,3)_"-" _$E(PHONE, 4,6)_"-"_$ E(PHONE,7, 10) | |
283 | I PHONE=" " S PPHONE ="",GTFLG= 0 | |
284 | S TELENO= PPHONE | |
285 | ;GET OHI CODE | |
286 | S OHICODE ="" | |
287 | S DFNI=0 S DFNI=$O( ^CHMDFN("B ",DFN,DFNI )) I 'DFNI S GTFLG=0 Q GTFLG | |
288 | S BFNJ=0 S BFNJ=$O( ^CHMDFN(DF NI,100,"B" ,BFN,BFNJ) ) I 'BFNJ S GTFLG=0 Q GTFLG | |
289 | S CHKVAL= 99 S CHKVA L=$O(^CHMD FN(DFNI,10 0,BFNJ,2,C HKVAL),-1) | |
290 | I '$D(^CH MDFN(DFNI, 100,BFNJ,2 ,CHKVAL,0) ) S GTFLG= 0 Q GTFLG | |
291 | S OHICODE =$P(^CHMDF N(DFNI,100 ,BFNJ,2,CH KVAL,0),"^ ",3) | |
292 | Q GTFLG | |
293 | QUEA ;QUE THIS ROUTI NE MANUALL Y. | |
294 | I '$D(DUZ ) S DUZ=1, DUZ(0)="@" | |
295 | D NOW^%DT C S DT=X | |
296 | S DTIME=3 00 | |
297 | S U="^" | |
298 | S CHFIO=" " | |
299 | S ZTRTN=" START^CHMK SMLO",ZTDE SC="PROCES S SML FILE S" | |
300 | S ZTIO="" ,ZTSAVE("F NAME")="", ZTSAVE("TO TDAYS")="" ,ZTSAVE("T OTBENE")=" ",ZTSAVE(" EMAILNM")= "" | |
301 | D ^%ZTLOA D | |
302 | Q | |
303 | END ;END O F ROUTINE | |
304 | C FIOOI,F IOOM,FIOII ,FIOIM,FIT LI,FITLM | |
305 | D MMMSG ; SENDING MM MESSAGE T HAT REPORT IS READY | |
306 | K ^CHMZHO LD("SML",F NAME) | |
307 | K FIOOI,FIOO M,FIOII,FI OIM,FNAME, CNT,TOTDAY S,TOTBENE, CHFIO,DTIM E,TODAY | |
308 | K OHICODE,DF NI,BFNJ,CH KVAL,TELEN O,PPHONE,P HONE,ADRZI P,ADRZIP1, ADRZIP2,AD RST,ADRCTY ,ADRLN1,AD RLN2,ADDRL AB | |
309 | K NAMLAB,NAM E,DOB,BRTH DAY,AGE,GE NDR,SSN,SS N2,SSN3,SS N4,EMAILNM | |
310 | K CFCTR,RECN UM,CTRRND, FLTYPE,TMP REC,TMPREC M,CLMPTR,X 1,X2,STRDT | |
311 | W !!,"*** END OF RO UTINE ***" | |
312 | Q | |
313 | ||
314 |
Araxis Merge (but not the data content of this report) is Copyright © 1993-2016 Araxis Ltd (www.araxis.com). All rights reserved.